From 97672104acdafd84c791fb00651b264e8c1345f7 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Wed, 22 May 2013 18:17:21 +0000 Subject: Replace Lisp-level structure with Boot datatype --- src/interp/Makefile.in | 6 ++--- src/interp/monitor.lisp | 8 +++--- src/interp/nlib.lisp | 60 ++++++++++++++++++++------------------------- src/interp/profile.boot | 5 ++-- src/interp/sys-utility.boot | 13 +++++++++- 5 files changed, 47 insertions(+), 45 deletions(-) (limited to 'src/interp') diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in index c7a6b3ce..5718c61d 100644 --- a/src/interp/Makefile.in +++ b/src/interp/Makefile.in @@ -270,7 +270,7 @@ hypertex.$(FASLEXT): types.$(FASLEXT) ## OpenAxiom's interpreter. makeint.$(FASLEXT): util.$(FASLEXT) setvars.$(FASLEXT): sys-macros.$(FASLEXT) debug.$(FASLEXT) -profile.$(FASLEXT): sys-macros.$(FASLEXT) +profile.$(FASLEXT): sys-macros.$(FASLEXT) sys-utility.$(FASLEXT) rulesets.$(FASLEXT): vmlisp.$(FASLEXT) osyscmd.$(FASLEXT): int-top.$(FASLEXT) int-top.$(FASLEXT): incl.$(FASLEXT) i-toplev.$(FASLEXT) unlisp.$(FASLEXT) @@ -323,7 +323,7 @@ spad-parser.$(FASLEXT): parse.$(FASLEXT) lexing.$(FASLEXT) parse.$(FASLEXT): postpar.$(FASLEXT) packtran.$(FASLEXT): sys-macros.$(FASLEXT) postpar.$(FASLEXT): sys-macros.$(FASLEXT) -nlib.$(FASLEXT): sys-macros.$(FASLEXT) +nlib.$(FASLEXT): sys-macros.$(FASLEXT) sys-utility.$(FASLEXT) lexing.$(FASLEXT): sys-utility.$(FASLEXT) sys-macros.$(FASLEXT) \ io.$(FASLEXT) @@ -353,7 +353,7 @@ dq.$(FASLEXT): types.$(FASLEXT) daase.$(FASLEXT): sys-utility.$(FASLEXT) debug.$(FASLEXT): sys-macros.$(FASLEXT) lexing.$(FASLEXT) spad.$(FASLEXT): spad-parser.$(FASLEXT) postpar.$(FASLEXT) debug.$(FASLEXT) -monitor.$(FASLEXT): sys-macros.$(FASLEXT) +monitor.$(FASLEXT): sys-macros.$(FASLEXT) sys-utility.$(FASLEXT) sfsfun-l.$(FASLEXT): sys-macros.$(FASLEXT) trace.$(FASLEXT): debug.$(FASLEXT) termrw.$(FASLEXT): sys-macros.$(FASLEXT) diff --git a/src/interp/monitor.lisp b/src/interp/monitor.lisp index 69c27f6f..1a8c8b03 100644 --- a/src/interp/monitor.lisp +++ b/src/interp/monitor.lisp @@ -1,6 +1,6 @@ ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ;; All rights reserved. -;; Copyright (C) 2007-2012, Gabriel Dos Reis. +;; Copyright (C) 2007-2013, Gabriel Dos Reis. ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without @@ -33,6 +33,7 @@ (import-module "sys-macros") +(import-module "sys-utility") (in-package "BOOT") (defun monitor-help () @@ -150,9 +151,6 @@ (defstruct monitor-data name count monitorp sourcefile) -(unless (fboundp 'libstream-dirname) - (defstruct libstream mode dirname (indextable nil) (indexstream nil))) - (defun monitor-inittable () "initialize the table" (setq *monitor-table* (make-hash-table))) @@ -326,7 +324,7 @@ (defun monitor-dirname (args) "expects a list of 1 libstream (loadvol's arglist) and monitors the source" (let (name) - (setq name (libstream-dirname (car args))) + (setq name (|libDirname| (car args))) (setq name (file-namestring name)) (setq name (concatenate 'string "/spad/int/algebra/" name "/code.lsp")) (when (probe-file name) diff --git a/src/interp/nlib.lisp b/src/interp/nlib.lisp index e682b2f5..4b57238e 100644 --- a/src/interp/nlib.lisp +++ b/src/interp/nlib.lisp @@ -1,6 +1,6 @@ ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. ;; All rights reserved. -;; Copyright (C) 2007-2012, Gabriel Dos Reis. +;; Copyright (C) 2007-2013, Gabriel Dos Reis. ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without @@ -33,19 +33,15 @@ (IMPORT-MODULE "sys-macros") +(IMPORT-MODULE "sys-utility") (in-package "BOOT") -;; definition of our stream structure -(defstruct libstream mode dirname (indextable nil) (indexstream nil)) -;indextable is a list of entries (key class ) -;filename is of the form filenumber.lsp or filenumber.o - (defun addoptions (key value) "adds pairs to $compilerOptions" (push (cons key value) |$compilerOptions|) (if (equal key 'FILE) (push (cons 'COMPILER-OUTPUT-STREAM - (open (concat (libstream-dirname value) "/" "code.lsp") + (open (concat (|libDirname| value) "/" "code.lsp") :direction :output :if-exists :supersede)) |$compilerOptions|))) @@ -66,9 +62,9 @@ ;;(make-filename (cdr file) 'LISPLIB)) (make-filename (cdr file) 'NIL))) NIL) - (make-libstream :mode 'input :dirname fullname - :indextable (get-index-table-from-stream stream) - :indexstream stream))) + (|makeLibstream| 'input fullname + (get-index-table-from-stream stream) + stream))) ((equal (elt (string mode) 0) #\O) ;;(setq fullname (make-full-namestring (cdr file) 'LISPLIB)) (setq fullname (make-full-namestring (cdr file) 'NIL)) @@ -80,9 +76,7 @@ #-:GCL (ensure-directories-exist (|ensureTrailingSlash| fullname)) (multiple-value-setq (stream indextable) (get-io-index-stream fullname)) - (make-libstream :mode 'output :dirname fullname - :indextable indextable - :indexstream stream )) + (|makeLibstream| 'output fullname indextable stream)) ('t (ERROR "Unknown MODE"))))) @@ -129,20 +123,20 @@ ;; (RREAD key rstream) (defun rread (key rstream &optional (error-val nil error-val-p)) - (if (equal (libstream-mode rstream) 'output) (error "not input stream")) + (if (equal (|libIOMode| rstream) 'output) (error "not input stream")) (let* ((entry (and (stringp key) - (assoc key (libstream-indextable rstream) :test #'string=))) + (assoc key (|libIndexTable| rstream) :test #'string=))) (file-or-pos (and entry (caddr entry)))) (cond ((null entry) (if error-val-p error-val (error (format nil "key ~a not found" key)))) ((null (caddr entry)) (cdddr entry)) ;; for small items ((numberp file-or-pos) - (file-position (libstream-indexstream rstream) file-or-pos) - (read (libstream-indexstream rstream))) + (file-position (|libIndexStream| rstream) file-or-pos) + (read (|libIndexStream| rstream))) (t (with-open-file - (stream (concat (libstream-dirname rstream) "/" file-or-pos)) + (stream (concat (|libDirname| rstream) "/" file-or-pos)) (read stream))) ))) (defvar *lib-var*) @@ -157,9 +151,9 @@ ;; (RWRITE cvec item rstream) (defun rwrite (key item rstream) - (if (equal (libstream-mode rstream) 'input) (error "not output stream")) - (let ((stream (libstream-indexstream rstream)) - (pos (if item (cons (file-position (libstream-indexstream rstream)) nil) + (if (equal (|libIOMode| rstream) 'input) (error "not output stream")) + (let ((stream (|libIndexStream| rstream)) + (pos (if item (cons (file-position (|libIndexStream| rstream)) nil) (cons nil item)))) ;; for small items (make-entry (string key) rstream pos) (when (numberp (car pos)) @@ -168,10 +162,10 @@ (terpri stream)))) (defun make-entry (key rstream value-or-pos) - (let ((entry (assoc key (libstream-indextable rstream) :test #'equal))) + (let ((entry (assoc key (|libIndexTable| rstream) :test #'equal))) (if (null entry) (push (setq entry (cons key (cons 0 value-or-pos))) - (libstream-indextable rstream)) + (|libIndexTable| rstream)) (progn (if (stringp (caddr entry)) ($erase (caddr entry))) (setf (cddr entry) value-or-pos))) @@ -182,17 +176,17 @@ ;; (assoc 'compiler-output-stream |$compilerOptions|)) ;; (close (cdr (assoc 'compiler-output-stream |$compilerOptions|))) ;; (setq |$compilerOptions| nil)) -;; (if (eq (libstream-mode rstream) 'output) -;; (write-indextable (libstream-indextable rstream) (libstream-indexstream rstream))) -;; (close (libstream-indexstream rstream))) +;; (if (eq (|libIOMode| rstream) 'output) +;; (write-indextable (|libIndexTable| rstream) (|libIndexStream| rstream))) +;; (close (|libIndexStream| rstream))) (defun rshut (rstream) (when (and (equal rstream (cdr (assoc 'FILE |$compilerOptions|))) (assoc 'compiler-output-stream |$compilerOptions|)) (close (cdr (assoc 'compiler-output-stream |$compilerOptions|))) (setq |$compilerOptions| (cddr |$compilerOptions|))) - (if (eq (libstream-mode rstream) 'output) - (write-indextable (libstream-indextable rstream) (libstream-indexstream rstream))) - (close (libstream-indexstream rstream))) + (if (eq (|libIOMode| rstream) 'output) + (write-indextable (|libIndexTable| rstream) (|libIndexStream| rstream))) + (close (|libIndexStream| rstream))) ;; filespec is id or list of 1, 2 or 3 ids ;; filearg is filespec or 1, 2 or 3 ids @@ -213,14 +207,12 @@ :defaults index-file-name))) (rename-file index-file-name temp-index-file-name ) ;; stays until closed (multiple-value-setq (nstream nindextable) (get-io-index-stream filespec)) - (setq nrstream (make-libstream :mode 'output :dirname filespec - :indextable nindextable - :indexstream nstream )) - (dolist (entry (libstream-indextable rstream)) + (setq nrstream (|makeLibstream| 'output filespec nindextable nstream)) + (dolist (entry (|libIndexTable| rstream)) (rwrite (car entry) (rread (car entry) rstream) nrstream) (if (stringp (caddr entry)) (delete-file (concat filespec "/" (caddr entry))))) - (close (libstream-indexstream rstream)) + (close (|libIndexStream| rstream)) (delete-file temp-index-file-name) (rshut nrstream))) filespec) diff --git a/src/interp/profile.boot b/src/interp/profile.boot index 75f2e5ab..7714c190 100644 --- a/src/interp/profile.boot +++ b/src/interp/profile.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2012, Gabriel Dos Reis. +-- Copyright (C) 2007-2013, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -33,13 +33,14 @@ import sys_-macros +import sys_-utility namespace BOOT --$profileCompiler := true $profileAlist := nil profileWrite() == --called from finalizeLisplib - outStream := MAKE_-OUTSTREAM strconc(LIBSTREAM_-DIRNAME $libFile,'"/info") + outStream := MAKE_-OUTSTREAM strconc(libDirname $libFile,'"/info") SETQ(_*PRINT_-PRETTY_*, true) PRINT_-FULL(profileTran $profileAlist,outStream) SHUT outStream diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot index b75c3115..189ff955 100644 --- a/src/interp/sys-utility.boot +++ b/src/interp/sys-utility.boot @@ -1,4 +1,4 @@ --- Copyright (C) 2007-2012 Gabriel Dos Reis. +-- Copyright (C) 2007-2013 Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -409,3 +409,14 @@ macro loopBody x == macro constructorDB ctor == property(ctor,'DATABASE) +--% +structure %Libstream == + Record(mode: %IOMode, dir: %Pathname,tbl: %Thing, st: %Stream) + with + libIOMode == (.mode) + libDirname == (.dir) + libIndexTable == (.tbl) + libIndexStream == (.st) + +makeLibstream(m,p,idx==nil,st==nil) == + mk%Libstream(m,p,idx,st) -- cgit v1.2.3