you can now specifiy an arg vm parser
This commit is contained in:
		
							parent
							
								
									4703ce142a
								
							
						
					
					
						commit
						88aaa91880
					
				| 
						 | 
				
			
			@ -80,6 +80,13 @@ For testing load this at a scsh prompt
 | 
			
		|||
		       (else 
 | 
			
		||||
			(display "error: -o requires argument") (newline)
 | 
			
		||||
			(usage (car argl)))))
 | 
			
		||||
		((equal? (car args) "--args")
 | 
			
		||||
		 (cond ((not (null? (cdr args)))
 | 
			
		||||
			(set-options:args-parser options (cadr args))
 | 
			
		||||
			(loop (cddr args)))
 | 
			
		||||
		       (else 
 | 
			
		||||
			(display "error: --args requires argument") (newline)
 | 
			
		||||
			(usage (car argl)))))
 | 
			
		||||
		((equal? (car args) "--temp")
 | 
			
		||||
		 (cond ((not (null? (cdr args)))
 | 
			
		||||
			(set-options:temp-dir options (cadr args))
 | 
			
		||||
| 
						 | 
				
			
			@ -112,6 +119,11 @@ For testing load this at a scsh prompt
 | 
			
		|||
		 (format #t "error: unknown argument ~a" (car args)) 
 | 
			
		||||
		 (newline)
 | 
			
		||||
		 (usage (car argl)))))
 | 
			
		||||
	(set-options:args-parser
 | 
			
		||||
	 options
 | 
			
		||||
	 (if (options:args-parser options)
 | 
			
		||||
	     (list (options:args-parser options))
 | 
			
		||||
	     '()))
 | 
			
		||||
	(set-options:temp-dir 
 | 
			
		||||
	 options
 | 
			
		||||
	 (or (options:temp-dir options)
 | 
			
		||||
| 
						 | 
				
			
			@ -142,6 +154,7 @@ For testing load this at a scsh prompt
 | 
			
		|||
	       "usage: ~a ~%" 
 | 
			
		||||
	       "          [-i image]~%"
 | 
			
		||||
	       "          [-o executable]~%"
 | 
			
		||||
	       "          [--args object]~%"
 | 
			
		||||
	       "          [--temp directory]~%"
 | 
			
		||||
	       "          [--cc command]~%"
 | 
			
		||||
	       "          [--ld command]~%"
 | 
			
		||||
| 
						 | 
				
			
			@ -154,8 +167,9 @@ For testing load this at a scsh prompt
 | 
			
		|||
 | 
			
		||||
    (define-record options
 | 
			
		||||
      (input-image #f)			; the input scheme image file
 | 
			
		||||
      (temp-dir #f)			; place for intermediate .c .o files
 | 
			
		||||
      (output-executable #f)		; the output executable file
 | 
			
		||||
      (args-parser #f)			; .o file for replacement process_args
 | 
			
		||||
      (temp-dir #f)			; place for intermediate .c .o files
 | 
			
		||||
      (cc-command #f)			; command to compile a .c file
 | 
			
		||||
      (ld-flags #f)			; flags needed to link executable
 | 
			
		||||
      (libraries #f)			; linbraries need to link executable
 | 
			
		||||
| 
						 | 
				
			
			@ -367,8 +381,9 @@ For testing load this at a scsh prompt
 | 
			
		|||
	    (scsh-emit-descriptor start reloc port)
 | 
			
		||||
	    (write-char #\; port)
 | 
			
		||||
	    (newline port)))
 | 
			
		||||
	(message (append cc '("static.c")))
 | 
			
		||||
	(run  (,@(append cc '("static.c"))))))
 | 
			
		||||
	(let ((command (append cc '("static.c"))))
 | 
			
		||||
	  (message command)
 | 
			
		||||
	  (run (,@command)))))
 | 
			
		||||
 | 
			
		||||
;;; compile-c-image
 | 
			
		||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 | 
			
		||||
| 
						 | 
				
			
			@ -404,9 +419,10 @@ For testing load this at a scsh prompt
 | 
			
		|||
		   ;; wait for last compile before starting new one
 | 
			
		||||
		   (if process
 | 
			
		||||
		       (wait process))
 | 
			
		||||
		   (message (append cc (list filename)))
 | 
			
		||||
		   (set! process (& (,@(append cc (list filename)))))
 | 
			
		||||
		 (chunk-loop (+ 1 c))))
 | 
			
		||||
		   (let ((command (append cc (list filename))))
 | 
			
		||||
		     (message command)
 | 
			
		||||
		     (set! process (& (,@command))))
 | 
			
		||||
		   (chunk-loop (+ 1 c))))
 | 
			
		||||
		(else
 | 
			
		||||
		 (wait process))))))
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -421,39 +437,25 @@ For testing load this at a scsh prompt
 | 
			
		|||
			(line->list (options:ld-flags options))
 | 
			
		||||
			`(-o ,(options:output-executable options))))
 | 
			
		||||
	    (libs (line->list (options:libraries options))))
 | 
			
		||||
	(message (append ld
 | 
			
		||||
			 (let loop ((i 0)
 | 
			
		||||
				    (l '()))
 | 
			
		||||
			   (cond ((not (= i n))
 | 
			
		||||
				  (loop (+ i 1)
 | 
			
		||||
					(cons 
 | 
			
		||||
					 (format #f "static-i~s.o" i)
 | 
			
		||||
					 (cons
 | 
			
		||||
					  (format #f "static-p~s.o" i)
 | 
			
		||||
					  l))))
 | 
			
		||||
				 (else 
 | 
			
		||||
				  (reverse 		
 | 
			
		||||
				   (cons "static.o"
 | 
			
		||||
					 l)))))
 | 
			
		||||
			 '("@prefix@/lib/scsh/libscshvm.a")
 | 
			
		||||
			 libs))
 | 
			
		||||
	(run (,@(append 
 | 
			
		||||
		 ld
 | 
			
		||||
		 (let loop ((i 0)
 | 
			
		||||
			    (l '()))
 | 
			
		||||
		   (cond ((not (= i n))
 | 
			
		||||
			  (loop (+ i 1)
 | 
			
		||||
				(cons 
 | 
			
		||||
				 (format #f "static-i~s.o" i)
 | 
			
		||||
				 (cons
 | 
			
		||||
				  (format #f "static-p~s.o" i)
 | 
			
		||||
				  l))))
 | 
			
		||||
			 (else 
 | 
			
		||||
			  (reverse 		
 | 
			
		||||
			   (cons "static.o"
 | 
			
		||||
				 l)))))
 | 
			
		||||
		 '("@prefix@/lib/scsh/libscshvm.a")
 | 
			
		||||
		 libs)))))
 | 
			
		||||
	(let ((command (append ld
 | 
			
		||||
			       (let loop ((i 0)
 | 
			
		||||
					  (l '()))
 | 
			
		||||
				 (cond ((not (= i n))
 | 
			
		||||
					(loop (+ i 1)
 | 
			
		||||
					      (cons 
 | 
			
		||||
					       (format #f "static-i~s.o" i)
 | 
			
		||||
					       (cons
 | 
			
		||||
						(format #f "static-p~s.o" i)
 | 
			
		||||
						l))))
 | 
			
		||||
				       (else 
 | 
			
		||||
					(reverse 		
 | 
			
		||||
					 (cons "static.o"
 | 
			
		||||
					       l)))))
 | 
			
		||||
			       (options:args-parser options)
 | 
			
		||||
			       '("-L" "@prefix@/lib/scsh" "-lscshvm")
 | 
			
		||||
			       libs)))
 | 
			
		||||
	  (message command)
 | 
			
		||||
	  (run (,@command)))))
 | 
			
		||||
 | 
			
		||||
;;; scsh-emit-initializer
 | 
			
		||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue