summaryrefslogtreecommitdiffstats
path: root/mkimpcat.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:24 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:24 -0800
commit1edcb9b62a1a520eddae8403c19d841c9b18737f (patch)
treebc0a43d9b3905726a76ed6f0528b54275f23d082 /mkimpcat.scm
parent5ca6e8e6a4e5c022a6fb5d28f30219c22c99eda8 (diff)
downloadscm-1edcb9b62a1a520eddae8403c19d841c9b18737f.tar.gz
scm-1edcb9b62a1a520eddae8403c19d841c9b18737f.zip
Import Upstream version 5b3upstream/5b3
Diffstat (limited to 'mkimpcat.scm')
-rw-r--r--mkimpcat.scm221
1 files changed, 221 insertions, 0 deletions
diff --git a/mkimpcat.scm b/mkimpcat.scm
new file mode 100644
index 0000000..4c69937
--- /dev/null
+++ b/mkimpcat.scm
@@ -0,0 +1,221 @@
+;; Copyright (C) 1993, 1994, 1995, 1997 Free Software Foundation, Inc.
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this software; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;
+;; As a special exception, the Free Software Foundation gives permission
+;; for additional uses of the text contained in its release of GUILE.
+;;
+;; The exception is that, if you link the GUILE library with other files
+;; to produce an executable, this does not by itself cause the
+;; resulting executable to be covered by the GNU General Public License.
+;; Your use of that executable is in no way restricted on account of
+;; linking the GUILE library code into it.
+;;
+;; This exception does not however invalidate any other reasons why
+;; the executable file might be covered by the GNU General Public License.
+;;
+;; This exception applies only to the code released by the
+;; Free Software Foundation under the name GUILE. If you copy
+;; code from other Free Software Foundation releases into a copy of
+;; GUILE, as the General Public License permits, the exception does
+;; not apply to the code that you add in this way. To avoid misleading
+;; anyone as to the status of such modified files, you must delete
+;; this exception notice from them.
+;;
+;; If you write modifications of your own for GUILE, it is your choice
+;; whether to permit this exception to apply to your modifications.
+;; If you do not wish that, delete this exception notice.
+
+;;;; "mkimpcat.scm" Build SCM-specific catalog for SLIB.
+;;; Author: Aubrey Jaffer.
+
+(let ((catname "implcat"))
+ (call-with-output-file (in-vicinity (implementation-vicinity) catname)
+ (lambda (op)
+ (define (display* . args)
+ (for-each (lambda (arg) (display arg op)) args)
+ (newline op))
+ (define wb:vicinity (string-append (implementation-vicinity) "../wb/"))
+ (define x-scm:vicinity
+ (string-append (implementation-vicinity) "../xscm-2.01/"))
+ (define (add-link feature ofile . libs)
+ (cond ((file-exists? ofile)
+ ;; remove #f from libs list
+ (set! libs (let rem ((l libs))
+ (cond ((null? l) l)
+ ((car l) (cons (car l) (rem (cdr l))))
+ (else (rem (cdr l))))))
+ (display " " op)
+ (write (cons feature (cons 'compiled (cons ofile libs))) op)
+ (newline op)
+ #t)
+ (else #f)))
+ (define (add-alias from to)
+ (display " " op)
+ (write (cons from to) op)
+ (newline op))
+ (define (add-source feature filename) (add-alias feature filename))
+ (define (add-links feature usr:lib x:lib link:able-suffix)
+ (display* "#+" feature)
+ (display* "(")
+ (begin
+ (cond ((add-link 'i/o-extensions
+ (in-vicinity (implementation-vicinity) "ioext"
+ link:able-suffix)
+ (usr:lib "c"))
+ (add-alias 'line-i/o 'i/o-extensions)
+ (add-alias 'pipe 'i/o-extensions)))
+ (cond ((add-link 'rev2-procedures
+ (in-vicinity (implementation-vicinity) "sc2"
+ link:able-suffix))
+ (add-alias 'rev3-procedures 'rev2-procedures)))
+ (cond ((or
+ (add-link 'db
+ (in-vicinity wb:vicinity "db.so"))
+ (add-link 'db
+ (in-vicinity wb:vicinity "db" link:able-suffix)
+ (in-vicinity wb:vicinity "handle" link:able-suffix)
+ (in-vicinity wb:vicinity "blink" link:able-suffix)
+ (in-vicinity wb:vicinity "prev" link:able-suffix)
+ (in-vicinity wb:vicinity "ent" link:able-suffix)
+ (in-vicinity wb:vicinity "sys" link:able-suffix)
+ (in-vicinity wb:vicinity "del" link:able-suffix)
+ (in-vicinity wb:vicinity "stats" link:able-suffix)
+ (in-vicinity wb:vicinity "blkio" link:able-suffix)
+ (in-vicinity wb:vicinity "scan" link:able-suffix)
+ (usr:lib "c")))
+ (add-source 'wb-table
+ (in-vicinity wb:vicinity "wbtab"))
+ (add-alias 'wb 'db)))
+ (cond ((add-link 'stringvector
+ (in-vicinity x-scm:vicinity "strvec" link:able-suffix))
+ (add-source 'x11 (in-vicinity x-scm:vicinity "x11"))
+ (add-source 'xevent(in-vicinity x-scm:vicinity "xevent"))
+ (add-source 'xt (in-vicinity x-scm:vicinity "xt"))
+ (add-source 'xm (in-vicinity x-scm:vicinity "xm"))
+ (add-source 'xmsubs(in-vicinity x-scm:vicinity "xmsubs"))
+ (add-source 'xaw (in-vicinity x-scm:vicinity "xaw"))
+ (add-source 'xpm (in-vicinity x-scm:vicinity "xpm"))))
+
+ (add-link 'turtle-graphics
+ (in-vicinity (implementation-vicinity) "turtlegr"
+ link:able-suffix)
+ (x:lib "X11")
+ (usr:lib "m")
+ (usr:lib "c"))
+ (add-link 'curses
+ (in-vicinity (implementation-vicinity) "crs"
+ link:able-suffix)
+ (usr:lib "ncurses")
+ ;;(usr:lib "curses")
+ ;;(usr:lib "termcap")
+ (usr:lib "c"))
+ (add-link 'edit-line
+ (in-vicinity (implementation-vicinity) "edline"
+ link:able-suffix)
+ (usr:lib "edit")
+ (usr:lib "termcap")
+ (usr:lib "c"))
+ (add-link 'regex
+ (in-vicinity (implementation-vicinity) "rgx"
+ link:able-suffix)
+ (usr:lib "c"))
+ (add-link 'unix
+ (in-vicinity (implementation-vicinity) "unix"
+ link:able-suffix)
+ (in-vicinity (implementation-vicinity) "ioext"
+ link:able-suffix)
+ (usr:lib "c"))
+ (add-link 'posix
+ (in-vicinity (implementation-vicinity) "posix"
+ link:able-suffix)
+ (usr:lib "c"))
+ (add-link 'socket
+ (in-vicinity (implementation-vicinity) "socket"
+ link:able-suffix)
+ (usr:lib "c"))
+ (add-link 'record
+ (in-vicinity (implementation-vicinity) "record"
+ link:able-suffix))
+ (add-link 'generalized-c-arguments
+ (in-vicinity (implementation-vicinity) "gsubr"
+ link:able-suffix))
+ (add-link 'array-for-each
+ (in-vicinity (implementation-vicinity) "ramap"
+ link:able-suffix))
+ )
+ (display* ")")
+ )
+
+ (begin
+ (display* ";\"" catname "\" Implementation-specific SLIB catalog for "
+ (scheme-implementation-type) (scheme-implementation-version)
+ ". -*-scheme-*-")
+ (display* ";")
+ (display* "; DO NOT EDIT THIS FILE")
+ (display* "; it is automagically generated by \"" *load-pathname* "\"")
+ (newline op)
+ )
+
+ ;; Output association lists to file "implcat"
+
+ (begin
+ ;; Simple associations -- OK for all modes of dynamic-linking
+ (display* "(")
+ (add-alias 'hobbit (in-vicinity (implementation-vicinity) "hobbit"))
+ (add-alias 'scmhob (in-vicinity (implementation-vicinity) "scmhob"))
+ (add-alias 'build (in-vicinity (implementation-vicinity) "build"))
+
+ ;; (add-alias 'impl:callback '(identity))
+
+ (display* ")")
+ )
+
+ (begin
+ ;; Messy because this trait has no C-installed feature name
+ (display* "#.(if (defined? renamed-identifier)")
+ (display* " '(")
+ (display " " op)
+ (add-source 'macro (in-vicinity (implementation-vicinity) "Macro"))
+ (display* " )")
+ (display* " '())")
+ )
+
+ (add-links 'dld
+ (lambda (lib) (string-append "/usr/lib/lib" lib ".a"))
+ (lambda (lib) (string-append "/usr/X11/lib/lib" lib ".sa"))
+ ".o")
+ (add-links 'dld:dyncm
+ (lambda (lib)
+ (or (and (member lib '("c" "m"))
+ (let ((sa (string-append "/usr/lib/lib" lib ".sa")))
+ (and (file-exists? sa) sa)))
+ (string-append "/usr/lib/lib" lib ".a")))
+ (lambda (lib) (string-append "/usr/X11/lib/lib" lib ".sa"))
+ ".o")
+ (add-links 'shl
+ (lambda (lib)
+ (if (member lib '("c" "m"))
+ (string-append "/lib/lib" lib ".sl")
+ (string-append "/usr/lib/lib" lib ".sl")))
+ (lambda (lib)
+ (string-append "/usr/X11R5/lib/lib" lib ".sl"))
+ ".sl")
+ (add-links 'sun-dl
+ ;; These libraries are (deferred) linked in conversion to ".so"
+ (lambda (lib) #f)
+ (lambda (lib) #f)
+ ".so")
+ )))