diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 47 | ||||
| -rw-r--r-- | src/include/cfuns.h | 4 | ||||
| -rw-r--r-- | src/interp/Makefile.in | 6 | ||||
| -rw-r--r-- | src/interp/Makefile.pamphlet | 8 | ||||
| -rw-r--r-- | src/interp/as.boot | 4 | ||||
| -rw-r--r-- | src/interp/br-data.boot | 13 | ||||
| -rw-r--r-- | src/interp/br-saturn.boot | 6 | ||||
| -rw-r--r-- | src/interp/br-search.boot | 4 | ||||
| -rw-r--r-- | src/interp/c-doc.boot | 12 | ||||
| -rw-r--r-- | src/interp/construc.lisp | 8 | ||||
| -rw-r--r-- | src/interp/daase.lisp | 10 | ||||
| -rw-r--r-- | src/interp/fortcall.boot | 13 | ||||
| -rw-r--r-- | src/interp/ht-root.boot | 9 | ||||
| -rw-r--r-- | src/interp/i-syscmd.boot | 18 | ||||
| -rw-r--r-- | src/interp/nlib.lisp | 30 | ||||
| -rw-r--r-- | src/interp/obey.lisp | 8 | ||||
| -rw-r--r-- | src/interp/sys-os.boot | 59 | ||||
| -rw-r--r-- | src/interp/sys-utility.boot | 15 | ||||
| -rw-r--r-- | src/interp/util.lisp | 15 | ||||
| -rw-r--r-- | src/lib/cfuns-c.c | 133 |
20 files changed, 325 insertions, 97 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 4b3a5d14..1a276841 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,50 @@ +2008-03-17 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * lib/cfuns-c.c (oa_chdir): Define. + (is_dot_or_dotdot): New. + (oa_unlink): Define. + (oa_rename): Likewise. + (oa_mkdir): Likewise. + * interp/sys-os.boot: New file. + * interp/util.lisp (MAKE-TAGS-FILE): Use changeDirectory. + (MAKELIB): Likewise. + (MAKESPAD): Likewise. + (LIBCHECK): Likewise. + * interp/sys-utility.boot ($ERASE): Define here. Use removeFile. + ($REPLACE): Likewise. + (checkMkdir): Define. + * interp/obey.lisp (MAKEDIR): Remove definition. + * interp/nlib.lisp (RDEFIOSTREAM): Use checkMkdir. + (MAKEDIR): Remove. + (RPACKFILE): Use removeFile. + ($ERASE): Remove Lisp definition. + ($REPLACE): Likewise. + * interp/i-syscmd.boot (cd): Use changeDirectory. + (compileAsharpArchiveCmd): Use mkdir. + (histFileErase): Likewise. + * interp/fortcall.boot (fortCall): Use removeFile. + (invokeNagman): Likewise. + * interp/daase.lisp (|library|): Use changeDirectory. + (LOCALDATABASE): Likewise. + (DaaseName): Use removeFile. + * interp/construc.lisp (mergelibs): Use removeFile. + (mergeall): Use changeDirectory. + * interp/c-doc.boot (docreport): Use removeFile. + * interp/br-search.boot (getTempPath): Likewise. + * interp/br-saturn.boot (dbSort): Likewise. + * interp/br-data.boot (buildLibdb): Likewise + (dbSplitLibdb): Likewise. + (buildGloss): Likewise. + (purgeLocalLibdb): Likewise. + * interp/as.boot (asList): Likewise. + * interp/Makefile.pamphlet (OBJS): Include sys-os.$(FASLEXT). + (sys-os.$(FASLEXT)): New rule. + (sys-utility.$(FASLEXT)): Require sys-os.$(FASLEXT). + * include/cfuns.h (oa_chdir): Declare. + (oa_unlink): Likewise. + (oa_rename): Likewise. + (oad_mkdir): Likewise. + 2008-03-16 Alfredo Portes <doyenatccny@gmail.com> Arthur Ralfs <acralfs@shaw.ca> diff --git a/src/include/cfuns.h b/src/include/cfuns.h index b4dcbb8b..89518926 100644 --- a/src/include/cfuns.h +++ b/src/include/cfuns.h @@ -45,5 +45,9 @@ OPENAXIOM_EXPORT int writeablep(char*); OPENAXIOM_EXPORT int readablep(char*); OPENAXIOM_EXPORT long findString(char*, char*); OPENAXIOM_EXPORT int copyEnvValue(char*, char*); +OPENAXIOM_EXPORT int oa_chdir(const char*); +OPENAXIOM_EXPORT int oa_unlink(const char*); +OPENAXIOM_EXPORT int oa_rename(const char*, const char*); +OPENAXIOM_EXPORT int oa_mkdir(const char*); #endif /* OPENAXIOM_CFUNS_included */ diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in index 26fd1f92..375a9857 100644 --- a/src/interp/Makefile.in +++ b/src/interp/Makefile.in @@ -18,7 +18,8 @@ LOADSYS= $(axiom_build_bindir)/lisp$(EXEEXT) SAVESYS= interpsys$(EXEEXT) AXIOMSYS= $(axiom_target_bindir)/AXIOMsys$(EXEEXT) -OBJS= vmlisp.$(FASLEXT) hash.$(FASLEXT) \ +OBJS= sys-os.$(FASLEXT) \ + vmlisp.$(FASLEXT) hash.$(FASLEXT) \ diagnostics.$(FASLEXT) sys-driver.$(FASLEXT) \ sys-utility.$(FASLEXT) macros.$(FASLEXT) \ unlisp.$(FASLEXT) \ @@ -758,6 +759,9 @@ sys-utility.$(FASLEXT): sys-utility.boot vmlisp.$(FASLEXT) vmlisp.$(FASLEXT): vmlisp.lisp boot-pkg.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< +sys-os.$(FASLEXT): sys-os.boot boot-pkg.$(FASLEXT) + $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< + boot-pkg.$(FASLEXT): boot-pkg.lisp $(BOOTSYS) -- --compile --output=$@ $< diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 93b32464..68acfbf6 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -109,7 +109,8 @@ compiled. \subsection{The Spad interpreter and compiler} <<environment>>= -OBJS= vmlisp.$(FASLEXT) hash.$(FASLEXT) \ +OBJS= sys-os.$(FASLEXT) \ + vmlisp.$(FASLEXT) hash.$(FASLEXT) \ diagnostics.$(FASLEXT) sys-driver.$(FASLEXT) \ sys-utility.$(FASLEXT) macros.$(FASLEXT) \ unlisp.$(FASLEXT) \ @@ -1066,12 +1067,15 @@ axext_l.$(FASLEXT): axext_l.lisp foam_l.$(FASLEXT) foam_l.$(FASLEXT): foam_l.lisp vmlisp.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< -sys-utility.$(FASLEXT): sys-utility.boot vmlisp.$(FASLEXT) +sys-utility.$(FASLEXT): sys-utility.boot vmlisp.$(FASLEXT) sys-os.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< vmlisp.$(FASLEXT): vmlisp.lisp boot-pkg.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< +sys-os.$(FASLEXT): sys-os.boot boot-pkg.$(FASLEXT) + $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< + boot-pkg.$(FASLEXT): boot-pkg.lisp $(BOOTSYS) -- --compile --output=$@ $< diff --git a/src/interp/as.boot b/src/interp/as.boot index 2751419a..93286283 100644 --- a/src/interp/as.boot +++ b/src/interp/as.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2008, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -42,7 +42,7 @@ $opHash := MAKE_-HASH_-TABLE() $asyPrint := false asList() == - OBEY '"rm -f temp.text" + removeFile '"temp.text" OBEY '"ls as/*.asy > temp.text" instream := OPEN '"temp.text" lines := [READLINE instream while not EOFP instream] diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot index 58c13a83..86b71b8b 100644 --- a/src/interp/br-data.boot +++ b/src/interp/br-data.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2008, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -94,8 +94,7 @@ buildLibdb(:options) == --called by buildDatabase (database.boot) $machineType = 'RIOS => '"sort -f -T /tmp -y200 _"temp.text_" > _"libdb.text_"" $machineType = 'SPARC => '"sort -f _"temp.text_" > _"libdb.text_"" '"sort _"temp.text_" > _"libdb.text_"" - --OBEY '"mv libdb.text olibdb.text" - RENAME_-FILE('"libdb.text", '"olibdb.text") + renameFile('"libdb.text", '"olibdb.text") deleteFile '"temp.text" buildLibdbConEntry conname == @@ -303,7 +302,7 @@ dbSplitLibdb() == SHUT instream SHUT outstream SHUT comstream - OBEY '"rm olibdb.text" + removeFile '"olibdb.text" dbSplit(line,n,k) == k := charPosition($tick,line,k + 1) @@ -332,10 +331,10 @@ buildGloss() == --called by buildDatabase (database.boot) pathname := STRCONC(systemRootDirectory(),'"/algebra/gloss.text") instream := MAKE_-INSTREAM pathname keypath := '"glosskey.text" - OBEY STRCONC('"rm -f ",keypath) + removeFile keypath outstream:= MAKE_-OUTSTREAM keypath htpath := '"gloss.ht" - OBEY STRCONC('"rm -f ",htpath) + removeFile htpath htstream:= MAKE_-OUTSTREAM htpath defpath := '"glossdef.text" defstream:= MAKE_-OUTSTREAM defpath @@ -783,6 +782,6 @@ extendLocalLibdb conlist == -- called by astran purgeLocalLibdb() == --used for debugging purposes only $newConstructorList := nil - obey '"rm libdb.text" + removeFile '"libdb.text" diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot index 1a3c653f..32225b11 100644 --- a/src/interp/br-saturn.boot +++ b/src/interp/br-saturn.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2008, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -1629,13 +1629,13 @@ mkButtonBox n == STRCONC('"\buttonbox{", STRINGIMAGE n, '"}") -- SHUT instream -- SHUT outstream -- SHUT comstream ---OBEY '"rm libdb.text" +--removeFile '"libdb.text" dbSort(x,y) == sin := STRINGIMAGE x sout:= STRINGIMAGE y OBEY STRCONC('"sort -f _"",sin,'".text_" > _"", sout, '".text_"") - OBEY STRCONC('"rm ", sin, '".text") + removeFile STRCONC(sin, '".text") -- override in br-util.boot.pamphlet diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot index 3cc6fd86..1949c5ae 100644 --- a/src/interp/br-search.boot +++ b/src/interp/br-search.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2008, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -930,7 +930,7 @@ obey x == getTempPath kind == pathname := mkGrepFile kind - obey STRCONC('"rm -f ", pathname) + removeFile pathname pathname dbWriteLines(s, :options) == diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot index 7cc35056..e04fb69a 100644 --- a/src/interp/c-doc.boot +++ b/src/interp/c-doc.boot @@ -1,6 +1,6 @@ --- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. +-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2008, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -15,7 +15,7 @@ -- the documentation and/or other materials provided with the -- distribution. -- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the +-- - Neither the name of The Numerical Algorithms Group Ltd. nor the -- names of its contributors may be used to endorse or promote products -- derived from this software without specific prior written permission. -- @@ -1215,14 +1215,14 @@ checkAlphabetic c == --======================================================================= docreport(nam) == --creates a report for person "nam" using file "whofiles" - OBEY '"rm docreport.input" + removeFile '"docreport.input" OBEY STRCONC('"echo _")bo setOutStream('",STRINGIMAGE nam,'")_" > temp.input") OBEY '"cat docreport.header temp.input > docreport.input" OBEY STRCONC('"awk '/",STRINGIMAGE nam,'"/ {printf(_")co %s.spad\n_",$2)}' whofiles > temp.input") OBEY '"cat docreport.input temp.input > temp1.input" OBEY '"cat temp1.input docreport.trailer > docreport.input" - OBEY '"rm temp.input" - OBEY '"rm temp1.input" + removeFile '"temp.input" + removeFile '"temp1.input" SETQ(_/EDITFILE,'"docreport.input") _/RQ() diff --git a/src/interp/construc.lisp b/src/interp/construc.lisp index 6e8e1373..3d5aeca0 100644 --- a/src/interp/construc.lisp +++ b/src/interp/construc.lisp @@ -133,8 +133,8 @@ (concatenate 'string (|systemRootDirectory|) "/../../int/algebra/" (string name) ".NRLIB/code.lsp"))) (let (masterindex blanks index newindex (space (* 22 (length innames)))) (setq newindex space) - (system::system (concatenate 'string "rm -r " (libname outname))) - (system::system (concatenate 'string "mkdir " (libname outname))) + (|removeFile| (libname outname)) + (|checkMkdir| (libname outname)) (with-open-file (out (indexname outname) :direction :output) (setq blanks (make-string space :initial-element #\ )) (write blanks :stream out) ; reserve space for the masterindex @@ -239,7 +239,7 @@ ((equal (elt (string mode) 0) #\O) (setq fullname (make-full-namestring (cdr file) 'LISPLIB)) (case (directory? fullname) - (-1 (makedir fullname)) + (-1 (|checkMkdir| fullname)) (0 (error (format nil "~s is an existing file, not a library" fullname))) (otherwise)) (multiple-value-setq (stream indextable) (get-io-index-stream fullname)) @@ -336,7 +336,7 @@ (labels ( (SRCSCAN () (let (spads) - (system:chdir src) + (|changeDirectory| src) (setq spads (directory "*.spad")) (dolist (spad spads) (srcabbrevs spad)) nil)) diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp index 57732417..88f599e2 100644 --- a/src/interp/daase.lisp +++ b/src/interp/daase.lisp @@ -817,7 +817,7 @@ #+:CCL (dolist (a args) (check-module-exists a)) (|extendLocalLibdb| |$newConlist|) - (system::chdir original-directory) + (|changeDirectory| original-directory) (tersyscommand)) ;; check-module-exists looks to see if a module exists in one of the current @@ -870,9 +870,9 @@ (values only dir noexpose))) (processDir (dirarg thisdir) (let (allfiles skipasos) - (system:chdir (string dirarg)) + (|changeDirectory| (string dirarg)) (setq allfiles (directory "*")) - (system:chdir thisdir) + (|changeDirectory| thisdir) (values (mapcan #'(lambda (f) (when (string-equal (pathname-type f) "NRLIB") @@ -1237,7 +1237,7 @@ (|systemRootDirectory|) "/algebra/" name))) - (when erase? (system::system (concatenate 'string "rm -f " filename))) + (when erase? (|removeFile| filename)) filename)) ;; rewrite this so it works in mnt @@ -1249,7 +1249,7 @@ ;; (setq filename (concatenate 'string daase "/algebra/" name)) ;; (format t " Using local database ~a.." filename)) ;; (setq filename (concatenate 'string $spadroot "/algebra/" name))) -;; (when erase? (system::system (concatenate 'string "rm -f " filename))) +;; (when erase? (|removeFile| filename)) ;; filename)) diff --git a/src/interp/fortcall.boot b/src/interp/fortcall.boot index f89a67ca..4d7fa940 100644 --- a/src/interp/fortcall.boot +++ b/src/interp/fortcall.boot @@ -1,6 +1,6 @@ --- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. +-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2008, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -15,7 +15,7 @@ -- the documentation and/or other materials provided with the -- distribution. -- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the +-- - Neither the name of The Numerical Algorithms Group Ltd. nor the -- names of its contributors may be used to endorse or promote products -- derived from this software without specific prior written permission. -- @@ -680,9 +680,8 @@ fortCall(objFile,data,results) == tmpFile2 := generateResultsName() SYSTEM STRCONC(objFile," < ",tmpFile1," > ",tmpFile2) results := readData(tmpFile2,results) - -- SYSTEM STRCONC("rm -f ",tmpFile1," ",tmpFile2) - PROBE_-FILE(tmpFile1) and DELETE_-FILE(tmpFile1) - PROBE_-FILE(tmpFile2) and DELETE_-FILE(tmpFile2) + removeFile tmpFile1 + removeFile tmpFile2 results invokeNagman(objFiles,nfile,args,dummies,decls,results,actual) == @@ -693,7 +692,7 @@ invokeNagman(objFiles,nfile,args,dummies,decls,results,actual) == results,decls,inFirstNotSecond(args,dummies),actual) -- Tidy up asps -- if objFiles then SYSTEM STRCONC("rm -f ",addSpaces objFiles) - for fn in objFiles repeat PROBE_-FILE(fn) and DELETE_-FILE(fn) + for fn in objFiles repeat removeFile fn result diff --git a/src/interp/ht-root.boot b/src/interp/ht-root.boot index b81501a1..59099875 100644 --- a/src/interp/ht-root.boot +++ b/src/interp/ht-root.boot @@ -1,6 +1,6 @@ --- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. +-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2008, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -15,7 +15,7 @@ -- the documentation and/or other materials provided with the -- distribution. -- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the +-- - Neither the name of The Numerical Algorithms Group Ltd. nor the -- names of its contributors may be used to endorse or promote products -- derived from this software without specific prior written permission. -- @@ -150,8 +150,7 @@ htGlossPage(htPage,pattern,tryAgain?) == --instream := MAKE_-INSTREAM pathname defstream := MAKE_-INSTREAM STRCONC(systemRootDirectory(),'"/algebra/glossdef.text") lines := gatherGlossLines(results,defstream) - -- OBEY STRCONC('"rm -f ", pathname) - --PROBE_-FILE(pathname) and DELETE_-FILE(pathname) + -- removeFile pathname --SHUT instream heading := pattern = '"" => '"Glossary" diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index f731ade7..e51b9261 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -1,4 +1,4 @@ --- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. +-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. -- Copyright (C) 2007-2008, Gabriel Dos Reis. -- All rights reserved. @@ -15,7 +15,7 @@ -- the documentation and/or other materials provided with the -- distribution. -- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the +-- - Neither the name of The Numerical Algorithms Group Ltd. nor the -- names of its contributors may be used to endorse or promote products -- derived from this software without specific prior written permission. -- @@ -259,13 +259,7 @@ listConstructorAbbreviations() == cd args == dir := TRUENAME STRING(car args or '"") -)if %hasFeature KEYWORD::SBCL - SB_-POSIX::CHDIR NAMESTRING dir -)elseif %hasFeature KEYWORD::GCL - SYSTEM::CHDIR NAMESTRING dir -)else - internalError '"don't know how to chdir in this Lisp" -)endif + changeDirectory NAMESTRING dir SETF(_*DEFAULT_-PATHNAME_-DEFAULTS_*, ensureTrailingSlash NAMESTRING dir) sayKeyedMsg("S2IZ0070", [NAMESTRING _*DEFAULT_-PATHNAME_-DEFAULTS_*]) @@ -639,8 +633,7 @@ compileAsharpArchiveCmd args == throwKeyedMsg("S2IL0027",[namestring dir, namestring args]) if isDir ^= 1 then - cmd := STRCONC('"mkdir ", namestring dir) - rc := OBEY cmd + rc := mkdir namestring dir rc ^= 0 => throwKeyedMsg("S2IL0027",[namestring dir, namestring args]) curDir := $CURRENT_-DIRECTORY @@ -1610,8 +1603,7 @@ putHist(x,prop,val,e) == putIntSymTab(x,prop,val,e) histFileErase file == - --OBEY STRCONC('"rm -rf ", file) - PROBE_-FILE(file) and DELETE_-FILE(file) + removeFile file diff --git a/src/interp/nlib.lisp b/src/interp/nlib.lisp index 2d070775..fa788f2a 100644 --- a/src/interp/nlib.lisp +++ b/src/interp/nlib.lisp @@ -1,6 +1,6 @@ -;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. +;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. ;; All rights reserved. -;; Copyright (C) 2007, Gabriel Dos Reis. +;; Copyright (C) 2007-2008, Gabriel Dos Reis. ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without @@ -15,7 +15,7 @@ ;; the documentation and/or other materials provided with the ;; distribution. ;; -;; - Neither the name of The Numerical ALgorithms Group Ltd. nor the +;; - Neither the name of The Numerical Algorithms Group Ltd. nor the ;; names of its contributors may be used to endorse or promote products ;; derived from this software without specific prior written permission. ;; @@ -79,7 +79,7 @@ ;;(setq fullname (make-full-namestring (cdr file) 'LISPLIB)) (setq fullname (make-full-namestring (cdr file) 'NIL)) (case (|directoryp| fullname) - (-1 (makedir fullname)) + (-1 (|checkMkdir| fullname)) (0 (error (format nil "~s is an existing file, not a library" fullname))) (otherwise)) (multiple-value-setq (stream indextable) (get-io-index-stream fullname)) @@ -150,12 +150,6 @@ (file-position stream :end) (write-indextable indextable stream))) -;; makedir (fname) fname is a directory name. -(defun makedir (fname) - #+ (and (not :GCL) :COMMON-LISP) (ensure-directories-exist fname) - #+ :GCL (system (concat "mkdir " fname)) - ) - ;; (RREAD key rstream) (defun rread (key rstream &optional (error-val nil error-val-p)) (if (equal (libstream-mode rstream) 'output) (error "not input stream")) @@ -249,9 +243,9 @@ (o (make-pathname :type "o"))) (si::system (format nil "cp ~S ~S" code temp)) (recompile-lib-file-if-necessary temp) - (si::system (format nil "mv ~S ~S~%" + (|renameFile| (namestring (merge-pathnames o temp)) - (namestring (merge-pathnames o code))))) + (namestring (merge-pathnames o code)))) ;; only pack non libraries to avoid lucid file handling problems (let* ((rstream (rdefiostream (list (cons 'file filespec) (cons 'mode 'input)))) (nstream nil) @@ -406,16 +400,6 @@ (some #'(lambda (ft) (make-input-filename file-name ft)) filetypelist))) -;; ($ERASE filearg) -> 0 if succeeds else 1 -(defun $erase (&rest filearg) - (system (concat "rm -rf "(make-full-namestring filearg)))) - -(defun $REPLACE (filespec1 filespec2) - ($erase (setq filespec1 (make-full-namestring filespec1))) - (rename-file (make-full-namestring filespec2) filespec1)) - - - ;;(defun move-file (namestring1 namestring2) ;; (rename-file namestring1 namestring2)) @@ -429,7 +413,7 @@ #+(OR :AKCL (AND :CCL :UNIX)) (defun copy-lib-directory (name1 name2) - (makedir name2) + (|checkMkdir| name2) (system (concat "sh -c 'cp " name1 "/* " name2 "'"))) #+(OR :AKCL (AND :CCL :UNIX)) diff --git a/src/interp/obey.lisp b/src/interp/obey.lisp index f7973dec..6061ce8d 100644 --- a/src/interp/obey.lisp +++ b/src/interp/obey.lisp @@ -1,4 +1,4 @@ -;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. +;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. ;; All rights reserved. ;; Copyright (C) 2007-2008, Gabriel Dos Reis. ;; All rights reserved. @@ -15,7 +15,7 @@ ;; the documentation and/or other materials provided with the ;; distribution. ;; -;; - Neither the name of The Numerical ALgorithms Group Ltd. nor the +;; - Neither the name of The Numerical Algorithms Group Ltd. nor the ;; names of its contributors may be used to endorse or promote products ;; derived from this software without specific prior written permission. ;; @@ -41,10 +41,6 @@ :arguments (list "-c" S))) #+ (and :lucid :unix) -(defun makedir (fname) - (system:run-aix-program "mkdir" :arguments (list fname))) - -#+ (and :lucid :unix) (defun delete-directory (dirname) (system:run-aix-program "rm" :arguments (list "-r" dirname))) diff --git a/src/interp/sys-os.boot b/src/interp/sys-os.boot new file mode 100644 index 00000000..d46e7741 --- /dev/null +++ b/src/interp/sys-os.boot @@ -0,0 +1,59 @@ +-- Copyright (C) 2007-2008 Gabriel Dos Reis +-- All rights reserved. +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are +-- met: +-- +-- - Redistributions of source code must retain the above copyright +-- notice, this list of conditions and the following disclaimer. +-- +-- - Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in +-- the documentation and/or other materials provided with the +-- distribution. +-- +-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the +-- names of its contributors may be used to endorse or promote products +-- derived from this software without specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS +-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A +-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER +-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +-- +-- + +-- +-- This file contains interface to functionalities required from the +-- hosting operating systems. More to the point, it is mostly +-- a set of interfaces to native routines provided in the +-- supporting C runtime libopen-axiom-core. +-- + +import '"boot-pkg" +)package "BOOT" + +++ change current working directory. +import changeDirectory for + oa__chdir: string -> int -- 0: success, -1: failure + +++ remove file or directory tree. +import removeFile for + oa__unlink: string -> int -- 0: sucess, -1: failure + +++ rename file or directory +import renameFile for + oa__rename: (string,string) -> int -- 0: success, -1 failure + +++ create a directory +import mkdir for + oa__mkdir: string -> int -- 0: sucess, -1: failure. + diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot index ff8e32cb..07dba9f5 100644 --- a/src/interp/sys-utility.boot +++ b/src/interp/sys-utility.boot @@ -33,6 +33,7 @@ -- This file defines some utility functions common to both the compiler -- and interpreter. +import '"sys-os" import '"vmlisp" )package "BOOT" @@ -146,3 +147,17 @@ makeAbsoluteFilename name == existingFile? file == PROBE_-FILE file +++ original version returned 0 on success, and 1 on failure +++ ??? fix that to return -1 on failure. +$ERASE(:filearg) == + -removeFile MAKE_-FULL_-NAMESTRING filearg + +++ +$REPLACE(filespec1,filespec2) == + $ERASE(filespec1 := MAKE_-FULL_-NAMESTRING filespec1) + renameFile(MAKE_-FULL_-NAMESTRING filespec2, filespec1) + +++ +checkMkdir path == + mkdir path = 0 => true + systemError ['"cannot create directory",:bright path] diff --git a/src/interp/util.lisp b/src/interp/util.lisp index fe54e013..72d6166d 100644 --- a/src/interp/util.lisp +++ b/src/interp/util.lisp @@ -252,8 +252,7 @@ ;; TAGS are useful for finding functions if you run Emacs. We have a ;; set of functions that construct TAGS files for Axiom. (defun make-tags-file () -#+:gcl (system:chdir "/tmp") -#-:gcl (obey (concatenate 'string "cd " "/tmp")) + (|changeDirectory| "/tmp") (obey (concat "etags " (|makeAbsoluteFilename| "../../src/interp/*.lisp"))) (spadtags-from-directory "../../src/interp" "boot") (obey "cat /tmp/boot.TAGS >> /tmp/TAGS")) @@ -710,8 +709,7 @@ (format t "doing directory on ~s...~%" (concatenate 'string mid "/*")) (error "makelib:MID=~a OUT=~a~% these are not set properly~%" mid out)) #+:akcl (compiler::emit-fn nil) -#+:akcl (si::chdir mid) -#-:akcl (obey (concatenate 'string "cd " mid)) + (|changeDirectory| mid) (setq libs (directory "*.NRLIB")) (unless libs (format t "makelib:directory of ~a returned NIL~%" mid) @@ -792,8 +790,7 @@ (if (and src mid) (format t "doing directory on ~s...~%" (concatenate 'string src "/*")) (error "makespad:SRC=~a MID=~a not set properly~%" src mid)) -#+:akcl (si::chdir mid) -#-:akcl (obey (concatenate 'string "cd " mid)) + (|changeDirectory| mid) (setq mntlibs (directory "*.NRLIB")) (unless mntlibs (format t "makespad:directory of ~a returned NIL~%" src) @@ -887,8 +884,7 @@ (READLIBS (algebra) "read the NRLIB directory and return a sorted abbreviation list" (let (libs nrlibs) -#+:akcl (si::chdir algebra) -#-:akcl (obey (concatenate 'string "cd " algebra)) + (|changeDirectory| algebra) (setq nrlibs (directory "*.NRLIB")) (unless nrlibs (error "libcheck: (directory ~s) returned NIL~%" @@ -929,8 +925,7 @@ (values names longnames))) (SRCSCAN () (let (longnames names) -#+:gcl (system::chdir int) -#-:gcl (obey (concatenate 'string "cd " int)) + (|changeDirectory| int) (setq spads (directory "*.spad")) (dolist (spad spads) (multiple-value-setq (short long) (srcabbrevs spad)) diff --git a/src/lib/cfuns-c.c b/src/lib/cfuns-c.c index 7ed80551..95c9787f 100644 --- a/src/lib/cfuns-c.c +++ b/src/lib/cfuns-c.c @@ -2,7 +2,7 @@ Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. All rights reserved. - Copyright (C) 2007, 2008, Gabriel Dos Reis + Copyright (C) 2007-2008, Gabriel Dos Reis. All rights reserved. Redistribution and use in source and binary forms, with or without @@ -36,6 +36,7 @@ #include "axiom-c-macros.h" +#include <errno.h> #include <sys/types.h> #include <sys/stat.h> #include <unistd.h> @@ -46,6 +47,8 @@ #ifdef __WIN32__ # include <windows.h> +#else +# include <dirent.h> #endif #include "cfuns.h" @@ -300,3 +303,131 @@ std_stream_is_terminal(int fd) return isatty(fd); #endif } + +/* Change the process' curretnt directory. Return zero on success, + and -1 on failure. */ +OPENAXIOM_EXPORT int +oa_chdir(const char* path) +{ +#ifdef __MINGW32__ + SetCurrentDirectory(path) ? 0 : -1; +#else + return chdir(path); +#endif /* __MINGW32__ */ +} + + +/* return true if path is `.' or `..'. */ +static inline int +is_dot_or_dotdot(const char* path) +{ + return strcmp(path, ".") == 0 || strcmp(path, "..") == 0; +} + +/* Remove a directory entry. Files are removed, directories are + recursively walked and there removed. + Return 0 on success, and -1 on falure. + In practice, OpenAxiom does not remove directories with + non-trivial recursive structues. */ +OPENAXIOM_EXPORT int +oa_unlink(const char* path) +{ +#ifdef __MINGW32__ + WIN32_FIND_DATA findData; + HANDLE walkHandle; + DWORD pathAttributes; + + if (is_dot_or_dotdot(path)) + return -1; + + if ((pathAttributes = GetFileAttributes(path)) == 0xFFFFFFFF) + return -1; + + if (pathAttributes & ~FILE_ATTRIBUTE_DIRECTORY) + return DeleteFile(path) ? 0 : -1; + + if ((walkHandle = FindFirstFile(path, &findData)) == INVALID_HANDLE_VALUE + || oa_chdir(path) < 0) + return -1; + do { + if (is_dot_or_dotdot(findData.cFileName)) + continue; + if (findData.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) { + if (oa_chdir(findData.cFileName) < 0) + return -1; + } + else if (!DeleteFile(findData.cFileName)) + return -1; + } while (FindNextFile(walkHandle, &findData)); + if (!FindClose(walkHandle)) + return -1; + if (oa_chdir("..") < 0) + return -1; + return RemoveDirectory(path) ? 0 : -1; +#else + struct stat pathstat; + DIR* dir; + struct dirent* entry; + + /* Don't ever try to remove `.' or `..'. */ + if (is_dot_or_dotdot(path)) + return -1; + + if (stat(path, &pathstat) < 0) + return -1; + + /* handle non dictories first. */ + if (!S_ISDIR(pathstat.st_mode)) + return unlink(path); + + /* change into the path so that we don't have to form full + pathnames. */ + if ((dir = opendir(path)) == NULL || oa_chdir(path) < 0) + return -1; + + while (errno = 0, (entry = readdir(dir)) != NULL) { + struct stat s; + if (is_dot_or_dotdot(entry->d_name)) + continue; + if (stat(entry->d_name, &s) < 0) + return -1; + if (S_ISDIR(s.st_mode) && oa_unlink(entry->d_name) < 0) + return -1; + else if (unlink(entry->d_name) < 0) + return -1; + } + if (errno != 0) + return -1; + + /* Now, get one level up, and remove the empty directory. */ + if (oa_chdir("..") < 0 || closedir(dir) < 0 || rmdir(path) < 0) + return -1; + + return 0; +#endif /* __MINGW32__ */ +} + +/* Rename a file or directory. */ +OPENAXIOM_EXPORT int +oa_rename(const char* old_path, const char* new_path) +{ +#ifdef __MINGW32__ + return MoveFile(old_path, new_path) ? 0 : -1; +#else + return rename(old_path, new_path); +#endif +} + +/* Create a new directory named `path'. Return 0 on success, + and -1 on failure. */ +OPENAXIOM_EXPORT int +oa_mkdir(const char* path) +{ +#ifdef __MINGW32__ + return CreateDirectory(path, NULL) ? 0 : -1; +#else +# define DIRECTORY_PERM ((S_IRWXU|S_IRWXG|S_IRWXO) & ~(S_IWGRP|S_IWOTH)) + return mkdir (path, DIRECTORY_PERM); +# undef DIRECTORY_PERM +#endif +} |