/*
 * Copyright 1994-2009 Clozure Associates
 *
 * Licensed under the Apache License, Version 2.0 (the "License");
 * you may not use this file except in compliance with the License.
 * You may obtain a copy of the License at
 *
 * http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 */

#include "x86-constants.h"

/* Indicies of GPRs in the mcontext component of a ucontext */
#define Iimm0  REG_EAX
#define Iarg_z REG_EBX
#define Itemp0 REG_ECX
#define Itemp1 REG_EDX
#define Ifn    REG_EDI
#define Iarg_y REG_ESI
#define Iesp   REG_ESP
#define Iebp   REG_EBP
#define Ieip   REG_EIP
#define Iflags REG_EFL

#define Isp Iesp
#define Iip Ieip
#define Iallocptr Itemp0
#define Ira0 Itemp0
#define Inargs Itemp1
#define Ixfn Itemp1
#define Ifp Iebp

/* MMX register offsets from where mm0 is found in uc_mcontext.fs */
#define Imm0 0
#define Imm1 1

#define nbits_in_word 32
#define log2_nbits_in_word 5
#define nbits_in_byte 8
#define ntagbits 3
#define nlisptagbits 2
#define nfixnumtagbits 2
#define num_subtag_bits 8
#define fixnumshift 2
#define fixnum_shift 2
#define fulltagmask 7
#define tagmask  3
#define fixnummask 3
#define subtagmask ((1<<num_subtag_bits)-1)
#define ncharcodebits 8
#define charcode_shift 8
#define node_size 4
#define node_shift 2
#define nargregs 2

#define tag_fixnum 0
#define tag_list 1
#define tag_misc 2
#define tag_imm 3

#define fulltag_even_fixnum 0
#define fulltag_cons 1
#define fulltag_nodeheader 2
#define fulltag_imm 3
#define fulltag_odd_fixnum 4
#define fulltag_tra 5
#define fulltag_misc 6
#define fulltag_immheader 7

#define SUBTAG(tag,subtag) ((tag) | ((subtag) << ntagbits))
#define IMM_SUBTAG(subtag) SUBTAG(fulltag_immheader,(subtag))
#define NODE_SUBTAG(subtag) SUBTAG(fulltag_nodeheader,(subtag))

#define subtag_bignum IMM_SUBTAG(0)
#define min_numeric_subtag subtag_bignum
#define subtag_ratio NODE_SUBTAG(1)
#define max_rational_subtag subtag_ratio
#define subtag_single_float IMM_SUBTAG(1)
#define subtag_double_float IMM_SUBTAG(2)
#define min_float_subtag subtag_single_float
#define max_float_subtag subtag_double_float
#define max_real_subtag subtag_double_float
#define subtag_complex NODE_SUBTAG(3)
#define max_numeric_subtag subtag_complex

#define subtag_bit_vector IMM_SUBTAG(31)
#define subtag_complex_double_float_vector IMM_SUBTAG(30)
#define subtag_complex_single_float_vector IMM_SUBTAG(29)
#define subtag_double_float_vector IMM_SUBTAG(28)
#define subtag_s16_vector IMM_SUBTAG(27)
#define subtag_u16_vector IMM_SUBTAG(26)
#define min_16_bit_ivector_subtag subtag_u16_vector
#define max_16_bit_ivector_subtag subtag_s16_vector
#define subtag_s8_vector IMM_SUBTAG(25)
#define subtag_u8_vector IMM_SUBTAG(24)
#define min_8_bit_ivector_subtag subtag_u8_vector
#define max_8_bit_ivector_subtag subtag_s8_vector
#define subtag_simple_base_string IMM_SUBTAG(23)
#define subtag_fixnum_vector IMM_SUBTAG(22)
#define subtag_s32_vector IMM_SUBTAG(21)
#define subtag_u32_vector IMM_SUBTAG(20)
#define subtag_single_float_vector IMM_SUBTAG(19)
#define max_32_bit_ivector_subtag subtag_simple_base_string
#define min_cl_ivector_subtag subtag_single_float_vector

#define subtag_vectorH NODE_SUBTAG(30)
#define subtag_arrayH NODE_SUBTAG(29)
#define subtag_simple_vector NODE_SUBTAG(31)    /*  Only one such subtag */

#define subtag_macptr IMM_SUBTAG(3)
#define min_non_numeric_imm_subtag subtag_macptr

#define subtag_dead_macptr IMM_SUBTAG(4)
#define subtag_code_vector IMM_SUBTAG(5)
#define subtag_creole IMM_SUBTAG(6)
#define subtag_complex_single_float IMM_SUBTAG(8)
#define subtag_complex_double_float IMM_SUBTAG(9)

#define max_non_array_imm_subtag ((19<<ntagbits)|fulltag_immheader)

#define subtag_catch_frame NODE_SUBTAG(4)
#define subtag_function NODE_SUBTAG(5)
#define subtag_basic_stream NODE_SUBTAG(6)
#define subtag_symbol NODE_SUBTAG(7)
#define subtag_lock NODE_SUBTAG(8)
#define subtag_hash_vector NODE_SUBTAG(9)
#define subtag_pool NODE_SUBTAG(10)
#define subtag_weak NODE_SUBTAG(11)
#define subtag_package NODE_SUBTAG(12)
#define subtag_slot_vector NODE_SUBTAG(13)
#define subtag_instance NODE_SUBTAG(14)
#define subtag_struct NODE_SUBTAG(15)
#define subtag_istruct NODE_SUBTAG(16)
#define max_non_array_node_subtag ((19<<ntagbits)|fulltag_immheader)

#define subtag_unbound SUBTAG(fulltag_imm, 6)
#define unbound_marker subtag_unbound
#define undefined subtag_unbound
#define unbound subtag_unbound
#define subtag_character SUBTAG(fulltag_imm, 9)
#define slot_unbound SUBTAG(fulltag_imm, 10)
#define slot_unbound_marker slot_unbound
#define subtag_illegal SUBTAG(fulltag_imm,11)
#define illegal_marker subtag_illegal
#define subtag_forward_marker SUBTAG(fulltag_imm,28)
#define subtag_reserved_frame  SUBTAG(fulltag_imm,29)
#define reserved_frame_marker subtag_reserved_frame
#define subtag_no_thread_local_binding SUBTAG(fulltag_imm,30)
#define no_thread_local_binding_marker subtag_no_thread_local_binding
#define subtag_function_boundary_marker SUBTAG(fulltag_imm,31)
#define function_boundary_marker subtag_function_boundary_marker

/* The 32-bit immediate value in the instruction
 * "(mov ($ 0x12345678) (% fn))" at a tagged return address
 * refers to the associated function.
 */
#define RECOVER_FN_OPCODE 0xbf
#define RECOVER_FN_LENGTH 5


typedef struct double_float {
    LispObj header;
    LispObj pad;
    LispObj value_low;
    LispObj value_high;
} double_float;

typedef struct complex_single_float {
  LispObj header;
  LispObj pad;
  LispObj realpart;
  LispObj imagpart;
} complex_single_float;

typedef struct complex_double_float {
  LispObj header;
  LispObj pad;
  LispObj realpart_low;
  LispObj realpart_high;
  LispObj imagpart_low;
  LispObj imagpart_high;
} complex_double_float;

typedef struct single_float {
    LispObj header;
    LispObj value;
} single_float;


typedef struct lisp_frame {
    struct lisp_frame *backlink;
    LispObj tra;
    LispObj xtra;		/* if tra is nvalretn */
} lisp_frame;

typedef struct exception_callback_frame {
    struct lisp_frame *backlink;
    LispObj tra;		/* ALWAYS 0 FOR AN XCF */
    LispObj nominal_function;   /* the current function at the time of the exception */
    LispObj relative_pc;        /* Boxed byte offset within actual function */
    LispObj containing_uvector;	/* the uvector that contains the relative PC or NIL */
    LispObj xp;			/* exception context */
    LispObj ra0;		/* value of ra0 from context */
    LispObj foreign_sp;		/* foreign sp at the time that exception occurred */
    LispObj prev_xframe;	/* so %apply-in-frame can unwind it */
    LispObj pc_low;		/* fixnum low half of absolute pc */
    LispObj pc_high;		/* and the high half */
} xcf;


typedef struct catch_frame {
    LispObj header;
    LispObj catch_tag;
    LispObj link;
    LispObj mvflag;
    LispObj esp;
    LispObj ebp;
    LispObj foreign_sp;
    LispObj db_link;
    LispObj xframe;
    LispObj pc;
} catch_frame;

#define catch_frame_element_count ((sizeof(catch_frame)/sizeof(LispObj))-1)
#define catch_frame_header make_header(subtag_catch_frame,catch_frame_element_count)

/* 
   All exception frames in a thread are linked together 
 */
typedef struct xframe_list {
  ExceptionInformation *curr;
  natural node_regs_mask;
  struct xframe_list *prev;
} xframe_list;

#define fixnum_bitmask(n)  (1<<((n)+fixnumshift))






#include "lisp-errors.h"

#ifdef DARWIN
#include <architecture/i386/sel.h>
#else
typedef unsigned short sel_t;   /* for now */
#endif

/*
 * bits correspond to reg encoding used in instructions
 *   7   6   5   4   3   2   1   0
 *  edi esi ebp esp ebx edx ecx eax
 */

#define X8632_DEFAULT_NODE_REGS_MASK 0xce

#ifdef WIN_32
/* TCR is in the last 34 words of NtCurrentTeb()->TlsSlots[] */
#define TCR_BIAS (0xe10 + 30 * sizeof(natural))

typedef struct tcr {
  struct tcr *linear;
  struct tcr_aux *aux;
  signed_natural valence;	/* odd when in foreign code */
  natural node_regs_mask;	/* bit set means register contains node */
  char *save_allocbase;
  char *save_allocptr;
  char *last_allocptr;
  LispObj catch_top;            /* top catch frame */
  special_binding *db_link;     /* special binding chain head */
  natural tlb_limit;
  LispObj *tlb_pointer;
  LispObj ffi_exception;        /* fpscr bits from ff-call */
  LispObj *foreign_sp;
  signed_natural interrupt_pending;     /* pending interrupt flag */
  LispObj next_method_context;  /* used in lieu of register */
  LispObj *next_tsp;
  void *nfp;
  LispObj *save_tsp;		/* TSP when in foreign code */
  LispObj *save_vsp;		/* VSP when in foreign code */
  LispObj *save_fp;		/* EBP when in foreign code */
  struct area *ts_area;		/* tstack area pointer */
  struct area *vs_area;		/* vstack area pointer */
  xframe_list *xframe;		/* exception-frame linked list */
  signed_natural unwinding;
  natural flags;
  natural foreign_mxcsr;
  natural lisp_mxcsr;
  ExceptionInformation *pending_exception_context;
  natural unboxed0;		/* unboxed scratch locations */
  natural unboxed1;
  LispObj save0;		/* spill area for node registers: */
  LispObj save1;		/*  it must be 16-byte aligned */
  LispObj save2;
  LispObj save3;
} TCR;

struct tcr_aux {
  unsigned long long bytes_allocated;
  struct area *cs_area;		/* cstack area pointer */
  LispObj cs_limit;		/* stack overflow limit */
  natural log2_allocation_quantum;      /* for per-thread consing */
  int *errno_loc;               /* per-thread (?) errno location */
  LispObj osid;                 /* OS thread id */
  signed_natural foreign_exception_status; /* non-zero -> call lisp_exit_hook */
  void *native_thread_info;	/* platform-dependent */
  void *native_thread_id;	/* mach_thread_t, pid_t, etc. */
  void *reset_completion;
  void *activate;
  ExceptionInformation *gc_context;
  void *termination_semaphore;
  natural shutdown_count;
  natural save_eflags;
  sel_t ldt_selector;
  signed_natural suspend_count;
  ExceptionInformation *suspend_context;
  void *suspend;                /* suspension semaphore */
  void *resume;                 /* resumption semaphore */
  void *allocated;
  void *pending_io_info;
  void *io_datum;
  struct tcr *next;
  struct tcr *prev;
  void *safe_ref_address;
};
#else
#define TCR_BIAS 0

typedef struct tcr {
  struct tcr *next;
  struct tcr *prev;
  natural node_regs_mask; /* bit set means correspnding reg contains node */
  struct tcr *linear;
  /* this spill area must be 16-byte aligned */
  LispObj save0;		/* spill area for node registers */
  LispObj save1;
  LispObj save2;
  LispObj save3;
  LispObj *save_fp;		/* EBP when in foreign code */
  uint32_t lisp_mxcsr;
  uint32_t foreign_mxcsr;
  special_binding *db_link;     /* special binding chain head */
  LispObj catch_top;            /* top catch frame */
  LispObj *save_vsp;		  /* VSP when in foreign code */
  LispObj *save_tsp;		  /* TSP when in foreign code */
  LispObj *foreign_sp;
  struct area *cs_area;		/* cstack area pointer */
  struct area *vs_area;		/* vstack area pointer */
  struct area *ts_area;		/* tstack area pointer */
  LispObj cs_limit;			/* stack overflow limit */
  natural bytes_allocated;
  natural bytes_consed_high;
  natural log2_allocation_quantum;      /* for per-thread consing */
  signed_natural interrupt_pending;     /* pending interrupt flag */
  xframe_list *xframe;	  /* exception-frame linked list */
  int *errno_loc;               /* per-thread (?) errno location */
  LispObj ffi_exception;        /* fpscr bits from ff-call */
  LispObj osid;                 /* OS thread id */
  signed_natural valence;	  /* odd when in foreign code */
  signed_natural foreign_exception_status; /* non-zero -> call lisp_exit_hook */
  void *native_thread_info;		     /* platform-dependent */
  void *native_thread_id;	/* mach_thread_t, pid_t, etc. */
  char *last_allocptr;
  char *save_allocptr;
  char *save_allocbase;
  void *reset_completion;
  void *activate;
  signed_natural suspend_count;
  ExceptionInformation *suspend_context;
  ExceptionInformation *pending_exception_context;
  void *suspend;                /* suspension semaphore */
  void *resume;                 /* resumption semaphore */
  natural flags;
  ExceptionInformation *gc_context;
  void *termination_semaphore;
  signed_natural unwinding;
  natural tlb_limit;
  LispObj *tlb_pointer;
  natural shutdown_count;
  LispObj *next_tsp;
  void *safe_ref_address;
  sel_t ldt_selector;
  natural scratch_mxcsr;
  natural unboxed0;
  natural unboxed1;
  LispObj next_method_context; /* used in lieu of register */
  natural save_eflags;
  void *allocated;
  void *pending_io_info;
  void *io_datum;
  void *nfp;
} TCR;
#endif

/* expansion of "TCR_AUX(tcr)": TCR_AUX(tcr) */

#define nil_value ((0x13000 + (fulltag_cons))+(LOWMEM_BIAS))
#define t_value ((0x13008 + (fulltag_misc))+(LOWMEM_BIAS))
#define t_offset (t_value-nil_value)
#define misc_header_offset -fulltag_misc
#define misc_data_offset misc_header_offset + node_size

typedef struct {
  natural Eip;
  natural Cs;                   /* in low 16 bits */
  natural EFlags;
} ia32_iret_frame;

#define heap_segment_size 0x00010000
#define log2_heap_segment_size 16

#ifndef EFL_DF
#define EFL_DF 1024
#endif

#define ABI_VERSION_MIN 1042
#define ABI_VERSION_CURRENT 1042
#define ABI_VERSION_MAX 1042
