making long argument lists more efficient
This commit is contained in:
		
							parent
							
								
									0278b152b8
								
							
						
					
					
						commit
						66c671bfee
					
				| 
						 | 
					@ -24,7 +24,7 @@
 | 
				
			||||||
	  
 | 
						  
 | 
				
			||||||
	  :closure :argc :vargc :trycatch :copyenv :let :for :tapply
 | 
						  :closure :argc :vargc :trycatch :copyenv :let :for :tapply
 | 
				
			||||||
	  :add2 :sub2 :neg :largc :lvargc
 | 
						  :add2 :sub2 :neg :largc :lvargc
 | 
				
			||||||
	  :loada0 :loada1 :loadc00 :loadc01
 | 
						  :loada0 :loada1 :loadc00 :loadc01 :call.l :tcall.l
 | 
				
			||||||
	  
 | 
						  
 | 
				
			||||||
	  dummy_t dummy_f dummy_nil]))
 | 
						  dummy_t dummy_f dummy_nil]))
 | 
				
			||||||
    (for 0 (1- (length keys))
 | 
					    (for 0 (1- (length keys))
 | 
				
			||||||
| 
						 | 
					@ -148,7 +148,7 @@
 | 
				
			||||||
		      ((number? nxt)
 | 
							      ((number? nxt)
 | 
				
			||||||
		       (case vi
 | 
							       (case vi
 | 
				
			||||||
			 ((:loadv.l :loadg.l :setg.l :loada.l :seta.l
 | 
								 ((:loadv.l :loadg.l :setg.l :loada.l :seta.l
 | 
				
			||||||
			   :largc :lvargc)
 | 
								   :largc :lvargc :call.l :tcall.l)
 | 
				
			||||||
			  (io.write bcode (int32 nxt))
 | 
								  (io.write bcode (int32 nxt))
 | 
				
			||||||
			  (set! i (+ i 1)))
 | 
								  (set! i (+ i 1)))
 | 
				
			||||||
			 
 | 
								 
 | 
				
			||||||
| 
						 | 
					@ -306,22 +306,6 @@
 | 
				
			||||||
(define (compile-or g env tail? forms)
 | 
					(define (compile-or g env tail? forms)
 | 
				
			||||||
  (compile-short-circuit g env tail? forms #f :brt))
 | 
					  (compile-short-circuit g env tail? forms #f :brt))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (list-partition l n)
 | 
					 | 
				
			||||||
  (define (list-part- l n  i subl acc)
 | 
					 | 
				
			||||||
    (cond ((atom? l) (if (> i 0)
 | 
					 | 
				
			||||||
			 (cons (reverse! subl) acc)
 | 
					 | 
				
			||||||
			 acc))
 | 
					 | 
				
			||||||
	  ((>= i n)  (list-part- l n 0 () (cons (reverse! subl) acc)))
 | 
					 | 
				
			||||||
	  (else      (list-part- (cdr l) n (+ 1 i) (cons (car l) subl) acc))))
 | 
					 | 
				
			||||||
  (if (<= n 0)
 | 
					 | 
				
			||||||
      (error "list-partition: invalid count")
 | 
					 | 
				
			||||||
      (reverse! (list-part- l n 0 () ()))))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
(define (make-nested-arglist args n)
 | 
					 | 
				
			||||||
  (cons nconc
 | 
					 | 
				
			||||||
	(map (lambda (l) (cons list l))
 | 
					 | 
				
			||||||
	     (list-partition args n))))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
(define (compile-arglist g env lst)
 | 
					(define (compile-arglist g env lst)
 | 
				
			||||||
  (for-each (lambda (a)
 | 
					  (for-each (lambda (a)
 | 
				
			||||||
	      (compile-in g env #f a))
 | 
						      (compile-in g env #f a))
 | 
				
			||||||
| 
						 | 
					@ -410,10 +394,10 @@
 | 
				
			||||||
	       (top-level-value head)
 | 
						       (top-level-value head)
 | 
				
			||||||
	       head)))
 | 
						       head)))
 | 
				
			||||||
      (if (length> (cdr x) 255)
 | 
					      (if (length> (cdr x) 255)
 | 
				
			||||||
	  ; argument count is a uint8, so for more than 255 arguments
 | 
						  ; more than 255 arguments, need long versions of instructions
 | 
				
			||||||
	  ; we use apply on a list built from sublists that fit the limit
 | 
						  (begin (compile-in g env #f head)
 | 
				
			||||||
	  (compile-in g env tail?
 | 
							 (let ((nargs (compile-arglist g env (cdr x))))
 | 
				
			||||||
		      `(#.apply ,head ,(make-nested-arglist (cdr x) 255)))
 | 
							   (emit g (if tail? :tcall.l :call.l) nargs)))
 | 
				
			||||||
	  (let ((b (and (builtin? head)
 | 
						  (let ((b (and (builtin? head)
 | 
				
			||||||
			(builtin->instruction head))))
 | 
								(builtin->instruction head))))
 | 
				
			||||||
	    (if (not b)
 | 
						    (if (not b)
 | 
				
			||||||
| 
						 | 
					@ -590,7 +574,7 @@
 | 
				
			||||||
		  (princ (number->string (aref code i)))
 | 
							  (princ (number->string (aref code i)))
 | 
				
			||||||
		  (set! i (+ i 1)))
 | 
							  (set! i (+ i 1)))
 | 
				
			||||||
		 
 | 
							 
 | 
				
			||||||
		 ((:loada.l :seta.l :largc :lvargc)
 | 
							 ((:loada.l :seta.l :largc :lvargc :call.l :tcall.l)
 | 
				
			||||||
		  (princ (number->string (ref-int32-LE code i)))
 | 
							  (princ (number->string (ref-int32-LE code i)))
 | 
				
			||||||
		  (set! i (+ i 4)))
 | 
							  (set! i (+ i 4)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
										
											
												File diff suppressed because one or more lines are too long
											
										
									
								
							| 
						 | 
					@ -1038,6 +1038,8 @@ static value_t apply_cl(uint32_t nargs)
 | 
				
			||||||
                NEXT_OP;
 | 
					                NEXT_OP;
 | 
				
			||||||
            }
 | 
					            }
 | 
				
			||||||
            type_error("apply", "function", func);
 | 
					            type_error("apply", "function", func);
 | 
				
			||||||
 | 
					        OP(OP_TCALLL) n = GET_INT32(ip); ip+=4; goto do_tcall;
 | 
				
			||||||
 | 
					        OP(OP_CALLL)  n = GET_INT32(ip); ip+=4; goto do_call;
 | 
				
			||||||
        OP(OP_JMP) ip += (ptrint_t)GET_INT16(ip); NEXT_OP;
 | 
					        OP(OP_JMP) ip += (ptrint_t)GET_INT16(ip); NEXT_OP;
 | 
				
			||||||
        OP(OP_BRF)
 | 
					        OP(OP_BRF)
 | 
				
			||||||
            v = POP();
 | 
					            v = POP();
 | 
				
			||||||
| 
						 | 
					@ -1580,7 +1582,7 @@ static value_t apply_cl(uint32_t nargs)
 | 
				
			||||||
                pv[0] = fixnum(n+1);
 | 
					                pv[0] = fixnum(n+1);
 | 
				
			||||||
                pv++;
 | 
					                pv++;
 | 
				
			||||||
                do {
 | 
					                do {
 | 
				
			||||||
                  pv[n] = Stack[bp+n];
 | 
					                    pv[n] = Stack[bp+n];
 | 
				
			||||||
                } while (n--);
 | 
					                } while (n--);
 | 
				
			||||||
                // environment representation changed; install
 | 
					                // environment representation changed; install
 | 
				
			||||||
                // the new representation so everybody can see it
 | 
					                // the new representation so everybody can see it
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -25,7 +25,7 @@ enum {
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    OP_CLOSURE, OP_ARGC, OP_VARGC, OP_TRYCATCH, OP_COPYENV, OP_LET, OP_FOR,
 | 
					    OP_CLOSURE, OP_ARGC, OP_VARGC, OP_TRYCATCH, OP_COPYENV, OP_LET, OP_FOR,
 | 
				
			||||||
    OP_TAPPLY, OP_ADD2, OP_SUB2, OP_NEG, OP_LARGC, OP_LVARGC,
 | 
					    OP_TAPPLY, OP_ADD2, OP_SUB2, OP_NEG, OP_LARGC, OP_LVARGC,
 | 
				
			||||||
    OP_LOADA0, OP_LOADA1, OP_LOADC00, OP_LOADC01,
 | 
					    OP_LOADA0, OP_LOADA1, OP_LOADC00, OP_LOADC01, OP_CALLL, OP_TCALLL,
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    OP_BOOL_CONST_T, OP_BOOL_CONST_F, OP_THE_EMPTY_LIST,
 | 
					    OP_BOOL_CONST_T, OP_BOOL_CONST_F, OP_THE_EMPTY_LIST,
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -66,7 +66,8 @@ enum {
 | 
				
			||||||
    &&L_OP_LET, &&L_OP_FOR,                                             \
 | 
					    &&L_OP_LET, &&L_OP_FOR,                                             \
 | 
				
			||||||
    &&L_OP_TAPPLY, &&L_OP_ADD2, &&L_OP_SUB2, &&L_OP_NEG, &&L_OP_LARGC,  \
 | 
					    &&L_OP_TAPPLY, &&L_OP_ADD2, &&L_OP_SUB2, &&L_OP_NEG, &&L_OP_LARGC,  \
 | 
				
			||||||
    &&L_OP_LVARGC,                                                      \
 | 
					    &&L_OP_LVARGC,                                                      \
 | 
				
			||||||
    &&L_OP_LOADA0, &&L_OP_LOADA1, &&L_OP_LOADC00, &&L_OP_LOADC01        \
 | 
					    &&L_OP_LOADA0, &&L_OP_LOADA1, &&L_OP_LOADC00, &&L_OP_LOADC01,       \
 | 
				
			||||||
 | 
					    &&L_OP_CALLL, &&L_OP_TCALLL                                         \
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#define VM_APPLY_LABELS                                                 \
 | 
					#define VM_APPLY_LABELS                                                 \
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -972,8 +972,6 @@ consolidated todo list as of 7/8:
 | 
				
			||||||
- #+, #- reader macros
 | 
					- #+, #- reader macros
 | 
				
			||||||
- printing improvements: *print-big*, keep track of horiz. position
 | 
					- printing improvements: *print-big*, keep track of horiz. position
 | 
				
			||||||
  per-stream so indenting works across print calls
 | 
					  per-stream so indenting works across print calls
 | 
				
			||||||
- improve bootstrapping process so compiled version can recompile
 | 
					 | 
				
			||||||
  itself for a broader set of changes
 | 
					 | 
				
			||||||
- remaining c types
 | 
					- remaining c types
 | 
				
			||||||
- remaining cvalues functions
 | 
					- remaining cvalues functions
 | 
				
			||||||
- finish ios
 | 
					- finish ios
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue