diff --git a/inc/arith.h b/inc/arith.h index e27feaa..5ce73a5 100644 --- a/inc/arith.h +++ b/inc/arith.h @@ -1,10 +1,6 @@ #ifndef ARITH_H #define ARITH_H 1 -/* $Id: arith.h,v 1.2 1999/01/03 02:05:52 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ - - - - +/* $Id: arith.h,v 1.2 1999/01/03 02:05:52 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ /************************************************************************/ /* */ @@ -13,168 +9,151 @@ /* */ /************************************************************************/ +#define MAX_SMALL 65535 /* == 0x0000FFFF */ +#define MIN_SMALL -65536 /* == 0xFFFF0000 */ -#define MAX_SMALL 65535 /* == 0x0000FFFF */ -#define MIN_SMALL -65536 /* == 0xFFFF0000 */ +#define MAX_FIXP 2147483647 /* == 0x7FFFFFFF */ +#define MIN_FIXP -2147483648 /* == 0x80000000 */ -#define MAX_FIXP 2147483647 /* == 0x7FFFFFFF */ -#define MIN_FIXP -2147483648 /* == 0x80000000 */ - -#define GetSmalldata(x) (((SEGMASK & x)==S_POSITIVE) ? (0xFFFF & x) : (((SEGMASK & x)==S_NEGATIVE) ? (0xFFFF0000 | x) : error("Not smallp address"))) - -#define GetSmallp(x) ((0xFFFF0000 & x) ? (((0xFFFF0000 & x)==0xFFFF0000) ? (S_NEGATIVE | (0xFFFF & x)) : error("Not Smallp data") ) : (S_POSITIVE | (0xFFFF & x))) +#define GetSmalldata(x) \ + (((SEGMASK & x) == S_POSITIVE) \ + ? (0xFFFF & x) \ + : (((SEGMASK & x) == S_NEGATIVE) ? (0xFFFF0000 | x) : error("Not smallp address"))) +#define GetSmallp(x) \ + ((0xFFFF0000 & x) ? (((0xFFFF0000 & x) == 0xFFFF0000) ? (S_NEGATIVE | (0xFFFF & x)) \ + : error("Not Smallp data")) \ + : (S_POSITIVE | (0xFFFF & x))) #define FIXP_VALUE(dest) *((int *)Addr68k_from_LADDR(dest)) #define FLOATP_VALUE(dest) *((float *)Addr68k_from_LADDR(dest)) -#define N_GETNUMBER(sour, dest, label) \ -{ dest = sour; /* access memory once */ \ - switch(SEGMASK & dest){ \ - case S_POSITIVE: \ - dest = 0xFFFF & (dest); \ - break; \ - case S_NEGATIVE: \ - dest = 0xFFFF0000 | (dest); \ - break; \ - default: \ - if (GetTypeNumber( dest ) != TYPE_FIXP) \ - { goto label; } \ - dest = FIXP_VALUE(dest); \ - } \ -} +#define N_GETNUMBER(sour, dest, label) \ + { \ + dest = sour; /* access memory once */ \ + switch (SEGMASK & dest) { \ + case S_POSITIVE: dest = 0xFFFF & (dest); break; \ + case S_NEGATIVE: dest = 0xFFFF0000 | (dest); break; \ + default: \ + if (GetTypeNumber(dest) != TYPE_FIXP) { goto label; } \ + dest = FIXP_VALUE(dest); \ + } \ + } -#define N_IGETNUMBER(sour, dest, label) \ -{ dest = sour; /* access memory once */ \ - switch(SEGMASK & dest){ \ - case S_POSITIVE: \ - dest = 0xFFFF & dest; \ - break; \ - case S_NEGATIVE: \ - dest = 0xFFFF0000 | dest; \ - break; \ - default: \ - switch (GetTypeNumber( dest )) { \ - case TYPE_FIXP: \ - dest = FIXP_VALUE(dest); \ - break; \ - case TYPE_FLOATP: \ - {register float temp; \ - temp = FLOATP_VALUE(dest) ; \ - if ( (temp > ((float) 0x7fffffff)) || \ - (temp < ((float) 0x80000000)) ) \ - goto label; \ - dest = (int) temp; \ - } \ - break; \ - default: goto label; \ - } \ - break; \ - } \ -} - - -#define ARITH_SWITCH(arg, result) \ - switch((int) arg & 0xFFFF0000){ \ - case 0: \ - result = (S_POSITIVE | (int) arg); \ - break; \ - case 0xFFFF0000: \ - result = (S_NEGATIVE | (0xFFFF & (int) arg)); \ - break; \ - default:{register LispPTR *wordp; \ - /* arg is FIXP, call createcell */ \ - wordp = (LispPTR *) createcell68k(TYPE_FIXP); \ - *((int *)wordp) = (int) arg; \ - result = (LADDR_from_68k(wordp)); \ - break; \ - } \ - } +#define N_IGETNUMBER(sour, dest, label) \ + { \ + dest = sour; /* access memory once */ \ + switch (SEGMASK & dest) { \ + case S_POSITIVE: dest = 0xFFFF & dest; break; \ + case S_NEGATIVE: dest = 0xFFFF0000 | dest; break; \ + default: \ + switch (GetTypeNumber(dest)) { \ + case TYPE_FIXP: dest = FIXP_VALUE(dest); break; \ + case TYPE_FLOATP: { \ + register float temp; \ + temp = FLOATP_VALUE(dest); \ + if ((temp > ((float)0x7fffffff)) || (temp < ((float)0x80000000))) goto label; \ + dest = (int)temp; \ + } break; \ + default: goto label; \ + } \ + break; \ + } \ + } +#define ARITH_SWITCH(arg, result) \ + switch ((int)arg & 0xFFFF0000) { \ + case 0: result = (S_POSITIVE | (int)arg); break; \ + case 0xFFFF0000: result = (S_NEGATIVE | (0xFFFF & (int)arg)); break; \ + default: { \ + register LispPTR *wordp; \ + /* arg is FIXP, call createcell */ \ + wordp = (LispPTR *)createcell68k(TYPE_FIXP); \ + *((int *)wordp) = (int)arg; \ + result = (LADDR_from_68k(wordp)); \ + break; \ + } \ + } /* ******* - NEED to See if this is faster than the N_ARITH_SWITCH macro + NEED to See if this is faster than the N_ARITH_SWITCH macro - if( (MIN_FIXP <= result) && (result <= MAX_FIXP) ){ - if(0 <= result){ - if(result <= MAX_SMALL) - return(S_POSITIVE | result); - else{ - wordp = createcell68k(TYPE_FIXP); - *((unsigned int *)wordp) = result; - return(LADDR_from_68k(wordp)); - } - }else{ - if(MIN_SMALL <= result) - return(S_NEGATIVE | (0xFFFF & result)); - else{ - wordp = createcell68k(TYPE_FIXP); - *((unsigned int *)wordp) = result; - return(LADDR_from_68k(wordp)); - } - }/ - } + if( (MIN_FIXP <= result) && (result <= MAX_FIXP) ){ + if(0 <= result){ + if(result <= MAX_SMALL) + return(S_POSITIVE | result); + else{ + wordp = createcell68k(TYPE_FIXP); + *((unsigned int *)wordp) = result; + return(LADDR_from_68k(wordp)); + } + }else{ + if(MIN_SMALL <= result) + return(S_NEGATIVE | (0xFFFF & result)); + else{ + wordp = createcell68k(TYPE_FIXP); + *((unsigned int *)wordp) = result; + return(LADDR_from_68k(wordp)); + } + }/ + } ****** */ +#define N_ARITH_SWITCH(arg) \ + switch (arg & 0xFFFF0000) { \ + case 0: return (S_POSITIVE | arg); \ + case 0xFFFF0000: return (S_NEGATIVE | (0xFFFF & arg)); \ + default: { \ + register LispPTR *fixpp; \ + /* arg is FIXP, call createcell */ \ + fixpp = (LispPTR *)createcell68k(TYPE_FIXP); \ + *((int *)fixpp) = arg; \ + return (LADDR_from_68k(fixpp)); \ + } \ + } +#define N_IARITH_BODY_2(a, tos, op) \ + { \ + register int arg1, arg2; \ + \ + N_IGETNUMBER(a, arg1, do_ufn); \ + N_IGETNUMBER(tos, arg2, do_ufn); \ + \ + arg1 = arg1 op arg2; \ + \ + N_ARITH_SWITCH(arg1); \ + \ + do_ufn: \ + ERROR_EXIT(tos); \ + } -#define N_ARITH_SWITCH(arg) \ - switch(arg & 0xFFFF0000){ \ - case 0: \ - return(S_POSITIVE | arg); \ - case 0xFFFF0000: \ - return(S_NEGATIVE | (0xFFFF & arg)); \ - default:{register LispPTR *fixpp; \ - /* arg is FIXP, call createcell */ \ - fixpp = (LispPTR *) createcell68k(TYPE_FIXP); \ - *((int *)fixpp) = arg; \ - return(LADDR_from_68k(fixpp)); \ - } \ - } - - -#define N_IARITH_BODY_2(a, tos, op) \ -{ \ -register int arg1,arg2; \ - \ - N_IGETNUMBER( a, arg1, do_ufn); \ - N_IGETNUMBER( tos, arg2, do_ufn); \ - \ - arg1 = arg1 op arg2; \ - \ - N_ARITH_SWITCH(arg1); \ - \ -do_ufn: ERROR_EXIT(tos); \ -} - - -#define N_ARITH_BODY_1(a, n, op) \ -{ \ -register int arg1; \ - \ - N_GETNUMBER( a, arg1, do_ufn); \ - \ - arg1 = arg1 op n; \ - \ -N_ARITH_SWITCH(arg1); \ - \ -do_ufn: ERROR_EXIT(a); \ -} - - -#define N_ARITH_BODY_1_UNSIGNED(a, n, op) \ -{ \ -register unsigned int arg1; \ - \ - N_GETNUMBER( a, arg1, do_ufn); \ - \ - arg1 = arg1 op n; \ - \ -N_ARITH_SWITCH(arg1); \ - \ -do_ufn: ERROR_EXIT(a); \ -} +#define N_ARITH_BODY_1(a, n, op) \ + { \ + register int arg1; \ + \ + N_GETNUMBER(a, arg1, do_ufn); \ + \ + arg1 = arg1 op n; \ + \ + N_ARITH_SWITCH(arg1); \ + \ + do_ufn: \ + ERROR_EXIT(a); \ + } +#define N_ARITH_BODY_1_UNSIGNED(a, n, op) \ + { \ + register unsigned int arg1; \ + \ + N_GETNUMBER(a, arg1, do_ufn); \ + \ + arg1 = arg1 op n; \ + \ + N_ARITH_SWITCH(arg1); \ + \ + do_ufn: \ + ERROR_EXIT(a); \ + } #endif /* ARITH_H */ diff --git a/inc/inlineC.h b/inc/inlineC.h old mode 100755 new mode 100644 index 4dfbde7..6d56229 --- a/inc/inlineC.h +++ b/inc/inlineC.h @@ -1,4 +1,5 @@ -/* $Id: inlineC.h,v 1.3 1999/01/03 02:06:02 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ +/* $Id: inlineC.h,v 1.3 1999/01/03 02:06:02 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved + */ /************************************************************************/ /* */ @@ -7,9 +8,9 @@ /* */ /************************************************************************/ -/* - These are the Macros Used to generate inline c code. - These are the goto ni definitions of the opcodes. +/* + These are the Macros Used to generate inline c code. + These are the goto ni definitions of the opcodes. */ /************************************************************************/ @@ -22,31 +23,31 @@ /************************************************************************/ #define Get_BYTE_PCMAC0 Get_BYTE(PCMAC) -#define Get_BYTE_PCMAC1 Get_BYTE(PCMAC+1) -#define Get_BYTE_PCMAC2 Get_BYTE(PCMAC+2) -#define Get_BYTE_PCMAC3 Get_BYTE(PCMAC+3) +#define Get_BYTE_PCMAC1 Get_BYTE(PCMAC + 1) +#define Get_BYTE_PCMAC2 Get_BYTE(PCMAC + 2) +#define Get_BYTE_PCMAC3 Get_BYTE(PCMAC + 3) #define Get_DLword_PCMAC0 Get_DLword(PCMAC) -#define Get_DLword_PCMAC1 Get_DLword(PCMAC+1) -#define Get_DLword_PCMAC2 Get_DLword(PCMAC+2) -#define Get_DLword_PCMAC3 Get_DLword(PCMAC+3) +#define Get_DLword_PCMAC1 Get_DLword(PCMAC + 1) +#define Get_DLword_PCMAC2 Get_DLword(PCMAC + 2) +#define Get_DLword_PCMAC3 Get_DLword(PCMAC + 3) #define Get_Pointer_PCMAC0 #define Get_Pointer_PCMAC1 Get_Pointer(PCMAC + 1) #define Get_Pointer_PCMAC2 Get_Pointer(PCMAC + 2) - /* For getting a signed byte */ +/* For getting a signed byte */ #ifndef BYTESWAP /* in the unswapped case, the type of the argument carries through to the result */ #define Get_SBYTE_PCMAC0 GETBYTE((int8_t *)PCMAC) -#define Get_SBYTE_PCMAC1 GETBYTE((int8_t *)PCMAC+1) +#define Get_SBYTE_PCMAC1 GETBYTE((int8_t *)PCMAC + 1) #else /* cf. GETBYTE in lsptypes.h */ -#define Get_SBYTE_PCMAC0 (* (int8_t *) (3^(UNSIGNED)(PCMAC))) -#define Get_SBYTE_PCMAC1 (* (int8_t *) (3^(UNSIGNED)(PCMAC+1))) +#define Get_SBYTE_PCMAC0 (*(int8_t *)(3 ^ (UNSIGNED)(PCMAC))) +#define Get_SBYTE_PCMAC1 (*(int8_t *)(3 ^ (UNSIGNED)(PCMAC + 1))) #endif - /* for getting an atom number, e.g., for FNx or DTEST */ +/* for getting an atom number, e.g., for FNx or DTEST */ #ifdef BIGATOMS #define Get_AtomNo_PCMAC1 Get_Pointer_PCMAC1 #define Get_AtomNo_PCMAC2 Get_Pointer_PCMAC2 @@ -64,836 +65,999 @@ #define nextop_ptr nextop4 #endif /* BIGATOMS */ +#define CHECK_INTERRUPT \ + { \ + if ((UNSIGNED)CSTKPTR > Irq_Stk_Check) goto check_interrupt; \ + } +#define nextop0 \ + { goto nextopcode; } +#define nextop1 \ + { \ + PCMACL += 1; \ + nextop0; \ + } +#define nextop2 \ + { \ + PCMACL += 2; \ + nextop0; \ + } +#define nextop3 \ + { \ + PCMACL += 3; \ + nextop0; \ + } +#define nextop4 \ + { \ + PCMACL += 4; \ + nextop0; \ + } +#define nextop5 \ + { \ + PCMACL += 5; \ + nextop0; \ + } - -#define CHECK_INTERRUPT {if((UNSIGNED)CSTKPTR > Irq_Stk_Check) goto check_interrupt;} - - -#define nextop0 {goto nextopcode; } -#define nextop1 {PCMACL += 1; nextop0; } -#define nextop2 {PCMACL += 2; nextop0; } -#define nextop3 {PCMACL += 3; nextop0; } -#define nextop4 {PCMACL += 4; nextop0; } -#define nextop5 {PCMACL += 5; nextop0; } - -#define OPCAR \ - if (Listp(TOPOFSTACK))\ - {\ - register ConsCell *DATUM68K = (ConsCell *)(Addr68k_from_LADDR(TOPOFSTACK));\ - if (DATUM68K->cdr_code == CDR_INDIRECT)\ - {\ - TOPOFSTACK = ((LispPTR)((ConsCell *)Addr68k_from_LADDR(DATUM68K->car_field))->car_field);\ - nextop1; \ - }\ - else \ - { \ - TOPOFSTACK = ((LispPTR)DATUM68K->car_field);\ - nextop1; \ - } \ - }\ - else if (TOPOFSTACK == NIL_PTR)\ - { nextop1; } \ - else if ( TOPOFSTACK == ATOM_T)\ - { nextop1; } \ - else \ - {\ - goto op_ufn; \ - } /* end of OPCAR */ +#define OPCAR \ + if (Listp(TOPOFSTACK)) { \ + register ConsCell *DATUM68K = (ConsCell *)(Addr68k_from_LADDR(TOPOFSTACK)); \ + if (DATUM68K->cdr_code == CDR_INDIRECT) { \ + TOPOFSTACK = ((LispPTR)((ConsCell *)Addr68k_from_LADDR(DATUM68K->car_field))->car_field); \ + nextop1; \ + } else { \ + TOPOFSTACK = ((LispPTR)DATUM68K->car_field); \ + nextop1; \ + } \ + } else if (TOPOFSTACK == NIL_PTR) { \ + nextop1; \ + } else if (TOPOFSTACK == ATOM_T) { \ + nextop1; \ + } else { \ + goto op_ufn; \ + } /* end of OPCAR */ #ifdef NEWCDRCODING -#define OPCDR \ - if (Listp(TOPOFSTACK))\ - {\ -register ConsCell *DATUM68K = (ConsCell *)(Addr68k_from_LADDR(TOPOFSTACK));\ -register int CDRCODEX = DATUM68K->cdr_code;\ - if (CDRCODEX == CDR_NIL) {\ - /* cdr-nil */\ - TOPOFSTACK = (NIL_PTR);\ - nextop1; \ - } \ - else if (CDRCODEX> CDR_ONPAGE) {\ - /* cdr-samepage */\ - TOPOFSTACK = ((TOPOFSTACK) + ((CDRCODEX & 7) << 1));\ - nextop1; \ - } \ - else if (CDRCODEX == CDR_INDIRECT) { /* CDRCODEX < CDR_ONPAGE */\ - /* cdr-indirect */\ - TOPOFSTACK = (cdr ((LispPTR)(DATUM68K->car_field)));\ - nextop1; \ - } \ - else\ - {\ - /* cdr-differentpage */\ - TOPOFSTACK = ((ConsCell *)(Addr68k_from_LADDR \ - ((TOPOFSTACK) + (CDRCODEX << 1)))\ - )->car_field;\ - nextop1; \ - }\ - }\ - else if (TOPOFSTACK == NIL_PTR)\ - { nextop1; } \ - else\ - {\ - goto op_ufn; \ - } /* end of OPCDR */ +#define OPCDR \ + if (Listp(TOPOFSTACK)) { \ + register ConsCell *DATUM68K = (ConsCell *)(Addr68k_from_LADDR(TOPOFSTACK)); \ + register int CDRCODEX = DATUM68K->cdr_code; \ + if (CDRCODEX == CDR_NIL) { \ + /* cdr-nil */ \ + TOPOFSTACK = (NIL_PTR); \ + nextop1; \ + } else if (CDRCODEX > CDR_ONPAGE) { \ + /* cdr-samepage */ \ + TOPOFSTACK = ((TOPOFSTACK) + ((CDRCODEX & 7) << 1)); \ + nextop1; \ + } else if (CDRCODEX == CDR_INDIRECT) { /* CDRCODEX < CDR_ONPAGE */ \ + /* cdr-indirect */ \ + TOPOFSTACK = (cdr((LispPTR)(DATUM68K->car_field))); \ + nextop1; \ + } else { \ + /* cdr-differentpage */ \ + TOPOFSTACK = ((ConsCell *)(Addr68k_from_LADDR((TOPOFSTACK) + (CDRCODEX << 1))))->car_field; \ + nextop1; \ + } \ + } else if (TOPOFSTACK == NIL_PTR) { \ + nextop1; \ + } else { \ + goto op_ufn; \ + } /* end of OPCDR */ #else -#define OPCDR \ - if (Listp(TOPOFSTACK))\ - {\ -register ConsCell *DATUM68K = (ConsCell *)(Addr68k_from_LADDR(TOPOFSTACK));\ -register int CDRCODEX = DATUM68K->cdr_code;\ - if (CDRCODEX == CDR_NIL) {\ - /* cdr-nil */\ - TOPOFSTACK = (NIL_PTR);\ - nextop1; \ - } \ - else if (CDRCODEX> CDR_ONPAGE) {\ - /* cdr-samepage */\ - TOPOFSTACK = (POINTER_PAGEBASE(TOPOFSTACK) + \ - ((CDRCODEX & 127) << 1));\ - nextop1; \ - } \ - else if (CDRCODEX == CDR_INDIRECT) { /* CDRCODEX < CDR_ONPAGE */\ - /* cdr-indirect */\ - TOPOFSTACK = (cdr ((LispPTR)(DATUM68K->car_field)));\ - nextop1; \ - } \ - else\ - {\ - /* cdr-differentpage */\ - TOPOFSTACK = ((ConsCell *)(Addr68k_from_LADDR \ - (POINTER_PAGEBASE(TOPOFSTACK) + (CDRCODEX << 1)))\ - )->car_field;\ - nextop1; \ - }\ - }\ - else if (TOPOFSTACK == NIL_PTR)\ - { nextop1; } \ - else\ - {\ - goto op_ufn; \ - } /* end of OPCDR */ +#define OPCDR \ + if (Listp(TOPOFSTACK)) { \ + register ConsCell *DATUM68K = (ConsCell *)(Addr68k_from_LADDR(TOPOFSTACK)); \ + register int CDRCODEX = DATUM68K->cdr_code; \ + if (CDRCODEX == CDR_NIL) { \ + /* cdr-nil */ \ + TOPOFSTACK = (NIL_PTR); \ + nextop1; \ + } else if (CDRCODEX > CDR_ONPAGE) { \ + /* cdr-samepage */ \ + TOPOFSTACK = (POINTER_PAGEBASE(TOPOFSTACK) + ((CDRCODEX & 127) << 1)); \ + nextop1; \ + } else if (CDRCODEX == CDR_INDIRECT) { /* CDRCODEX < CDR_ONPAGE */ \ + /* cdr-indirect */ \ + TOPOFSTACK = (cdr((LispPTR)(DATUM68K->car_field))); \ + nextop1; \ + } else { \ + /* cdr-differentpage */ \ + TOPOFSTACK = \ + ((ConsCell *)(Addr68k_from_LADDR(POINTER_PAGEBASE(TOPOFSTACK) + (CDRCODEX << 1)))) \ + ->car_field; \ + nextop1; \ + } \ + } else if (TOPOFSTACK == NIL_PTR) { \ + nextop1; \ + } else { \ + goto op_ufn; \ + } /* end of OPCDR */ #endif /* NEWCDRCODING */ -#define IVARMACRO(x) {PUSH(IVAR[x]); nextop1;} -#define PVARMACRO(x) {PUSH(PVAR[x]); nextop1;} -#define PVARSETMACRO(x) {PVAR[x] = TOPOFSTACK; nextop1;} -#define PVARSETPOPMACRO(x) {PVAR[x] = TOPOFSTACK; POP; nextop1;} -#define PUSHATOM(x) {PUSH(x); nextop1;} +#define IVARMACRO(x) \ + { \ + PUSH(IVAR[x]); \ + nextop1; \ + } +#define PVARMACRO(x) \ + { \ + PUSH(PVAR[x]); \ + nextop1; \ + } +#define PVARSETMACRO(x) \ + { \ + PVAR[x] = TOPOFSTACK; \ + nextop1; \ + } +#define PVARSETPOPMACRO(x) \ + { \ + PVAR[x] = TOPOFSTACK; \ + POP; \ + nextop1; \ + } +#define PUSHATOM(x) \ + { \ + PUSH(x); \ + nextop1; \ + } +#define JUMPMACRO(x) \ + { \ + CHECK_INTERRUPT; \ + PCMACL += x; \ + nextop0; \ + } -#define JUMPMACRO(x) {CHECK_INTERRUPT; PCMACL += x; nextop0;} +#define FJUMPMACRO(x) \ + { \ + if (TOPOFSTACK != 0) { goto PopNextop1; } \ + { \ + CHECK_INTERRUPT; \ + POP; \ + PCMACL += x; \ + nextop0; \ + } \ + } +#define TJUMPMACRO(x) \ + { \ + if (TOPOFSTACK == 0) { goto PopNextop1; } \ + { \ + CHECK_INTERRUPT; \ + POP; \ + PCMACL += x; \ + nextop0; \ + } \ + } -#define FJUMPMACRO(x) {if(TOPOFSTACK != 0) {goto PopNextop1 ; } \ - {CHECK_INTERRUPT; POP; PCMACL += x; nextop0;} \ - } -#define TJUMPMACRO(x) {if(TOPOFSTACK == 0) {goto PopNextop1 ; } \ - {CHECK_INTERRUPT; POP; PCMACL += x; nextop0;} \ - } +#define GETBASE_N(N) \ + { \ + TOPOFSTACK = \ + (S_POSITIVE | GETWORD((DLword *)Addr68k_from_LADDR((POINTERMASK & TOPOFSTACK) + N))); \ + nextop2; \ + } -#define GETBASE_N(N) { \ - TOPOFSTACK = \ - (S_POSITIVE | GETWORD((DLword *) \ - Addr68k_from_LADDR((POINTERMASK & TOPOFSTACK) + N)));\ - nextop2; \ - } +#define GETBASEPTR_N(N) \ + { \ + TOPOFSTACK = (POINTERMASK & *((LispPTR *)Addr68k_from_LADDR((POINTERMASK & TOPOFSTACK) + N))); \ + nextop2; \ + } +#define PUTBASEBYTE \ + { \ + register int byteoffset; \ + register char *p_data; \ + if (((SEGMASK & TOPOFSTACK) != S_POSITIVE) || ((unsigned short)TOPOFSTACK >= 256)) \ + goto op_ufn; \ + byteoffset = GET_TOS_1; \ + switch ((SEGMASK & byteoffset)) { \ + case S_POSITIVE: byteoffset &= 0x0000FFFF; break; \ + case S_NEGATIVE: byteoffset |= 0xFFFF0000; break; \ + default: \ + goto op_ufn; \ + /*** if( GetTypeNumber(byteoffset) == TYPE_FIXP ) \ + byteoffset = *((int *)Addr68k_from_LADDR(byteoffset)); \ + else \ + goto op_ufn; ***/ \ + } \ + --CSTKPTRL; \ + p_data = (char *)Addr68k_from_LADDR(POINTERMASK & (POP_TOS_1)) + byteoffset; \ + GETBYTE(p_data) = 0xFF & TOPOFSTACK; \ + nextop1; \ + } -#define GETBASEPTR_N(N) { \ - TOPOFSTACK = \ - ( POINTERMASK & *((LispPTR *) \ - Addr68k_from_LADDR((POINTERMASK & TOPOFSTACK) + N)));\ - nextop2; \ - } -#define PUTBASEBYTE \ - { register int byteoffset; \ - register char *p_data; \ - if(((SEGMASK & TOPOFSTACK) != S_POSITIVE) || \ - ((unsigned short)TOPOFSTACK >= 256)) \ - goto op_ufn; \ - byteoffset = GET_TOS_1; \ - switch( (SEGMASK & byteoffset) ){ \ - case S_POSITIVE: \ - byteoffset &= 0x0000FFFF; \ - break; \ - case S_NEGATIVE: \ - byteoffset |= 0xFFFF0000; \ - break; \ - default: \ - goto op_ufn; \ - /*** if( GetTypeNumber(byteoffset) == TYPE_FIXP ) \ - byteoffset = *((int *)Addr68k_from_LADDR(byteoffset)); \ - else \ - goto op_ufn; ***/ \ - } \ - --CSTKPTRL; \ - p_data = (char*)Addr68k_from_LADDR(POINTERMASK & (POP_TOS_1)) + byteoffset; \ - GETBYTE(p_data) = 0xFF & TOPOFSTACK; \ - nextop1; \ - } +#define GETBASEBYTE \ + { \ + switch ((SEGMASK & TOPOFSTACK)) { \ + case S_POSITIVE: TOPOFSTACK &= 0x0000FFFF; break; \ + case S_NEGATIVE: TOPOFSTACK |= 0xFFFF0000; break; \ + default: \ + if (GetTypeNumber(TOPOFSTACK) == TYPE_FIXP) \ + TOPOFSTACK = *((int *)Addr68k_from_LADDR(TOPOFSTACK)); \ + else \ + goto op_ufn; \ + } \ + TOPOFSTACK = \ + (0xFF & (GETBYTE((char *)Addr68k_from_LADDR((POINTERMASK & (POP_TOS_1))) + TOPOFSTACK))) | \ + S_POSITIVE; \ + nextop1; \ + } -#define GETBASEBYTE \ - {switch( (SEGMASK & TOPOFSTACK) ){ \ - case S_POSITIVE: \ - TOPOFSTACK &= 0x0000FFFF; \ - break; \ - case S_NEGATIVE: \ - TOPOFSTACK |= 0xFFFF0000; \ - break; \ - default: \ - if( GetTypeNumber(TOPOFSTACK) == TYPE_FIXP ) \ - TOPOFSTACK = *((int *)Addr68k_from_LADDR(TOPOFSTACK)); \ - else \ - goto op_ufn; \ - } \ - TOPOFSTACK = (0xFF & (GETBYTE((char*)Addr68k_from_LADDR((POINTERMASK & (POP_TOS_1))) + TOPOFSTACK))) | S_POSITIVE; \ - nextop1; \ - } +#define PUTBASEPTR_N(n) \ + { \ + register int base; \ + base = POINTERMASK & POP_TOS_1; \ + *((LispPTR *)Addr68k_from_LADDR(base + n)) = TOPOFSTACK; \ + TOPOFSTACK = base; \ + nextop2; \ + } +#define PUTBASE_N(n) \ + { \ + register int base; \ + if (GetHiWord(TOPOFSTACK) != (S_POSITIVE >> 16)) goto op_ufn; \ + base = POINTERMASK & POP_TOS_1; \ + GETWORD((DLword *)Addr68k_from_LADDR(base + n)) = GetLoWord(TOPOFSTACK); \ + TOPOFSTACK = base; \ + nextop2; \ + } -#define PUTBASEPTR_N(n) \ - { register int base; \ - base = POINTERMASK & POP_TOS_1; \ - *((LispPTR *)Addr68k_from_LADDR(base + n)) = TOPOFSTACK; \ - TOPOFSTACK = base; \ - nextop2; \ - } - -#define PUTBASE_N(n) \ - { register int base; \ - if (GetHiWord(TOPOFSTACK) != (S_POSITIVE >> 16)) \ - goto op_ufn; \ - base = POINTERMASK & POP_TOS_1; \ - GETWORD((DLword *)Addr68k_from_LADDR(base + n)) = GetLoWord(TOPOFSTACK);\ - TOPOFSTACK = base; \ - nextop2; \ - } - - -#define PVARX(x) { PUSH(GetLongWord((DLword *)PVAR + x)); nextop2; } -#define PVARX_(x) { *((LispPTR *)((DLword *)PVAR+x))=TOPOFSTACK; nextop2;} -#define IVARX(x) { PUSH(GetLongWord((DLword *)IVAR + x)); nextop2; } -#define IVARX_(x) { *((LispPTR *)((DLword *)IVAR+x))=TOPOFSTACK; nextop2;} +#define PVARX(x) \ + { \ + PUSH(GetLongWord((DLword *)PVAR + x)); \ + nextop2; \ + } +#define PVARX_(x) \ + { \ + *((LispPTR *)((DLword *)PVAR + x)) = TOPOFSTACK; \ + nextop2; \ + } +#define IVARX(x) \ + { \ + PUSH(GetLongWord((DLword *)IVAR + x)); \ + nextop2; \ + } +#define IVARX_(x) \ + { \ + *((LispPTR *)((DLword *)IVAR + x)) = TOPOFSTACK; \ + nextop2; \ + } #ifndef BIGATOMS -#define GVAR(x) { PUSH(GetLongWord(Valspace + ((x)<<1))); nextop_atom; } +#define GVAR(x) \ + { \ + PUSH(GetLongWord(Valspace + ((x) << 1))); \ + nextop_atom; \ + } #elif defined(BIGVM) -#define GVAR(x) \ - { register int tx = x; \ - if (tx & SEGMASK) \ - { \ - PUSH(GetLongWord( \ - Addr68k_from_LADDR((tx)+NEWATOM_VALUE_OFFSET))); \ - } \ - else PUSH(GetLongWord((LispPTR *)AtomSpace + (tx*5) + NEWATOM_VALUE_PTROFF)); \ - \ - nextop_atom; \ +#define GVAR(x) \ + { \ + register int tx = x; \ + if (tx & SEGMASK) { \ + PUSH(GetLongWord(Addr68k_from_LADDR((tx) + NEWATOM_VALUE_OFFSET))); \ + } else \ + PUSH(GetLongWord((LispPTR *)AtomSpace + (tx * 5) + NEWATOM_VALUE_PTROFF)); \ + \ + nextop_atom; \ } #else -#define GVAR(x) \ - { register int tx = x; \ - if (tx & SEGMASK) \ - { \ - PUSH(GetLongWord( \ - Addr68k_from_LADDR((tx)+NEWATOM_VALUE_OFFSET))); \ - } \ - else PUSH(GetLongWord(Valspace + ((tx)<<1))); \ - \ - nextop_atom; \ +#define GVAR(x) \ + { \ + register int tx = x; \ + if (tx & SEGMASK) { \ + PUSH(GetLongWord(Addr68k_from_LADDR((tx) + NEWATOM_VALUE_OFFSET))); \ + } else \ + PUSH(GetLongWord(Valspace + ((tx) << 1))); \ + \ + nextop_atom; \ } #endif /* BIGATOMS */ +#define COPY \ + { \ + HARD_PUSH(TOPOFSTACK); \ + nextop1; \ + } +#define SWAP \ + { \ + register LispPTR temp; \ + temp = GET_TOS_1; \ + GET_TOS_1 = TOPOFSTACK; \ + TOPOFSTACK = temp; \ + nextop1; \ + } -#define COPY { HARD_PUSH(TOPOFSTACK); nextop1; } +/*********************************************/ +/* Note: No matter how smart it seems, don't */ +/* AND in POINTERMASK in VAG2, because there */ +/* is code that depends on VAG2 building */ +/* full, 32-bit pointers from 16-bit ints. */ +/*********************************************/ +#define N_OP_VAG2 \ + { \ + TOPOFSTACK = ((GET_TOS_1 << 16) | (0xFFFF & TOPOFSTACK)); \ + CSTKPTRL--; \ + nextop1; \ + } -#define SWAP { register LispPTR temp; \ - temp = GET_TOS_1; \ - GET_TOS_1 = TOPOFSTACK; \ - TOPOFSTACK = temp; \ - nextop1; \ - } +#define FN0 \ + { OPFN(0, fn0_args, fn0_xna, fn0_native); } +#define FN1 \ + { OPFN(1, fn1_args, fn1_xna, fn1_native); } +#define FN2 \ + { OPFN(2, fn2_args, fn2_xna, fn2_native); } +#define FN3 \ + { OPFN(3, fn3_args, fn3_xna, fn3_native); } +#define FN4 \ + { OPFN(4, fn4_args, fn4_xna, fn4_native); } +#define FNX \ + { \ + OPFNX; \ + nextop0; \ + } +#define ENVCALL \ + { \ + OP_ENVCALL; \ + nextop0; \ + } +#define RETURN \ + { \ + OPRETURN; \ + nextop0; \ + } +#define APPLY \ + { OPAPPLY; } +#define CHECKAPPLY \ + { \ + OPCHECKAPPLY; \ + nextop1; \ + } - /*********************************************/ - /* Note: No matter how smart it seems, don't */ - /* AND in POINTERMASK in VAG2, because there */ - /* is code that depends on VAG2 building */ - /* full, 32-bit pointers from 16-bit ints. */ - /*********************************************/ -#define N_OP_VAG2 { TOPOFSTACK = ((GET_TOS_1 << 16) \ - | (0xFFFF & TOPOFSTACK)); CSTKPTRL--; nextop1; } - -#define FN0 { OPFN(0, fn0_args, fn0_xna, fn0_native); } -#define FN1 { OPFN(1, fn1_args, fn1_xna, fn1_native); } -#define FN2 { OPFN(2, fn2_args, fn2_xna, fn2_native); } -#define FN3 { OPFN(3, fn3_args, fn3_xna, fn3_native); } -#define FN4 { OPFN(4, fn4_args, fn4_xna, fn4_native); } -#define FNX { OPFNX; nextop0; } -#define ENVCALL { OP_ENVCALL; nextop0; } -#define RETURN { OPRETURN; nextop0; } -#define APPLY { OPAPPLY;} -#define CHECKAPPLY { OPCHECKAPPLY; nextop1; } - -#define BIN \ -{ \ -register Stream *stream68k; /* stream instance on TOS */ \ -register char *buff68k; /* pointer to BUFF */ \ - \ - if ( GetTypeNumber(TOPOFSTACK) == TYPE_STREAM ) { \ - stream68k=(Stream *) Addr68k_from_LADDR(TOPOFSTACK); \ - if( ( !stream68k->BINABLE ) || \ - ( stream68k->COFFSET >= \ - stream68k->CBUFSIZE ) ) goto op_ufn; \ - \ - /* get BUFFER instance */ \ - buff68k =(char *)Addr68k_from_LADDR(stream68k->CBUFPTR); \ - \ - /* get BYTE data and set it to TOS */ \ - TOPOFSTACK = (S_POSITIVE | \ - (Get_BYTE(buff68k + (stream68k->COFFSET)++)) ); \ - nextop1; \ - } \ - else goto op_ufn; \ -} +#define BIN \ + { \ + register Stream *stream68k; /* stream instance on TOS */ \ + register char *buff68k; /* pointer to BUFF */ \ + \ + if (GetTypeNumber(TOPOFSTACK) == TYPE_STREAM) { \ + stream68k = (Stream *)Addr68k_from_LADDR(TOPOFSTACK); \ + if ((!stream68k->BINABLE) || (stream68k->COFFSET >= stream68k->CBUFSIZE)) goto op_ufn; \ + \ + /* get BUFFER instance */ \ + buff68k = (char *)Addr68k_from_LADDR(stream68k->CBUFPTR); \ + \ + /* get BYTE data and set it to TOS */ \ + TOPOFSTACK = (S_POSITIVE | (Get_BYTE(buff68k + (stream68k->COFFSET)++))); \ + nextop1; \ + } else \ + goto op_ufn; \ + } #ifdef RECLAIMINC -#define RECLAIMCELL { TOPOFSTACK = gcreclaimcell(TOPOFSTACK); nextop1; } +#define RECLAIMCELL \ + { \ + TOPOFSTACK = gcreclaimcell(TOPOFSTACK); \ + nextop1; \ + } #else -#define RECLAIMCELL { goto op_ufn; } +#define RECLAIMCELL \ + { goto op_ufn; } #endif -#define GCSCAN1 { TOPOFSTACK=gcscan1(TOPOFSTACK & 0xffff); \ - if (TOPOFSTACK) {TOPOFSTACK |= S_POSITIVE; };nextop1;} +#define GCSCAN1 \ + { \ + TOPOFSTACK = gcscan1(TOPOFSTACK & 0xffff); \ + if (TOPOFSTACK) { TOPOFSTACK |= S_POSITIVE; }; \ + nextop1; \ + } -#define GCSCAN2 { TOPOFSTACK=gcscan2(TOPOFSTACK & 0xffff); \ - if (TOPOFSTACK) {TOPOFSTACK |=S_POSITIVE; };nextop1;} +#define GCSCAN2 \ + { \ + TOPOFSTACK = gcscan2(TOPOFSTACK & 0xffff); \ + if (TOPOFSTACK) { TOPOFSTACK |= S_POSITIVE; }; \ + nextop1; \ + } +#define CONTEXTSWITCH \ + { \ + EXT; \ + OP_contextsw(); \ + RET; \ + /*CHECK_INTERRUPT;*/ CLR_IRQ; \ + nextop0; \ + } -#define CONTEXTSWITCH { EXT; OP_contextsw(); RET; \ - /*CHECK_INTERRUPT;*/ CLR_IRQ; \ - nextop0; } +#define NOP \ + { nextop1; } +#define RESLIST(n) \ + { goto op_ufn; } -#define NOP { nextop1; } -#define RESLIST(n) { goto op_ufn; } +#define FINDKEY(x) \ + { \ + TOPOFSTACK = N_OP_findkey(TOPOFSTACK, x); \ + nextop2; \ + } -#define FINDKEY(x) \ - { \ - TOPOFSTACK = N_OP_findkey(TOPOFSTACK, x); \ - nextop2; \ - } +#define RPLPTR(n) \ + { \ + TOPOFSTACK = N_OP_rplptr(POP_TOS_1, TOPOFSTACK, n); \ + nextop2; \ + } -#define RPLPTR(n) \ - { \ - TOPOFSTACK = N_OP_rplptr(POP_TOS_1, TOPOFSTACK, n); \ - nextop2; \ - } +#define GVAR_(atom_index) \ + { \ + N_OP_gvar_(TOPOFSTACK, atom_index); \ + nextop_atom; \ + } -#define GVAR_(atom_index) \ - { \ - N_OP_gvar_(TOPOFSTACK, atom_index); \ - nextop_atom; \ - } +#define BIND \ + { \ + register int byte = Get_BYTE_PCMAC1; \ + register unsigned n1; \ + register unsigned n2; \ + register LispPTR *ppvar; \ + register int i; \ + n1 = byte >> 4; \ + n2 = byte & 0xf; \ + ppvar = (LispPTR *)PVAR + 1 + Get_BYTE_PCMAC2; \ + for (i = n1; --i >= 0;) { *--ppvar = NIL_PTR; } \ + if (n2 == 0) { \ + *CSTKPTRL++ = TOPOFSTACK; \ + } else { \ + *--ppvar = TOPOFSTACK; \ + for (i = 1; i < n2; i++) { *--ppvar = *(--CSTKPTRL); } \ + } \ + TOPOFSTACK = ((~(n1 + n2)) << 16) | (Get_BYTE_PCMAC2 << 1); \ + nextop3; \ + } -#define BIND {register int byte = Get_BYTE_PCMAC1; \ - register unsigned n1; \ - register unsigned n2; \ - register LispPTR *ppvar; \ - register int i; \ - n1 = byte >> 4; \ - n2 = byte & 0xf; \ - ppvar = (LispPTR *)PVAR + 1 + Get_BYTE_PCMAC2; \ - for(i=n1; --i >= 0;){ *--ppvar = NIL_PTR; } \ - if(n2 == 0){ \ - *CSTKPTRL++ = TOPOFSTACK; \ - }else{ \ - *--ppvar = TOPOFSTACK; \ - for(i=1; i= 0);) \ + ; \ + value = *CSTKPTR; \ + num = (~value) >> 16; \ + ppvar = (LispPTR *)((DLword *)PVAR + 2 + GetLoWord(value)); \ + for (i = num; --i >= 0;) { *--ppvar = 0xffffffff; } \ + nextop1; \ + } -#define UNBIND {register int num; \ - register LispPTR *ppvar; \ - register int i; \ - register LispPTR value; \ - for(; ( ((int)*--CSTKPTRL) >= 0 );); \ - value = *CSTKPTR; \ - num = (~value)>>16; \ - ppvar = (LispPTR *)((DLword *)PVAR + 2 + GetLoWord(value));\ - for(i=num; --i >= 0;){*--ppvar = 0xffffffff;} \ - nextop1; \ - } +#define DUNBIND \ + { \ + register int num; \ + register LispPTR *ppvar; \ + register int i; \ + register LispPTR value; \ + if ((int)TOPOFSTACK < 0) { \ + num = (~TOPOFSTACK) >> 16; \ + if (num != 0) { \ + ppvar = (LispPTR *)((DLword *)PVAR + 2 + GetLoWord(TOPOFSTACK)); \ + for (i = num; --i >= 0;) { *--ppvar = 0xffffffff; } \ + } \ + } else { \ + for (; (((int)*--CSTKPTRL) >= 0);) \ + ; \ + value = *CSTKPTR; \ + num = (~value) >> 16; \ + ppvar = (LispPTR *)((DLword *)PVAR + 2 + GetLoWord(value)); \ + for (i = num; --i >= 0;) { *--ppvar = 0xffffffff; } \ + } \ + POP; \ + nextop1; \ + } -#define DUNBIND {register int num; \ - register LispPTR *ppvar; \ - register int i; \ - register LispPTR value; \ - if((int)TOPOFSTACK < 0){ \ - num =(~TOPOFSTACK)>>16; \ - if(num != 0){ \ - ppvar = (LispPTR *)((DLword *)PVAR + 2 + GetLoWord(TOPOFSTACK)); \ - for(i=num; --i >= 0;) { \ - *--ppvar = 0xffffffff; } \ - } \ - }else{ \ - for(; ( ((int)*--CSTKPTRL) >= 0 );); \ - value = *CSTKPTR; \ - num = (~value)>>16; \ - ppvar = (LispPTR *)((DLword *)PVAR + 2 + GetLoWord(value));\ - for(i=num; --i >= 0;) { \ - *--ppvar = 0xffffffff; } \ - } \ - POP; \ - nextop1; \ - } +#define N_OP_HILOC \ + { \ + TOPOFSTACK = GetHiWord(TOPOFSTACK) | S_POSITIVE; \ + nextop1; \ + } +#define N_OP_LOLOC \ + { \ + TOPOFSTACK = GetLoWord(TOPOFSTACK) | S_POSITIVE; \ + nextop1; \ + } -#define N_OP_HILOC \ - { \ - TOPOFSTACK = GetHiWord(TOPOFSTACK) | S_POSITIVE; \ - nextop1; \ - } -#define N_OP_LOLOC \ - { \ - TOPOFSTACK = GetLoWord(TOPOFSTACK) | S_POSITIVE; \ - nextop1; \ - } +#define GETBITS_N_M(a, b) \ + { \ + register int temp, bb = b; \ + temp = 0xF & bb; \ + TOPOFSTACK = S_POSITIVE | (((GETWORD(Addr68k_from_LADDR(POINTERMASK & (TOPOFSTACK + a)))) >> \ + (16 - ((0xF & (bb >> 4)) + temp + 1))) & \ + n_mask_array[temp]); \ + nextop3; \ + } -#define GETBITS_N_M(a, b) \ - {register int temp, bb = b; \ - temp = 0xF & bb; \ - TOPOFSTACK = S_POSITIVE | \ - (( (GETWORD(Addr68k_from_LADDR(POINTERMASK & (TOPOFSTACK+a)))) \ - >> (16 - ( (0xF & (bb >> 4)) + temp + 1)) ) \ - & n_mask_array[temp] ); \ - nextop3; \ - } +#define PUTBITS_N_M(a, b) \ + { \ + int base; \ + register int bb = b; \ + register DLword *pword; \ + register int shift_size, field_size, fmask; \ + if ((SEGMASK & TOPOFSTACK) != S_POSITIVE) { goto op_ufn; }; \ + base = POINTERMASK & POP_TOS_1; \ + pword = (DLword *)Addr68k_from_LADDR(base + a); \ + field_size = 0xF & bb; \ + shift_size = 15 - (0xF & (bb >> 4)) - field_size; \ + fmask = n_mask_array[field_size] << shift_size; \ + GETWORD(pword) = ((TOPOFSTACK << shift_size) & fmask) | (GETWORD(pword) & (~fmask)); \ + TOPOFSTACK = base; \ + nextop3; \ + } -#define PUTBITS_N_M(a, b) \ - { int base; \ - register int bb = b; \ - register DLword *pword; \ - register int shift_size, field_size, fmask; \ - if( (SEGMASK & TOPOFSTACK) != S_POSITIVE ){ goto op_ufn; }; \ - base = POINTERMASK & POP_TOS_1; \ - pword = (DLword*)Addr68k_from_LADDR( base + a ); \ - field_size = 0xF & bb; \ - shift_size = 15 - (0xF & (bb >> 4)) - field_size; \ - fmask = n_mask_array[field_size] << shift_size; \ - GETWORD(pword) = ( (TOPOFSTACK << shift_size) & fmask) | \ - (GETWORD(pword) & (~fmask)); \ - TOPOFSTACK = base; \ - nextop3; \ - } +#define CONS \ + { \ + TOPOFSTACK = N_OP_cons(POP_TOS_1, TOPOFSTACK); \ + nextop1; \ + } +#define MYALINK \ + { \ + PUSH((((CURRENTFX->alink) & 0xfffe) - FRAMESIZE) | S_POSITIVE); \ + nextop1; \ + } -#define CONS \ - { TOPOFSTACK = N_OP_cons(POP_TOS_1, TOPOFSTACK); \ - nextop1; \ - } +#define MYARGCOUNT \ + { \ + register UNSIGNED arg_num; \ + if ((CURRENTFX->alink & 1) == 0) \ + arg_num = (UNSIGNED)((LispPTR *)(CURRENTFX)-1); \ + else \ + arg_num = (UNSIGNED)(Stackspace + CURRENTFX->blink); \ + PUSH((DLword)((arg_num - (UNSIGNED)IVar) >> 2) | S_POSITIVE); \ + nextop1; \ + } -#define MYALINK \ - { \ - PUSH(((( CURRENTFX->alink) & 0xfffe)-FRAMESIZE) | S_POSITIVE); \ - nextop1; \ - } +#define RCLK \ + { \ + TOPOFSTACK = N_OP_rclk(TOPOFSTACK); \ + nextop1; \ + } -#define MYARGCOUNT \ - { register UNSIGNED arg_num; \ - if (( CURRENTFX->alink & 1) == 0) \ - arg_num = (UNSIGNED)((LispPTR *)(CURRENTFX) - 1); \ - else \ - arg_num = (UNSIGNED)(Stackspace + CURRENTFX->blink); \ - PUSH( (DLword)((arg_num - (UNSIGNED)IVar) >> 2) | S_POSITIVE); \ - nextop1; \ - } +#define LISTP \ + { \ + if ((DLword)GetTypeNumber(TOPOFSTACK) != TYPE_LISTP) TOPOFSTACK = NIL_PTR; \ + nextop1; \ + } -#define RCLK \ - { \ - TOPOFSTACK = N_OP_rclk(TOPOFSTACK); \ - nextop1; \ - } +#define NTYPEX \ + { \ + TOPOFSTACK = S_POSITIVE | (DLword)(GetTypeNumber(TOPOFSTACK)); \ + nextop1; \ + } -#define LISTP { \ - if((DLword)GetTypeNumber(TOPOFSTACK) != TYPE_LISTP)\ - TOPOFSTACK = NIL_PTR; \ - nextop1; \ - } +#define TYPEP(n) \ + { \ + if ((DLword)GetTypeNumber(TOPOFSTACK) != n) TOPOFSTACK = NIL_PTR; \ + nextop2; \ + } -#define NTYPEX \ - { \ - TOPOFSTACK = S_POSITIVE | (DLword)(GetTypeNumber(TOPOFSTACK));\ - nextop1; \ - } +#define TYPEMASK(n) \ + { \ + if ((((DLword)GetTypeEntry(TOPOFSTACK)) & ((DLword)n << 8)) == 0) TOPOFSTACK = NIL_PTR; \ + nextop2; \ + } -#define TYPEP(n) \ - { \ - if((DLword)GetTypeNumber(TOPOFSTACK) != n) \ - TOPOFSTACK = NIL_PTR; \ - nextop2; \ - } +#define INSTANCEP(atom_index) \ + { \ + TOPOFSTACK = N_OP_instancep(TOPOFSTACK, atom_index); \ + nextop_atom; \ + } -#define TYPEMASK(n) \ - { \ - if( ( ((DLword)GetTypeEntry(TOPOFSTACK)) & \ - ( (DLword)n << 8)) == 0) \ - TOPOFSTACK = NIL_PTR; \ - nextop2; \ - } +#define STOREN(n) \ + { \ + *(CSTKPTR - ((n + 2) >> 1)) = TOPOFSTACK; \ + nextop2; \ + } -#define INSTANCEP(atom_index) \ - { \ - TOPOFSTACK = N_OP_instancep(TOPOFSTACK,atom_index); \ - nextop_atom; \ - } +#define COPYN(n) \ + { \ + PUSH(*(CSTKPTR - ((n + 2) >> 1))); \ + nextop2; \ + } -#define STOREN(n) \ - { *(CSTKPTR - ((n+2) >> 1)) = TOPOFSTACK; \ - nextop2; \ - } +#define POPN(n) \ + { \ + TOPOFSTACK = *(CSTKPTRL -= ((n) + 1)); \ + nextop2; \ + } -#define COPYN(n) \ - { PUSH(*(CSTKPTR - ((n+2) >> 1))); \ - nextop2; \ - } - -#define POPN(n) \ - {TOPOFSTACK = *(CSTKPTRL -= ((n)+1)); \ - nextop2; \ - } - -#define CLARITHEQUAL { \ -register int arg2; \ - SV; arg2 = POP_TOS_1; \ - if ((TOPOFSTACK & SEGMASK) == S_POSITIVE) \ - { \ - if (arg2 == TOPOFSTACK) {TOPOFSTACK = ATOM_T; nextop1;} \ - if ((arg2 & SEGMASK) == S_POSITIVE) {TOPOFSTACK = NIL; nextop1;} \ - } \ - N_OP_POPPED_CALL_2(N_OP_eqq, arg2); \ -} +#define CLARITHEQUAL \ + { \ + register int arg2; \ + SV; \ + arg2 = POP_TOS_1; \ + if ((TOPOFSTACK & SEGMASK) == S_POSITIVE) { \ + if (arg2 == TOPOFSTACK) { \ + TOPOFSTACK = ATOM_T; \ + nextop1; \ + } \ + if ((arg2 & SEGMASK) == S_POSITIVE) { \ + TOPOFSTACK = NIL; \ + nextop1; \ + } \ + } \ + N_OP_POPPED_CALL_2(N_OP_eqq, arg2); \ + } #define S_CHARACTER 0x70000 -#define AREF1 { \ -LispPTR arrayarg; \ -register LispPTR baseL; \ -register int index; \ -register OneDArray *arrayblk; \ - SV; arrayarg = POP_TOS_1; \ - if (GetTypeNumber(arrayarg) != TYPE_ONED_ARRAY) goto aref_ufn; \ - arrayblk = (OneDArray *)Addr68k_from_LADDR(arrayarg); \ - if ((TOPOFSTACK & SEGMASK) != S_POSITIVE) goto aref_ufn; \ - index = TOPOFSTACK & 0xFFFF; \ - if (index >= arrayblk->totalsize) goto aref_ufn; \ - index += arrayblk->offset; \ - baseL = arrayblk->base; \ - switch (arrayblk->typenumber) { \ - case 38: /* pointer : 32 bits */ \ - TOPOFSTACK = *(((int *)Addr68k_from_LADDR(baseL)) + index); \ - nextop1; \ - case 20: /* signed : 16 bits */ \ - TOPOFSTACK = (GETWORD(((DLword *)Addr68k_from_LADDR(baseL)) + index)) & 0xFFFF; \ - if (TOPOFSTACK & 0x8000) TOPOFSTACK |= S_NEGATIVE; \ - else TOPOFSTACK |= S_POSITIVE; \ - nextop1; \ - case 67: /* Character : 8 bits */ \ - TOPOFSTACK = S_CHARACTER | ((GETBYTE(((char *)Addr68k_from_LADDR(baseL)) + index)) & 0xFF); \ - nextop1; \ - case 22: /* signed : 32 bits */ \ - TOPOFSTACK = *(((int *)Addr68k_from_LADDR(baseL)) + index); \ - switch(TOPOFSTACK & 0xFFFF0000){ \ - case 0: \ - TOPOFSTACK |= S_POSITIVE; \ - break; \ - case (unsigned)0xFFFF0000: \ - TOPOFSTACK &= S_NEGATIVE; \ - break; \ - default:{register DLword *wordp; \ - wordp = createcell68k(TYPE_FIXP); \ - *((int *)wordp) = TOPOFSTACK; \ - TOPOFSTACK = (LispPTR)LADDR_from_68k(wordp); \ - } \ - } \ - nextop1; \ - case 0: /* unsigned : 1 bit per element */ \ - TOPOFSTACK = S_POSITIVE | (((GETBYTE(((char *)Addr68k_from_LADDR(baseL)) + (index >> 3))) >> (7 - (index & 7))) & 1); \ - nextop1; \ - case 3: /* unsigned : 8 bits per element */ \ - TOPOFSTACK = S_POSITIVE | ((GETBYTE(((char *)Addr68k_from_LADDR(baseL)) + index)) & 0xFF); \ - nextop1; \ - case 4: /* unsigned : 16 bits per element */ \ - TOPOFSTACK = S_POSITIVE | ((GETWORD(((DLword *)Addr68k_from_LADDR(baseL)) + index)) & 0xFFFF); \ - nextop1; \ - case 54: /* Float : 32 bits */{register DLword *wordp; \ - wordp = createcell68k(TYPE_FLOATP); \ - *((int *)wordp) = *(((int *)Addr68k_from_LADDR(baseL)) + index);\ - TOPOFSTACK = (LispPTR)LADDR_from_68k(wordp); \ - } \ - nextop1; \ - case 68: /* Character : 16 bits */ \ - TOPOFSTACK = S_CHARACTER | ((GETWORD(((DLword *)Addr68k_from_LADDR(baseL)) + index)) & 0xFFFF); \ - nextop1; \ - case 86: /* XPointer : 32 bits */ \ - TOPOFSTACK = *(((int *)Addr68k_from_LADDR(baseL)) + index); \ - nextop1; \ - default: /* Illegal or Unimplemented */ \ - goto aref_ufn; \ - }/* end switch typenumber */ \ -aref_ufn: \ - N_OP_POPPED_CALL_2(N_OP_aref1, arrayarg); \ -} +#define AREF1 \ + { \ + LispPTR arrayarg; \ + register LispPTR baseL; \ + register int index; \ + register OneDArray *arrayblk; \ + SV; \ + arrayarg = POP_TOS_1; \ + if (GetTypeNumber(arrayarg) != TYPE_ONED_ARRAY) goto aref_ufn; \ + arrayblk = (OneDArray *)Addr68k_from_LADDR(arrayarg); \ + if ((TOPOFSTACK & SEGMASK) != S_POSITIVE) goto aref_ufn; \ + index = TOPOFSTACK & 0xFFFF; \ + if (index >= arrayblk->totalsize) goto aref_ufn; \ + index += arrayblk->offset; \ + baseL = arrayblk->base; \ + switch (arrayblk->typenumber) { \ + case 38: /* pointer : 32 bits */ \ + TOPOFSTACK = *(((int *)Addr68k_from_LADDR(baseL)) + index); \ + nextop1; \ + case 20: /* signed : 16 bits */ \ + TOPOFSTACK = (GETWORD(((DLword *)Addr68k_from_LADDR(baseL)) + index)) & 0xFFFF; \ + if (TOPOFSTACK & 0x8000) \ + TOPOFSTACK |= S_NEGATIVE; \ + else \ + TOPOFSTACK |= S_POSITIVE; \ + nextop1; \ + case 67: /* Character : 8 bits */ \ + TOPOFSTACK = \ + S_CHARACTER | ((GETBYTE(((char *)Addr68k_from_LADDR(baseL)) + index)) & 0xFF); \ + nextop1; \ + case 22: /* signed : 32 bits */ \ + TOPOFSTACK = *(((int *)Addr68k_from_LADDR(baseL)) + index); \ + switch (TOPOFSTACK & 0xFFFF0000) { \ + case 0: TOPOFSTACK |= S_POSITIVE; break; \ + case (unsigned)0xFFFF0000: TOPOFSTACK &= S_NEGATIVE; break; \ + default: { \ + register DLword *wordp; \ + wordp = createcell68k(TYPE_FIXP); \ + *((int *)wordp) = TOPOFSTACK; \ + TOPOFSTACK = (LispPTR)LADDR_from_68k(wordp); \ + } \ + } \ + nextop1; \ + case 0: /* unsigned : 1 bit per element */ \ + TOPOFSTACK = \ + S_POSITIVE | (((GETBYTE(((char *)Addr68k_from_LADDR(baseL)) + (index >> 3))) >> \ + (7 - (index & 7))) & \ + 1); \ + nextop1; \ + case 3: /* unsigned : 8 bits per element */ \ + TOPOFSTACK = S_POSITIVE | ((GETBYTE(((char *)Addr68k_from_LADDR(baseL)) + index)) & 0xFF); \ + nextop1; \ + case 4: /* unsigned : 16 bits per element */ \ + TOPOFSTACK = \ + S_POSITIVE | ((GETWORD(((DLword *)Addr68k_from_LADDR(baseL)) + index)) & 0xFFFF); \ + nextop1; \ + case 54: /* Float : 32 bits */ { \ + register DLword *wordp; \ + wordp = createcell68k(TYPE_FLOATP); \ + *((int *)wordp) = *(((int *)Addr68k_from_LADDR(baseL)) + index); \ + TOPOFSTACK = (LispPTR)LADDR_from_68k(wordp); \ + } \ + nextop1; \ + case 68: /* Character : 16 bits */ \ + TOPOFSTACK = \ + S_CHARACTER | ((GETWORD(((DLword *)Addr68k_from_LADDR(baseL)) + index)) & 0xFFFF); \ + nextop1; \ + case 86: /* XPointer : 32 bits */ \ + TOPOFSTACK = *(((int *)Addr68k_from_LADDR(baseL)) + index); \ + nextop1; \ + default: /* Illegal or Unimplemented */ goto aref_ufn; \ + } /* end switch typenumber */ \ + aref_ufn: \ + N_OP_POPPED_CALL_2(N_OP_aref1, arrayarg); \ + } #ifdef BIGVM -#define DTEST(n) \ -{ \ - register int atom_index; \ - register struct dtd *dtd68k ; \ - atom_index = n; \ - for(dtd68k=(struct dtd *) GetDTD(GetTypeNumber(TOPOFSTACK)); \ - atom_index != dtd68k->dtd_name ; \ - dtd68k=(struct dtd *) GetDTD(dtd68k->dtd_supertype)) \ - { \ - if( dtd68k->dtd_supertype == 0) \ - { \ - goto op_ufn; \ - } \ - } \ -nextop_atom; \ -} +#define DTEST(n) \ + { \ + register int atom_index; \ + register struct dtd *dtd68k; \ + atom_index = n; \ + for (dtd68k = (struct dtd *)GetDTD(GetTypeNumber(TOPOFSTACK)); atom_index != dtd68k->dtd_name; \ + dtd68k = (struct dtd *)GetDTD(dtd68k->dtd_supertype)) { \ + if (dtd68k->dtd_supertype == 0) { goto op_ufn; } \ + } \ + nextop_atom; \ + } #else /* BIGVM */ -#define DTEST(n) \ -{ \ - register int atom_index; \ - register struct dtd *dtd68k ; \ - atom_index = n; \ - for(dtd68k=(struct dtd *) GetDTD(GetTypeNumber(TOPOFSTACK)); \ - atom_index != dtd68k->dtd_namelo +((int)(dtd68k->dtd_namehi)<<16) ; \ - dtd68k=(struct dtd *) GetDTD(dtd68k->dtd_supertype)) \ - { \ - if( dtd68k->dtd_supertype == 0) \ - { \ - goto op_ufn; \ - } \ - } \ -nextop_atom; \ -} +#define DTEST(n) \ + { \ + register int atom_index; \ + register struct dtd *dtd68k; \ + atom_index = n; \ + for (dtd68k = (struct dtd *)GetDTD(GetTypeNumber(TOPOFSTACK)); \ + atom_index != dtd68k->dtd_namelo + ((int)(dtd68k->dtd_namehi) << 16); \ + dtd68k = (struct dtd *)GetDTD(dtd68k->dtd_supertype)) { \ + if (dtd68k->dtd_supertype == 0) { goto op_ufn; } \ + } \ + nextop_atom; \ + } #endif /* BIGVM */ -#define FVAR(n) { \ -register LispPTR *chain; \ -chain = (LispPTR *) (PVar + n); \ -if(WBITSPTR(chain)->LSB){ \ - PUSH(GetLongWord(Addr68k_from_LADDR( \ - POINTERMASK & swapx(native_newframe(n >> 1))))); \ - nextop1; \ - }/* if(((WBITS */ \ -PUSH(GetLongWord(Addr68k_from_LADDR(POINTERMASK & swapx(*chain)))); \ -nextop1; \ -} - -#define FVARX(n) { \ -register int nn = n; \ -register LispPTR *chain; \ -chain = (LispPTR *) (PVar + nn); \ -if(WBITSPTR(chain)->LSB){ \ - PUSH(GetLongWord(Addr68k_from_LADDR( \ - POINTERMASK & swapx(native_newframe(nn >> 1))))); \ - nextop2; \ - }/* if(((WBITS */ \ -PUSH(GetLongWord(Addr68k_from_LADDR(POINTERMASK & swapx(*chain)))); \ -nextop2; \ -} +#define FVAR(n) \ + { \ + register LispPTR *chain; \ + chain = (LispPTR *)(PVar + n); \ + if (WBITSPTR(chain)->LSB) { \ + PUSH(GetLongWord(Addr68k_from_LADDR(POINTERMASK &swapx(native_newframe(n >> 1))))); \ + nextop1; \ + } /* if(((WBITS */ \ + PUSH(GetLongWord(Addr68k_from_LADDR(POINTERMASK &swapx(*chain)))); \ + nextop1; \ + } +#define FVARX(n) \ + { \ + register int nn = n; \ + register LispPTR *chain; \ + chain = (LispPTR *)(PVar + nn); \ + if (WBITSPTR(chain)->LSB) { \ + PUSH(GetLongWord(Addr68k_from_LADDR(POINTERMASK &swapx(native_newframe(nn >> 1))))); \ + nextop2; \ + } /* if(((WBITS */ \ + PUSH(GetLongWord(Addr68k_from_LADDR(POINTERMASK &swapx(*chain)))); \ + nextop2; \ + } /* ******************************************************************** */ /* THE FOLLOWING WAS IN n_op_inlinedefsC.h */ /* ******************************************************************** */ -#define GCREF(n) { \ - GCLOOKUPV(TOPOFSTACK, n, TOPOFSTACK); \ - nextop2;} +#define GCREF(n) \ + { \ + GCLOOKUPV(TOPOFSTACK, n, TOPOFSTACK); \ + nextop2; \ + } #ifndef BIGATOMS -#define ATOMCELL_N(n) \ - {if ((unsigned int)TOPOFSTACK >> 16) {goto op_ufn;} \ - TOPOFSTACK = (n << 16) + (TOPOFSTACK << 1) ; \ - nextop2; \ - } +#define ATOMCELL_N(n) \ + { \ + if ((unsigned int)TOPOFSTACK >> 16) { goto op_ufn; } \ + TOPOFSTACK = (n << 16) + (TOPOFSTACK << 1); \ + nextop2; \ + } #elif defined(BIGVM) -#define ATOMCELL_N(n) \ - { register int nn = n; \ - if (0==((unsigned int)(TOPOFSTACK&= POINTERMASK) & SEGMASK)) \ - { /* old-symbol case; just add cell-number arg */ \ - switch (nn) \ - { \ - case PLIS_HI: /* PLIST entry for symbol */ \ - TOPOFSTACK = (ATOMS_HI << 16) + (10*(unsigned int)TOPOFSTACK) + NEWATOM_PLIST_OFFSET; \ - break; \ - case PNP_HI: /* PNAME entry for symbol */ \ - TOPOFSTACK = (ATOMS_HI << 16) + (10*(unsigned int)TOPOFSTACK) + NEWATOM_PNAME_OFFSET; \ - break; \ - case VALS_HI: /* VALUE cell for symbol */ \ - TOPOFSTACK = (ATOMS_HI << 16) + (10*(unsigned int)TOPOFSTACK) + NEWATOM_VALUE_OFFSET; \ - break; \ - case DEFS_HI: /* DEFINITION for symbol */ \ - TOPOFSTACK = (ATOMS_HI << 16) + (10*(unsigned int)TOPOFSTACK) + NEWATOM_DEFN_OFFSET; \ - break; \ - default: goto op_ufn; \ - } \ - nextop2; \ - } \ - else if (TYPE_NEWATOM == GetTypeNumber(TOPOFSTACK)) \ - { /* NEW-symbol case; it's an offset from the main ptr */ \ - switch (nn) \ - { \ - case PLIS_HI: /* PLIST entry for symbol */ \ - TOPOFSTACK = TOPOFSTACK + NEWATOM_PLIST_OFFSET; \ - break; \ - case PNP_HI: /* PNAME entry for symbol */ \ - TOPOFSTACK = TOPOFSTACK + NEWATOM_PNAME_OFFSET; \ - break; \ - case VALS_HI: /* VALUE cell for symbol */ \ - TOPOFSTACK = TOPOFSTACK + NEWATOM_VALUE_OFFSET; \ - break; \ - case DEFS_HI: /* DEFINITION for symbol */ \ - TOPOFSTACK = TOPOFSTACK + NEWATOM_DEFN_OFFSET; \ - break; \ - default: goto op_ufn; \ - } \ - nextop2; \ - } \ - else goto op_ufn; \ - } +#define ATOMCELL_N(n) \ + { \ + register int nn = n; \ + if (0 == ((unsigned int)(TOPOFSTACK &= POINTERMASK) & \ + SEGMASK)) { /* old-symbol case; just add cell-number arg */ \ + switch (nn) { \ + case PLIS_HI: /* PLIST entry for symbol */ \ + TOPOFSTACK = (ATOMS_HI << 16) + (10 * (unsigned int)TOPOFSTACK) + NEWATOM_PLIST_OFFSET; \ + break; \ + case PNP_HI: /* PNAME entry for symbol */ \ + TOPOFSTACK = (ATOMS_HI << 16) + (10 * (unsigned int)TOPOFSTACK) + NEWATOM_PNAME_OFFSET; \ + break; \ + case VALS_HI: /* VALUE cell for symbol */ \ + TOPOFSTACK = (ATOMS_HI << 16) + (10 * (unsigned int)TOPOFSTACK) + NEWATOM_VALUE_OFFSET; \ + break; \ + case DEFS_HI: /* DEFINITION for symbol */ \ + TOPOFSTACK = (ATOMS_HI << 16) + (10 * (unsigned int)TOPOFSTACK) + NEWATOM_DEFN_OFFSET; \ + break; \ + default: goto op_ufn; \ + } \ + nextop2; \ + } else if (TYPE_NEWATOM == \ + GetTypeNumber( \ + TOPOFSTACK)) { /* NEW-symbol case; it's an offset from the main ptr */ \ + switch (nn) { \ + case PLIS_HI: /* PLIST entry for symbol */ \ + TOPOFSTACK = TOPOFSTACK + NEWATOM_PLIST_OFFSET; \ + break; \ + case PNP_HI: /* PNAME entry for symbol */ \ + TOPOFSTACK = TOPOFSTACK + NEWATOM_PNAME_OFFSET; \ + break; \ + case VALS_HI: /* VALUE cell for symbol */ \ + TOPOFSTACK = TOPOFSTACK + NEWATOM_VALUE_OFFSET; \ + break; \ + case DEFS_HI: /* DEFINITION for symbol */ \ + TOPOFSTACK = TOPOFSTACK + NEWATOM_DEFN_OFFSET; \ + break; \ + default: goto op_ufn; \ + } \ + nextop2; \ + } else \ + goto op_ufn; \ + } #else /* */ -#define ATOMCELL_N(n) \ - { register int nn = n; \ - if (0==((unsigned int)TOPOFSTACK & SEGMASK)) \ - { /* old-symbol case; just add cell-number arg */ \ - TOPOFSTACK = (nn << 16) + (TOPOFSTACK << 1) ; \ - nextop2; \ - } \ - else if (TYPE_NEWATOM == GetTypeNumber(TOPOFSTACK)) \ - { /* NEW-symbol case; it's an offset from the main ptr */ \ - switch (nn) \ - { \ - case PLIS_HI: /* PLIST entry for symbol */ \ - TOPOFSTACK = TOPOFSTACK + NEWATOM_PLIST_OFFSET; \ - break; \ - case PNP_HI: /* PNAME entry for symbol */ \ - TOPOFSTACK = TOPOFSTACK + NEWATOM_PNAME_OFFSET; \ - break; \ - case VALS_HI: /* VALUE cell for symbol */ \ - TOPOFSTACK = TOPOFSTACK + NEWATOM_VALUE_OFFSET; \ - break; \ - case DEFS_HI: /* DEFINITION for symbol */ \ - TOPOFSTACK = TOPOFSTACK + NEWATOM_DEFN_OFFSET; \ - break; \ - default: goto op_ufn; \ - } \ - nextop2; \ - } \ - else goto op_ufn; \ - } +#define ATOMCELL_N(n) \ + { \ + register int nn = n; \ + if (0 == \ + ((unsigned int)TOPOFSTACK & SEGMASK)) { /* old-symbol case; just add cell-number arg */ \ + TOPOFSTACK = (nn << 16) + (TOPOFSTACK << 1); \ + nextop2; \ + } else if (TYPE_NEWATOM == \ + GetTypeNumber( \ + TOPOFSTACK)) { /* NEW-symbol case; it's an offset from the main ptr */ \ + switch (nn) { \ + case PLIS_HI: /* PLIST entry for symbol */ \ + TOPOFSTACK = TOPOFSTACK + NEWATOM_PLIST_OFFSET; \ + break; \ + case PNP_HI: /* PNAME entry for symbol */ \ + TOPOFSTACK = TOPOFSTACK + NEWATOM_PNAME_OFFSET; \ + break; \ + case VALS_HI: /* VALUE cell for symbol */ \ + TOPOFSTACK = TOPOFSTACK + NEWATOM_VALUE_OFFSET; \ + break; \ + case DEFS_HI: /* DEFINITION for symbol */ \ + TOPOFSTACK = TOPOFSTACK + NEWATOM_DEFN_OFFSET; \ + break; \ + default: goto op_ufn; \ + } \ + nextop2; \ + } else \ + goto op_ufn; \ + } #endif /* BIGATOMS */ +#define DIFFERENCE \ + { N_OP_CALL_2(N_OP_difference); } +#define LOGOR \ + { N_OP_CALL_2(N_OP_logor); } +#define LOGAND \ + { N_OP_CALL_2(N_OP_logand); } +#define LOGXOR \ + { N_OP_CALL_2(N_OP_logxor); } +#define PLUS2 \ + { N_OP_CALL_2(N_OP_plus2); } +#define QUOTIENT \ + { N_OP_CALL_2(N_OP_quot); } +#define TIMES2 \ + { N_OP_CALL_2(N_OP_times2); } +#define GREATERP \ + { N_OP_CALL_2(N_OP_greaterp); } +#define IDIFFERENCE \ + { N_OP_CALL_2(N_OP_idifference); } +#define IPLUS2 \ + { N_OP_CALL_2(N_OP_iplus2); } +#define IQUOTIENT \ + { N_OP_CALL_2(N_OP_iquot); } +#define ITIMES2 \ + { N_OP_CALL_2(N_OP_itimes2); } +#define IGREATERP \ + { N_OP_CALL_2(N_OP_igreaterp); } +#define IREMAINDER \ + { N_OP_CALL_2(N_OP_iremainder); } +#define IPLUS_N(n) \ + { N_OP_CALL_1d(N_OP_iplusn, n) } +#define IDIFFERENCE_N(n) \ + { N_OP_CALL_1d(N_OP_idifferencen, n); } +#define BOXIPLUS \ + { N_OP_CALL_2(N_OP_boxiplus); } +#define BOXIDIFFERENCE \ + { N_OP_CALL_2(N_OP_boxidiff); } +#define FPLUS2 \ + { N_OP_CALL_2(N_OP_fplus2); } +#define FDIFFERENCE \ + { N_OP_CALL_2(N_OP_fdifference); } +#define FTIMES2 \ + { N_OP_CALL_2(N_OP_ftimes2); } +#define FQUOTIENT \ + { N_OP_CALL_2(N_OP_fquotient); } +#define FGREATERP \ + { N_OP_CALL_2(N_OP_fgreaterp); } +#define UBFLOAT1(n) \ + { N_OP_UNBOXED_CALL_1d(N_OP_ubfloat1, n); } +#define UBFLOAT2(n) \ + { N_OP_UNBOXED_CALL_2d(N_OP_ubfloat2, n); } +#define UBFLOAT3(n) \ + { N_OP_UNBOXED_CALL_3d(N_OP_ubfloat3, n); } +#define LRSH1 \ + { N_OP_CALL_1(N_OP_lrsh1); } +#define LRSH8 \ + { N_OP_CALL_1(N_OP_lrsh8); } +#define LLSH1 \ + { N_OP_CALL_1(N_OP_llsh1); } +#define LLSH8 \ + { N_OP_CALL_1(N_OP_llsh8); } +#define LSH \ + { N_OP_CALL_2(N_OP_lsh); } +#define RPLACA \ + { N_OP_CALL_2(N_OP_rplaca); } +#define RPLACD \ + { N_OP_CALL_2(N_OP_rplacd); } +#define RPLCONS \ + { N_OP_CALL_2(N_OP_rplcons); } +#define MAKENUMBER \ + { N_OP_CALL_2(N_OP_makenumber); } +#define EQLOP \ + { N_OP_CALL_2(N_OP_eqlop); } +#define CLEQUAL \ + { N_OP_CALL_2(N_OP_clequal); } +#define ILEQUAL \ + { N_OP_CALL_2(N_OP_equal); } +#define CLFMEMB \ + { N_OP_CALL_exception_2(N_OP_clfmemb); } +#define CLASSOC \ + { N_OP_CALL_exception_2(N_OP_classoc); } +#define FMEMB \ + { N_OP_CALL_exception_2(N_OP_fmemb); } +#define ASSOC \ + { N_OP_CALL_exception_2(N_OP_assoc); } +#define ARG0 \ + { N_OP_CALL_1(N_OP_arg0); } +#define LISTGET \ + { N_OP_CALL_exception_2C(N_OP_listget); } +#define DRAWLINE \ + { N_OP_CALL_9(N_OP_drawline); } +#define N_OP_ADDBASE \ + { N_OP_CALL_2(N_OP_addbase); } -#define DIFFERENCE {N_OP_CALL_2(N_OP_difference);} -#define LOGOR {N_OP_CALL_2(N_OP_logor);} -#define LOGAND {N_OP_CALL_2(N_OP_logand);} -#define LOGXOR {N_OP_CALL_2(N_OP_logxor);} -#define PLUS2 {N_OP_CALL_2(N_OP_plus2);} -#define QUOTIENT {N_OP_CALL_2(N_OP_quot);} -#define TIMES2 {N_OP_CALL_2(N_OP_times2);} -#define GREATERP {N_OP_CALL_2(N_OP_greaterp);} -#define IDIFFERENCE {N_OP_CALL_2(N_OP_idifference);} -#define IPLUS2 {N_OP_CALL_2(N_OP_iplus2);} -#define IQUOTIENT {N_OP_CALL_2(N_OP_iquot);} -#define ITIMES2 {N_OP_CALL_2(N_OP_itimes2);} -#define IGREATERP {N_OP_CALL_2(N_OP_igreaterp);} -#define IREMAINDER {N_OP_CALL_2(N_OP_iremainder);} -#define IPLUS_N(n) {N_OP_CALL_1d(N_OP_iplusn, n)} -#define IDIFFERENCE_N(n) {N_OP_CALL_1d(N_OP_idifferencen, n);} -#define BOXIPLUS {N_OP_CALL_2(N_OP_boxiplus);} -#define BOXIDIFFERENCE {N_OP_CALL_2(N_OP_boxidiff);} -#define FPLUS2 {N_OP_CALL_2(N_OP_fplus2);} -#define FDIFFERENCE {N_OP_CALL_2(N_OP_fdifference);} -#define FTIMES2 {N_OP_CALL_2(N_OP_ftimes2);} -#define FQUOTIENT {N_OP_CALL_2(N_OP_fquotient);} -#define FGREATERP {N_OP_CALL_2(N_OP_fgreaterp);} -#define UBFLOAT1(n) {N_OP_UNBOXED_CALL_1d(N_OP_ubfloat1, n);} -#define UBFLOAT2(n) {N_OP_UNBOXED_CALL_2d(N_OP_ubfloat2, n);} -#define UBFLOAT3(n) {N_OP_UNBOXED_CALL_3d(N_OP_ubfloat3, n);} -#define LRSH1 {N_OP_CALL_1(N_OP_lrsh1);} -#define LRSH8 {N_OP_CALL_1(N_OP_lrsh8);} -#define LLSH1 {N_OP_CALL_1(N_OP_llsh1);} -#define LLSH8 {N_OP_CALL_1(N_OP_llsh8);} -#define LSH {N_OP_CALL_2(N_OP_lsh);} -#define RPLACA {N_OP_CALL_2(N_OP_rplaca);} -#define RPLACD {N_OP_CALL_2(N_OP_rplacd);} -#define RPLCONS {N_OP_CALL_2(N_OP_rplcons);} -#define MAKENUMBER {N_OP_CALL_2(N_OP_makenumber);} -#define EQLOP {N_OP_CALL_2(N_OP_eqlop);} -#define CLEQUAL {N_OP_CALL_2(N_OP_clequal);} -#define ILEQUAL {N_OP_CALL_2(N_OP_equal);} -#define CLFMEMB {N_OP_CALL_exception_2(N_OP_clfmemb);} -#define CLASSOC {N_OP_CALL_exception_2(N_OP_classoc);} -#define FMEMB {N_OP_CALL_exception_2(N_OP_fmemb);} -#define ASSOC {N_OP_CALL_exception_2(N_OP_assoc);} -#define ARG0 {N_OP_CALL_1(N_OP_arg0);} -#define LISTGET {N_OP_CALL_exception_2C(N_OP_listget);} -#define DRAWLINE {N_OP_CALL_9(N_OP_drawline);} -#define N_OP_ADDBASE {N_OP_CALL_2(N_OP_addbase);} +#define UNWIND(n, m) \ + { \ + if ((CSTKPTRL = N_OP_unwind(CSTKPTR, TOPOFSTACK, n, m)) == (LispPTR *)-1) goto unwind_err; \ + POP; \ + nextop3; \ + } -#define UNWIND(n, m) \ - { \ - if ((CSTKPTRL = N_OP_unwind(CSTKPTR, TOPOFSTACK, n, m)) == (LispPTR *)-1) \ - goto unwind_err; \ - POP; \ - nextop3; \ - } +#define STKSCAN \ + { \ + TOPOFSTACK = N_OP_stkscan(TOPOFSTACK); \ + nextop1; \ + } -#define STKSCAN \ - {TOPOFSTACK = N_OP_stkscan(TOPOFSTACK); \ - nextop1; \ - } +#define FVARX_(n) \ + { \ + TOPOFSTACK = N_OP_fvar_(TOPOFSTACK, n); \ + nextop2; \ + } -#define FVARX_(n) \ - {TOPOFSTACK = N_OP_fvar_(TOPOFSTACK, n); \ - nextop2; \ - } +#define BLT \ + { N_OP_CALL_3(N_OP_blt); } -#define BLT {N_OP_CALL_3(N_OP_blt);} +#define PILOTBITBLT \ + { \ + TOPOFSTACK = N_OP_pilotbitblt(POP_TOS_1, TOPOFSTACK); \ + nextop1; \ + } -#define PILOTBITBLT \ - {TOPOFSTACK = N_OP_pilotbitblt(POP_TOS_1, TOPOFSTACK); \ - nextop1; \ - } +#define CREATECELL \ + { N_OP_CALL_1(N_OP_createcell); } -#define CREATECELL {N_OP_CALL_1(N_OP_createcell);} - -#define RESTLIST(n) {TOPOFSTACK = N_OP_restlist(POP_TOS_1, TOPOFSTACK, n);\ - nextop2;} - - -#define ASET1 {N_OP_CALL_3(N_OP_aset1);} -#define ASET2 {N_OP_CALL_4(N_OP_aset2);} -#define MISC3(n) {N_OP_CALL_3d(N_OP_misc3, n);} -#define MISC4(n) {N_OP_CALL_4d(N_OP_misc4, n);} -#define MISC7(n) {N_OP_CALL_7d(N_OP_misc7, n);} -#define AREF2 {N_OP_CALL_3(N_OP_aref2);} -#define MISCN(index, args) \ -{ EXT; \ - if (OP_miscn(index,args)) { \ - RET; \ - /* PUSH(S_POSITIVE | (index << 8) | args); */ \ - goto op_ufn; \ - } \ - RET; \ - nextop0; \ -} +#define RESTLIST(n) \ + { \ + TOPOFSTACK = N_OP_restlist(POP_TOS_1, TOPOFSTACK, n); \ + nextop2; \ + } +#define ASET1 \ + { N_OP_CALL_3(N_OP_aset1); } +#define ASET2 \ + { N_OP_CALL_4(N_OP_aset2); } +#define MISC3(n) \ + { N_OP_CALL_3d(N_OP_misc3, n); } +#define MISC4(n) \ + { N_OP_CALL_4d(N_OP_misc4, n); } +#define MISC7(n) \ + { N_OP_CALL_7d(N_OP_misc7, n); } +#define AREF2 \ + { N_OP_CALL_3(N_OP_aref2); } +#define MISCN(index, args) \ + { \ + EXT; \ + if (OP_miscn(index, args)) { \ + RET; \ + /* PUSH(S_POSITIVE | (index << 8) | args); */ \ + goto op_ufn; \ + } \ + RET; \ + nextop0; \ + } /* ******************************************************************** */ /* Call Interface where -1 indicates an error return */ @@ -902,149 +1066,138 @@ nextop2; \ /* SV need do no work */ #define SV -/* UFN_CALLS are inserted in xc.c. Note that only ufn_2 calls have decremented the stack at the time the UFN is called */ +/* UFN_CALLS are inserted in xc.c. Note that only ufn_2 calls have decremented the stack at the time + * the UFN is called */ /* ufn_x there are x args from the Lisp stack - ufn_xd there are x args from the Lisp stack & - some from the code stream. + ufn_xd there are x args from the Lisp stack & + some from the code stream. */ -#define UFN_CALLS \ - \ -unwind_err: \ - CSTKPTRL = (LispPTR *) CurrentStackPTR; \ - Error_Exit = 0; \ - goto op_ufn; \ -ufn_2d: CSTKPTRL += 1; \ - goto fix_tos_ufn; \ -ufn_2d2:CSTKPTRL += 1; \ - goto fix_tos_ufn; \ -ufn_2: CSTKPTRL += 1; \ - goto fix_tos_ufn; \ -exception_2 : \ - Error_Exit = 0; \ - CSTKPTRL += 1; \ - TOPOFSTACK = TopOfStack; \ - if(!Irq_Stk_End){ \ - goto check_interrupt; \ - } \ - else goto op_ufn; \ -exception_2C : \ - Error_Exit = 0; \ - TOPOFSTACK = TopOfStack; \ - *CSTKPTRL = Scratch_CSTK; \ - CSTKPTRL += 1; \ - if(!Irq_Stk_End){ \ - goto check_interrupt; \ - } \ - else { \ - goto op_ufn; \ - } \ -fix_tos_ufn: \ - TOPOFSTACK = TopOfStack; \ - Error_Exit = 0; \ - goto op_ufn; +#define UFN_CALLS \ + \ + unwind_err: \ + CSTKPTRL = (LispPTR *)CurrentStackPTR; \ + Error_Exit = 0; \ + goto op_ufn; \ + ufn_2d: \ + CSTKPTRL += 1; \ + goto fix_tos_ufn; \ + ufn_2d2: \ + CSTKPTRL += 1; \ + goto fix_tos_ufn; \ + ufn_2: \ + CSTKPTRL += 1; \ + goto fix_tos_ufn; \ + exception_2: \ + Error_Exit = 0; \ + CSTKPTRL += 1; \ + TOPOFSTACK = TopOfStack; \ + if (!Irq_Stk_End) { \ + goto check_interrupt; \ + } else \ + goto op_ufn; \ + exception_2C: \ + Error_Exit = 0; \ + TOPOFSTACK = TopOfStack; \ + *CSTKPTRL = Scratch_CSTK; \ + CSTKPTRL += 1; \ + if (!Irq_Stk_End) { \ + goto check_interrupt; \ + } else { \ + goto op_ufn; \ + } \ + fix_tos_ufn: \ + TOPOFSTACK = TopOfStack; \ + Error_Exit = 0; \ + goto op_ufn; -#define N_OP_CALL_1(op_name) \ -if ((int)(TOPOFSTACK = (LispPTR)op_name(TOPOFSTACK)) < 0) goto fix_tos_ufn;\ -nextop1; +#define N_OP_CALL_1(op_name) \ + if ((int)(TOPOFSTACK = (LispPTR)op_name(TOPOFSTACK)) < 0) goto fix_tos_ufn; \ + nextop1; +#define N_OP_CALL_1d(op_name, n) \ + if ((int)(TOPOFSTACK = (LispPTR)op_name(TOPOFSTACK, n)) < 0) goto fix_tos_ufn; \ + nextop2; -#define N_OP_CALL_1d(op_name, n) \ -if ((int)(TOPOFSTACK = (LispPTR)op_name(TOPOFSTACK, n)) < 0) goto fix_tos_ufn;\ -nextop2; +#define N_OP_UNBOXED_CALL_1d(op_name, n) \ + TOPOFSTACK = op_name(TOPOFSTACK, n); \ + if (Error_Exit) goto fix_tos_ufn; \ + nextop2; -#define N_OP_UNBOXED_CALL_1d(op_name, n) \ -TOPOFSTACK = op_name(TOPOFSTACK, n); \ -if (Error_Exit) goto fix_tos_ufn; \ -nextop2; +#define N_OP_CALL_2(op_name) \ + if ((int)(TOPOFSTACK = (LispPTR)op_name(POP_TOS_1, TOPOFSTACK)) < 0) goto ufn_2; \ + nextop1; +#define N_OP_POPPED_CALL_2(op_name, popped_arg) \ + if ((int)(TOPOFSTACK = (LispPTR)op_name(popped_arg, TOPOFSTACK)) < 0) goto ufn_2; \ + nextop1; -#define N_OP_CALL_2(op_name) \ -if ((int)(TOPOFSTACK = (LispPTR)op_name(POP_TOS_1, TOPOFSTACK)) < 0) \ - goto ufn_2; \ -nextop1; +#define N_OP_CALL_2d(op_name, n) \ + if ((int)(TOPOFSTACK = (LispPTR)op_name(POP_TOS_1, TOPOFSTACK, n)) < 0) goto ufn_2d; \ + nextop2; -#define N_OP_POPPED_CALL_2(op_name, popped_arg) \ -if ((int)(TOPOFSTACK = (LispPTR)op_name(popped_arg, TOPOFSTACK)) < 0) \ - goto ufn_2; \ -nextop1; +#define N_OP_UNBOXED_CALL_2d(op_name, n) \ + TOPOFSTACK = op_name(POP_TOS_1, TOPOFSTACK, n); \ + if (Error_Exit) goto ufn_2d; \ + nextop2; -#define N_OP_CALL_2d(op_name, n) \ -if ((int)(TOPOFSTACK = (LispPTR)op_name(POP_TOS_1, TOPOFSTACK, n)) < 0) \ - goto ufn_2d; \ -nextop2; +#define N_OP_CALL_2d2(op_name, a, b) \ + if ((int)(TOPOFSTACK = (LispPTR)op_name(POP_TOS_1, TOPOFSTACK, a, b)) < 0) goto ufn_2d2; \ + nextop3; -#define N_OP_UNBOXED_CALL_2d(op_name, n) \ -TOPOFSTACK = op_name(POP_TOS_1, TOPOFSTACK, n); \ -if (Error_Exit) goto ufn_2d; \ -nextop2; +#define N_OP_CALL_exception_2(op_name) \ + if ((int)(TOPOFSTACK = (LispPTR)op_name(POP_TOS_1, TOPOFSTACK)) < 0) goto exception_2; \ + nextop1; -#define N_OP_CALL_2d2(op_name, a, b) \ -if ((int)(TOPOFSTACK = (LispPTR)op_name(POP_TOS_1, TOPOFSTACK, a, b)) < 0) \ - goto ufn_2d2; \ -nextop3; +#define N_OP_CALL_exception_2C(op_name) \ + if ((int)(TOPOFSTACK = (LispPTR)op_name(POP_TOS_1, TOPOFSTACK)) < 0) goto exception_2C; \ + nextop1; -#define N_OP_CALL_exception_2(op_name) \ -if ((int)(TOPOFSTACK = (LispPTR)op_name(POP_TOS_1, TOPOFSTACK)) < 0) \ - goto exception_2; \ -nextop1; +#define N_OP_CALL_3(op_name) \ + if ((int)(TOPOFSTACK = (LispPTR)op_name(*(CSTKPTR - 2), *(CSTKPTR - 1), TOPOFSTACK)) < 0) \ + goto fix_tos_ufn; \ + CSTKPTRL -= 2; \ + nextop1; -#define N_OP_CALL_exception_2C(op_name) \ -if ((int)(TOPOFSTACK = (LispPTR)op_name(POP_TOS_1, TOPOFSTACK)) < 0) \ - goto exception_2C; \ -nextop1; +#define N_OP_CALL_3d(op_name, n) \ + if ((int)(TOPOFSTACK = (LispPTR)op_name(*(CSTKPTR - 2), *(CSTKPTR - 1), TOPOFSTACK, n)) < 0) \ + goto fix_tos_ufn; \ + CSTKPTRL -= 2; \ + nextop2; -#define N_OP_CALL_3(op_name) \ -if ((int)(TOPOFSTACK = (LispPTR)op_name( \ - *(CSTKPTR-2), *(CSTKPTR-1), TOPOFSTACK)) < 0) \ - goto fix_tos_ufn; \ -CSTKPTRL -= 2; \ -nextop1; +#define N_OP_UNBOXED_CALL_3d(op_name, n) \ + TOPOFSTACK = op_name(*(CSTKPTR - 2), *(CSTKPTR - 1), TOPOFSTACK, n); \ + if (Error_Exit) goto fix_tos_ufn; \ + CSTKPTRL -= 2; \ + nextop2; -#define N_OP_CALL_3d(op_name, n) \ -if ((int)(TOPOFSTACK = (LispPTR)op_name( \ - *(CSTKPTR-2), *(CSTKPTR-1), TOPOFSTACK, n)) < 0) \ - goto fix_tos_ufn; \ -CSTKPTRL -= 2; \ -nextop2; +#define N_OP_CALL_4(op_name) \ + if ((int)(TOPOFSTACK = \ + (LispPTR)op_name(*(CSTKPTR - 3), *(CSTKPTR - 2), *(CSTKPTR - 1), TOPOFSTACK)) < 0) \ + goto fix_tos_ufn; \ + CSTKPTRL -= 3; \ + nextop1; -#define N_OP_UNBOXED_CALL_3d(op_name, n) \ -TOPOFSTACK = op_name(*(CSTKPTR-2), *(CSTKPTR-1), TOPOFSTACK, n); \ -if (Error_Exit) goto fix_tos_ufn; \ -CSTKPTRL -= 2; \ -nextop2; +#define N_OP_CALL_4d(op_name, n) \ + if ((int)(TOPOFSTACK = (LispPTR)op_name(*(CSTKPTR - 3), *(CSTKPTR - 2), *(CSTKPTR - 1), \ + TOPOFSTACK, n)) < 0) \ + goto fix_tos_ufn; \ + CSTKPTRL -= 3; \ + nextop2; +#define N_OP_CALL_7d(op_name, n) \ + if ((int)(TOPOFSTACK = \ + (LispPTR)op_name(*(CSTKPTR - 6), *(CSTKPTR - 5), *(CSTKPTR - 4), *(CSTKPTR - 3), \ + *(CSTKPTR - 2), *(CSTKPTR - 1), TOPOFSTACK, n)) < 0) \ + goto fix_tos_ufn; \ + CSTKPTRL -= 6; \ + nextop2; -#define N_OP_CALL_4(op_name) \ -if ((int)(TOPOFSTACK = (LispPTR)op_name( \ - *(CSTKPTR-3), *(CSTKPTR-2), *(CSTKPTR-1), TOPOFSTACK)) < 0) \ - goto fix_tos_ufn; \ -CSTKPTRL -= 3; \ -nextop1; - - -#define N_OP_CALL_4d(op_name, n) \ -if ((int)(TOPOFSTACK = (LispPTR)op_name( \ - *(CSTKPTR-3), *(CSTKPTR-2), *(CSTKPTR-1), TOPOFSTACK, n)) < 0) \ - goto fix_tos_ufn; \ -CSTKPTRL -= 3; \ -nextop2; - -#define N_OP_CALL_7d(op_name, n) \ -if ((int)(TOPOFSTACK = (LispPTR)op_name( \ - *(CSTKPTR-6), *(CSTKPTR-5), *(CSTKPTR-4), \ - *(CSTKPTR-3), *(CSTKPTR-2), *(CSTKPTR-1), TOPOFSTACK, n)) < 0) \ - goto fix_tos_ufn; \ -CSTKPTRL -= 6; \ -nextop2; - - - -#define N_OP_CALL_9(op_name) \ -if ((int)(TOPOFSTACK = (LispPTR)op_name( \ - *(CSTKPTR-8), *(CSTKPTR-7), *(CSTKPTR-6), \ - *(CSTKPTR-5), *(CSTKPTR-4), *(CSTKPTR-3), *(CSTKPTR-2),\ - *(CSTKPTR-1), TOPOFSTACK /*, fix_tos_ufn*/)) < 0) \ - goto fix_tos_ufn; \ -CSTKPTRL -= 8; \ -nextop1; +#define N_OP_CALL_9(op_name) \ + if ((int)(TOPOFSTACK = \ + (LispPTR)op_name(*(CSTKPTR - 8), *(CSTKPTR - 7), *(CSTKPTR - 6), *(CSTKPTR - 5), \ + *(CSTKPTR - 4), *(CSTKPTR - 3), *(CSTKPTR - 2), *(CSTKPTR - 1), \ + TOPOFSTACK /*, fix_tos_ufn*/)) < 0) \ + goto fix_tos_ufn; \ + CSTKPTRL -= 8; \ + nextop1; diff --git a/inc/lispemul.h b/inc/lispemul.h index d952371..a303a74 100644 --- a/inc/lispemul.h +++ b/inc/lispemul.h @@ -1,8 +1,7 @@ #ifndef LISPEMUL_H #define LISPEMUL_H 1 -/* $Id: lispemul.h,v 1.4 2001/12/24 01:08:57 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ - - +/* $Id: lispemul.h,v 1.4 2001/12/24 01:08:57 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved + */ /************************************************************************/ /* */ @@ -11,115 +10,102 @@ /* */ /************************************************************************/ - - - #ifndef BYTESWAP - /*** Normal byte-order type decls */ -typedef struct {unsigned char code;} BYTECODE; +/*** Normal byte-order type decls */ +typedef struct { + unsigned char code; +} BYTECODE; typedef char ByteCode; -typedef unsigned short DLword; -typedef char DLbyte; -typedef unsigned int LispPTR; +typedef unsigned short DLword; +typedef char DLbyte; +typedef unsigned int LispPTR; /* 32 bit Cell Chang. 14 Jan 87 take */ -typedef DLword mds_page; /* Top word of the MDS */ +typedef DLword mds_page; /* Top word of the MDS */ #ifdef BIGVM -typedef struct consstr - { - unsigned cdr_code : 4; - unsigned car_field : 28; - } ConsCell; +typedef struct consstr { + unsigned cdr_code : 4; + unsigned car_field : 28; +} ConsCell; -typedef struct ufn_entry - { - DLword atom_name; /* UFN's atomindex */ - unsigned byte_num : 8; /* num of byte code */ - unsigned arg_num : 8; /* num of arguments */ - } UFN; +typedef struct ufn_entry { + DLword atom_name; /* UFN's atomindex */ + unsigned byte_num : 8; /* num of byte code */ + unsigned arg_num : 8; /* num of arguments */ +} UFN; -typedef struct closure_type - { - unsigned nil1 : 4; - unsigned def_ptr : 28; /* LispPTR to definition cell */ - unsigned nil2 : 4; - unsigned env_ptr : 28; /* LispPTR to environment */ - } Closure; +typedef struct closure_type { + unsigned nil1 : 4; + unsigned def_ptr : 28; /* LispPTR to definition cell */ + unsigned nil2 : 4; + unsigned env_ptr : 28; /* LispPTR to environment */ +} Closure; #else /* not BIGVM */ -typedef struct consstr - { - unsigned cdr_code : 8; - unsigned car_field : 24; - } ConsCell; +typedef struct consstr { + unsigned cdr_code : 8; + unsigned car_field : 24; +} ConsCell; -typedef struct ufn_entry - { - DLword atom_name; /* UFN's atomindex */ - unsigned byte_num : 8; /* num of byte code */ - unsigned arg_num : 8; /* num of arguments */ - } UFN; +typedef struct ufn_entry { + DLword atom_name; /* UFN's atomindex */ + unsigned byte_num : 8; /* num of byte code */ + unsigned arg_num : 8; /* num of arguments */ +} UFN; -typedef struct closure_type - { - unsigned nil1 : 8; - unsigned def_ptr : 24; /* LispPTR to definition cell */ - unsigned nil2 : 8; - unsigned env_ptr : 24; /* LispPTR to environment */ - } Closure; +typedef struct closure_type { + unsigned nil1 : 8; + unsigned def_ptr : 24; /* LispPTR to definition cell */ + unsigned nil2 : 8; + unsigned env_ptr : 24; /* LispPTR to environment */ +} Closure; #endif /* BIGVM */ -typedef struct interrupt_state - { /* Interrupt-request mask to communicate with INTERRUPTED */ - unsigned LogFileIO :1; /* console msg arrived to print */ - unsigned ETHERInterrupt :1; /* 10MB activity happened */ - unsigned IOInterrupt :1; /* I/O happened (not used yet) */ - unsigned gcdisabled :1; - unsigned vmemfull :1; - unsigned stackoverflow :1; - unsigned storagefull :1; - unsigned waitinginterrupt :1; - unsigned nil :8; /* mask of ints being processed */ - DLword intcharcode; - } INTSTAT; +typedef struct interrupt_state { /* Interrupt-request mask to communicate with INTERRUPTED */ + unsigned LogFileIO : 1; /* console msg arrived to print */ + unsigned ETHERInterrupt : 1; /* 10MB activity happened */ + unsigned IOInterrupt : 1; /* I/O happened (not used yet) */ + unsigned gcdisabled : 1; + unsigned vmemfull : 1; + unsigned stackoverflow : 1; + unsigned storagefull : 1; + unsigned waitinginterrupt : 1; + unsigned nil : 8; /* mask of ints being processed */ + DLword intcharcode; +} INTSTAT; -typedef struct interrupt_state_2 - { /* alternate view of the interrupt state */ - unsigned pendingmask :8; - unsigned handledmask :8; - DLword nil; - } INTSTAT2; +typedef struct interrupt_state_2 { /* alternate view of the interrupt state */ + unsigned pendingmask : 8; + unsigned handledmask : 8; + DLword nil; +} INTSTAT2; -struct state - { - DLword *ivar; /* + 0 */ - DLword *pvar; /* + 4 */ - DLword *csp; /* + 8 */ - LispPTR tosvalue; /* + 12 */ - ByteCode *currentpc; /* + 16 */ - struct fnhead *currentfunc; /* + 20*/ - DLword *endofstack; /* + 24*/ - UNSIGNED irqcheck; /* + 28 */ - UNSIGNED irqend; /* + 32 */ - LispPTR scratch_cstk; /* + 34 */ - int errorexit; /* + 38 */ - }; +struct state { + DLword *ivar; /* + 0 */ + DLword *pvar; /* + 4 */ + DLword *csp; /* + 8 */ + LispPTR tosvalue; /* + 12 */ + ByteCode *currentpc; /* + 16 */ + struct fnhead *currentfunc; /* + 20*/ + DLword *endofstack; /* + 24*/ + UNSIGNED irqcheck; /* + 28 */ + UNSIGNED irqend; /* + 32 */ + LispPTR scratch_cstk; /* + 34 */ + int errorexit; /* + 38 */ +}; /***** Get_DLword(ptr) ptr is char* ***/ #ifndef UNALIGNED_FETCH_OK -#define Get_DLword(ptr) ((Get_BYTE(ptr) <<8) | Get_BYTE(ptr+1)) +#define Get_DLword(ptr) ((Get_BYTE(ptr) << 8) | Get_BYTE(ptr + 1)) #else -#define Get_DLword(ptr) *(((DLword *)WORDPTR(ptr))) +#define Get_DLword(ptr) *(((DLword *)WORDPTR(ptr))) #endif #ifdef BIGVM -#define Get_Pointer(ptr) ((Get_BYTE(ptr) << 24) | \ - (Get_BYTE(ptr+1) << 16) | \ - (Get_BYTE(ptr+2) << 8) | Get_BYTE(ptr+3)) +#define Get_Pointer(ptr) \ + ((Get_BYTE(ptr) << 24) | (Get_BYTE(ptr + 1) << 16) | (Get_BYTE(ptr + 2) << 8) | Get_BYTE(ptr + 3)) #else -#define Get_Pointer(ptr) ((Get_BYTE(ptr) << 16) | \ - (Get_BYTE(ptr+1) << 8) | \ - Get_BYTE(ptr+2)) +#define Get_Pointer(ptr) ((Get_BYTE(ptr) << 16) | (Get_BYTE(ptr + 1) << 8) | Get_BYTE(ptr + 2)) #endif /* BIGVM */ #define Get_code_BYTE Get_BYTE @@ -128,152 +114,139 @@ struct state #define Get_code_Pointer Get_Pointer #ifdef BIGATOMS -#define Get_AtomNo(ptr) Get_Pointer(ptr) +#define Get_AtomNo(ptr) Get_Pointer(ptr) #else #define Get_AtomNo(ptr) Get_DLword(ptr) #endif /* BIGATOMS */ - /* For bit test */ -typedef struct wbits - { - unsigned xMSB :1; - unsigned B1 :1; - unsigned B2 :1; - unsigned B3 :1; - unsigned B4 :1; - unsigned B5 :1; - unsigned B6 :1; - unsigned B7 :1; - unsigned B8 :1; - unsigned B9 :1; - unsigned B10 :1; - unsigned B11 :1; - unsigned B12 :1; - unsigned B13 :1; - unsigned B14 :1; - unsigned LSB :1; - }WBITS; +typedef struct wbits { + unsigned xMSB : 1; + unsigned B1 : 1; + unsigned B2 : 1; + unsigned B3 : 1; + unsigned B4 : 1; + unsigned B5 : 1; + unsigned B6 : 1; + unsigned B7 : 1; + unsigned B8 : 1; + unsigned B9 : 1; + unsigned B10 : 1; + unsigned B11 : 1; + unsigned B12 : 1; + unsigned B13 : 1; + unsigned B14 : 1; + unsigned LSB : 1; +} WBITS; -typedef struct lbits - { - unsigned xMSB :1; - unsigned MIDDLE :30; - unsigned LSB :1; - }LBITS; +typedef struct lbits { + unsigned xMSB : 1; + unsigned MIDDLE : 30; + unsigned LSB : 1; +} LBITS; -#define PUTBASEBIT68K(base68k, offset, bitvalue ) { \ - if( bitvalue) \ - *((DLword*)(base68k) + (((u_short)(offset))>>4 )) \ - |= 1 << (15 - ((u_short)(offset))%BITSPER_DLWORD); \ - else \ - *((DLword*)(base68k) + (((u_short)(offset))>>4 )) \ - &= ~( 1 << (15 - ((u_short)(offset)) %BITSPER_DLWORD)); \ - } +#define PUTBASEBIT68K(base68k, offset, bitvalue) \ + { \ + if (bitvalue) \ + *((DLword *)(base68k) + (((u_short)(offset)) >> 4)) |= \ + 1 << (15 - ((u_short)(offset)) % BITSPER_DLWORD); \ + else \ + *((DLword *)(base68k) + (((u_short)(offset)) >> 4)) &= \ + ~(1 << (15 - ((u_short)(offset)) % BITSPER_DLWORD)); \ + } #else - /*** Byte-swapped structure declarations, for 80386 ***/ -typedef struct {unsigned char code;} BYTECODE; +/*** Byte-swapped structure declarations, for 80386 ***/ +typedef struct { + unsigned char code; +} BYTECODE; typedef char ByteCode; -typedef unsigned short DLword; -typedef char DLbyte; -typedef unsigned int LispPTR; +typedef unsigned short DLword; +typedef char DLbyte; +typedef unsigned int LispPTR; /* 32 bit Cell Chang. 14 Jan 87 take */ -typedef DLword mds_page; /* Top word of the MDS */ +typedef DLword mds_page; /* Top word of the MDS */ #ifdef BIGVM -typedef struct consstr - { - unsigned car_field : 28; - unsigned cdr_code : 4; - } ConsCell; +typedef struct consstr { + unsigned car_field : 28; + unsigned cdr_code : 4; +} ConsCell; -typedef struct ufn_entry - { - unsigned arg_num : 8; /* num of arguments */ - unsigned byte_num : 8; /* num of byte code */ - DLword atom_name; /* UFN's atomindex */ - } UFN; +typedef struct ufn_entry { + unsigned arg_num : 8; /* num of arguments */ + unsigned byte_num : 8; /* num of byte code */ + DLword atom_name; /* UFN's atomindex */ +} UFN; -typedef struct closure_type - { - unsigned def_ptr : 28; /* LispPTR to definition cell */ - unsigned nil1 : 4; - unsigned env_ptr : 28; /* LispPTR to environment */ - unsigned nil2 : 4; - } Closure; +typedef struct closure_type { + unsigned def_ptr : 28; /* LispPTR to definition cell */ + unsigned nil1 : 4; + unsigned env_ptr : 28; /* LispPTR to environment */ + unsigned nil2 : 4; +} Closure; #else /* BIGVM */ -typedef struct consstr - { - unsigned car_field : 24; - unsigned cdr_code : 8; - } ConsCell; +typedef struct consstr { + unsigned car_field : 24; + unsigned cdr_code : 8; +} ConsCell; -typedef struct ufn_entry - { - unsigned arg_num : 8; /* num of arguments */ - unsigned byte_num : 8; /* num of byte code */ - DLword atom_name; /* UFN's atomindex */ - } UFN; +typedef struct ufn_entry { + unsigned arg_num : 8; /* num of arguments */ + unsigned byte_num : 8; /* num of byte code */ + DLword atom_name; /* UFN's atomindex */ +} UFN; -typedef struct closure_type - { - unsigned def_ptr : 24; /* LispPTR to definition cell */ - unsigned nil1 : 8; - unsigned env_ptr : 24; /* LispPTR to environment */ - unsigned nil2 : 8; - } Closure; +typedef struct closure_type { + unsigned def_ptr : 24; /* LispPTR to definition cell */ + unsigned nil1 : 8; + unsigned env_ptr : 24; /* LispPTR to environment */ + unsigned nil2 : 8; +} Closure; #endif /* BIGVM */ -typedef struct interrupt_state - { /* Interrupt-request mask to communicate with INTERRUPTED */ - DLword intcharcode; - unsigned nil :8; - unsigned waitinginterrupt :1; - unsigned storagefull :1; - unsigned stackoverflow :1; - unsigned vmemfull :1; - unsigned gcdisabled :1; - unsigned IOInterrupt :1; /* I/O happened (not used yet) */ - unsigned ETHERInterrupt :1; /* 10MB activity happened */ - unsigned LogFileIO :1; /* console msg arrived to print */ - } INTSTAT; +typedef struct interrupt_state { /* Interrupt-request mask to communicate with INTERRUPTED */ + DLword intcharcode; + unsigned nil : 8; + unsigned waitinginterrupt : 1; + unsigned storagefull : 1; + unsigned stackoverflow : 1; + unsigned vmemfull : 1; + unsigned gcdisabled : 1; + unsigned IOInterrupt : 1; /* I/O happened (not used yet) */ + unsigned ETHERInterrupt : 1; /* 10MB activity happened */ + unsigned LogFileIO : 1; /* console msg arrived to print */ +} INTSTAT; -typedef struct interrupt_state_2 - { /* alternate view of the interrupt state */ - DLword nil; - unsigned handledmask :8; - unsigned pendingmask :8; - } INTSTAT2; +typedef struct interrupt_state_2 { /* alternate view of the interrupt state */ + DLword nil; + unsigned handledmask : 8; + unsigned pendingmask : 8; +} INTSTAT2; - -struct state - { - DLword *ivar; /* + 0 */ - DLword *pvar; /* + 4 */ - DLword *csp; /* + 8 */ - LispPTR tosvalue; /* + 12 */ - ByteCode *currentpc; /* + 16 */ - struct fnhead *currentfunc; /* + 20*/ - DLword *endofstack; /* + 24*/ - UNSIGNED irqcheck; /* + 28 */ - UNSIGNED irqend; /* + 32 */ - LispPTR scratch_cstk; /* + 34 */ - int errorexit; /* + 38 */ - }; +struct state { + DLword *ivar; /* + 0 */ + DLword *pvar; /* + 4 */ + DLword *csp; /* + 8 */ + LispPTR tosvalue; /* + 12 */ + ByteCode *currentpc; /* + 16 */ + struct fnhead *currentfunc; /* + 20*/ + DLword *endofstack; /* + 24*/ + UNSIGNED irqcheck; /* + 28 */ + UNSIGNED irqend; /* + 32 */ + LispPTR scratch_cstk; /* + 34 */ + int errorexit; /* + 38 */ +}; /* Fetching 2 bytes to make a word -- always do it the hard way */ /* if we're byte-swapped: You can't rely on byte ordering!! */ -#define Get_DLword(ptr) ((Get_BYTE(ptr) <<8) | Get_BYTE(ptr+1)) +#define Get_DLword(ptr) ((Get_BYTE(ptr) << 8) | Get_BYTE(ptr + 1)) #ifdef BIGVM -#define Get_Pointer(ptr) ((Get_BYTE(ptr) << 24) | \ - (Get_BYTE(ptr+1) << 16) | \ - (Get_BYTE(ptr+2) << 8) | Get_BYTE(ptr+3)) +#define Get_Pointer(ptr) \ + ((Get_BYTE(ptr) << 24) | (Get_BYTE(ptr + 1) << 16) | (Get_BYTE(ptr + 2) << 8) | Get_BYTE(ptr + 3)) #else -#define Get_Pointer(ptr) ((Get_BYTE(ptr) << 16) | \ - (Get_BYTE(ptr+1) << 8) | \ - Get_BYTE(ptr+2)) +#define Get_Pointer(ptr) ((Get_BYTE(ptr) << 16) | (Get_BYTE(ptr + 1) << 8) | Get_BYTE(ptr + 2)) #endif /* BIGVM */ #ifndef RESWAPPEDCODESTREAM @@ -283,85 +256,78 @@ struct state #else #define Get_code_BYTE(ptr) (((BYTECODE *)(ptr))->code) -#define Get_code_Pointer(ptr) ((Get_code_BYTE(ptr) << 16) | \ - (Get_code_BYTE(ptr+1) << 8) | \ - Get_code_BYTE(ptr+2)) -#define Get_code_DLword(ptr) ((Get_code_BYTE(ptr) << 8) | Get_code_BYTE(ptr+1)) +#define Get_code_Pointer(ptr) \ + ((Get_code_BYTE(ptr) << 16) | (Get_code_BYTE(ptr + 1) << 8) | Get_code_BYTE(ptr + 2)) +#define Get_code_DLword(ptr) ((Get_code_BYTE(ptr) << 8) | Get_code_BYTE(ptr + 1)) #define Get_code_AtomNo Get_code_Pointer #endif /* RESWAPPEDCODESTREAM */ - #ifdef BIGATOMS -#define Get_AtomNo(ptr) Get_Pointer(ptr) +#define Get_AtomNo(ptr) Get_Pointer(ptr) #else #define Get_AtomNo(ptr) Get_DLword(ptr) #endif /* BIGATOMS */ - /* For bit test */ -typedef struct wbits - { - USHORT LSB :1; - USHORT B14 :1; - USHORT B13 :1; - USHORT B12 :1; - USHORT B11 :1; - USHORT B10 :1; - USHORT B9 :1; - USHORT B8 :1; - USHORT B7 :1; - USHORT B6 :1; - USHORT B5 :1; - USHORT B4 :1; - USHORT B3 :1; - USHORT B2 :1; - USHORT B1 :1; - USHORT xMSB :1; - } WBITS; +typedef struct wbits { + USHORT LSB : 1; + USHORT B14 : 1; + USHORT B13 : 1; + USHORT B12 : 1; + USHORT B11 : 1; + USHORT B10 : 1; + USHORT B9 : 1; + USHORT B8 : 1; + USHORT B7 : 1; + USHORT B6 : 1; + USHORT B5 : 1; + USHORT B4 : 1; + USHORT B3 : 1; + USHORT B2 : 1; + USHORT B1 : 1; + USHORT xMSB : 1; +} WBITS; -typedef struct lbits - { - unsigned LSB :1; - unsigned MIDDLE :30; - unsigned xMSB :1; /* xMSB b/c HPUX defined MSB in a header */ - } LBITS; +typedef struct lbits { + unsigned LSB : 1; + unsigned MIDDLE : 30; + unsigned xMSB : 1; /* xMSB b/c HPUX defined MSB in a header */ +} LBITS; -#define PUTBASEBIT68K(base68k, offset, bitvalue ) { \ - UNSIGNED real68kbase; \ - real68kbase = 2 ^ ((UNSIGNED)(base68k)); \ - if( bitvalue) \ - (* (DLword *) (2^(UNSIGNED)((DLword*)(real68kbase) + (((u_short)(offset))>>4 )))) \ - |= 1 << (15 - ((u_short)(offset))%BITSPER_DLWORD); \ - else \ - (* (DLword *) (2^(UNSIGNED)((DLword*)(real68kbase) + (((u_short)(offset))>>4 )))) \ - &= ~( 1 << (15 - ((u_short)(offset)) %BITSPER_DLWORD)); \ - } +#define PUTBASEBIT68K(base68k, offset, bitvalue) \ + { \ + UNSIGNED real68kbase; \ + real68kbase = 2 ^ ((UNSIGNED)(base68k)); \ + if (bitvalue) \ + (*(DLword *)(2 ^ (UNSIGNED)((DLword *)(real68kbase) + (((u_short)(offset)) >> 4)))) |= \ + 1 << (15 - ((u_short)(offset)) % BITSPER_DLWORD); \ + else \ + (*(DLword *)(2 ^ (UNSIGNED)((DLword *)(real68kbase) + (((u_short)(offset)) >> 4)))) &= \ + ~(1 << (15 - ((u_short)(offset)) % BITSPER_DLWORD)); \ + } #endif /* BYTESWAP */ +/* Because a WBITS is only 1 word long, need byte-swapped */ +/* access to it. Use WBITSPTR(x) instead of ((WBITS *) x) */ - - /* Because a WBITS is only 1 word long, need byte-swapped */ - /* access to it. Use WBITSPTR(x) instead of ((WBITS *) x) */ - -#define WBITSPTR(ptr) ((WBITS *) WORDPTR(ptr)) - +#define WBITSPTR(ptr) ((WBITS *)WORDPTR(ptr)) extern struct state MachineState; #define MState (&MachineState) -#define CURRENTFX ((struct frameex1 *)(((DLword *) PVar) - FRAMESIZE)) -#define IVar (MState->ivar) -#define PVar (MState->pvar) +#define CURRENTFX ((struct frameex1 *)(((DLword *)PVar) - FRAMESIZE)) +#define IVar (MState->ivar) +#define PVar (MState->pvar) #define CurrentStackPTR (MState->csp) -#define TopOfStack (MState->tosvalue) -#define PC (MState->currentpc) -#define FuncObj (MState->currentfunc) -#define EndSTKP (MState->endofstack) -#define Irq_Stk_Check (MState->irqcheck) -#define Irq_Stk_End (MState->irqend) -#define Scratch_CSTK (MState->scratch_cstk) -#define Error_Exit (MState->errorexit) +#define TopOfStack (MState->tosvalue) +#define PC (MState->currentpc) +#define FuncObj (MState->currentfunc) +#define EndSTKP (MState->endofstack) +#define Irq_Stk_Check (MState->irqcheck) +#define Irq_Stk_End (MState->irqend) +#define Scratch_CSTK (MState->scratch_cstk) +#define Error_Exit (MState->errorexit) /* Typedef for IFPAGE */ #include "ifpage.h" @@ -369,66 +335,79 @@ extern struct state MachineState; /* Typedef for IOPAGE */ #include "iopage.h" - /* Typedef for MISCSTAT */ #include "miscstat.h" /**************************************************** MakeAddr: - base: DLword* - offset: word offset from base - return: DLword* + base: DLword* + offset: word offset from base + return: DLword* ****************************************************/ -#define MakeAddr(base, offset) ((DLword *)(base + (int)offset)) - +#define MakeAddr(base, offset) ((DLword *)(base + (int)offset)) /**************************************************** GetHiWord: *****************************************************/ -#define GetHiWord(x) ((DLword)((x)>>16)) +#define GetHiWord(x) ((DLword)((x) >> 16)) /**************************************************** GetLoWord: *****************************************************/ -#define GetLoWord(x) ((DLword)(x)) +#define GetLoWord(x) ((DLword)(x)) /**************************************************** GetLongWord: - address: DLword* - return: int + address: DLword* + return: int *****************************************************/ -#define GetLongWord(address) (*((LispPTR *) (address))) - +#define GetLongWord(address) (*((LispPTR *)(address))) /**************************************************** PopCStack: #define PopCStack {TopOfStack = *((LispPTR *)(--CurrentStackPTR)); --CurrentStackPTR;} *****************************************************/ -#define PopCStack {TopOfStack = *((LispPTR *)(CurrentStackPTR)); CurrentStackPTR -= 2;} +#define PopCStack \ + { \ + TopOfStack = *((LispPTR *)(CurrentStackPTR)); \ + CurrentStackPTR -= 2; \ + } /**************************************************** PopStackTo: CSTK -> Place #define PopStackTo(Place) {Place= *((LispPTR *)(--CurrentStackPTR)); CurrentStackPTR--; } *****************************************************/ -#define PopStackTo(Place) {Place= *((LispPTR *)(CurrentStackPTR)); CurrentStackPTR -= 2; } +#define PopStackTo(Place) \ + { \ + Place = *((LispPTR *)(CurrentStackPTR)); \ + CurrentStackPTR -= 2; \ + } /**************************************************** PushCStack: #define PushCStack {*((int *)(++CurrentStackPTR)) = TopOfStack; ++CurrentStackPTR;} *****************************************************/ -#define PushCStack {CurrentStackPTR += 2;*((LispPTR *)(CurrentStackPTR)) = TopOfStack; } +#define PushCStack \ + { \ + CurrentStackPTR += 2; \ + *((LispPTR *)(CurrentStackPTR)) = TopOfStack; \ + } /**************************************************** PushStack: #define PushStack(x) {*((LispPTR *)(++CurrentStackPTR))=x;CurrentStackPTR++;} *****************************************************/ -#define PushStack(x) {CurrentStackPTR += 2;*((LispPTR *)(CurrentStackPTR))=x;} +#define PushStack(x) \ + { \ + CurrentStackPTR += 2; \ + *((LispPTR *)(CurrentStackPTR)) = x; \ + } /**************************************************** SmashStack: #define SmashStack(x) (*((LispPTR *)(CurrentStackPTR-1))=x) *****************************************************/ -#define SmashStack(x) (*((LispPTR *)(CurrentStackPTR))=x) +#define SmashStack(x) (*((LispPTR *)(CurrentStackPTR)) = x) /********************************************************* Get_BYTE(byteptr) byteptr: pointer to 8 bit data @@ -436,22 +415,20 @@ Get_BYTE(byteptr) byteptr: pointer to 8 bit data /***** OLD definition ************* 13 Nov 1987 takeshi *** #define Get_BYTE(byteptr) (((unsigned)(*(byteptr))) & 0xff) **********************************************/ -#define Get_BYTE(byteptr) (((BYTECODE *)BYTEPTR(byteptr))->code) +#define Get_BYTE(byteptr) (((BYTECODE *)BYTEPTR(byteptr))->code) /********************************************************** DOSTACKOVERFLOW(argnum,bytenum) if it needs hardreturn-cleanup - then upnt to contextsw and immediately return + then upnt to contextsw and immediately return **********************************************************/ -#define DOSTACKOVERFLOW(argnum,bytenum) { \ - if(do_stackoverflow(T)) \ - { PushStack(S_POSITIVE | argnum); \ - contextsw(SubovFXP,bytenum,1); \ - return;\ - } \ - } - - - +#define DOSTACKOVERFLOW(argnum, bytenum) \ + { \ + if (do_stackoverflow(T)) { \ + PushStack(S_POSITIVE | argnum); \ + contextsw(SubovFXP, bytenum, 1); \ + return; \ + } \ + } /************************************************************************/ /* */ @@ -480,61 +457,73 @@ DOSTACKOVERFLOW(argnum,bytenum) if it needs hardreturn-cleanup /* */ /************************************************************************/ -#define ERROR_EXIT(tos) do {TopOfStack=tos; Error_Exit = 1; return(-1);} while (0) -#define TIMER_EXIT(tos) do {TopOfStack=tos; Error_Exit = 1; return(-2);} while (0) +#define ERROR_EXIT(tos) \ + do { \ + TopOfStack = tos; \ + Error_Exit = 1; \ + return (-1); \ + } while (0) +#define TIMER_EXIT(tos) \ + do { \ + TopOfStack = tos; \ + Error_Exit = 1; \ + return (-2); \ + } while (0) +#define WARN(message, operation) \ + do { \ + warn(message); \ + operation; \ + } while (0) +#define NO_WOP \ + {} -#define WARN(message,operation) do {warn(message);operation;} while (0) -#define NO_WOP {} +#define NIL 0 /* added 29-jan */ +#define T 1 +#define ATOM_T 0114 /* T's AtomIndex Number 114Q */ -#define NIL 0 /* added 29-jan */ -#define T 1 -#define ATOM_T 0114 /* T's AtomIndex Number 114Q */ +#define NIL_PTR 0 /* from cell.h 24-mar-87 take */ +#define NOBIND_PTR 1 -#define NIL_PTR 0 /* from cell.h 24-mar-87 take */ -#define NOBIND_PTR 1 - -#define STKLIM 0x1FFFF -#define FRAMESIZE 10 /* size of frameex1: 10 words */ -#define FNHEADSIZE 8 /* size of fnhead: 8 words */ -#define BFSIZE 2 /* size of basic frame pointer: 2 words */ +#define STKLIM 0x1FFFF +#define FRAMESIZE 10 /* size of frameex1: 10 words */ +#define FNHEADSIZE 8 /* size of fnhead: 8 words */ +#define BFSIZE 2 /* size of basic frame pointer: 2 words */ -#define BITSPER_DLWORD 16 -#define BITSPER_CELL 32 -#define BYTESPER_DLWORD 2 -#define BYTESPER_CELL 4 -#define BYTESPER_QUAD 8 -#define BYTESPER_PAGE 512 -#define CELLSPER_QUAD 2 -#define CELLSPER_PAGE 128 -#define CELLSPER_SEGMENT 32768 -#define DLWORDSPER_CELL 2 -#define DLWORDSPER_QUAD 4 -#define DLWORDSPER_PAGE 256 -#define DLWORDSPER_SEGMENT 65536 -#define PAGESPER_SEGMENT 256 -#define PAGESPER_MDSUNIT 2 -#define MDSINCREMENT 512 +#define BITSPER_DLWORD 16 +#define BITSPER_CELL 32 +#define BYTESPER_DLWORD 2 +#define BYTESPER_CELL 4 +#define BYTESPER_QUAD 8 +#define BYTESPER_PAGE 512 +#define CELLSPER_QUAD 2 +#define CELLSPER_PAGE 128 +#define CELLSPER_SEGMENT 32768 +#define DLWORDSPER_CELL 2 +#define DLWORDSPER_QUAD 4 +#define DLWORDSPER_PAGE 256 +#define DLWORDSPER_SEGMENT 65536 +#define PAGESPER_SEGMENT 256 +#define PAGESPER_MDSUNIT 2 +#define MDSINCREMENT 512 -#define GUARDSTORAGEFULL 128 -#define GUARD1STORAGEFULL 64 +#define GUARDSTORAGEFULL 128 +#define GUARD1STORAGEFULL 64 -#define SFS_NOTSWITCHABLE 1 -#define SFS_SWITCHABLE 2 -#define SFS_ARRAYSWITCHED 3 -#define SFS_FULLYSWITCHED 4 +#define SFS_NOTSWITCHABLE 1 +#define SFS_SWITCHABLE 2 +#define SFS_ARRAYSWITCHED 3 +#define SFS_FULLYSWITCHED 4 +#define AtomHTSIZE 256 * DLWORDSPER_PAGE -#define AtomHTSIZE 256 * DLWORDSPER_PAGE - -#define MAXPNCHARS 255 /* Maximum length of PnChars */ +#define MAXPNCHARS 255 /* Maximum length of PnChars */ #define FALSE 0 -#define TRUE !FALSE +#define TRUE !FALSE typedef unsigned int boolean; - /************************************************************************/ /* Define sizes of FN and FNX opcodes; depends on atom size */ /************************************************************************/ @@ -550,8 +539,6 @@ typedef unsigned int boolean; #define FNX_OPCODE_SIZE 4 #endif /* BIGATOMS */ - - /************************************************************************/ /* */ /* Definitions for "NEW" Symbols */ @@ -561,31 +548,27 @@ typedef unsigned int boolean; /************************************************************************/ #ifdef BIGATOMS -typedef struct newatom - { - LispPTR na_pname; /* Pointer to the print name */ - LispPTR na_value; /* The value cell */ - LispPTR na_defn; /* The definition cell */ - LispPTR na_plist; /* The property list */ - LispPTR na_flags; /* flags from other cells, to make BIGVM work ok */ - } NEWATOM; +typedef struct newatom { + LispPTR na_pname; /* Pointer to the print name */ + LispPTR na_value; /* The value cell */ + LispPTR na_defn; /* The definition cell */ + LispPTR na_plist; /* The property list */ + LispPTR na_flags; /* flags from other cells, to make BIGVM work ok */ +} NEWATOM; - /* Offsets, in WORDS, from the start of the NEWATOM structure */ -#define NEWATOM_PNAME_OFFSET 0 -#define NEWATOM_VALUE_OFFSET 2 -#define NEWATOM_DEFN_OFFSET 4 -#define NEWATOM_PLIST_OFFSET 6 +/* Offsets, in WORDS, from the start of the NEWATOM structure */ +#define NEWATOM_PNAME_OFFSET 0 +#define NEWATOM_VALUE_OFFSET 2 +#define NEWATOM_DEFN_OFFSET 4 +#define NEWATOM_PLIST_OFFSET 6 - - /* Offsets, in cells from start of the NEWATOM structure */ -#define NEWATOM_PNAME_PTROFF 0 -#define NEWATOM_VALUE_PTROFF 1 -#define NEWATOM_DEFN_PTROFF 2 -#define NEWATOM_PLIST_PTROFF 3 +/* Offsets, in cells from start of the NEWATOM structure */ +#define NEWATOM_PNAME_PTROFF 0 +#define NEWATOM_VALUE_PTROFF 1 +#define NEWATOM_DEFN_PTROFF 2 +#define NEWATOM_PLIST_PTROFF 3 #endif - - /************************************************************************/ /* */ /* Mask to mask off relevant bits in a pointer. */ @@ -593,17 +576,14 @@ typedef struct newatom /************************************************************************/ #ifdef BIGVM #define POINTERMASK 0xfffffff -#define SEGMASK 0xfff0000 -#define mPAGEMASK 0xfffff00 +#define SEGMASK 0xfff0000 +#define mPAGEMASK 0xfffff00 #else #define POINTERMASK 0xffffff -#define SEGMASK 0xff0000 -#define mPAGEMASK 0xffff00 +#define SEGMASK 0xff0000 +#define mPAGEMASK 0xffff00 #endif /* BIGVM */ - - - /************************************************************************/ /* */ /* F P t o V P M a n i p u l a t i o n */ @@ -612,10 +592,9 @@ typedef struct newatom /* */ /************************************************************************/ - #ifdef BIGVM -#define GETFPTOVP(b,o) b[o] -#define GETPAGEOK(b,o) (b[o]>>16) +#define GETFPTOVP(b, o) b[o] +#define GETPAGEOK(b, o) (b[o] >> 16) #else #define GETFPTOVP GETWORDBASEWORD #define GETPAGEOK GETWORDBASEWORD diff --git a/inc/stack.h b/inc/stack.h index f090d82..e09e10f 100644 --- a/inc/stack.h +++ b/inc/stack.h @@ -1,8 +1,6 @@ #ifndef STACK_H #define STACK_H 1 -/* $Id: stack.h,v 1.2 1999/01/03 02:06:23 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ - - +/* $Id: stack.h,v 1.2 1999/01/03 02:06:23 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ /************************************************************************/ /* */ @@ -11,342 +9,342 @@ /* */ /************************************************************************/ - /* ContextSW frame number */ -#define CurrentFXP 0 -#define ResetFXP 1 -#define SubovFXP 2 -#define KbdFXP 3 -#define HardReturnFXP 4 -#define GCFXP 5 -#define FAULTFXP 6 +#define CurrentFXP 0 +#define ResetFXP 1 +#define SubovFXP 2 +#define KbdFXP 3 +#define HardReturnFXP 4 +#define GCFXP 5 +#define FAULTFXP 6 -#define STK_FSB_WORD 0xA000u -#define STK_GUARD_WORD 0xE000u -#define BF_MARK 0x8000u -#define BF_MARK32 0x80000000 -#define FX_MARK 0xc000u +#define STK_FSB_WORD 0xA000u +#define STK_GUARD_WORD 0xE000u +#define BF_MARK 0x8000u +#define BF_MARK32 0x80000000 +#define FX_MARK 0xc000u -#define STK_GUARD 7 -#define STK_FX 6 -#define STK_FSB 5 -#define STK_BF 4 -#define STK_NOTFLG 0 +#define STK_GUARD 7 +#define STK_FX 6 +#define STK_FSB 5 +#define STK_BF 4 +#define STK_NOTFLG 0 -#define STK_SAFE 32 /* added with stkmin */ -#define MINEXTRASTACKWORDS 32 -#define STACKAREA_SIZE 768 +#define STK_SAFE 32 /* added with stkmin */ +#define MINEXTRASTACKWORDS 32 +#define STACKAREA_SIZE 768 /* For Fvar operations */ -#define FVSTACK 2 -#define FVGLOBAL 6 -#define FVUBNBOUND 3 -#define FVIVAR 0x0 -#define FVPVAR 0x80 -#define FVFVAR 0xC0 -#define ENDSTACKMARK 0xb +#define FVSTACK 2 +#define FVGLOBAL 6 +#define FVUBNBOUND 3 +#define FVIVAR 0x0 +#define FVPVAR 0x80 +#define FVFVAR 0xC0 +#define ENDSTACKMARK 0xb -#define FXPTR(base) ((struct frameex1 *) WORDPTR(base)) +#define FXPTR(base) ((struct frameex1 *)WORDPTR(base)) #ifndef BYTESWAP - /*******************************************************/ - /* Normal definitions for structures on stack */ - /*******************************************************/ -typedef struct fnhead{ - DLword stkmin; /* ?? */ - short na; /* Numbers of arguments */ - short pv; /* ?? */ - DLword startpc; - /* head of ByteCodes, DLword offset from stkmin */ - unsigned nil4 : 1; /* not used, prev: native translated? */ - unsigned byteswapped : 1; /* code was reswapped. */ - unsigned argtype : 2; /* ?? */ +/*******************************************************/ +/* Normal definitions for structures on stack */ +/*******************************************************/ +typedef struct fnhead { + DLword stkmin; /* ?? */ + short na; /* Numbers of arguments */ + short pv; /* ?? */ + DLword startpc; + /* head of ByteCodes, DLword offset from stkmin */ + unsigned nil4 : 1; /* not used, prev: native translated? */ + unsigned byteswapped : 1; /* code was reswapped. */ + unsigned argtype : 2; /* ?? */ #ifdef BIGVM - unsigned framename :28; /* index in AtomSpace */ + unsigned framename : 28; /* index in AtomSpace */ #else - unsigned nil2 : 2; /* not used */ - unsigned nil3 : 2; /* not used */ - unsigned framename :24; /* index in AtomSpace */ + unsigned nil2 : 2; /* not used */ + unsigned nil3 : 2; /* not used */ + unsigned framename : 24; /* index in AtomSpace */ #endif /* BIGVM */ - DLword ntsize; /* size of NameTable */ - unsigned nlocals : 8; /* ?? */ - unsigned fvaroffset : 8; - /* DLword offset from head of NameTable */ - /* NameTable of variable length is following with this structure. */ + DLword ntsize; /* size of NameTable */ + unsigned nlocals : 8; /* ?? */ + unsigned fvaroffset : 8; + /* DLword offset from head of NameTable */ + /* NameTable of variable length is following with this structure. */ } FNHEAD; - -typedef struct frameex1{ - unsigned flags :3; - unsigned fast :1; - unsigned nil2 :1; /* not used, prev: This frame treats N-func */ - unsigned incall :1; - unsigned validnametable :1; - /* 0: look for FunctionHeader - 1: look for NameTable on this FrameEx */ - unsigned nopush :1; - unsigned usecount :8; - DLword alink; /* alink pointer (Low addr) */ +typedef struct frameex1 { + unsigned flags : 3; + unsigned fast : 1; + unsigned nil2 : 1; /* not used, prev: This frame treats N-func */ + unsigned incall : 1; + unsigned validnametable : 1; + /* 0: look for FunctionHeader + 1: look for NameTable on this FrameEx */ + unsigned nopush : 1; + unsigned usecount : 8; + DLword alink; /* alink pointer (Low addr) */ #ifdef BIGVM - LispPTR fnheader; /* pointer to FunctionHeader (Hi2 addr) */ + LispPTR fnheader; /* pointer to FunctionHeader (Hi2 addr) */ #else - DLword lofnheader; /* pointer to FunctionHeader (Low addr) */ - unsigned hi1fnheader : 8; /* pointer to FunctionHeader (Hi1 addr) */ - unsigned hi2fnheader : 8; /* pointer to FunctionHeader (Hi2 addr) */ + DLword lofnheader; /* pointer to FunctionHeader (Low addr) */ + unsigned hi1fnheader : 8; /* pointer to FunctionHeader (Hi1 addr) */ + unsigned hi2fnheader : 8; /* pointer to FunctionHeader (Hi2 addr) */ #endif /* BIGVM */ - DLword nextblock; /* pointer to FreeStackBlock */ - DLword pc; /* Program counter */ + DLword nextblock; /* pointer to FreeStackBlock */ + DLword pc; /* Program counter */ #ifdef BIGVM - LispPTR nametable; /* ptr to NameTable of this FrameEx (Hi2 addr) */ + LispPTR nametable; /* ptr to NameTable of this FrameEx (Hi2 addr) */ #else - DLword lonametable; /* ptr to NameTable of this FrameEx (Low addr) */ - unsigned hi1nametable :8; /* ptr to NameTable of this FrameEx (Hi1 addr) */ - unsigned hi2nametable :8; /* ptr to NameTable of this FrameEx (Hi2 addr) */ + DLword lonametable; /* ptr to NameTable of this FrameEx (Low addr) */ + unsigned hi1nametable : 8; /* ptr to NameTable of this FrameEx (Hi1 addr) */ + unsigned hi2nametable : 8; /* ptr to NameTable of this FrameEx (Hi2 addr) */ #endif /* BIGVM */ - DLword blink; /* blink pointer (Low addr) */ - DLword clink; /* clink pointer (Low addr) */ + DLword blink; /* blink pointer (Low addr) */ + DLword clink; /* clink pointer (Low addr) */ } FX; -typedef struct frameex2{ - unsigned flags :3; - unsigned fast :1; - unsigned nil2 :1; /* not used, prev: This frame treats N-func */ - unsigned incall :1; - unsigned validnametable :1; - /* 0: look for FunctionHeader - 1: look for NameTable on this FrameEx */ - unsigned nopush :1; - unsigned usecount :8; - DLword alink; /* alink pointer (Low addr) */ - LispPTR fnheader; /* pointer to FunctionHeader */ - DLword nextblock; /* pointer to FreeStackBlock */ - DLword pc; /* Program counter */ - LispPTR nametable; /* address of NameTable */ - DLword blink; /* blink pointer (Low addr) */ - DLword clink; /* clink pointer (Low addr) */ +typedef struct frameex2 { + unsigned flags : 3; + unsigned fast : 1; + unsigned nil2 : 1; /* not used, prev: This frame treats N-func */ + unsigned incall : 1; + unsigned validnametable : 1; + /* 0: look for FunctionHeader + 1: look for NameTable on this FrameEx */ + unsigned nopush : 1; + unsigned usecount : 8; + DLword alink; /* alink pointer (Low addr) */ + LispPTR fnheader; /* pointer to FunctionHeader */ + DLword nextblock; /* pointer to FreeStackBlock */ + DLword pc; /* Program counter */ + LispPTR nametable; /* address of NameTable */ + DLword blink; /* blink pointer (Low addr) */ + DLword clink; /* clink pointer (Low addr) */ } FX2; - - - typedef struct fxblock { - unsigned flagbyte : 8; - unsigned nil : 23; - unsigned slowp : 1; + unsigned flagbyte : 8; + unsigned nil : 23; + unsigned slowp : 1; } FXBLOCK; - - typedef struct basic_frame { - unsigned flags : 3; - unsigned nil : 3; - unsigned residual: 1; - unsigned padding : 1; - unsigned usecnt : 8; - DLword ivar; /* stk offset of IVARs for this frame ?? */ + unsigned flags : 3; + unsigned nil : 3; + unsigned residual : 1; + unsigned padding : 1; + unsigned usecnt : 8; + DLword ivar; /* stk offset of IVARs for this frame ?? */ } Bframe; typedef struct stkword { - unsigned short flags :3; - unsigned short nil :5; - unsigned short usecount :8; - } StackWord; + unsigned short flags : 3; + unsigned short nil : 5; + unsigned short usecount : 8; +} StackWord; - - typedef struct stack_block { - DLword flagword; - DLword size; - } STKBLK; +typedef struct stack_block { + DLword flagword; + DLword size; +} STKBLK; /* Lisp DATATYPE STACKP */ typedef struct stackp { - DLword stackp0; - DLword edfxp; + DLword stackp0; + DLword edfxp; } STACKP; - - /*************************************************************/ - /* Pointer-dereferencing macros for one-word structure ptrs */ - /*************************************************************/ +/*************************************************************/ +/* Pointer-dereferencing macros for one-word structure ptrs */ +/*************************************************************/ #define BFRAMEPTR(ptr) ((Bframe *)(ptr)) #define STKWORDPTR(ptr) ((StackWord *)(ptr)) #else - /*******************************************************/ - /* Byte-swapped/Word-swapped definitions of stack */ - /*******************************************************/ -typedef struct fnhead - { - short na; /* Numbers of arguments */ - DLword stkmin; /* ?? */ - DLword startpc; - /* head of ByteCodes, DLword offset from stkmin */ - short pv; /* ?? */ +/*******************************************************/ +/* Byte-swapped/Word-swapped definitions of stack */ +/*******************************************************/ +typedef struct fnhead { + short na; /* Numbers of arguments */ + DLword stkmin; /* ?? */ + DLword startpc; + /* head of ByteCodes, DLword offset from stkmin */ + short pv; /* ?? */ #ifdef BIGVM - unsigned framename :28; /* index in AtomSpace */ + unsigned framename : 28; /* index in AtomSpace */ #else - unsigned framename :24; /* index in AtomSpace */ - unsigned nil3 : 2; /* not used */ - unsigned nil2 : 2; /* not used */ + unsigned framename : 24; /* index in AtomSpace */ + unsigned nil3 : 2; /* not used */ + unsigned nil2 : 2; /* not used */ #endif /* BIGVM */ - unsigned argtype : 2; /* ?? */ - unsigned byteswapped : 1; /* code was reswapped. */ - unsigned nil4 : 1; /* not used, prev: native translated? */ - unsigned fvaroffset : 8; - /* DLword offset from head of NameTable */ - unsigned nlocals :8; /* ?? */ - DLword ntsize; /* size of NameTable */ - /* NameTable of variable length is following with this structure. */ - } FNHEAD; + unsigned argtype : 2; /* ?? */ + unsigned byteswapped : 1; /* code was reswapped. */ + unsigned nil4 : 1; /* not used, prev: native translated? */ + unsigned fvaroffset : 8; + /* DLword offset from head of NameTable */ + unsigned nlocals : 8; /* ?? */ + DLword ntsize; /* size of NameTable */ + /* NameTable of variable length is following with this structure. */ +} FNHEAD; - -typedef struct frameex1{ - DLword alink; /* alink pointer (Low addr) */ - unsigned usecount :8; - unsigned nopush :1; - unsigned validnametable :1; - /* 0: look for FunctionHeader - 1: look for NameTable on this FrameEx */ - unsigned incall :1; - unsigned nil2 :1; /* not used, prev: This frame treats N-func */ - unsigned fast :1; - unsigned flags :3; /* hi word */ +typedef struct frameex1 { + DLword alink; /* alink pointer (Low addr) */ + unsigned usecount : 8; + unsigned nopush : 1; + unsigned validnametable : 1; + /* 0: look for FunctionHeader + 1: look for NameTable on this FrameEx */ + unsigned incall : 1; + unsigned nil2 : 1; /* not used, prev: This frame treats N-func */ + unsigned fast : 1; + unsigned flags : 3; /* hi word */ #ifdef BIGVM - LispPTR fnheader; /* pointer to FunctionHeader (Hi2 addr) */ + LispPTR fnheader; /* pointer to FunctionHeader (Hi2 addr) */ #else - unsigned hi2fnheader : 8; /* pointer to FunctionHeader (Hi2 addr) */ - unsigned hi1fnheader : 8; /* pointer to FunctionHeader (Hi1 addr) */ - DLword lofnheader; /* pointer to FunctionHeader (Low addr) */ + unsigned hi2fnheader : 8; /* pointer to FunctionHeader (Hi2 addr) */ + unsigned hi1fnheader : 8; /* pointer to FunctionHeader (Hi1 addr) */ + DLword lofnheader; /* pointer to FunctionHeader (Low addr) */ #endif /* BIGVM */ - DLword pc; /* Program counter */ - DLword nextblock; /* pointer to FreeStackBlock */ + DLword pc; /* Program counter */ + DLword nextblock; /* pointer to FreeStackBlock */ #ifdef BIGVM - LispPTR nametable; /* pointer to NameTable of this FX (Hi2 addr) */ + LispPTR nametable; /* pointer to NameTable of this FX (Hi2 addr) */ #else - unsigned hi2nametable :8; /* pointer to NameTable of this FX (Hi2 addr) */ - unsigned hi1nametable :8; /* pointer to NameTable of this FX (Hi1 addr) */ - DLword lonametable; /* pointer to NameTable of this FX (Low addr) */ + unsigned hi2nametable : 8; /* pointer to NameTable of this FX (Hi2 addr) */ + unsigned hi1nametable : 8; /* pointer to NameTable of this FX (Hi1 addr) */ + DLword lonametable; /* pointer to NameTable of this FX (Low addr) */ #endif /* BIGVM */ - DLword clink; /* clink pointer (Low addr) */ - DLword blink; /* blink pointer (Low addr) */ + DLword clink; /* clink pointer (Low addr) */ + DLword blink; /* blink pointer (Low addr) */ } FX; -typedef struct frameex2{ - DLword alink; /* alink pointer (Low addr) */ - unsigned usecount :8; - unsigned nopush :1; - unsigned validnametable :1; - /* 0: look for FunctionHeader - 1: look for NameTable on this FrameEx */ - unsigned incall :1; - unsigned nil2 :1; /* not used, prev: This frame treats N-func */ - unsigned fast :1; - unsigned flags :3; +typedef struct frameex2 { + DLword alink; /* alink pointer (Low addr) */ + unsigned usecount : 8; + unsigned nopush : 1; + unsigned validnametable : 1; + /* 0: look for FunctionHeader + 1: look for NameTable on this FrameEx */ + unsigned incall : 1; + unsigned nil2 : 1; /* not used, prev: This frame treats N-func */ + unsigned fast : 1; + unsigned flags : 3; - LispPTR fnheader; /* pointer to FunctionHeader (swapped) */ + LispPTR fnheader; /* pointer to FunctionHeader (swapped) */ - DLword pc; /* Program counter */ - DLword nextblock; /* pointer to FreeStackBlock */ + DLword pc; /* Program counter */ + DLword nextblock; /* pointer to FreeStackBlock */ - LispPTR nametable; /* address of NameTable (swapped) */ + LispPTR nametable; /* address of NameTable (swapped) */ - DLword clink; /* clink pointer (Low addr) */ - DLword blink; /* blink pointer (Low addr) */ + DLword clink; /* clink pointer (Low addr) */ + DLword blink; /* blink pointer (Low addr) */ } FX2; - - - typedef struct fxblock { - unsigned slowp : 1; - unsigned nil : 23; - unsigned flagbyte : 8; + unsigned slowp : 1; + unsigned nil : 23; + unsigned flagbyte : 8; } FXBLOCK; typedef struct basic_frame { - DLword ivar; - unsigned usecnt : 8; - unsigned padding : 1; - unsigned residual: 1; - unsigned nil : 3; - unsigned flags : 3; + DLword ivar; + unsigned usecnt : 8; + unsigned padding : 1; + unsigned residual : 1; + unsigned nil : 3; + unsigned flags : 3; } Bframe; -typedef struct stkword - { - USHORT usecount :8; - USHORT nil :5; - USHORT flags :3; - } StackWord; +typedef struct stkword { + USHORT usecount : 8; + USHORT nil : 5; + USHORT flags : 3; +} StackWord; -typedef struct stack_block - { - DLword size; - DLword flagword; - } STKBLK; +typedef struct stack_block { + DLword size; + DLword flagword; +} STKBLK; /* Lisp DATATYPE STACKP */ -typedef struct stackp - { - DLword edfxp; - DLword stackp0; - } STACKP; +typedef struct stackp { + DLword edfxp; + DLword stackp0; +} STACKP; - - /*************************************************************/ - /* Pointer-dereferencing macros for one-word structure ptrs */ - /*************************************************************/ +/*************************************************************/ +/* Pointer-dereferencing macros for one-word structure ptrs */ +/*************************************************************/ #define BFRAMEPTR(ptr) ((Bframe *)(ptr)) -#define STKWORDPTR(ptr) ((StackWord *) (2^(UNSIGNED)(ptr))) +#define STKWORDPTR(ptr) ((StackWord *)(2 ^ (UNSIGNED)(ptr))) #endif #define STKWORD(stkptr) ((StackWord *)WORDPTR(stkptr)) -#define FX_INVALIDP(fx68k) (((fx68k)==0) || ((DLword*)(fx68k)==Stackspace)) -#define FX_size(fx68k) (((FX*)(fx68k))->nextblock - LOLOC(LADDR_from_68k(fx68k))) -#define FSBP(ptr68k) ( ((STKBLK*)(ptr68k))->flagword == STK_FSB_WORD ) -#define FSB_size(ptr68k) (((STKBLK*)(ptr68k))->size) +#define FX_INVALIDP(fx68k) (((fx68k) == 0) || ((DLword *)(fx68k) == Stackspace)) +#define FX_size(fx68k) (((FX *)(fx68k))->nextblock - LOLOC(LADDR_from_68k(fx68k))) +#define FSBP(ptr68k) (((STKBLK *)(ptr68k))->flagword == STK_FSB_WORD) +#define FSB_size(ptr68k) (((STKBLK *)(ptr68k))->size) /** Following suff assumes fx is 68kptr and val is LISP_LO_OFFSET **/ -#define DUMMYBF(fx) ( ((DLword*)(fx))-DLWORDSPER_CELL ) -#define SLOWP(fx) (((FXBLOCK*)(fx))->slowp) -#define FASTP(fx) (!SLOWP(fx)) -#define SET_FASTP_NIL(fx68k) { \ - if(FASTP(fx68k)){ \ - ((FX*)fx68k)->blink=StkOffset_from_68K(DUMMYBF(fx68k));\ - ((FX*)fx68k)->clink=((FX*)fx68k)->alink;\ - SLOWP(fx68k)=T; }} +#define DUMMYBF(fx) (((DLword *)(fx)) - DLWORDSPER_CELL) +#define SLOWP(fx) (((FXBLOCK *)(fx))->slowp) +#define FASTP(fx) (!SLOWP(fx)) +#define SET_FASTP_NIL(fx68k) \ + { \ + if (FASTP(fx68k)) { \ + ((FX *)fx68k)->blink = StkOffset_from_68K(DUMMYBF(fx68k)); \ + ((FX *)fx68k)->clink = ((FX *)fx68k)->alink; \ + SLOWP(fx68k) = T; \ + } \ + } -#define GETALINK(fx) ((((fx)->alink) & 0xfffe)-FRAMESIZE) -#define SETALINK(fx,val) {if(FASTP(fx)) \ - {((FX*)(fx))->blink=LADDR_from_68k(DUMMYBF(fx));\ - ((FX*)(fx))->clink=((FX*)(fx))->alink;}\ - ((FX*)(fx))->alink=(val)+FRAMESIZE+1;} +#define GETALINK(fx) ((((fx)->alink) & 0xfffe) - FRAMESIZE) +#define SETALINK(fx, val) \ + { \ + if (FASTP(fx)) { \ + ((FX *)(fx))->blink = LADDR_from_68k(DUMMYBF(fx)); \ + ((FX *)(fx))->clink = ((FX *)(fx))->alink; \ + } \ + ((FX *)(fx))->alink = (val) + FRAMESIZE + 1; \ + } -#define GETBLINK(fx) (SLOWP(fx) ? ((FX*)(fx))->blink : LOLOC(LADDR_from_68k(DUMMYBF(fx)))) -#define SETBLINK(fx,val) { ((FX*)(fx))->blink =(val);\ - if(FASTP(fx)){\ - ((FX*)(fx))->clink=((FX*)(fx))->alink; \ - SLOWP(fx)=1;}} +#define GETBLINK(fx) (SLOWP(fx) ? ((FX *)(fx))->blink : LOLOC(LADDR_from_68k(DUMMYBF(fx)))) +#define SETBLINK(fx, val) \ + { \ + ((FX *)(fx))->blink = (val); \ + if (FASTP(fx)) { \ + ((FX *)(fx))->clink = ((FX *)(fx))->alink; \ + SLOWP(fx) = 1; \ + } \ + } -#define GETCLINK(fx) (SLOWP(fx) ? (((FX*)(fx))->clink -FRAMESIZE):(((FX*)(fx))->alink -FRAMESIZE)) -#define SETCLINK(fx,val) { ((FX*)(fx))->clink = (val) +FRAMESIZE;\ - if(FASTP((fx))){\ - ((FX*)(fx))->blink=LADDR_from_68k(DUMMYBF(fx));\ - SLOWP(fx)=1;}} +#define GETCLINK(fx) \ + (SLOWP(fx) ? (((FX *)(fx))->clink - FRAMESIZE) : (((FX *)(fx))->alink - FRAMESIZE)) +#define SETCLINK(fx, val) \ + { \ + ((FX *)(fx))->clink = (val) + FRAMESIZE; \ + if (FASTP((fx))) { \ + ((FX *)(fx))->blink = LADDR_from_68k(DUMMYBF(fx)); \ + SLOWP(fx) = 1; \ + } \ + } -#define SETACLINK(fx,val) {if(FASTP(fx)) \ - {((FX*)(fx))->blink=LADDR_from_68k(DUMMYBF(fx));}\ - ((FX*)(fx))->clink= (val) + FRAMESIZE;\ - ((FX*)(fx))->alink= ((FX*)(fx))->clink +1; } +#define SETACLINK(fx, val) \ + { \ + if (FASTP(fx)) { ((FX *)(fx))->blink = LADDR_from_68k(DUMMYBF(fx)); } \ + ((FX *)(fx))->clink = (val) + FRAMESIZE; \ + ((FX *)(fx))->alink = ((FX *)(fx))->clink + 1; \ + } #ifdef BIGVM #define SWAP_FNHEAD @@ -354,28 +352,24 @@ typedef struct stackp #define SWAP_FNHEAD(x) swapx(x) #endif /* BIGVM */ -#define GETNAMETABLE(fx) \ - ((struct fnhead *) Addr68k_from_LADDR(SWAP_FNHEAD( \ - ((((FX2 *)fx)->validnametable) \ - ? ((FX2 *)fx)->nametable \ - : ((FX2 *)fx)->fnheader \ - )) & POINTERMASK)) +#define GETNAMETABLE(fx) \ + ((struct fnhead *)Addr68k_from_LADDR( \ + SWAP_FNHEAD( \ + ((((FX2 *)fx)->validnametable) ? ((FX2 *)fx)->nametable : ((FX2 *)fx)->fnheader)) & \ + POINTERMASK)) -#define MAKEFREEBLOCK(ptr68k,size) \ - { \ - if ((size) <= 0) error("creating 0 long FSP"); \ - *((LispPTR*)(ptr68k))=(STK_FSB_WORD << 16) | ((DLword)(size)); \ +#define MAKEFREEBLOCK(ptr68k, size) \ + { \ + if ((size) <= 0) error("creating 0 long FSP"); \ + *((LispPTR *)(ptr68k)) = (STK_FSB_WORD << 16) | ((DLword)(size)); \ } -#define SETUPGUARDBLOCK(ptr68k,size) \ - { \ - if ((size) <= 0) error("creating 0 long Guard block"); \ - ( *((LispPTR*)(ptr68k))=(STK_GUARD_WORD << 16) | ((DLword)(size)) ); \ +#define SETUPGUARDBLOCK(ptr68k, size) \ + { \ + if ((size) <= 0) error("creating 0 long Guard block"); \ + (*((LispPTR *)(ptr68k)) = (STK_GUARD_WORD << 16) | ((DLword)(size))); \ } - - - /************************************************************************/ /* */ /* Stack-checking macros */ @@ -388,62 +382,55 @@ typedef struct stackp #include -#define S_CHECK(condition, msg) \ - { \ - if(!(condition)) \ - { \ - printf("\n\nStack check failed: %s.\n\n", (msg)); \ - error("S_Check.."); \ - } \ +#define S_CHECK(condition, msg) \ + { \ + if (!(condition)) { \ + printf("\n\nStack check failed: %s.\n\n", (msg)); \ + error("S_Check.."); \ + } \ } -#define S_WARN(condition, msg, scanptr) \ - { \ - if(!(condition)) \ - { \ - printf("\n\nStack check failed at %p: %s.\n\n", (scanptr), (msg)); \ - } \ +#define S_WARN(condition, msg, scanptr) \ + { \ + if (!(condition)) { printf("\n\nStack check failed at %p: %s.\n\n", (scanptr), (msg)); } \ } #define CHECK_BF(bf68k) check_BF(bf68k) #define CHECK_FX(fx68k) check_FX(fx68k) -#define PreMoveFrameCheck(fx68k) \ - { LispPTR *tos_on_stack; \ - if(check_stack_rooms(fx68k) > 1000) \ - { \ - warn("moveframe:there is more than 100 words SPACE for FX"); \ - printf("# When calling "); \ - tos_on_stack=(LispPTR*)Addr68k_from_StkOffset((fx68k)->nextblock - 2); \ - print_atomname(*tos_on_stack); \ - printf("\n"); \ - stack_check(0); \ - } \ +#define PreMoveFrameCheck(fx68k) \ + { \ + LispPTR *tos_on_stack; \ + if (check_stack_rooms(fx68k) > 1000) { \ + warn("moveframe:there is more than 100 words SPACE for FX"); \ + printf("# When calling "); \ + tos_on_stack = (LispPTR *)Addr68k_from_StkOffset((fx68k)->nextblock - 2); \ + print_atomname(*tos_on_stack); \ + printf("\n"); \ + stack_check(0); \ + } \ } #else /* STACKCHECK */ - -#define S_CHECK(condition,msg) {} -#define S_WARN(condition, msg, scanptr) {} -#define PreMoveFrameCheck(fx68k) {} -#define CHECK_BF(bf68k) {} -#define CHECK_FX(fx68k) {} +#define S_CHECK(condition, msg) \ + {} +#define S_WARN(condition, msg, scanptr) \ + {} +#define PreMoveFrameCheck(fx68k) \ + {} +#define CHECK_BF(bf68k) \ + {} +#define CHECK_FX(fx68k) \ + {} #endif /* STACKCHECK */ - - - #define STK_MIN(fnobj) ((fnobj->stkmin /* NOT NEEDED in stkmin +STK_SAFE */) << 1) -#define STK_END_COMPUTE(stk_end,fnobj) \ - ( (UNSIGNED)(stk_end) - STK_MIN(fnobj) ) +#define STK_END_COMPUTE(stk_end, fnobj) ((UNSIGNED)(stk_end)-STK_MIN(fnobj)) - -#define CLR_IRQ \ - {Irq_Stk_Check = STK_END_COMPUTE((Irq_Stk_End = (UNSIGNED) EndSTKP), \ - FuncObj); \ - } +#define CLR_IRQ \ + { Irq_Stk_Check = STK_END_COMPUTE((Irq_Stk_End = (UNSIGNED)EndSTKP), FuncObj); } #endif diff --git a/inc/tos1defs.h b/inc/tos1defs.h index 2d2011a..1717a5c 100644 --- a/inc/tos1defs.h +++ b/inc/tos1defs.h @@ -1,8 +1,7 @@ #ifndef TOS1DEFS_H #define TOS1DEFS_H 1 -/* $Id: tos1defs.h,v 1.2 1999/01/03 02:06:27 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ - - +/* $Id: tos1defs.h,v 1.2 1999/01/03 02:06:27 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved + */ /************************************************************************/ /* */ @@ -21,60 +20,77 @@ /************************************************************************/ #ifndef BYTESWAP - /********************************************************/ - /* Normal byte-order definitions, for e.g., 68020s */ - /********************************************************/ +/********************************************************/ +/* Normal byte-order definitions, for e.g., 68020s */ +/********************************************************/ /* These are the TOS manipulation Macros */ -#define HARD_PUSH(x) *(CSTKPTRL++) = x -#define PUSH(x) {HARD_PUSH(TOPOFSTACK); TOPOFSTACK = x;} -#define POP TOPOFSTACK = *(--CSTKPTRL) -#define GET_TOS_1 *(CSTKPTR - 1) -#define GET_TOS_2 *(CSTKPTR - 2) -#define GET_POPPED *CSTKPTR -#define POP_TOS_1 *(--CSTKPTRL) -#define TOPOFSTACK tscache -#define GET_TOS_1_HI *((DLword *)(CSTKPTR - 1)) -#define GET_TOS_1_LO *((DLword *)(CSTKPTR - 1)+1) +#define HARD_PUSH(x) *(CSTKPTRL++) = x +#define PUSH(x) \ + { \ + HARD_PUSH(TOPOFSTACK); \ + TOPOFSTACK = x; \ + } +#define POP TOPOFSTACK = *(--CSTKPTRL) +#define GET_TOS_1 *(CSTKPTR - 1) +#define GET_TOS_2 *(CSTKPTR - 2) +#define GET_POPPED *CSTKPTR +#define POP_TOS_1 *(--CSTKPTRL) +#define TOPOFSTACK tscache +#define GET_TOS_1_HI *((DLword *)(CSTKPTR - 1)) +#define GET_TOS_1_LO *((DLword *)(CSTKPTR - 1) + 1) #else - /********************************************************/ - /* Byte-swapped definitions, for e.g., 80386s */ - /********************************************************/ +/********************************************************/ +/* Byte-swapped definitions, for e.g., 80386s */ +/********************************************************/ /* These are the TOS manipulation Macros */ -#define HARD_PUSH(x) *(CSTKPTRL++) = x -#define PUSH(x) {HARD_PUSH(TOPOFSTACK); TOPOFSTACK = x;} -#define POP TOPOFSTACK = *(--CSTKPTRL) -#define GET_TOS_1 *(CSTKPTR - 1) -#define GET_TOS_2 *(CSTKPTR - 2) -#define GET_POPPED *CSTKPTR -#define POP_TOS_1 *(--CSTKPTRL) -#define TOPOFSTACK tscache -#define GET_TOS_1_HI GETWORD((DLword *)(CSTKPTR - 1)) -#define GET_TOS_1_LO GETWORD((DLword *)(CSTKPTR - 1)+1) +#define HARD_PUSH(x) *(CSTKPTRL++) = x +#define PUSH(x) \ + { \ + HARD_PUSH(TOPOFSTACK); \ + TOPOFSTACK = x; \ + } +#define POP TOPOFSTACK = *(--CSTKPTRL) +#define GET_TOS_1 *(CSTKPTR - 1) +#define GET_TOS_2 *(CSTKPTR - 2) +#define GET_POPPED *CSTKPTR +#define POP_TOS_1 *(--CSTKPTRL) +#define TOPOFSTACK tscache +#define GET_TOS_1_HI GETWORD((DLword *)(CSTKPTR - 1)) +#define GET_TOS_1_LO GETWORD((DLword *)(CSTKPTR - 1) + 1) #endif /* BYTESWAP */ - /* OPCODE interface routines */ -#define StackPtrSave {CurrentStackPTR = (DLword *) (CSTKPTR-1);} -#define StackPtrRestore {CSTKPTRL = ((LispPTR *) CurrentStackPTR)+1;} +#define StackPtrSave \ + { CurrentStackPTR = (DLword *)(CSTKPTR - 1); } +#define StackPtrRestore \ + { CSTKPTRL = ((LispPTR *)CurrentStackPTR) + 1; } +#define EXT \ + { \ + PC = pccache - 1; \ + TopOfStack = TOPOFSTACK; \ + StackPtrSave; \ + } +#define RET \ + { \ + pccache = PC + 1; \ + StackPtrRestore; \ + TOPOFSTACK = TopOfStack; \ + } -#define EXT { PC=pccache-1; \ - TopOfStack=TOPOFSTACK; \ - StackPtrSave; } - -#define RET { pccache=PC+1; \ - StackPtrRestore; \ - TOPOFSTACK = TopOfStack; } - -#define NRET { RET; nextop0; } +#define NRET \ + { \ + RET; \ + nextop0; \ + } #endif /* TOS1DEFS_H */ diff --git a/inc/tosfns.h b/inc/tosfns.h old mode 100755 new mode 100644 index 41fbb46..b08d6de --- a/inc/tosfns.h +++ b/inc/tosfns.h @@ -1,6 +1,5 @@ -/* $Id: tosfns.h,v 1.2 1999/01/03 02:06:28 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ - - +/* $Id: tosfns.h,v 1.2 1999/01/03 02:06:28 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved + */ /************************************************************************/ /* */ @@ -9,8 +8,6 @@ /* */ /************************************************************************/ - - /****************************************************************/ /****** CURRENT Stack Overflow checks ********/ /****************************************************************/ @@ -18,22 +15,20 @@ with last frame right against the edge of the stack, which caused lots of trouble w/ 0-length free blocks, etc. */ #if 0 -#define FN_STACK_CHECK \ - if ((UNSIGNED)CSTKPTR >= (Irq_Stk_Check=(Irq_Stk_End-STK_MIN(LOCFNCELL)))) \ - goto check_interrupt; +#define FN_STACK_CHECK \ + if ((UNSIGNED)CSTKPTR >= (Irq_Stk_Check = (Irq_Stk_End - STK_MIN(LOCFNCELL)))) \ + goto check_interrupt; #else /* JDS 13 Feb 98 -- with Irq_Stk_Chk being unsigned, need to revise */ /* the test; if Irq_Stk_Chk == 0, can't just do the subtraction now */ /* or we get a HUGE unsigned, and the test doesn't work right. */ -#define FN_STACK_CHECK \ - if ((Irq_Stk_End == 0) || \ - ((UNSIGNED)CSTKPTR > \ - (Irq_Stk_Check=(Irq_Stk_End-STK_MIN(LOCFNCELL))))) \ +#define FN_STACK_CHECK \ + if ((Irq_Stk_End == 0) || \ + ((UNSIGNED)CSTKPTR > (Irq_Stk_Check = (Irq_Stk_End - STK_MIN(LOCFNCELL))))) \ goto check_interrupt; #endif /* 0 */ - /****************************************************************/ /****** LOCAL MACROS ********/ /****************************************************************/ @@ -45,7 +40,6 @@ #define SWAP_FNHEAD(x) swapx(x) #endif /* BIGVM */ - /************************************************************************/ /* */ /* A P P L Y _ P O P _ P U S H _ T E S T */ @@ -71,299 +65,294 @@ /************************************************************************/ #ifdef BIGATOMS -#define APPLY_POP_PUSH_TEST \ - { \ - switch (fn_apply) \ - { \ - case 0: break; /* do nothing */ \ - case 1: POP; POP; break; /* from apply */ \ - case 2: break; /* ufn 0 args */ \ - case 3: PUSH(S_POSITIVE | Get_BYTE_PCMAC1); break; \ - case 4: PUSH(S_POSITIVE | Get_DLword_PCMAC1); break; \ - case 6: /* BIGVM possibility */ \ - case 5: { \ - unsigned int atm = Get_AtomNo_PCMAC1; \ - if (atm & SEGMASK) PUSH(atm) /* new atom */ \ - else PUSH(S_POSITIVE | atm); /* old atom as SMALLP*/\ - } \ - break; \ - default: error("Storage error: invalid UFN entry"); \ - } \ - if (needpush) PUSH(fn_atom_index); \ +#define APPLY_POP_PUSH_TEST \ + { \ + switch (fn_apply) { \ + case 0: break; /* do nothing */ \ + case 1: \ + POP; \ + POP; \ + break; /* from apply */ \ + case 2: break; /* ufn 0 args */ \ + case 3: PUSH(S_POSITIVE | Get_BYTE_PCMAC1); break; \ + case 4: PUSH(S_POSITIVE | Get_DLword_PCMAC1); break; \ + case 6: /* BIGVM possibility */ \ + case 5: { \ + unsigned int atm = Get_AtomNo_PCMAC1; \ + if (atm & SEGMASK) \ + PUSH(atm) /* new atom */ \ + else \ + PUSH(S_POSITIVE | atm); /* old atom as SMALLP*/ \ + } break; \ + default: error("Storage error: invalid UFN entry"); \ + } \ + if (needpush) PUSH(fn_atom_index); \ } -#else /* not big atoms */ -#define APPLY_POP_PUSH_TEST \ - { \ - switch (fn_apply) \ - { \ - case 0: break; /* do nothing */ \ - case 1: POP; POP; break; /* from apply */ \ - case 2: break; /* ufn 0 args */ \ - case 3: PUSH(S_POSITIVE | Get_BYTE_PCMAC1); break; \ - case 4: PUSH(S_POSITIVE | Get_DLword_PCMAC1); break; \ - case 5: PUSH(S_POSITIVE | Get_AtomNo_PCMAC1); break; \ - default: error("Storage error: invalid UFN entry"); \ - } \ - if (needpush) PUSH(fn_atom_index); \ +#else /* not big atoms */ +#define APPLY_POP_PUSH_TEST \ + { \ + switch (fn_apply) { \ + case 0: break; /* do nothing */ \ + case 1: \ + POP; \ + POP; \ + break; /* from apply */ \ + case 2: break; /* ufn 0 args */ \ + case 3: PUSH(S_POSITIVE | Get_BYTE_PCMAC1); break; \ + case 4: PUSH(S_POSITIVE | Get_DLword_PCMAC1); break; \ + case 5: PUSH(S_POSITIVE | Get_AtomNo_PCMAC1); break; \ + default: error("Storage error: invalid UFN entry"); \ + } \ + if (needpush) PUSH(fn_atom_index); \ } #endif /* BIGATOMS */ +#define N_APPLY_POP_PUSH_TEST \ + { \ + APPLY_POP_PUSH_TEST; \ + native_closure_env = closure_env; \ + } - -#define N_APPLY_POP_PUSH_TEST { \ - APPLY_POP_PUSH_TEST; \ - native_closure_env=closure_env; \ - } - -#define N_ENVCALL_POP_TEST { \ - CSTKPTRL -=2; \ - native_closure_env=closure_env; \ - } - - +#define N_ENVCALL_POP_TEST \ + { \ + CSTKPTRL -= 2; \ + native_closure_env = closure_env; \ + } /****************************************************************/ /****** OPAPPLY ********/ /****************************************************************/ #ifndef BIGATOMS -#define OPAPPLY { \ - if ( GET_TOS_1_HI == SPOS_HI ) { \ - fn_num_args = GET_TOS_1_LO; \ - fn_opcode_size = 1; \ - fn_apply = 1; \ - fn_atom_index = TOPOFSTACK; \ - FNTRACER(Trace_APPLY(fn_atom_index)); \ - FNCHECKER(if (quick_stack_check()) Trace_APPLY(fn_atom_index)); \ - if ( (SEGMASK & TOPOFSTACK) == 0) \ - { fn_defcell = (DefCell *) GetDEFCELL68k(TOPOFSTACK); \ - goto op_fn_common; \ - } \ - else \ - if (GetTypeNumber(TOPOFSTACK)==TYPE_COMPILED_CLOSURE) \ - { TopOfStack=TOPOFSTACK; \ - fn_defcell = (DefCell *) &TopOfStack; \ - goto op_fn_common; \ - } \ - else { fn_defcell = (DefCell *) GetDEFCELL68k(NIL_PTR); \ - goto op_fn_common; \ - } \ - } \ - goto op_ufn; \ -} /* OPAPPLY */ +#define OPAPPLY \ + { \ + if (GET_TOS_1_HI == SPOS_HI) { \ + fn_num_args = GET_TOS_1_LO; \ + fn_opcode_size = 1; \ + fn_apply = 1; \ + fn_atom_index = TOPOFSTACK; \ + FNTRACER(Trace_APPLY(fn_atom_index)); \ + FNCHECKER(if (quick_stack_check()) Trace_APPLY(fn_atom_index)); \ + if ((SEGMASK & TOPOFSTACK) == 0) { \ + fn_defcell = (DefCell *)GetDEFCELL68k(TOPOFSTACK); \ + goto op_fn_common; \ + } else if (GetTypeNumber(TOPOFSTACK) == TYPE_COMPILED_CLOSURE) { \ + TopOfStack = TOPOFSTACK; \ + fn_defcell = (DefCell *)&TopOfStack; \ + goto op_fn_common; \ + } else { \ + fn_defcell = (DefCell *)GetDEFCELL68k(NIL_PTR); \ + goto op_fn_common; \ + } \ + } \ + goto op_ufn; \ + } /* OPAPPLY */ #else -#define OPAPPLY { \ - if ( GET_TOS_1_HI == SPOS_HI ) { \ - fn_num_args = GET_TOS_1_LO; \ - fn_opcode_size = 1; \ - fn_apply = 1; \ - fn_atom_index = TOPOFSTACK; \ - FNTRACER(Trace_APPLY(fn_atom_index)); \ - FNCHECKER(if (quick_stack_check()) Trace_APPLY(fn_atom_index)); \ - if ( (SEGMASK & TOPOFSTACK) == 0) \ - { fn_defcell = (DefCell *) GetDEFCELLlitatom(TOPOFSTACK); \ - goto op_fn_common; \ - } \ - else switch (GetTypeNumber(TOPOFSTACK)) \ - { \ - case TYPE_NEWATOM: \ - fn_defcell = (DefCell *) GetDEFCELLnew(TOPOFSTACK); \ - goto op_fn_common; \ - case TYPE_COMPILED_CLOSURE: \ - TopOfStack=TOPOFSTACK; \ - fn_defcell = (DefCell *) &TopOfStack; \ - goto op_fn_common; \ - default: fn_defcell = (DefCell *) GetDEFCELL68k(NIL_PTR); \ - goto op_fn_common; \ - } /* end of switch */ \ - } \ - goto op_ufn; \ -} /* OPAPPLY */ +#define OPAPPLY \ + { \ + if (GET_TOS_1_HI == SPOS_HI) { \ + fn_num_args = GET_TOS_1_LO; \ + fn_opcode_size = 1; \ + fn_apply = 1; \ + fn_atom_index = TOPOFSTACK; \ + FNTRACER(Trace_APPLY(fn_atom_index)); \ + FNCHECKER(if (quick_stack_check()) Trace_APPLY(fn_atom_index)); \ + if ((SEGMASK & TOPOFSTACK) == 0) { \ + fn_defcell = (DefCell *)GetDEFCELLlitatom(TOPOFSTACK); \ + goto op_fn_common; \ + } else \ + switch (GetTypeNumber(TOPOFSTACK)) { \ + case TYPE_NEWATOM: fn_defcell = (DefCell *)GetDEFCELLnew(TOPOFSTACK); goto op_fn_common; \ + case TYPE_COMPILED_CLOSURE: \ + TopOfStack = TOPOFSTACK; \ + fn_defcell = (DefCell *)&TopOfStack; \ + goto op_fn_common; \ + default: fn_defcell = (DefCell *)GetDEFCELL68k(NIL_PTR); goto op_fn_common; \ + } /* end of switch */ \ + } \ + goto op_ufn; \ + } /* OPAPPLY */ #endif /* BIGATOMS */ - - /****************************************************************/ /****** OPFN(x) ********/ /****************************************************************/ -#define OPFN(argcount, num_args_fn, fn_xna_args, fn_native) \ -{ /* argcount is a number of the arguments on stack */ \ - register struct fnhead *LOCFNCELL; \ - register int defcell_word; \ - register int NEXTBLOCK; \ - FNTRACER(Trace_FNCall(argcount, Get_AtomNo_PCMAC1, TOPOFSTACK, CSTKPTR-1)); \ - FNCHECKER(if (quick_stack_check()) Trace_FNCall(argcount, Get_AtomNo_PCMAC1, TOPOFSTACK,CSTKPTR-1)); \ - fn_defcell = (DefCell *)GetDEFCELL68k(fn_atom_index = Get_AtomNo_PCMAC1); \ - defcell_word = *(int *)fn_defcell; \ - FNTPRINT((" def cell = 0x%x.\n", defcell_word)); \ - if(!(fn_defcell->ccodep)) \ - { /* it's not a CCODEP */ \ - fn_num_args = argcount; \ - fn_opcode_size = FN_OPCODE_SIZE; \ - fn_apply = 0; \ - goto op_fn_common; \ - } \ - LOCFNCELL = (struct fnhead *)Addr68k_from_LADDR((defcell_word &= POINTERMASK));\ - BCE_CURRENTFX->pc = ((UNSIGNED)PCMAC - (UNSIGNED)FuncObj) + FN_OPCODE_SIZE;\ - FN_STACK_CHECK; \ - {register UNSIGNED newivar; \ - newivar = (UNSIGNED) (IVARL = (DLword *)(CSTKPTR-argcount+1)); \ - BCE_CURRENTFX->nextblock = \ - NEXTBLOCK = \ - StkOffset_from_68K(newivar); \ - } \ - HARD_PUSH(TOPOFSTACK); /* save TOS */ \ - if( LOCFNCELL->na >= 0 ) \ - {register int RESTARGS; \ - RESTARGS = argcount - LOCFNCELL->na; \ - while(RESTARGS <0) { \ - HARD_PUSH(NIL_PTR); \ - RESTARGS++; \ - } \ - CSTKPTRL -= (RESTARGS); \ - } /* if end */ \ - /* Set up BF */ \ - HARD_PUSH(BF_MARK32 | NEXTBLOCK); \ - *((LispPTR *)CSTKPTR) = (FX_MARK << 16) | (StkOffset_from_68K(PVAR)); \ - ((struct frameex2 *)CSTKPTR)->fnheader = SWAP_FNHEAD(defcell_word); \ - CSTKPTRL = (LispPTR *)(((DLword *)CSTKPTR) + FRAMESIZE); \ - PVARL = (DLword *) CSTKPTR; \ - {register int result; \ - result = LOCFNCELL->pv; \ - if (result >= 0) \ - {register LispPTR unboundval; \ - unboundval = (LispPTR) 0xffffffff; \ - HARD_PUSH(unboundval); \ - HARD_PUSH(unboundval); \ - if (result > 0) \ - {HARD_PUSH(unboundval); \ - HARD_PUSH(unboundval); \ - result-=1; \ - for (; --result >= 0;) { \ - HARD_PUSH(unboundval); \ - HARD_PUSH(unboundval); \ - } \ - } \ - } \ - } \ - CSTKPTRL += 1; \ - PCMACL = (ByteCode *)LOCFNCELL + LOCFNCELL->startpc + 1; \ - FuncObj = LOCFNCELL; \ - nextop0; \ -} /* end OPFN */ - +#define OPFN(argcount, num_args_fn, fn_xna_args, fn_native) \ + { /* argcount is a number of the arguments on stack */ \ + register struct fnhead *LOCFNCELL; \ + register int defcell_word; \ + register int NEXTBLOCK; \ + FNTRACER(Trace_FNCall(argcount, Get_AtomNo_PCMAC1, TOPOFSTACK, CSTKPTR - 1)); \ + FNCHECKER(if (quick_stack_check()) \ + Trace_FNCall(argcount, Get_AtomNo_PCMAC1, TOPOFSTACK, CSTKPTR - 1)); \ + fn_defcell = (DefCell *)GetDEFCELL68k(fn_atom_index = Get_AtomNo_PCMAC1); \ + defcell_word = *(int *)fn_defcell; \ + FNTPRINT((" def cell = 0x%x.\n", defcell_word)); \ + if (!(fn_defcell->ccodep)) { /* it's not a CCODEP */ \ + fn_num_args = argcount; \ + fn_opcode_size = FN_OPCODE_SIZE; \ + fn_apply = 0; \ + goto op_fn_common; \ + } \ + LOCFNCELL = (struct fnhead *)Addr68k_from_LADDR((defcell_word &= POINTERMASK)); \ + BCE_CURRENTFX->pc = ((UNSIGNED)PCMAC - (UNSIGNED)FuncObj) + FN_OPCODE_SIZE; \ + FN_STACK_CHECK; \ + { \ + register UNSIGNED newivar; \ + newivar = (UNSIGNED)(IVARL = (DLword *)(CSTKPTR - argcount + 1)); \ + BCE_CURRENTFX->nextblock = NEXTBLOCK = StkOffset_from_68K(newivar); \ + } \ + HARD_PUSH(TOPOFSTACK); /* save TOS */ \ + if (LOCFNCELL->na >= 0) { \ + register int RESTARGS; \ + RESTARGS = argcount - LOCFNCELL->na; \ + while (RESTARGS < 0) { \ + HARD_PUSH(NIL_PTR); \ + RESTARGS++; \ + } \ + CSTKPTRL -= (RESTARGS); \ + } /* if end */ \ + /* Set up BF */ \ + HARD_PUSH(BF_MARK32 | NEXTBLOCK); \ + *((LispPTR *)CSTKPTR) = (FX_MARK << 16) | (StkOffset_from_68K(PVAR)); \ + ((struct frameex2 *)CSTKPTR)->fnheader = SWAP_FNHEAD(defcell_word); \ + CSTKPTRL = (LispPTR *)(((DLword *)CSTKPTR) + FRAMESIZE); \ + PVARL = (DLword *)CSTKPTR; \ + { \ + register int result; \ + result = LOCFNCELL->pv; \ + if (result >= 0) { \ + register LispPTR unboundval; \ + unboundval = (LispPTR)0xffffffff; \ + HARD_PUSH(unboundval); \ + HARD_PUSH(unboundval); \ + if (result > 0) { \ + HARD_PUSH(unboundval); \ + HARD_PUSH(unboundval); \ + result -= 1; \ + for (; --result >= 0;) { \ + HARD_PUSH(unboundval); \ + HARD_PUSH(unboundval); \ + } \ + } \ + } \ + } \ + CSTKPTRL += 1; \ + PCMACL = (ByteCode *)LOCFNCELL + LOCFNCELL->startpc + 1; \ + FuncObj = LOCFNCELL; \ + nextop0; \ + } /* end OPFN */ /*************** OPFNX *************/ -#define OPFNX { \ - register struct fnhead *LOCFNCELL; \ - register DefCell *defcell; /* this reg is not allocated */ \ - register int NEXTBLOCK; \ - int num_args = Get_BYTE_PCMAC1; \ - defcell = (DefCell *) GetDEFCELL68k(Get_AtomNo_PCMAC2); \ - FNTRACER(Trace_FNCall(num_args, Get_AtomNo_PCMAC2, TOPOFSTACK, CSTKPTR-1)); \ - FNCHECKER(if (quick_stack_check()) Trace_FNCall(num_args, Get_AtomNo_PCMAC2, TOPOFSTACK, CSTKPTR-1)); \ - if( defcell->ccodep == 0 ) \ - { fn_defcell = defcell; \ - fn_num_args = num_args; \ - fn_opcode_size = FNX_OPCODE_SIZE; \ - fn_atom_index = Get_AtomNo_PCMAC2; \ - fn_apply = 0; \ - goto op_fn_common; \ - } \ - LOCFNCELL = (struct fnhead *)Addr68k_from_LADDR(defcell->defpointer); \ - BCE_CURRENTFX->pc = ((UNSIGNED)PCMAC - (UNSIGNED)FuncObj) + FNX_OPCODE_SIZE;\ - FN_STACK_CHECK; \ - {register UNSIGNED newivar; \ - newivar = (UNSIGNED)(IVARL = (DLword *)(CSTKPTR-num_args+1)); \ - BCE_CURRENTFX->nextblock = \ - NEXTBLOCK = \ - StkOffset_from_68K(newivar); \ - } \ - HARD_PUSH(TOPOFSTACK); /* save TOS */ \ - if( LOCFNCELL->na >= 0 ) \ - {register int RESTARGS; \ - RESTARGS = num_args - LOCFNCELL->na; \ - while(RESTARGS <0) { \ - HARD_PUSH(NIL_PTR); \ - RESTARGS++; \ - } \ - CSTKPTRL -= (RESTARGS); \ - } /* if end */ \ - /* Set up BF */ \ - HARD_PUSH(BF_MARK32 | NEXTBLOCK); \ - *((LispPTR *)CSTKPTR) = (FX_MARK << 16) | (StkOffset_from_68K(PVAR)); \ - ((struct frameex2 *)CSTKPTR)->fnheader = SWAP_FNHEAD(defcell->defpointer);\ - CSTKPTRL = (LispPTR *) (((DLword *)CSTKPTR) + FRAMESIZE); \ - PVARL = (DLword *) CSTKPTR; \ - {register int result; \ - result = LOCFNCELL->pv; \ - if (result >= 0) \ - {register LispPTR unboundval; \ - unboundval = (LispPTR) 0xffffffff; \ - HARD_PUSH(unboundval); \ - HARD_PUSH(unboundval); \ - if (result > 0) \ - {HARD_PUSH(unboundval); \ - HARD_PUSH(unboundval); \ - result-=1; \ - for (; --result >= 0;) { \ - HARD_PUSH(unboundval); \ - HARD_PUSH(unboundval); \ - } \ - } \ - } \ - } \ - CSTKPTRL += 1; \ - PCMACL = (ByteCode *)LOCFNCELL + LOCFNCELL->startpc + 1; \ - FuncObj = LOCFNCELL; \ -} /* end OPFN */ - - - - +#define OPFNX \ + { \ + register struct fnhead *LOCFNCELL; \ + register DefCell *defcell; /* this reg is not allocated */ \ + register int NEXTBLOCK; \ + int num_args = Get_BYTE_PCMAC1; \ + defcell = (DefCell *)GetDEFCELL68k(Get_AtomNo_PCMAC2); \ + FNTRACER(Trace_FNCall(num_args, Get_AtomNo_PCMAC2, TOPOFSTACK, CSTKPTR - 1)); \ + FNCHECKER(if (quick_stack_check()) \ + Trace_FNCall(num_args, Get_AtomNo_PCMAC2, TOPOFSTACK, CSTKPTR - 1)); \ + if (defcell->ccodep == 0) { \ + fn_defcell = defcell; \ + fn_num_args = num_args; \ + fn_opcode_size = FNX_OPCODE_SIZE; \ + fn_atom_index = Get_AtomNo_PCMAC2; \ + fn_apply = 0; \ + goto op_fn_common; \ + } \ + LOCFNCELL = (struct fnhead *)Addr68k_from_LADDR(defcell->defpointer); \ + BCE_CURRENTFX->pc = ((UNSIGNED)PCMAC - (UNSIGNED)FuncObj) + FNX_OPCODE_SIZE; \ + FN_STACK_CHECK; \ + { \ + register UNSIGNED newivar; \ + newivar = (UNSIGNED)(IVARL = (DLword *)(CSTKPTR - num_args + 1)); \ + BCE_CURRENTFX->nextblock = NEXTBLOCK = StkOffset_from_68K(newivar); \ + } \ + HARD_PUSH(TOPOFSTACK); /* save TOS */ \ + if (LOCFNCELL->na >= 0) { \ + register int RESTARGS; \ + RESTARGS = num_args - LOCFNCELL->na; \ + while (RESTARGS < 0) { \ + HARD_PUSH(NIL_PTR); \ + RESTARGS++; \ + } \ + CSTKPTRL -= (RESTARGS); \ + } /* if end */ \ + /* Set up BF */ \ + HARD_PUSH(BF_MARK32 | NEXTBLOCK); \ + *((LispPTR *)CSTKPTR) = (FX_MARK << 16) | (StkOffset_from_68K(PVAR)); \ + ((struct frameex2 *)CSTKPTR)->fnheader = SWAP_FNHEAD(defcell->defpointer); \ + CSTKPTRL = (LispPTR *)(((DLword *)CSTKPTR) + FRAMESIZE); \ + PVARL = (DLword *)CSTKPTR; \ + { \ + register int result; \ + result = LOCFNCELL->pv; \ + if (result >= 0) { \ + register LispPTR unboundval; \ + unboundval = (LispPTR)0xffffffff; \ + HARD_PUSH(unboundval); \ + HARD_PUSH(unboundval); \ + if (result > 0) { \ + HARD_PUSH(unboundval); \ + HARD_PUSH(unboundval); \ + result -= 1; \ + for (; --result >= 0;) { \ + HARD_PUSH(unboundval); \ + HARD_PUSH(unboundval); \ + } \ + } \ + } \ + } \ + CSTKPTRL += 1; \ + PCMACL = (ByteCode *)LOCFNCELL + LOCFNCELL->startpc + 1; \ + FuncObj = LOCFNCELL; \ + } /* end OPFN */ /****************************************************************/ /****** OPCHECKAPPLY ********/ /****************************************************************/ #ifdef BIGATOMS -#define OPCHECKAPPLY { \ - register DefCell *defcell; \ - defcell = (DefCell *) GetDEFCELL68k(TOPOFSTACK & POINTERMASK); \ - if (!( defcell->ccodep && (((TOPOFSTACK & SEGMASK) == 0) || (GetTypeNumber(TOPOFSTACK) == TYPE_NEWATOM)) && \ - ( ( defcell->argtype == 0 ) || ( defcell->argtype == 2 ) ) ) ) \ - goto op_ufn; \ -} +#define OPCHECKAPPLY \ + { \ + register DefCell *defcell; \ + defcell = (DefCell *)GetDEFCELL68k(TOPOFSTACK & POINTERMASK); \ + if (!(defcell->ccodep && \ + (((TOPOFSTACK & SEGMASK) == 0) || (GetTypeNumber(TOPOFSTACK) == TYPE_NEWATOM)) && \ + ((defcell->argtype == 0) || (defcell->argtype == 2)))) \ + goto op_ufn; \ + } #else -#define OPCHECKAPPLY { \ - register DefCell *defcell; \ - defcell = (DefCell *) GetDEFCELL68k(TOPOFSTACK & POINTERMASK); \ - if (!( defcell->ccodep && ((TOPOFSTACK & SEGMASK) == 0) ) && \ - ( ( defcell->argtype == 0 ) || ( defcell->argtype == 2 ) ) ) \ - goto op_ufn; \ -} +#define OPCHECKAPPLY \ + { \ + register DefCell *defcell; \ + defcell = (DefCell *)GetDEFCELL68k(TOPOFSTACK & POINTERMASK); \ + if (!(defcell->ccodep && ((TOPOFSTACK & SEGMASK) == 0)) && \ + ((defcell->argtype == 0) || (defcell->argtype == 2))) \ + goto op_ufn; \ + } #endif /* BIGATOMS */ - /****************************************************************/ /* UFN_COMMON at op_ufn */ /****************************************************************/ -#define GetUFNEntry(num) (((UFN *)UFNTable) + (num)) +#define GetUFNEntry(num) (((UFN *)UFNTable) + (num)) -#define UFN_COMMON \ -op_ufn: use code in XC.c \ -{ register UFN *entry68k; \ - entry68k = (UFN *)GetUFNEntry(Get_BYTE_PCMAC0); \ - fn_num_args = entry68k->arg_num; \ - fn_opcode_size = entry68k->byte_num+1; \ - fn_atom_index = entry68k->atom_name; \ - fn_defcell = (DefCell *) GetDEFCELL68k(fn_atom_index); \ - fn_apply = 0; \ - goto op_fn_common; \ +#define UFN_COMMON \ + op_ufn: \ + use code in XC.c { \ + register UFN *entry68k; \ + entry68k = (UFN *)GetUFNEntry(Get_BYTE_PCMAC0); \ + fn_num_args = entry68k->arg_num; \ + fn_opcode_size = entry68k->byte_num + 1; \ + fn_atom_index = entry68k->atom_name; \ + fn_defcell = (DefCell *)GetDEFCELL68k(fn_atom_index); \ + fn_apply = 0; \ + goto op_fn_common; \ }; - - /****************************************************************/ /****** OP_FN_COMMON ********/ /* vars: */ @@ -376,80 +365,74 @@ op_ufn: use code in XC.c \ /* All Closure Calls go through here */ /****************************************************************/ #define needpush NEXTBLOCK -#define OP_FN_COMMON \ -op_fn_common: \ -{ register struct fnhead *LOCFNCELL; \ - register DefCell *defcell; /* this reg is not allocated */ \ - CClosure *closure; \ - LispPTR closure_env = (LispPTR) 0xffffffff; \ - {register int NEXTBLOCK = NIL; \ - defcell = fn_defcell; \ - if(defcell->ccodep == 0) { \ - if(GetTypeNumber(defcell->defpointer)==TYPE_COMPILED_CLOSURE) \ - { /* setup closure */ \ - closure=(CClosure *)Addr68k_from_LADDR(defcell->defpointer);\ - defcell=(DefCell *)closure; \ - /* not a closure if closure's env is NIL */ \ - if(closure->env_ptr ) \ - {closure_env = (LispPTR) (closure->env_ptr); \ - } \ - } /* if end */ \ - else { \ - /* NOT compiled object . We must use Interpreter*/ \ - defcell = (DefCell *)GetDEFCELL68k(ATOM_INTERPRETER); \ - needpush = 1; \ - } /*else end */ \ - } \ - LOCFNCELL = (struct fnhead *)Addr68k_from_LADDR(defcell->defpointer); \ - BCE_CURRENTFX->pc = ((UNSIGNED)PCMAC \ - - (UNSIGNED)FuncObj) + fn_opcode_size; \ - FNTPRINT(("Saving PC = 0%o (0x%x).\n", \ - BCE_CURRENTFX->pc, PCMAC+fn_opcode_size)); \ - FN_STACK_CHECK; \ - APPLY_POP_PUSH_TEST; \ - {register UNSIGNED newivar; \ - newivar = (UNSIGNED)(IVARL = (DLword *) (CSTKPTR+(1-fn_num_args-needpush))); \ - BCE_CURRENTFX->nextblock = \ - NEXTBLOCK = \ - StkOffset_from_68K(newivar); \ - } \ - HARD_PUSH(TOPOFSTACK); /* save TOS */ \ - if( LOCFNCELL->na >= 0 ) \ - {register int RESTARGS; \ - RESTARGS = fn_num_args - LOCFNCELL->na; \ - while(RESTARGS <0) { \ - HARD_PUSH(NIL_PTR); \ - RESTARGS++; \ - } \ - CSTKPTRL -= (RESTARGS); \ - } /* if end */ \ - /* Set up BF */ \ - HARD_PUSH(BF_MARK32 | NEXTBLOCK); \ - } /* NEXTBLOCK BLOCK */ \ - *((LispPTR *)CSTKPTR) = (FX_MARK << 16) | (StkOffset_from_68K(PVAR)); \ - ((struct frameex2 *)CSTKPTR)->fnheader = SWAP_FNHEAD(defcell->defpointer);\ - CSTKPTRL = (LispPTR *) (((DLword *)CSTKPTR) + FRAMESIZE); \ - PVARL = (DLword *) CSTKPTR; \ - {register int result; \ - register LispPTR unboundval; \ - unboundval = (LispPTR) 0xffffffff; \ - result = LOCFNCELL->pv; \ - HARD_PUSH(closure_env); \ - HARD_PUSH(unboundval); \ - for (; --result >= 0;) { \ - HARD_PUSH(unboundval); \ - HARD_PUSH(unboundval); \ - } \ - } /* result, unboundval block */ \ - CSTKPTRL += 1; \ - PCMACL = (ByteCode *)LOCFNCELL + LOCFNCELL->startpc + 1; \ - FuncObj = LOCFNCELL; \ - SWAPPED_FN_CHECK; /* see if callee needs swapping */ \ - CHECK_INTERRUPT; \ - nextop0; \ -} /* end OP_FN_COMMON */ - - +#define OP_FN_COMMON \ + op_fn_common : { \ + register struct fnhead *LOCFNCELL; \ + register DefCell *defcell; /* this reg is not allocated */ \ + CClosure *closure; \ + LispPTR closure_env = (LispPTR)0xffffffff; \ + { \ + register int NEXTBLOCK = NIL; \ + defcell = fn_defcell; \ + if (defcell->ccodep == 0) { \ + if (GetTypeNumber(defcell->defpointer) == TYPE_COMPILED_CLOSURE) { /* setup closure */ \ + closure = (CClosure *)Addr68k_from_LADDR(defcell->defpointer); \ + defcell = (DefCell *)closure; \ + /* not a closure if closure's env is NIL */ \ + if (closure->env_ptr) { closure_env = (LispPTR)(closure->env_ptr); } \ + } /* if end */ \ + else { \ + /* NOT compiled object . We must use Interpreter*/ \ + defcell = (DefCell *)GetDEFCELL68k(ATOM_INTERPRETER); \ + needpush = 1; \ + } /*else end */ \ + } \ + LOCFNCELL = (struct fnhead *)Addr68k_from_LADDR(defcell->defpointer); \ + BCE_CURRENTFX->pc = ((UNSIGNED)PCMAC - (UNSIGNED)FuncObj) + fn_opcode_size; \ + FNTPRINT(("Saving PC = 0%o (0x%x).\n", BCE_CURRENTFX->pc, PCMAC + fn_opcode_size)); \ + FN_STACK_CHECK; \ + APPLY_POP_PUSH_TEST; \ + { \ + register UNSIGNED newivar; \ + newivar = (UNSIGNED)(IVARL = (DLword *)(CSTKPTR + (1 - fn_num_args - needpush))); \ + BCE_CURRENTFX->nextblock = NEXTBLOCK = StkOffset_from_68K(newivar); \ + } \ + HARD_PUSH(TOPOFSTACK); /* save TOS */ \ + if (LOCFNCELL->na >= 0) { \ + register int RESTARGS; \ + RESTARGS = fn_num_args - LOCFNCELL->na; \ + while (RESTARGS < 0) { \ + HARD_PUSH(NIL_PTR); \ + RESTARGS++; \ + } \ + CSTKPTRL -= (RESTARGS); \ + } /* if end */ \ + /* Set up BF */ \ + HARD_PUSH(BF_MARK32 | NEXTBLOCK); \ + } /* NEXTBLOCK BLOCK */ \ + *((LispPTR *)CSTKPTR) = (FX_MARK << 16) | (StkOffset_from_68K(PVAR)); \ + ((struct frameex2 *)CSTKPTR)->fnheader = SWAP_FNHEAD(defcell->defpointer); \ + CSTKPTRL = (LispPTR *)(((DLword *)CSTKPTR) + FRAMESIZE); \ + PVARL = (DLword *)CSTKPTR; \ + { \ + register int result; \ + register LispPTR unboundval; \ + unboundval = (LispPTR)0xffffffff; \ + result = LOCFNCELL->pv; \ + HARD_PUSH(closure_env); \ + HARD_PUSH(unboundval); \ + for (; --result >= 0;) { \ + HARD_PUSH(unboundval); \ + HARD_PUSH(unboundval); \ + } \ + } /* result, unboundval block */ \ + CSTKPTRL += 1; \ + PCMACL = (ByteCode *)LOCFNCELL + LOCFNCELL->startpc + 1; \ + FuncObj = LOCFNCELL; \ + SWAPPED_FN_CHECK; /* see if callee needs swapping */ \ + CHECK_INTERRUPT; \ + nextop0; \ + } /* end OP_FN_COMMON */ /************************************************************************/ /* */ @@ -464,170 +447,161 @@ op_fn_common: \ /* */ /************************************************************************/ -#define OP_ENVCALL { \ - register struct fnhead *LOCFNCELL; \ - register int NEXTBLOCK; \ - register LispPTR closure_env = TOPOFSTACK; \ - register int num_args; \ - register LispPTR Fn_DefCell= GET_TOS_1; \ - LOCFNCELL = (struct fnhead *)Addr68k_from_LADDR(Fn_DefCell); \ - FNTPRINT(("ENVCall.\n")); \ - FNCHECKER(if (quick_stack_check()) printf("In ENVCALL.\n")); \ - N_GETNUMBER(GET_TOS_2, num_args, op_ufn); \ - BCE_CURRENTFX->pc = ((UNSIGNED)PCMAC - (UNSIGNED)FuncObj) + 1;\ - FN_STACK_CHECK; \ - CSTKPTRL -= 2; \ - {register UNSIGNED newivar; \ - newivar = (UNSIGNED) (IVARL = (DLword *) (CSTKPTR-num_args)); \ - BCE_CURRENTFX->nextblock = \ - NEXTBLOCK = \ - StkOffset_from_68K(newivar); \ - } \ - if( LOCFNCELL->na >= 0 ) \ - {register int RESTARGS; \ - RESTARGS = num_args - LOCFNCELL->na; \ - while(RESTARGS <0) { \ - HARD_PUSH(NIL_PTR); \ - RESTARGS++; \ - } \ - CSTKPTRL -= (RESTARGS); \ - } /* if end */ \ - /* Set up BF */ \ - HARD_PUSH(BF_MARK32 | NEXTBLOCK); \ - *((LispPTR *)CSTKPTR) = (FX_MARK << 16) | (StkOffset_from_68K(PVAR)); \ - ((struct frameex2 *)CSTKPTR)->fnheader = SWAP_FNHEAD(Fn_DefCell); \ - CSTKPTRL = (LispPTR *)(((DLword *)CSTKPTR) + FRAMESIZE); \ - PVARL = (DLword *) CSTKPTR; \ - {register int result; \ - result = LOCFNCELL->pv; \ - if (result >= 0) \ - {register LispPTR unboundval; \ - unboundval = (LispPTR) 0xffffffff; \ - if (closure_env == NIL_PTR) HARD_PUSH(unboundval); \ - else HARD_PUSH(closure_env); \ - HARD_PUSH(unboundval); \ - if (result > 0) \ - {HARD_PUSH(unboundval); \ - HARD_PUSH(unboundval); \ - result-=1; \ - for (; --result >= 0;) { \ - HARD_PUSH(unboundval); \ - HARD_PUSH(unboundval); \ - } \ - } \ - } \ - } \ - CSTKPTRL += 1; \ - PCMACL = (ByteCode *)LOCFNCELL + LOCFNCELL->startpc + 1; \ - FuncObj = LOCFNCELL; \ - SWAPPED_FN_CHECK; \ -} /* end OP_ENVCALL */ +#define OP_ENVCALL \ + { \ + register struct fnhead *LOCFNCELL; \ + register int NEXTBLOCK; \ + register LispPTR closure_env = TOPOFSTACK; \ + register int num_args; \ + register LispPTR Fn_DefCell = GET_TOS_1; \ + LOCFNCELL = (struct fnhead *)Addr68k_from_LADDR(Fn_DefCell); \ + FNTPRINT(("ENVCall.\n")); \ + FNCHECKER(if (quick_stack_check()) printf("In ENVCALL.\n")); \ + N_GETNUMBER(GET_TOS_2, num_args, op_ufn); \ + BCE_CURRENTFX->pc = ((UNSIGNED)PCMAC - (UNSIGNED)FuncObj) + 1; \ + FN_STACK_CHECK; \ + CSTKPTRL -= 2; \ + { \ + register UNSIGNED newivar; \ + newivar = (UNSIGNED)(IVARL = (DLword *)(CSTKPTR - num_args)); \ + BCE_CURRENTFX->nextblock = NEXTBLOCK = StkOffset_from_68K(newivar); \ + } \ + if (LOCFNCELL->na >= 0) { \ + register int RESTARGS; \ + RESTARGS = num_args - LOCFNCELL->na; \ + while (RESTARGS < 0) { \ + HARD_PUSH(NIL_PTR); \ + RESTARGS++; \ + } \ + CSTKPTRL -= (RESTARGS); \ + } /* if end */ \ + /* Set up BF */ \ + HARD_PUSH(BF_MARK32 | NEXTBLOCK); \ + *((LispPTR *)CSTKPTR) = (FX_MARK << 16) | (StkOffset_from_68K(PVAR)); \ + ((struct frameex2 *)CSTKPTR)->fnheader = SWAP_FNHEAD(Fn_DefCell); \ + CSTKPTRL = (LispPTR *)(((DLword *)CSTKPTR) + FRAMESIZE); \ + PVARL = (DLword *)CSTKPTR; \ + { \ + register int result; \ + result = LOCFNCELL->pv; \ + if (result >= 0) { \ + register LispPTR unboundval; \ + unboundval = (LispPTR)0xffffffff; \ + if (closure_env == NIL_PTR) \ + HARD_PUSH(unboundval); \ + else \ + HARD_PUSH(closure_env); \ + HARD_PUSH(unboundval); \ + if (result > 0) { \ + HARD_PUSH(unboundval); \ + HARD_PUSH(unboundval); \ + result -= 1; \ + for (; --result >= 0;) { \ + HARD_PUSH(unboundval); \ + HARD_PUSH(unboundval); \ + } \ + } \ + } \ + } \ + CSTKPTRL += 1; \ + PCMACL = (ByteCode *)LOCFNCELL + LOCFNCELL->startpc + 1; \ + FuncObj = LOCFNCELL; \ + SWAPPED_FN_CHECK; \ + } /* end OP_ENVCALL */ - - /***************************/ - /* */ - /* Check a code block to make sure, on a byte-swapped */ - /* machine, that the code stream has been put back */ - /* in "natural order" for faster fetching. */ - /* (Only in on ISC, now. */ - /********************************************************/ +/***************************/ +/* */ +/* Check a code block to make sure, on a byte-swapped */ +/* machine, that the code stream has been put back */ +/* in "natural order" for faster fetching. */ +/* (Only in on ISC, now. */ +/********************************************************/ #ifdef RESWAPPEDCODESTREAM -#define SWAPPED_FN_CHECK \ - if (!FuncObj->byteswapped) { byte_swap_code_block(FuncObj); FuncObj->byteswapped = 1;} +#define SWAPPED_FN_CHECK \ + if (!FuncObj->byteswapped) { \ + byte_swap_code_block(FuncObj); \ + FuncObj->byteswapped = 1; \ + } #else #define SWAPPED_FN_CHECK #endif /* RESWAPPEDCODESTREAM */ - - - /****************************************************************/ /****** EVAL ********/ /****************************************************************/ #ifndef BIGATOMS -#define EVAL \ - { \ - LispPTR scratch, work, lookuped; \ - switch (TOPOFSTACK & SEGMASK) { \ - case S_POSITIVE: \ - case S_NEGATIVE: \ - nextop1; \ - case ATOM_OFFSET: \ - if ((TOPOFSTACK == NIL_PTR) || (TOPOFSTACK == ATOM_T)) \ - goto Hack_Label; \ - nnewframe(CURRENTFX, &scratch, TOPOFSTACK & 0xffff); \ - work = POINTERMASK & swapx(scratch); \ - lookuped = *((LispPTR *)(Addr68k_from_LADDR(work))); \ - if (lookuped == NOBIND_PTR) \ - goto op_ufn; \ - TOPOFSTACK = lookuped; \ - Hack_Label: \ - nextop1; \ - default: \ - switch (GetTypeNumber(TOPOFSTACK)) { \ - case TYPE_FIXP: \ - case TYPE_FLOATP: \ - case TYPE_STRINGP: \ - case TYPE_ONED_ARRAY: \ - case TYPE_GENERAL_ARRAY: \ - nextop1; \ - case TYPE_LISTP: \ - fn_atom_index = ATOM_EVALFORM; \ - fn_num_args = 1; \ - fn_opcode_size = 1; \ - fn_defcell = (DefCell *)GetDEFCELL68k(ATOM_EVALFORM); \ - fn_apply = 0; \ - goto op_fn_common; \ - default: \ - goto op_ufn; \ - } \ - } /* end switch */ \ +#define EVAL \ + { \ + LispPTR scratch, work, lookuped; \ + switch (TOPOFSTACK & SEGMASK) { \ + case S_POSITIVE: \ + case S_NEGATIVE: nextop1; \ + case ATOM_OFFSET: \ + if ((TOPOFSTACK == NIL_PTR) || (TOPOFSTACK == ATOM_T)) goto Hack_Label; \ + nnewframe(CURRENTFX, &scratch, TOPOFSTACK & 0xffff); \ + work = POINTERMASK & swapx(scratch); \ + lookuped = *((LispPTR *)(Addr68k_from_LADDR(work))); \ + if (lookuped == NOBIND_PTR) goto op_ufn; \ + TOPOFSTACK = lookuped; \ + Hack_Label: \ + nextop1; \ + default: \ + switch (GetTypeNumber(TOPOFSTACK)) { \ + case TYPE_FIXP: \ + case TYPE_FLOATP: \ + case TYPE_STRINGP: \ + case TYPE_ONED_ARRAY: \ + case TYPE_GENERAL_ARRAY: nextop1; \ + case TYPE_LISTP: \ + fn_atom_index = ATOM_EVALFORM; \ + fn_num_args = 1; \ + fn_opcode_size = 1; \ + fn_defcell = (DefCell *)GetDEFCELL68k(ATOM_EVALFORM); \ + fn_apply = 0; \ + goto op_fn_common; \ + default: goto op_ufn; \ + } \ + } /* end switch */ \ } /* EVAL end */ #else -#define EVAL \ - { \ - LispPTR scratch, work, lookuped; \ - switch (TOPOFSTACK & SEGMASK) { \ - case S_POSITIVE: \ - case S_NEGATIVE: \ - nextop1; \ - case ATOM_OFFSET: \ - if ((TOPOFSTACK == NIL_PTR) || (TOPOFSTACK == ATOM_T)) \ - goto Hack_Label; \ - nnewframe(CURRENTFX, &scratch, TOPOFSTACK & 0xffff); \ - work = POINTERMASK & swapx(scratch); \ - lookuped = *((LispPTR *)(Addr68k_from_LADDR(work))); \ - if (lookuped == NOBIND_PTR) \ - goto op_ufn; \ - TOPOFSTACK = lookuped; \ - Hack_Label: \ - nextop1; \ - default: \ - switch (GetTypeNumber(TOPOFSTACK)) { \ - case TYPE_FIXP: \ - case TYPE_FLOATP: \ - case TYPE_STRINGP: \ - case TYPE_ONED_ARRAY: \ - case TYPE_GENERAL_ARRAY: \ - nextop1; \ - case TYPE_LISTP: \ - fn_atom_index = ATOM_EVALFORM; \ - fn_num_args = 1; \ - fn_opcode_size = 1; \ - fn_defcell = (DefCell *)GetDEFCELL68k(ATOM_EVALFORM); \ - fn_apply = 0; \ - goto op_fn_common; \ - case TYPE_NEWATOM: \ - nnewframe(CURRENTFX, &scratch, TOPOFSTACK); \ - work = POINTERMASK & swapx(scratch); \ - lookuped = *((LispPTR *)(Addr68k_from_LADDR(work))); \ - if (lookuped == NOBIND_PTR) \ - goto op_ufn; \ - TOPOFSTACK = lookuped; \ - nextop1; \ - default: \ - goto op_ufn; \ - } \ - } /* end switch */ \ +#define EVAL \ + { \ + LispPTR scratch, work, lookuped; \ + switch (TOPOFSTACK & SEGMASK) { \ + case S_POSITIVE: \ + case S_NEGATIVE: nextop1; \ + case ATOM_OFFSET: \ + if ((TOPOFSTACK == NIL_PTR) || (TOPOFSTACK == ATOM_T)) goto Hack_Label; \ + nnewframe(CURRENTFX, &scratch, TOPOFSTACK & 0xffff); \ + work = POINTERMASK & swapx(scratch); \ + lookuped = *((LispPTR *)(Addr68k_from_LADDR(work))); \ + if (lookuped == NOBIND_PTR) goto op_ufn; \ + TOPOFSTACK = lookuped; \ + Hack_Label: \ + nextop1; \ + default: \ + switch (GetTypeNumber(TOPOFSTACK)) { \ + case TYPE_FIXP: \ + case TYPE_FLOATP: \ + case TYPE_STRINGP: \ + case TYPE_ONED_ARRAY: \ + case TYPE_GENERAL_ARRAY: nextop1; \ + case TYPE_LISTP: \ + fn_atom_index = ATOM_EVALFORM; \ + fn_num_args = 1; \ + fn_opcode_size = 1; \ + fn_defcell = (DefCell *)GetDEFCELL68k(ATOM_EVALFORM); \ + fn_apply = 0; \ + goto op_fn_common; \ + case TYPE_NEWATOM: \ + nnewframe(CURRENTFX, &scratch, TOPOFSTACK); \ + work = POINTERMASK & swapx(scratch); \ + lookuped = *((LispPTR *)(Addr68k_from_LADDR(work))); \ + if (lookuped == NOBIND_PTR) goto op_ufn; \ + TOPOFSTACK = lookuped; \ + nextop1; \ + default: goto op_ufn; \ + } \ + } /* end switch */ \ } /* EVAL end */ #endif