#!/usr/pkg/bin/siod -v01,-m2
# -*-parser:read-*-
(define (get-default-i-flag fname) (let ((default "/usr/local/bin/siod")) (cond ((not fname) default) ((memq (os-classification) (quote (win32 vms))) default) ((quote else) (let ((f (fopen fname "r")) (line nil)) (set! line (readline f)) (fclose f) (cond ((not (substring-equal? "#!" line 0 2)) default) ((quote else) (set! line (string-trim (substring line 2))) (set! line (substring line 0 (string-search " " line))) line)))))))
(define (main) (let ((input-files nil) (arg nil) (j 0) (output-file (lkey-default (cdddr *args*) (quote o) (if (memq (os-classification) (quote (unix))) "a.out" nil))) (m-flag (lkey-default (cdddr *args*) (quote m) "2")) (v-flag (lkey-default (cdddr *args*) (quote v) "01")) (i-flag (lkey-default (cdddr *args*) (quote i) nil)) (p-flag (lkey-default (cdddr *args*) (quote p) "fasl")) (e-flag (lkey-default (cdddr *args*) (quote e) "false")) (forms nil)) (or output-file (error "must specify :o=XXX for output")) (or i-flag (set! i-flag (get-default-i-flag (and (> (length *args*) 2) (nth 2 *args*))))) (while (set! arg (larg-default (cdddr *args*) j nil)) (set! input-files (append input-files (list arg))) (set! j (+ 1 j))) (or input-files (error "no source, object or ucode file specified")) (set! forms (process-input-files input-files (cond ((equal? "false" e-flag) nil) ((equal? "true" e-flag) t) ((quote else) (error "e-flag not true or false" e-flag))))) (cond ((equal? p-flag "fasl") (if (output-is-exe? output-file) (let ((f (fopen output-file "wb"))) (write-exe-bootstrap f) (fclose f))) (fast-save output-file forms nil (string-append "#!" i-flag " " "-v" v-flag "," "-m" m-flag "\n# -*-parser:fasl-*-\n") (and (output-is-exe? output-file) "ab"))) ((equal? p-flag "read") (let ((f (fopen output-file (if (output-is-exe? output-file) "wb" "w")))) (if (output-is-exe? output-file) (write-exe-bootstrap f)) (writes f "#!" i-flag " " "-v" v-flag "," "-m" m-flag "\n# -*-parser:read-*-\n") (while forms (print (car forms) f) (set! forms (cdr forms))) (fclose f))) ((quote else) (error "unknown p (parser) option" p-flag))) (cond ((not (memq (os-classification) (quote (vms)))) (chmod output-file (encode-file-mode (append (quote (RUSR WUSR XUSR)) (if (memq (os-classification) (quote (win32 vms))) nil (quote (RGRP XGRP ROTH XOTH))))))))))
(define (output-is-exe? x) (and (memq (os-classification) (quote (win32 vms))) (> (length x) 4) (equal? ".EXE" (string-upcase (substring x (- (length x) 4))))))
(define (write-exe-bootstrap f) (let ((bf (fopen (string-append (siod-lib) "siod.exe") "rb")) (buff (cons-array 1000 (quote byte))) (n nil)) (while (set! n (fread buff bf)) (fwrite (if (= n (length buff)) buff (list buff n)) f)) (fclose bf)))
(define (require-registration-form fname) (list (quote set!) (intern (string-append "*" fname "-loaded*")) (quote t)))
(define (process-input-files l e-flag) (apply append (mapcar (lambda (x) (if e-flag (load x nil t)) (append (load x t t) (list (require-registration-form x)))) l)))
(set! *csiod.smd-loaded* t)
