Index: /trunk/ccl/lisp-kernel/constants.s =================================================================== --- /trunk/ccl/lisp-kernel/constants.s (revision 518) +++ /trunk/ccl/lisp-kernel/constants.s (revision 519) @@ -1,4 +1,4 @@ /* - Copyright (C) 1994-2001 Digitool, Inc + Copyright (C) 2004 Clozure Associates This file is part of OpenMCL. @@ -15,800 +15,7 @@ */ - -nbits_in_word = 32 -nbits_in_byte = 8 -ntagbits = 3 /* But only 2 are significant to lisp */ -nlisptagbits = 2 -nfixnumtagbits = 2 -num_subtag_bits = 8 -fixnumshift = 2 -fixnum_shift = 2 -fulltagmask = 7 -tagmask = 3 -fixnummask = 3 -ncharcodebits = 16 -charcode_shift = nbits_in_word-ncharcodebits -word_shift = 2 -node_size = 4 -dnode_size = 8 -dnode_align_bits = 3 - -fixnumone = (1< 4 (so that code-vector entry-points can be branched to, since the low - two bits of the PC are ignored) and that both FULLTAG-MISC and FULLTAG-IMM have header fulltags - that share the same TAG. - Things that walk memory (and the stack) have to be careful to look at the FULLTAG of each - object that they see. -*/ - -fulltag_even_fixnum = 0 /* I suppose EVENP/ODDP might care; nothing else does. */ -fulltag_cons = 1 /* a real (non_null) cons. Shares TAG with fulltag_nil. */ -fulltag_nodeheader = 2 /* Header of heap_allocated object that contains lisp_object pointers */ -fulltag_imm = 3 /* a "real" immediate object. Shares TAG with fulltag_immheader. */ -fulltag_odd_fixnum = 4 /* */ -fulltag_nil = 5 /* NIL and nothing but. (Note that there]s still a hidden NILSYM.) */ -fulltag_misc = 6 /* Pointer "real" tag_misc object. Shares TAG with fulltag_nodeheader. */ -fulltag_immheader = 7 /* Header of heap-allocated object that contains unboxed data. */ - -nil_value = 0x00002015 -misc_bias = fulltag_misc -cons_bias = tag_list - -/* Functions are of (conceptually) unlimited size. */ - _struct(_function,-misc_bias) - _node(header) - _node(codevector) - _ends - - _struct(tsp_frame,0) - _node(backlink) - _node(type) - _struct_label(fixed_overhead) - _struct_label(data_offset) - _ends - -/* Order of CAR and CDR doesn]t seem to matter much - there aren]t */ -/* too many tricks to be played with predecrement/preincrement addressing. */ -/* Keep them in the confusing MCL 3.0 order, to avoid confusion. */ - _struct(cons,-cons_bias) - _node(cdr) - _node(car) - _ends - -misc_header_offset = -fulltag_misc -misc_subtag_offset = misc_header_offset+3 /* low byte of header */ -misc_data_offset = misc_header_offset+4 /* first word of data */ -misc_dfloat_offset = misc_header_offset+8 /* double-floats are doubleword-aligned */ - -max_64_bit_constant_index = ((0x7fff + misc_dfloat_offset)>>3) -max_32_bit_constant_index = ((0x7fff + misc_data_offset)>>2) -max_16_bit_constant_index = ((0x7fff + misc_data_offset)>>1) -max_8_bit_constant_index = (0x7fff + misc_data_offset) -max_1_bit_constant_index = ((0x7fff + misc_data_offset)<<5) - -/* T is almost adjacent to NIL: since NIL is a misaligned CONS, it spans */ -/* two doublewords. The arithmetic difference between T and NIL is */ -/* such that the least-significant bit and exactly one other bit is */ -/* set in the result. */ - -t_offset = (8+(8-fulltag_nil)+fulltag_misc) -t_value = nil_value+t_offset - -/* The order in which various header values are defined is significant in several ways: */ -/* 1) Numeric subtags precede non-numeric ones; there are further orderings among numeric subtags. */ -/* 2) All subtags which denote CL arrays are preceded by those that don]t, */ -/* with a further ordering which requires that (< header-arrayH header-vectorH ,@all-other-CL-vector-types) */ -/* 3) The element-size of ivectors is determined by the ordering of ivector subtags. */ -/* 4) All subtags are >= fulltag-immheader . */ - -define([define_subtag],[ -subtag_$1 = $2|($3< than - all non-CL-array subtags. So we start by defining the immediate subtags in decreasing order, starting - with that subtag whose element size isn]t an integral number of bits and ending with those whose - element size - like all non-CL-array fulltag-immheader types - is 32 bits. */ - - define_imm_subtag(bit_vector,31) - define_imm_subtag(double_float_vector,30) - define_imm_subtag(s16_vector,29) - define_imm_subtag(u16_vector,28) - define_imm_subtag(simple_general_string,27) -min_16_bit_ivector_subtag = subtag_simple_general_string -max_16_bit_ivector_subtag = subtag_s16_vector -max_string_subtag = subtag_simple_general_string - - define_imm_subtag(simple_base_string,26) - define_imm_subtag(s8_vector,25) - define_imm_subtag(u8_vector,24) -min_8_bit_ivector_subtag = subtag_u8_vector -max_8_bit_ivector_subtag = subtag_simple_base_string -min_string_subtag = subtag_simple_base_string - - define_imm_subtag(s32_vector,23) - define_imm_subtag(u32_vector,22) - define_imm_subtag(single_float_vector,21) -max_32_bit_ivector_subtag = subtag_s32_vector -min_cl_ivector_subtag = subtag_single_float_vector - - - define_node_subtag(vectorH,21) - define_node_subtag(arrayH,20) - define_node_subtag(simple_vector,22) -min_vector_subtag = subtag_vectorH -min_array_subtag = subtag_arrayH - -/* So, we get the remaining subtags (n: (n > max-numeric-subtag) & (n < min-array-subtag)) */ -/* for various immediate/node object types. */ - - define_imm_subtag(macptr,3) -min_non_numeric_imm_subtag = subtag_macptr - - define_imm_subtag(dead_macptr,4) - define_imm_subtag(code_vector,5) - define_imm_subtag(creole,6) - -max_non_array_imm_subtag = (19< -> unwind-protect, else catch */ - _node(link) /* backpointer to previous catch frame */ - _node(mvflag) /* 0 if single-valued catch, fixnum 1 otherwise */ - _node(csp) /* pointer to lisp_frame on csp */ - _node(db_link) /* head of special-binding chain */ - _field(regs,32) /* save7-save0 */ - _node(xframe) /* exception frame chain */ - _node(tsp_segment) /* maybe someday; padding for now */ - _endstructf - - _structf(macptr) - _node(address) - _node(domain) - _node(type) - _endstructf - - _structf(vectorH) - _node(logsize) - _node(physsize) - _node(data_vector) - _node(displacement) - _node(flags) - _endstructf - - _structf(svar) /* shallow-bound special-variable info */ - _node(symbol) - _node(idx) - _endstructf - - _struct(c_frame,0) /* PowerOpen ABI C stack frame */ - _node(backlink) - _node(crsave) - _node(savelr) - _field(unused, 8) - _node(savetoc) - _struct_label(params) - _node(param0) - _node(param1) - _node(param2) - _node(param3) - _node(param4) - _node(param5) - _node(param6) - _node(param7) - _struct_label(minsiz) - _ends - - -ifdef([PPC64],[],[ - _struct(eabi_c_frame,0) - _word(backlink) - _word(savelr) - _word(param0) - _word(param1) - _word(param2) - _word(param3) - _word(param4) - _word(param5) - _word(param6) - _word(param7) - _struct_label(minsiz) - _ends - - /* For entry to variable-argument-list functions - (e.g., via callback) */ - _struct(varargs_eabi_c_frame,0) - _word(backlink) - _word(savelr) - _struct_label(va_list) - _word(flags) /* gpr count byte, fpr count byte, padding */ - _word(overflow_arg_area) - _word(reg_save_area) - _field(padding,4) - _struct_label(regsave) - _field(gp_save,8*4) - _field(fp_save,8*8) - _word(old_backlink) - _word(old_savelr) - _struct_label(incoming_stack_args) - _ends -]) - - _struct(lisp_frame,0) - _node(backlink) - _node(savefn) - _node(savelr) - _node(savevsp) - _ends - - _struct(vector,-fulltag_misc) - _node(header) - _struct_label(data) - _ends - - _struct(binding,0) - _node(link) - _node(sym) - _node(val) - _ends - - -/* Nilreg-relative globals. Talking the assembler into doing something reasonable here */ -/* is surprisingly hard. */ - -symbol_extra = symbol.size-fulltag_misc -num_lisp_globals = 48 /* MUST UPDATE THIS !!! */ - - _struct(lisp_globals,nil_value-((4096+fulltag_nil))) - _struct_pad((1024-num_lisp_globals)*4) - _node(initial_tcr) /* initial thread tcr */ - _node(image_name) /* --image-name argument */ - _node(BADfpscr_save_high) /* high word of FP reg used to save FPSCR */ - _node(BADfpscr_save) /* saved FPSCR */ - _node(batch_flag) /* -b */ - _node(host_platform) /* for runtime platform-specific stuff */ - _node(argv) /* address of argv[0] */ - _node(errno) /* ADDRESS of errno */ - _node(tenured_area) /* the tenured_area */ - _node(oldest_ephemeral) /* dword address of oldest ephemeral object or 0 */ - _node(lisp_exit_hook) /* install foreign exception_handling */ - _node(lisp_return_hook) /* install lisp exception_handling */ - _node(double_float_one) /* high half of 1.0d0 */ - _node(short_float_zero) /* low half of 1.0d0 */ - _node(doh_head) /* creole objects header */ - _node(metering_info) /* address of lisp_metering global */ - _node(in_gc) /* non-zero when GC active */ - _node(lexpr_return1v) /* simpler when &lexpr called for single value. */ - _node(lexpr_return) /* magic &lexpr return code. */ - _node(all_areas) /* doubly-linked list of all memory areas */ - _node(BAD_cs_overflow_limit) /* limit for control-stack overflow check */ - _node(BAD_current_ts) /* current temp-stack area */ - _node(BAD_current_vs) /* current value-stack area */ - _node(statically_linked) /* non-zero if -static */ - _node(heap_end) /* end of lisp heap */ - _node(heap_start) /* start of lisp heap */ - _node(gcable_pointers) /* linked-list of weak macptrs. */ - _node(gc_num) /* fixnum: GC call count. */ - _node(fwdnum) /* fixnum: GC "forwarder" call count. */ - _node(altivec_present) /* non-zero when AltiVec available */ - _node(tb_trap_call) /* CallUniversalProc]s descriptor */ - _node(os_trap_call) /* CallOSTrapUnivesalProc]s descriptor */ - _node(gc_inhibit_count) - _node(intflag) /* sigint pending */ - _node(block_tag_counter) /* counter for (immediate) block tag */ - _node(go_tag_counter) /* counter for (immediate) go tag */ - _node(exception_lock) - _node(BADgc_lock) - _node(tcr_key) /* tsd key for per-thread tcr */ - _node(ret1val_addr) /* address of "dynamic" subprims magic values return addr */ - _node(subprims_base) /* address of dynamic subprims jump table */ - _node(appmain) /* probably don]t really need this */ - _node(emulator_registers) /* where the 68K emulator stores the emulated regs */ - _node(tcr_lock) /* this thread]s exception frame chain */ - _node(kernel_imports) /* some things we need imported for us */ - _node(interrupt_signal) /* signal used by PROCESS-INTERRUPT */ - _node(tcr_count) /* tcr_id for next tcr */ - _node(get_tcr) /* address of get_tcr() */ - _ends - -lisp_globals.saveTOC = lisp_globals.emulator_registers -lisp_globals.saveR13 = lisp_globals.appmain - - - _struct(nrs,nil_value-fulltag_nil) - _struct_pad(fulltag_nil) - _field(nilptr,16-fulltag_nil) - - _struct_pad(fulltag_misc) - _struct_label(tsym) - _struct_pad(symbol_extra) /* t */ - - _struct_pad(fulltag_misc) - _struct_label(nilsym) - _struct_pad(symbol_extra) /* nil */ - - _struct_pad(fulltag_misc) - _struct_label(errdisp) - _struct_pad(symbol_extra) /* %err-disp */ - - _struct_pad(fulltag_misc) - _struct_label(cmain) - _struct_pad(symbol_extra) /* cmain */ - - _struct_pad(fulltag_misc) - _struct_label(eval) - _struct_pad(symbol_extra) /* eval */ - - _struct_pad(fulltag_misc) - _struct_label(appevalfn) - _struct_pad(symbol_extra) /* apply-evaluated-function */ - - _struct_pad(fulltag_misc) - _struct_label(error) - _struct_pad(symbol_extra) /* error */ - - _struct_pad(fulltag_misc) - _struct_label(defun) - _struct_pad(symbol_extra) /* %defun */ - - _struct_pad(fulltag_misc) - _struct_label(defvar) - _struct_pad(symbol_extra) /* %defvar */ - - _struct_pad(fulltag_misc) - _struct_label(defconstant) - _struct_pad(symbol_extra) /* %defconstant */ - - _struct_pad(fulltag_misc) - _struct_label(macrosym) - _struct_pad(symbol_extra) /* %macro */ - - _struct_pad(fulltag_misc) - _struct_label(kernelrestart) - _struct_pad(symbol_extra) /* %kernel-restart */ - - _struct_pad(fulltag_misc) - _struct_label(package) - _struct_pad(symbol_extra) /* *package* */ - - _struct_pad(fulltag_misc) - _struct_label(total_bytes_freed) /* *total-bytes-freed* */ - _struct_pad(symbol_extra) - - _struct_pad(fulltag_misc) - _struct_label(kallowotherkeys) - _struct_pad(symbol_extra) /* allow-other-keys */ - - _struct_pad(fulltag_misc) - _struct_label(toplcatch) - _struct_pad(symbol_extra) /* %toplevel-catch% */ - - _struct_pad(fulltag_misc) - _struct_label(toplfunc) - _struct_pad(symbol_extra) /* %toplevel-function% */ - - _struct_pad(fulltag_misc) - _struct_label(callbacks) - _struct_pad(symbol_extra) /* %pascal-functions% */ - - _struct_pad(fulltag_misc) - _struct_label(allmeteredfuns) - _struct_pad(symbol_extra) /* *all-metered-functions* */ - - _struct_pad(fulltag_misc) - _struct_label(total_gc_microseconds) /* *total-gc-microseconds* */ - _struct_pad(symbol_extra) - - _struct_pad(fulltag_misc) - _struct_label(builtin_functions) /* %builtin-functions% */ - _struct_pad(symbol_extra) - - _struct_pad(fulltag_misc) - _struct_label(udf) - _struct_pad(symbol_extra) /* %unbound-function% */ - - _struct_pad(fulltag_misc) - _struct_label(init_misc) - _struct_pad(symbol_extra) /* %init-misc */ - - _struct_pad(fulltag_misc) - _struct_label(macro_code) - _struct_pad(symbol_extra) /* %macro-code% */ - - _struct_pad(fulltag_misc) - _struct_label(closure_code) - _struct_pad(symbol_extra) /* %closure-code% */ - - _struct_pad(fulltag_misc) - _struct_label(new_gcable_ptr) /* %new-gcable-ptr */ - _struct_pad(symbol_extra) - - _struct_pad(fulltag_misc) - _struct_label(gc_event_status_bits) - _struct_pad(symbol_extra) /* *gc-event-status-bits* */ - - _struct_pad(fulltag_misc) - _struct_label(post_gc_hook) - _struct_pad(symbol_extra) /* *post-gc-hook* */ - - _struct_pad(fulltag_misc) - _struct_label(handlers) - _struct_pad(symbol_extra) /* %handlers% */ - - - _struct_pad(fulltag_misc) - _struct_label(all_packages) - _struct_pad(symbol_extra) /* %all-packages% */ - - _struct_pad(fulltag_misc) - _struct_label(keyword_package) - _struct_pad(symbol_extra) /* *keyword-package* */ - - _struct_pad(fulltag_misc) - _struct_label(finalization_alist) - _struct_pad(symbol_extra) /* %finalization-alist% */ - - _struct_pad(fulltag_misc) - _struct_label(foreign_thread_control) - _struct_pad(symbol_extra) /* %foreign-thread-control */ - - _ends - -define([def_header],[ -$1 = ($2<lisp code that needs to save/restore C NVRs in a TSP frame. */ - _struct(c_reg_save,0) - _node(tsp_link) /* backpointer */ - _node(tsp_mark) /* frame type */ - _node(save_fpscr) /* for Cs FPSCR */ - _field(save_gprs,19*4) /* r13-r31 */ - _dword(save_fp_zero) /* for fp_zero */ - _dword(save_fps32conv) - _ends - -/* Indices in %builtin-functions% */ -_builtin_plus = 0 /* +-2 */ -_builtin_minus = 1 /* --2 */ -_builtin_times = 2 /* *-2 */ -_builtin_div = 3 /* /-2 */ -_builtin_eq = 4 /* =-2 */ -_builtin_ne = 5 /* /-2 */ -_builtin_gt = 6 /* >-2 */ -_builtin_ge = 7 /* >=-2 */ -_builtin_lt = 8 /* <-2 */ -_builtin_le = 9 /* <=-2 */ -_builtin_eql = 10 /* eql */ -_builtin_length = 11 /* length */ -_builtin_seqtype = 12 /* sequence-type */ -_builtin_assq = 13 /* assq */ -_builtin_memq = 14 /* memq */ -_builtin_logbitp = 15 /* logbitp */ -_builtin_logior = 16 /* logior-2 */ -_builtin_logand = 17 /* logand-2 */ -_builtin_ash = 18 /* ash */ -_builtin_negate = 19 /* %negate */ -_builtin_logxor = 20 /* logxor-2 */ -_builtin_aref1 = 21 /* %aref1 */ -_builtin_aset1 = 22 /* %aset1 */ - - /* FPSCR status bits */ -fpscr_FX = 0 -fpscr_FEX = 1 -fpscr_VX = 2 -fpscr_OX = 3 -fpscr_UX = 4 -fpscr_ZX = 5 -fpscr_XX = 6 - /* FPSCR control bits */ -fpscr_VE = 24 -fpscr_OE = 25 -fpscr_UE = 26 -fpscr_ZE = 27 -fpscr_XE = 28 - - -/* - This should be (a) an (UNSIGNED-BYTE 16) and (b) one less than - TSTACK_SOFTPROT (defined in "area.h") -*/ -tstack_alloc_limit = 0xffff - -/* - Thread context record. -*/ - _struct(tcr,0) - _node(prev) /* in doubly-linked list */ - _node(next) /* in doubly-linked list */ - _node(lisp_fpscr) /* lisp thread's fpscr (in low word) */ - _node(lisp_fpscr_low) - _node(db_link) /* special binding chain head */ - _node(catch_top) /* top catch frame */ - _node(save_vsp) /* VSP when in foreign code */ - _node(save_tsp) /* TSP when in foreign code */ - _node(cs_area) /* cstack area pointer */ - _node(vs_area) /* vstack area pointer */ - _node(ts_area) /* tstack area pointer */ - _node(cs_limit) /* cstack overflow limit */ - _node(bytes_consed_high) - _node(bytes_consed_low) - _node(interrupt_level) - _node(interrupt_pending) - _node(xframe) /* per-thread exception frame list */ - _node(errno_loc) /* per-thread errno location */ - _node(ffi_exception) /* fpscr exception bits from ff-call */ - _node(osid) /* OS thread id */ - _node(valence) /* odd when in foreign code */ - _node(foreign_exception_status) - _node(native_thread_info) - _node(native_thread_id) - _node(last_allocptr) - _node(save_allocptr) - _node(save_allocbase) - _node(reset_completion) - _node(activate) - _node(suspend_count) - _node(suspend_context) - _node(pending_exception_context) - _node(suspend) /* semaphore for suspension notify */ - _node(resume) /* sempahore for resumption notify */ - _node(flags) - _node(gc_context) - _node(suspend_total) - _node(suspend_total_on_exception_entry) - _node(tlb_limit) - _node(tlb_pointer) /* Consider using tcr+N as tlb_pointer */ - _node(shutdown_count) - _ends - -TCR_FLAG_BIT_FOREIGN = fixnum_shift -TCR_FLAG_BIT_AWAITING_PRESET = (fixnum_shift+1) -/* Register usage: */ - - -define([rzero],[r0]) -define([sp],[r1]) -define([rcontext],[r2]) -define([imm0],[r3]) -define([imm1],[r4]) -define([imm2],[r5]) -define([imm3],[r6]) -define([imm4],[r7]) -define([imm5],[r8]) -define([allocptr],[r9]) -define([allocbase],[r10]) -define([nargs],[r11]) -define([tsp],[r12]) /* temp-consing stack. */ -define([vsp],[r13]) -define([loc_pc],[r14]) /* code vector locative */ -define([fn],[r15]) -define([temp4],[r16]) -define([temp3],[r17]) -define([temp2],[r18]) -define([temp1],[r19]) -define([temp0],[r20]) -define([arg_x],[r21]) -define([arg_y],[r22]) -define([arg_z],[r23]) -define([save7],[r24]) -define([save6],[r25]) -define([save5],[r26]) -define([save4],[r27]) -define([save3],[r28]) -define([save2],[r29]) -define([save1],[r30]) -define([save0],[r31]) - -define([fname],[temp3]) -define([nfn],[temp2]) -define([next_method_context],[temp1]) -define([first_nvr],[save7]) -define([nargregs],[3]) - -r0 = 0 -r1 = 1 -r2 = 2 -r3 = 3 -r4 = 4 -r5 = 5 -r6 = 6 -r7 = 7 -r8 = 8 -r9 = 9 -r10 = 10 -r11 = 11 -r12 = 12 -r13 = 13 -r14 = 14 -r15 = 15 -r16 = 16 -r17 = 17 -r18 = 18 -r19 = 19 -r20 = 20 -r21 = 21 -r22 = 22 -r23 = 23 -r24 = 24 -r25 = 25 -r26 = 26 -r27 = 27 -r28 = 28 -r29 = 29 -r30 = 30 -r31 = 31 - -/* Lisp code keeps 0.0 in fp_zero */ -define([fp_zero],[f31]) /* a non-volatile reg as far as FFI is concerned. */ -define([fp_s32conv],[f30]) /* for s32->fp conversion */ - -/* registers, as used in destrucuring-bind/macro-bind */ - -define([whole_reg],[temp1]) -define([arg_reg],[temp3]) -define([keyvect_reg],[temp2]) -define([mask_req_start],[24]) -define([mask_req_width],[8]) -define([mask_opt_start],[16]) -define([mask_opt_width],[8]) -define([mask_key_start],[8]) -define([mask_key_width],[8]) -define([mask_initopt],[7]) -define([mask_keyp],[6]) /* note that keyp can be true even when 0 keys. */ -define([mask_aok],[5]) -define([mask_restp],[4]) - -ifdef([DARWIN],[ - define([STACK_ALIGN],16) - define([STACK_ALIGN_MASK],15) +ifdef([PPC64],[ + include(constants64.s) ],[ - define([STACK_ALIGN],8) - define([STACK_ALIGN_MASK],7) -]) - -define([TCR_STATE_FOREIGN],1) -define([TCR_STATE_LISP],0) -define([TCR_STATE_EXCEPTION_WAIT],2) -define([TCR_STATE_EXCEPTION_RETURN],4) - -define([RESERVATION_DISCHARGE],0x1004) + include(constants32.s) +])