scsh-conservatory
/
scsh-0.5
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

added first real command line interface

This commit is contained in:
bdc 1996-10-30 05:58:13 +00:00
parent 3d90d39924
commit e45e9a6b0d
1 changed files with 97 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

122
scsh/static.scm.in
View File

@ -46,31 +46,103 @@ For testing load this at a scsh prompt
;;; real work in static-heap-linker1
;;; argl is a list of the command line arguments
(define (static-heap-linker argl)
(cond ((not (= (length argl) 3))
(format #t
"usage: ~a input-image-file output-executible-file"
(car argl))
(exit 1)))
(let ((temp-dir ; place for intermediate .c .o files
(or (getenv "TMPDIR")
"@TMPDIR@"))
(cc-command ; command to compile a .c file
(or (getenv "CC")
"@CC@ @CFLAGS@"))
(ld-flags ; flags needed to link executible
(or (getenv "LDFLAGS")
"@LDFLAGS@"))
(libraries ; linbraries need to link executible
(or (getenv "LIBS")
"@LIBS@"))
(input-image ; the input scheme image file
(cadr argl))
(output-executible ; the output executible file
(caddr argl)))
(static-heap-linker1 input-image temp-dir output-executible
cc-command ld-flags libraries)
(exit 0)))
(let ((temp-dir-arg #f)
(cc-command-arg #f)
(ld-flags-arg #f)
(libraries-arg #f)
(input-image-arg #f)
(output-executible-arg #f))
(let loop ((args (cdr argl)))
(cond ((null? args)
(cond ((not output-executible-arg)
(display "error: -o is a required argument")
(newline)
(usage (car argl)))
((not input-image-arg)
(display "error: -i is a required argument")
(newline)
(usage (car argl)))))
((equal? (car args) "-o")
(cond ((not (null? (cdr args)))
(set! output-executible-arg (cadr args))
(loop (cddr args)))
(else
(display "error: -o requires argument") (newline)
(usage (car argl)))))
((equal? (car args) "-i")
(cond ((not (null? (cdr args)))
(set! input-executible-arg (cadr args))
(loop (cddr args)))
(else
(display "error: -i requires argument") (newline)
(usage (car argl)))))
((equal? (car args) "--temp")
(cond ((not (null? (cdr args)))
(set! temp-dir-arg (cadr args))
(loop (cddr args)))
(else
(display "error: --temp requires argument") (newline)
(usage (car argl)))))
((equal? (car args) "--cc")
(cond ((not (null? (cdr args)))
(set! cc-command-arg (cadr args))
(loop (cddr args)))
(else
(display "error: --cc requires argument") (newline)
(usage (car argl)))))
((equal? (car args) "--ld")
(cond ((not (null? (cdr args)))
(set! ld-command-arg (cadr args))
(loop (cddr args)))
(else
(display "error: --ld requires argument") (newline)
(usage (car argl)))))
((equal? (car args) "--libs")
(cond ((not (null? (cdr args)))
(set! libraries-arg (cadr args))
(loop (cddr args)))
(else
(display "error: --libs requires argument") (newline)
(usage (car argl)))))
(else
(format #t "error: unknown argument ~a" (car args))
(newline)
(usage (car argl)))))
(let ((temp-dir ; place for intermediate .c .o files
(or temp-dir-arg
(getenv "TMPDIR")
"@TMPDIR@"))
(cc-command ; command to compile a .c file
(or cc-command-arg
(getenv "CC")
"@CC@ @CFLAGS@"))
(ld-flags ; flags needed to link executible
(or ld-flags-arg
(getenv "LDFLAGS")
"@LDFLAGS@"))
(libraries ; linbraries need to link executible
(or libraries-arg
(getenv "LIBS")
"@LIBS@"))
(input-image ; the input scheme image file
(cadr argl))
(output-executible ; the output executible file
(caddr argl)))
(static-heap-linker1 input-image temp-dir output-executible
cc-command ld-flags libraries)
(exit 0))))
(define (usage program-name)
(format #t
(string-append
"usage: ~a -i image -o executible~%"
" [--temp directory]~%"
" [--cc command]~%"
" [--ld command]~%"
" [--libs libraries]~%")
program-name)
(exit 1))
;;; heap structure
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;