(in-package "BCOMP")
(provide 'FASDMACROS)
(defstruct (fasd (:type vector))
  stream
  table
  eof
  direction
  package
  index
  filepos
  table_length
  macro
  )

(defvar *fasd-ops*
'(  d_nil         ;/* dnil: nil */
  d_eval_skip    ;    /* deval o1: evaluate o1 after reading it */
  d_delimiter    ;/* occurs after d_listd_general and d_new_indexed_items */
  d_enter_vector ;     /* d_enter_vector o1 o2 .. on d_delimiter  make a cf_data with
		  ;  this length.   Used internally by akcl.  Just make
		  ;  an array in other lisps */
  d_cons        ; /* d_cons o1 o2: (o1 . o2) */
  d_dot         ;
  d_list    ;/* list* delimited by d_delimiter d_list,o1,o2, ... ,d_dot,on
		;for (o1 o2       . on)
		;or d_list,o1,o2, ... ,on,d_delimiter  for (o1 o2 ...  on)
	      ;*/
  d_list1   ;/* nil terminated length 1  d_list1o1   */
  d_list2   ; /* nil terminated length 2 */
  d_list3
  d_list4
  d_eval
  d_short_symbol
  d_short_string
  d_short_fixnum
  d_short_symbol_and_package
  d_bignum
  d_fixnum
  d_string
  d_objnull
  d_structure
  d_package
  d_symbol
  d_symbol_and_package
  d_end_of_file
  d_standard_character
  d_vector
  d_array
  d_begin_dump
  d_general_type
  d_sharp_equals ;              /* define a sharp */
  d_sharp_value
  d_sharp_value2
  d_new_indexed_item
  d_new_indexed_items
  d_reset_index
  d_macro
  d_reserve1
  d_reserve2
  d_reserve3
  d_reserve4
  d_indexed_item3 ;      /* d_indexed_item3 followed by 3bytes to give index */
  d_indexed_item2  ;      /* d_indexed_item2 followed by 2bytes to give index */
  d_indexed_item1 
  d_indexed_item0    ;  /* This must occur last ! */
))

(defmacro put-op (op str)
  `(write-byte ,(or (position op *fasd-ops*)
		    (error "illegal op")) ,str))

(defmacro putd (n str)
  `(write-byte ,n ,str))

(defmacro put2 (n str)
  `(progn  (write-bytei ,n 0 ,str)
	   (write-bytei  ,n 1 ,str)))

(defmacro put4 (n str)
  `(progn  (write-bytei ,n 0 ,str)
	   (write-bytei  ,n 1 ,str)
	   (write-bytei  ,n 2 ,str)
	   (write-bytei  ,n 3 ,str)
	   ))

  
(defmacro write-bytei (n i str)
  `(write-byte (the fixnum (ash (the fixnum ,n) >> ,(* i 8))) ,str))