210 lines
		
	
	
		
			5.3 KiB
		
	
	
	
		
			Common Lisp
		
	
	
	
			
		
		
	
	
			210 lines
		
	
	
		
			5.3 KiB
		
	
	
	
		
			Common Lisp
		
	
	
	
;;;-*- Mode: Lisp; Package: cl-user -*-
 | 
						|
 | 
						|
(in-package :cl-user)
 | 
						|
 | 
						|
(defparameter *assembler* 
 | 
						|
  '(
 | 
						|
 | 
						|
#+avr
 | 
						|
#"
 | 
						|
// Assembler
 | 
						|
 | 
						|
#if defined(CPU_ATmega1284P)
 | 
						|
#define CODE_ADDRESS 0x1bb00
 | 
						|
#elif defined(CPU_AVR128DX48)
 | 
						|
#define CODE_ADDRESS 0x1be00
 | 
						|
#endif
 | 
						|
 | 
						|
object *call (int entry, int nargs, object *args, object *env) {
 | 
						|
#if defined(CODESIZE)
 | 
						|
  (void) env;
 | 
						|
  int param[4];
 | 
						|
  for (int i=0; i<nargs; i++) {
 | 
						|
    object *arg = first(args);
 | 
						|
    if (integerp(arg)) param[i] = arg->integer;
 | 
						|
    else param[i] = (uintptr_t)arg;
 | 
						|
    args = cdr(args);
 | 
						|
  }
 | 
						|
  uint32_t address = (CODE_ADDRESS + entry)>>1; // Code addresses are word addresses on AVR
 | 
						|
  int w = ((intfn_ptr_type)address)(param[0], param[1], param[2], param[3]);
 | 
						|
  return number(w);
 | 
						|
#else
 | 
						|
  return nil;
 | 
						|
#endif
 | 
						|
}"#
 | 
						|
 | 
						|
#+arm
 | 
						|
#"
 | 
						|
// Assembler
 | 
						|
 | 
						|
object *call (int entry, int nargs, object *args, object *env) {
 | 
						|
#if defined(CODESIZE)
 | 
						|
  (void) env;
 | 
						|
  int param[4];
 | 
						|
  for (int i=0; i<nargs; i++) {
 | 
						|
    object *arg = first(args);
 | 
						|
    if (integerp(arg)) param[i] = arg->integer;
 | 
						|
    else param[i] = (uintptr_t)arg;
 | 
						|
    args = cdr(args);
 | 
						|
  }
 | 
						|
  int w = ((intfn_ptr_type)&MyCode[entry])(param[0], param[1], param[2], param[3]);
 | 
						|
  return number(w);
 | 
						|
#else
 | 
						|
  return nil;
 | 
						|
#endif
 | 
						|
}"#
 | 
						|
 | 
						|
#+riscv
 | 
						|
#"
 | 
						|
// Assembler
 | 
						|
 | 
						|
object *call (int entry, int nargs, object *args, object *env) {
 | 
						|
#if defined(CODESIZE)
 | 
						|
  (void) env;
 | 
						|
  int param[4];
 | 
						|
  for (int i=0; i<nargs; i++) {
 | 
						|
    object *arg = first(args);
 | 
						|
    if (integerp(arg)) param[i] = arg->integer;
 | 
						|
    else param[i] = (uintptr_t)arg;
 | 
						|
    args = cdr(args);
 | 
						|
  }
 | 
						|
  asm("fence.i");
 | 
						|
  int w = ((intfn_ptr_type)&MyCode[entry])(param[0], param[1], param[2], param[3]);
 | 
						|
  return number(w);
 | 
						|
#else
 | 
						|
  return nil;
 | 
						|
#endif
 | 
						|
}"#
 | 
						|
 | 
						|
#+avr
 | 
						|
#"
 | 
						|
void putcode (object *arg, int origin, int pc) {
 | 
						|
#if defined(CODESIZE)
 | 
						|
  int code = checkinteger(arg);
 | 
						|
  uint8_t hi = (code>>8) & 0xff;
 | 
						|
  uint8_t lo = code & 0xff; 
 | 
						|
  MyCode[origin+pc] = lo;            // Little-endian
 | 
						|
  MyCode[origin+pc+1] = hi;
 | 
						|
  #if defined(assemblerlist)
 | 
						|
  printhex2(pc>>8, pserial); printhex2(pc, pserial); pserial(' ');
 | 
						|
  printhex2(lo, pserial); pserial(' '); printhex2(hi, pserial); pserial(' ');
 | 
						|
  #endif
 | 
						|
#endif
 | 
						|
}"#
 | 
						|
 | 
						|
#+(or arm riscv)
 | 
						|
#"
 | 
						|
void putcode (object *arg, int origin, int pc) {
 | 
						|
#if defined(CODESIZE)
 | 
						|
  int code = checkinteger(arg);
 | 
						|
  MyCode[origin+pc] = code & 0xff;
 | 
						|
  MyCode[origin+pc+1] = (code>>8) & 0xff;
 | 
						|
  #if defined(assemblerlist)
 | 
						|
  printhex4(pc, pserial);
 | 
						|
  printhex4(code, pserial);
 | 
						|
  #endif
 | 
						|
#endif
 | 
						|
}"#
 | 
						|
 | 
						|
#+avr
 | 
						|
#"
 | 
						|
int assemble (int pass, int origin, object *entries, object *env, object *pcpair) {
 | 
						|
  int pc = 0; cdr(pcpair) = number(pc);
 | 
						|
  while (entries != NULL) {
 | 
						|
    object *arg = first(entries);
 | 
						|
    if (symbolp(arg)) {
 | 
						|
      if (pass == 2) {
 | 
						|
        #if defined(assemblerlist)
 | 
						|
        printhex2(pc>>8, pserial); printhex2(pc, pserial);
 | 
						|
        indent(7, ' ', pserial);
 | 
						|
        printobject(arg, pserial); pln(pserial);
 | 
						|
        #endif
 | 
						|
      } else {
 | 
						|
        object *pair = findvalue(arg, env);
 | 
						|
        cdr(pair) = number(pc);
 | 
						|
      }
 | 
						|
    } else {
 | 
						|
      object *argval = eval(arg, env);
 | 
						|
      if (listp(argval)) {
 | 
						|
        object *arglist = argval;
 | 
						|
        while (arglist != NULL) {
 | 
						|
          if (pass == 2) {
 | 
						|
            putcode(first(arglist), origin, pc);
 | 
						|
            #if defined(assemblerlist)
 | 
						|
            if (arglist == argval) superprint(arg, 0, pserial);
 | 
						|
            pln(pserial);
 | 
						|
            #endif
 | 
						|
          }
 | 
						|
          pc = pc + 2;
 | 
						|
          cdr(pcpair) = number(pc);
 | 
						|
          arglist = cdr(arglist);
 | 
						|
        }
 | 
						|
      } else if (integerp(argval)) {
 | 
						|
        if (pass == 2) {
 | 
						|
          putcode(argval, origin, pc);
 | 
						|
          #if defined(assemblerlist)
 | 
						|
          superprint(arg, 0, pserial); pln(pserial);
 | 
						|
          #endif
 | 
						|
        }
 | 
						|
        pc = pc + 2;
 | 
						|
        cdr(pcpair) = number(pc);
 | 
						|
      } else error(PSTR("illegal entry"), arg);
 | 
						|
    }
 | 
						|
    entries = cdr(entries);
 | 
						|
  }
 | 
						|
  // Round up to multiple of 2 to give code size
 | 
						|
  if (pc%2 != 0) pc = pc + 2 - pc%2;
 | 
						|
  return pc;
 | 
						|
}"#
 | 
						|
 | 
						|
#+(or arm riscv)
 | 
						|
#"
 | 
						|
int assemble (int pass, int origin, object *entries, object *env, object *pcpair) {
 | 
						|
  int pc = 0; cdr(pcpair) = number(pc);
 | 
						|
  while (entries != NULL) {
 | 
						|
    object *arg = first(entries);
 | 
						|
    if (symbolp(arg)) {
 | 
						|
      if (pass == 2) {
 | 
						|
        #if defined(assemblerlist)
 | 
						|
        printhex4(pc, pserial);
 | 
						|
        indent(5, ' ', pserial);
 | 
						|
        printobject(arg, pserial); pln(pserial);
 | 
						|
        #endif
 | 
						|
      } else {
 | 
						|
        object *pair = findvalue(arg, env);
 | 
						|
        cdr(pair) = number(pc);
 | 
						|
      }
 | 
						|
    } else {
 | 
						|
      object *argval = eval(arg, env);
 | 
						|
      if (listp(argval)) {
 | 
						|
        object *arglist = argval;
 | 
						|
        while (arglist != NULL) {
 | 
						|
          if (pass == 2) {
 | 
						|
            putcode(first(arglist), origin, pc);
 | 
						|
            #if defined(assemblerlist)
 | 
						|
            if (arglist == argval) superprint(arg, 0, pserial);
 | 
						|
            pln(pserial);
 | 
						|
            #endif
 | 
						|
          }
 | 
						|
          pc = pc + 2;
 | 
						|
          cdr(pcpair) = number(pc);
 | 
						|
          arglist = cdr(arglist);
 | 
						|
        }
 | 
						|
      } else if (integerp(argval)) {
 | 
						|
        if (pass == 2) {
 | 
						|
          putcode(argval, origin, pc);
 | 
						|
          #if defined(assemblerlist)
 | 
						|
          superprint(arg, 0, pserial); pln(pserial);
 | 
						|
          #endif
 | 
						|
        }
 | 
						|
        pc = pc + 2;
 | 
						|
        cdr(pcpair) = number(pc);
 | 
						|
      } else error(PSTR("illegal entry"), arg);
 | 
						|
    }
 | 
						|
    entries = cdr(entries);
 | 
						|
  }
 | 
						|
  // Round up to multiple of 4 to give code size
 | 
						|
  if (pc%4 != 0) pc = pc + 4 - pc%4;
 | 
						|
  return pc;
 | 
						|
}"#))
 | 
						|
         |