Mercurial > hg > jgplsrc
view jtype.h @ 0:e0bbaa717f41 draft default tip
lol J
author | Jordi Gutiérrez Hermoso <jordigh@octave.org> |
---|---|
date | Mon, 25 Nov 2013 11:56:30 -0500 |
parents | |
children |
line wrap: on
line source
/* Copyright 1990-2011, Jsoftware Inc. All rights reserved. */ /* License in license.txt. */ /* */ /* Type Definitions */ #define U unsigned #if (SYS & SYS_UNIX) #define _stdcall #endif #if SY_64 typedef long long A1; typedef unsigned long long BT; typedef long long I; typedef long long SB; typedef unsigned long long UI; #else typedef long A1; typedef unsigned long BT; typedef long I; typedef long SB; typedef unsigned long UI; #endif typedef char B; typedef char C; typedef char* Ptr; typedef short S; typedef short C2; typedef unsigned char UC; typedef unsigned short US; typedef unsigned short U2; typedef unsigned int UINT; typedef int I4; typedef double D; typedef FILE* F; typedef long double LD; typedef struct {I k,flag,m,t,c,n,r,s[1];}* A; typedef struct {A a,t;}TA; typedef A (*AF)(); typedef UI (*UF)(); typedef void (*VF)(); typedef int (*CMP)(); /* comparison function in sort */ typedef A X; typedef struct {X n,d;} Q; typedef struct {D re,im;} Z; typedef union {D d;UINT i[2];} DI; #if (SYS & SYS_PC+SYS_MACINTOSH) /* for use by the session manager */ typedef S SI; #else typedef I SI; #endif /* Fields of type A */ #define AK(x) ((x)->k) /* offset of ravel wrt x */ #define AFLAG(x) ((x)->flag) /* flag */ #define AM(x) ((x)->m) /* Max # bytes in ravel */ #define AT(x) ((x)->t) /* Type; one of the #define below */ #define AC(x) ((x)->c) /* Reference count. */ #define AN(x) ((x)->n) /* # elements in ravel */ #define AR(x) ((x)->r) /* Rank */ #define AH 7L /* # non-shape header words in A */ #define AS(x) ((x)->s) /* Pointer to shape */ #if SY_64 #define AKX(x) (SZI*(AH+AR(x))) #define WP(t,n,r) (AH+ r +(1&&t&LAST0)+((t&NAME?sizeof(NM):0)+(n)*bp(t)+SZI-1)/SZI) #else #define AKX(x) (SZI*(AH+AR(x)+!(1&AR(x)))) #define WP(t,n,r) (AH+(r+!(1&r))+(1&&t&LAST0)+((t&NAME?sizeof(NM):0)+(n)*bp(t)+SZI-1)/SZI) #endif /* make sure array values are double-word aligned */ #define AV(x) ( (I*)((C*)(x)+AK(x))) /* pointer to ravel */ #define BAV(x) ( (C*)(x)+AK(x) ) /* boolean */ #define CAV(x) ( (C*)(x)+AK(x) ) /* character */ #define USAV(x) ((US*)((C*)(x)+AK(x))) /* wchar */ #define UAV(x) ( (UC*)(x)+AK(x) ) /* unsigned character */ #define NAV(x) ((NM*)((C*)(x)+AK(x))) /* name */ #define IAV(x) AV(x) /* integer */ #define DAV(x) ( (D*)((C*)(x)+AK(x))) /* double */ #define ZAV(x) ( (Z*)((C*)(x)+AK(x))) /* complex */ #define XAV(x) ( (X*)((C*)(x)+AK(x))) /* extended */ #define QAV(x) ( (Q*)((C*)(x)+AK(x))) /* rational */ #define AAV(x) ( (A*)((C*)(x)+AK(x))) /* boxed */ #define A1AV(x) ((A1*)((C*)(x)+AK(x))) /* boxed relative address */ #define VAV(x) ( (V*)((C*)(x)+AK(x))) /* verb, adverb, conj */ #define PAV(x) ( (P*)((C*)(x)+AK(x))) /* sparse */ #define SBAV(x) ((SB*)((C*)(x)+AK(x))) /* symbol */ /* Types for AT(x) field of type A */ /* Note: BOOL name conflict with ???; SCHAR name conflict with sqltypes.h */ #define B01 (I)1L /* B boolean */ #define LIT (I)2L /* C literal (character) */ #define INT (I)4L /* I integer */ #define FL (I)8L /* D double (IEEE floating point) */ #define CMPX (I)16L /* Z complex */ #define BOX (I)32L /* A boxed */ #define XNUM (I)64L /* X extended precision integer */ #define RAT (I)128L /* Q rational number */ #define BIT (I)256L /* BT bit boolean */ #define SB01 (I)1024L /* P sparse boolean */ #define SLIT (I)2048L /* P sparse literal (character) */ #define SINT (I)4096L /* P sparse integer */ #define SFL (I)8192L /* P sparse floating point */ #define SCMPX (I)16384L /* P sparse complex */ #define SBOX (I)32768L /* P sparse boxed */ #define SBT (I)65536L /* SB symbol */ #define C2T (I)131072L /* C2 unicode (2-byte characters) */ #define VERB (I)262144L /* V verb */ #define ADV (I)524288L /* V adverb */ #define CONJ (I)1048576L /* V conjunction */ #define ASGN (I)2097152L /* I assignment */ #define MARK (I)4194304L /* I end-of-stack marker */ #define SYMB (I)8388608L /* I locale (symbol table) */ #define CONW (I)16777216L /* CW control word */ #define NAME (I)33554432L /* NM name */ #define LPAR (I)67108864L /* I left parenthesis */ #define RPAR (I)134217728L /* I right parenthesis */ #define XD (I)268435456L /* DX extended floating point */ #define XZ (I)536870912L /* ZX extended complex */ #define ANY -1L #define SPARSE (SB01+SINT+SFL+SCMPX+SLIT+SBOX) #define DENSE (NOUN&~SPARSE) #define NUMERIC (B01+BIT+INT+FL+CMPX+XNUM+RAT+XD+XZ+SB01+SINT+SFL+SCMPX) #define DIRECT (LIT+C2T+B01+BIT+INT+FL+CMPX+SBT) #define JCHAR (LIT+C2T+SLIT) #define NOUN (NUMERIC+JCHAR+BOX+SBOX+SBT) #define FUNC (VERB+ADV+CONJ) #define RHS (NOUN+FUNC) #define IS1BYTE (B01+LIT) #define LAST0 (B01+LIT+C2T+NAME) #define HOMO(s,t) ((s)==(t) || (s)&NUMERIC&&(t)&NUMERIC || (s)&JCHAR&&(t)&JCHAR) #define STYPE(t) ((t)& B01?SB01:(t)& INT?SINT:(t)& FL?SFL:(t)& CMPX?SCMPX:(t)&LIT?SLIT:(t)& BOX?SBOX:0L) #define DTYPE(t) ((t)&SB01? B01:(t)&SINT? INT:(t)&SFL? FL:(t)&SCMPX? CMPX:(t)&SLIT?LIT:(t)&SBOX? BOX:0L) /* Values for AFLAG(x) field of type A */ #define AFRO (I)1 /* read only; can't change data */ #define AFNJA (I)2 /* non-J alloc; i.e. mem mapped */ #define AFSMM (I)4 /* SMM managed */ #define AFREL (I)8 /* uses relative addressing */ #define AABS(rel,k) ((I)(rel)+(I)(k)) /* absolute address from relative address */ #define AREL(abs,k) ((I)(abs)-(I)(k)) /* relative address from absolute address */ #define ARELATIVE(w) (AT(w)&BOX&&AFLAG(w)&AFNJA+AFSMM+AFREL) #define AADR(w,z) ((w)?(A)((I)(w)+(I)(z)):(z)) #define AVR(i) AADR(ad,av[i]) #define IVR(i) AADR(id,iv[i]) #define WVR(i) AADR(wd,wv[i]) #define YVR(i) AADR(yd,yv[i]) #define AAV0(w) (ARELATIVE(w)?(A)(*AV(w)+(I)(w)):*AAV(w)) #define RELOCATE(w,z) (ARELATIVE(w)?relocate((I)(w)-(I)(z),(z)):(z)) typedef struct {I i;US n,go,source;C type;} CW; /* control word (always has corresponding token string) */ /* type - as specified in w.h */ /* go - line number to go to */ /* source - source line number */ /* i - beginning index of token string */ /* n - length of token string */ #define DCPARSE 1 /* sentence for parser */ #define DCSCRIPT 2 /* script -- line() */ #define DCCALL 3 /* verb/adv/conj call -- dbunquote() */ #define DCJUNK 4 /* stack entry is obsolete */ typedef struct DS{ /* 1 2 3 */ struct DS*dclnk; /* x x x link to next stack entry */ A dca; /* x fn/op name */ A dcf; /* x fn/op */ A dcx; /* x left argument */ A dcy; /* x x x tokens; text ; right argument */ A dcloc; /* x local symb table (0 if not explicit) */ A dcc; /* x control matrix (0 if not explicit) */ I dci; /* x x x index ; next index ; ptr to line # */ I dcj; /* x x ; prev index ; error # */ I dcn; /* x x ; line # ; ptr to symb entry */ I dcm; /* x x ; script index; # of non-locale part of name */ I dcstop; /* x the last stop in this function */ C dctype; /* x x x type of entry (see #define DC*) */ B dcsusp; /* x x 1 iff begins a debug suspension */ C dcss; /* x single step code */ } DST; typedef DST* DC; typedef struct {I e,p;X x;} DX; /* for the p field in DX */ #define DXIPREC ((I)-1) /* infinite precision */ #define DXINF ((I)-2) /* _ infinity */ #define DXMINF ((I)-3) /* __ negative infinity */ /* extended floating point */ /* e - exponent */ /* p - precision & other codes */ /* +ve # of significant digits */ /* _1 infinite precision (with trailing 0s) */ /* _2 infinity _ */ /* _3 negative infinity __ */ /* x - mantissa */ /* least significant digit first */ /* decimal point after last digit */ typedef struct {A name,val;I flag,sn,next,prev;} L; /* symbol pool entry LINFO entry */ /* name - name on LHS of assignment or locale name */ /* val - value or locale search path */ /* flag - various flags */ /* sn - script index */ /* next - index of successor in hash list or 0 */ /* prev - index of predecessor in hash list or address of hash entry */ #define LCH (I)1 /* changed since last exec of 4!:5 */ #define LHEAD (I)2 /* head pointer (no predecessor) */ #define LINFO (I)4 /* locale info */ typedef struct{A og,g;I ptr,flag;B sw0;} LS; /* og: old value of global */ /* g: global at this level */ /* ptr: index in pv/nv if numbered locale */ /* pointer to stloc entry if named locale */ /* flag: 1 if named locale marked for destruction */ /* 2 if numbered locale marked for destruction */ /* sw0: old value of stswitched */ typedef struct{UI hash;I sn;L*e;UC m;C flag,s[1];} NM; /* hash: hash for non-locale part of name */ /* m: length of non-locale part of name */ /* sn: symbol table number on last reference */ /* e: symbol pool entry on last reference */ /* s: points to string part of full name (1 to ?? characters) */ #define NMLOC 1 /* direct locale abc_lm_ */ #define NMILOC 2 /* indirect locale abc__de__fgh ... */ #define NMDOT 4 /* one of the names m. n. u. v. x. y. */ typedef struct {I a,e,i,x;} P; /* value fields of sparse array types */ /* fields are offsets from beginning of the P struct */ /* a: sparse axes */ /* e: sparse element */ /* i: index matrix, columns correspond to a */ /* x: value cells corresponding to rows of i */ #define SPA(p,a) ((A)((p)->a+(C*)(p))) #define SPB(p,a,x) {(p)->a=(C*)(x)-(C*)(p); RZ(p->a+(C*)(p));} /* performance monitoring stuff */ typedef struct{ A name; /* verb/adverb/conjunction name */ A loc; /* locale name */ I lc; /* line number (-1 for entry; -2 for exit) */ I s; /* space */ I t[2]; /* time */ C val; /* valence: 1 or 2 */ C unused[3]; /* padding */ } PM; #define PMCOL 6 /* # of fields in PM */ typedef struct{ I n; /* maximum number of records */ I i; /* index of next record to be written */ I s; /* initial bytesmax value */ B rec; /* what to record (0 entry & exit; 1 all) */ B trunc; /* what to do on overflow (0 wrap; 1 truncate) */ B wrapped; /* 1 iff wrapping has happened */ C unused[1]; /* padding */ } PM0; /* each unique symbol has a row in jt->sbu */ /* a row is interpreted per SBU */ /* for best results make sizeof(SBU) a multiple of sizeof(I) */ typedef struct{ I i; /* index into sbs */ I n; /* length */ UI h; /* hash value */ I color; /* binary tree: color */ I parent; /* binary tree: index of parent */ I left; /* binary tree: index of left child */ I right; /* binary tree: index of right child */ I order; /* order number */ I down; /* predecessor in ordering */ I up; /* successor in ordering */ I flag; /* bit flags */ } SBU; #define SBC2 1 /* 1 iff 2-byte character */ typedef struct {AF f1,f2;A f,g,h;I flag,mr,lr,rr,fdep;C id;} V; #define ID(f) (f&&FUNC&AT(f)?VAV(f)->id:C0) /* type V flag values */ /* < 256 see vcompsc.c */ #define VGERL (I)256 /* gerund left argument */ #define VGERR (I)512 /* gerund right argument */ #define VTAYFINITE (I)1024 /* t. finite polynomial */ #define VIRS1 (I)2048 /* monad has integral rank support */ #define VIRS2 (I)4096 /* dyad has integral rank support */ #define VFLR (I)8192 /* function is <.@g */ #define VCEIL (I)16384 /* function is >.@g */ #define VMOD (I)32768 /* function is m&|@g */ #define VLOCK (I)65536 /* function is locked */ #define VNAMED (I)131072 /* named explicit defn */ #define VFIX (I)262144 /* f. applied */ #define VXOPR (I)524288 /* : defn with u. and x. */ #define VXOP (I)1048576 /* : defn derived fn */ #define VXOPCALL (I)2097152 /* : defn derived fn call */ #define VTRY1 (I)4194304 /* monad contains try. */ #define VTRY2 (I)8388608 /* dyad contains try. */ #define VDDOP (I)16777216 /* derived from a derived operator */ typedef struct {DX re;DX im;} ZX; /* extended complex */ /* re - real part */ /* im - imaginary part */