diff options
| author | dos-reis <gdr@axiomatics.org> | 2008-03-17 09:00:41 +0000 | 
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2008-03-17 09:00:41 +0000 | 
| commit | 0f8d3e4c660cc6177e57b21579ac40733b82b940 (patch) | |
| tree | 815ca8b520f594bcbbe2fd4c23a30b1e4e1c9f92 /src | |
| parent | d9b9f67266bcb24e7bec1a26afaf062b376d450e (diff) | |
| download | open-axiom-0f8d3e4c660cc6177e57b21579ac40733b82b940.tar.gz | |
	* 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.
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    +} | 
