From 1edcb9b62a1a520eddae8403c19d841c9b18737f Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:24 -0800 Subject: Import Upstream version 5b3 --- mkimpcat.scm | 221 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 221 insertions(+) create mode 100644 mkimpcat.scm (limited to 'mkimpcat.scm') 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") + ))) -- cgit v1.2.3