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 --- Link.scm | 149 ++++++++++++--------------------------------------------------- 1 file changed, 28 insertions(+), 121 deletions(-) (limited to 'Link.scm') diff --git a/Link.scm b/Link.scm index ad88e47..a141e54 100644 --- a/Link.scm +++ b/Link.scm @@ -1,4 +1,4 @@ -;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. +;; 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 @@ -57,19 +57,18 @@ (define scm:object-suffix (case (software-type) ((MSDOS VMS) ".OBJ") - (else (if (provided? 'sun-dl) ".so" ".o")))) + (else ".o"))) ;;; This is an unusual autoload because it should load either the ;;; source or compiled version if present. (if (not (defined? hobbit)) ;Autoload for hobbit (define (hobbit . args) - (require (in-vicinity (implementation-vicinity) "hobbit")) - (provide 'hobbit) + (require 'hobbit) (apply hobbit args))) (define (compile-file file . args) (apply hobbit file args) - (require (in-vicinity (implementation-vicinity) "build")) + (require 'build) (build-from-whole-argv (list "build" "-tdll" (string-append "--compiler-options=-I" (implementation-vicinity)) @@ -80,7 +79,7 @@ ))) (define (link-named-scm name . modules) - (require (in-vicinity (implementation-vicinity) "build")) + (require 'build) (let* ((iv (implementation-vicinity)) (oss (string-append scm:object-suffix " ")) (command @@ -105,7 +104,7 @@ (cond ((defined? dyn:link) (define link:modules '()) - (define link:able-suffix + (define link:able-suffix (cond ((provided? 'shl) ".sl") ((provided? 'sun-dl) ".so") (else ".o"))) @@ -168,117 +167,25 @@ (else (loop (- i 1))))) (vms:dynamic-link-call dir fil (string-append "init_" fil))))) -(set! *catalog* - (acons 'scmhob (in-vicinity (implementation-vicinity) "scmhob") - *catalog*)) -(and (defined? *catalog*) (defined? link:link) - (cond ((provided? 'dld:dyncm) - (define (usr:lib 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"))) - (define (x:lib lib) (string-append "/usr/X11/lib/lib" lib ".sa"))) - ((provided? 'sun-dl) - ;; These libraries are (deferred) linked in conversion to ".so" - (define (usr:lib lib) #f) - (define (x:lib lib) #f)) - ((provided? 'shl) - (define (usr:lib lib) - (if (member lib '("c" "m")) - (string-append "/lib/lib" lib link:able-suffix) - (string-append "/usr/lib/lib" lib link:able-suffix))) - (define (x:lib lib) (string-append "/usr/X11R5/lib/lib" - lib link:able-suffix))) - (else - (define (usr:lib lib) (string-append "/usr/lib/lib" lib ".a")) - (define (x:lib lib) (string-append "/usr/X11/lib/lib" lib ".sa")))) - (begin - (define wb:vicinity (string-append (implementation-vicinity) "../wb/")) - (define (catalog:add-link feature ofile . libs) - (define fe (file-exists? ofile)) - (cond ((or (not (require:feature->path feature)) fe) - ;; 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)))))) - (set! *catalog* - (acons feature (cons 'compiled (cons ofile libs)) - *catalog*)) - fe) - (else #f))) - (set! *catalog* - (acons 'wb-table (in-vicinity wb:vicinity "wbtab") *catalog*)) - (catalog: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")) - (set! *catalog* (cons '(wb . db) *catalog*)) - (catalog:add-link 'turtle-graphics - (in-vicinity (implementation-vicinity) "turtlegr" - link:able-suffix) - (x:lib "X11") - (usr:lib "m") - (usr:lib "c")) - (catalog:add-link 'curses - (in-vicinity (implementation-vicinity) "crs" - link:able-suffix) - (usr:lib "ncurses") - ;;(usr:lib "curses") - ;;(usr:lib "termcap") - (usr:lib "c")) - (catalog:add-link 'edit-line - (in-vicinity (implementation-vicinity) "edline" - link:able-suffix) - (usr:lib "edit") - (usr:lib "termcap") - (usr:lib "c")) - (catalog:add-link 'regex - (in-vicinity (implementation-vicinity) "rgx" - link:able-suffix) - (usr:lib "c")) - (catalog:add-link 'unix - (in-vicinity (implementation-vicinity) "unix" - link:able-suffix) - (in-vicinity (implementation-vicinity) "ioext" - link:able-suffix) - (usr:lib "c")) - (catalog:add-link 'posix - (in-vicinity (implementation-vicinity) "posix" - link:able-suffix) - (usr:lib "c")) - (catalog:add-link 'socket - (in-vicinity (implementation-vicinity) "socket" - link:able-suffix) - (usr:lib "c")) - (cond ((catalog:add-link 'i/o-extensions - (in-vicinity (implementation-vicinity) "ioext" - link:able-suffix) - (usr:lib "c")) - (set! *catalog* (append '((line-i/o . i/o-extensions) - (pipe . i/o-extensions)) - *catalog*)))) - (cond ((catalog:add-link 'rev2-procedures - (in-vicinity (implementation-vicinity) "sc2" - link:able-suffix)) - (set! *catalog* (cons '(rev3-procedures . rev2-procedures) - *catalog*)))) - (catalog:add-link 'record - (in-vicinity (implementation-vicinity) "record" - link:able-suffix)) - (catalog:add-link 'generalized-c-arguments - (in-vicinity (implementation-vicinity) "gsubr" - link:able-suffix)) - (catalog:add-link 'array-for-each - (in-vicinity (implementation-vicinity) "ramap" - link:able-suffix)) - )) +(cond + ((provided? 'sun-dl) + ;; These libraries are (deferred) linked in conversion to ".so" + (define (usr:lib lib) #f) + (define (x:lib lib) #f)) + ((provided? 'shl) + (define (usr:lib lib) + (if (member lib '("c" "m")) + (string-append "/lib/lib" lib link:able-suffix) + (string-append "/usr/lib/lib" lib link:able-suffix))) + (define (x:lib lib) (string-append "/usr/X11R5/lib/lib" + lib link:able-suffix))) + ((provided? 'dld:dyncm) + (define (usr:lib 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"))) + (define (x:lib lib) (string-append "/usr/X11/lib/lib" lib ".sa"))) + ((provided? 'dld) + (define (usr:lib lib) (string-append "/usr/lib/lib" lib ".a")) + (define (x:lib lib) (string-append "/usr/X11/lib/lib" lib ".sa")))) -- cgit v1.2.3