newLISP Fan Club

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.

Show posts Menu

#6

newLISP newS / Context madness bugs?

November 20, 2008, 12:19:16 AM

Code Select Expand

newLISP v.9.9.94 on Win32 IPv4, execute 'newlisp -h' for more info.

> (setq FISH:test 10)
10
> (delete FISH)
true
> (setq FISH:test 20)

ERR: context expected in function setf : FISHCan you only create a context that way once? Also note the "setf" in the error.

Code Select Expand

newLISP v.9.9.94 on Win32 IPv4, execute 'newlisp -h' for more info.

> (setq FISH:FISH FISH)
FISH
> (delete 'FISH:FISH)This crashes with a segment fault.

#7

newLISP newS / Firefox downloads index.php

April 18, 2008, 10:20:25 AM

Running Firefox 2.0.0.14 on WinXP SP2.

Going to the main phpBB page (http://www.alh.net/newlisp/phpbb/index.php">http://www.alh.net/newlisp/phpbb/index.php) Firefox downloads the index.php file instead of seeing the generated html. I tried this in Firefox 'Safe Mode' with the same result.



Internet Explorer 6 displays the board properly, as does Firefox 2.0.0.14 on Mac OS X 10.5.2.



Is anyone else having this problem? (although if you are, you may never see this post ^^)



--Edit--



I cleared the history and cache and cookies and everything and now the board loads correctly. How odd?

#8

newLISP and the O.S. / Passing 64-bit int to DLL problem

July 02, 2007, 12:59:14 PM

I'm having trouble with passing 64-bit integers to DLL functions. The DLL is compiled on Windows XP using MinGW, and used with newLISP v9.1.1.



Here is a test program that shows the problem:



test64.c

Code Select Expand

#include <stdio.h>

__declspec (dllexport) int Test64(__int64 i)
{
unsigned int * pi;
pi = (unsigned int*)&i;
printf("0x %08X %08X", pi[1], pi[0]);
return 0;
}

test64.def

Code Select Expand

LIBRARY     TEST64.DLL

EXPORTS
Test64 @1 Test64

make.bat

Code Select Expand

C:MinGWbinmingw32-gcc test64.c -c -Wall
C:MinGWbindllwrap.exe test64.o --enable-stdcall-fixup -def test64.def -o test64.dll

test64.lsp

Code Select Expand

(import "test64.dll" "Test64")

(setq test-values
   '(0x0000000087654321
     0x000000A987654321
     0x0000CBA987654321))

(dolist (val test-values)

   (println (dump val))
   (println (format "0x %08X %08X"
      (get-int (+ 4 (address val)))
      (get-int (address val))
   ))
   (Test64 val)
   (println)(println)

)
(exit)

Output:

Code Select Expand

(218736 898 212400 -2023406815 0)
0x 00000000 87654321
0x 000356D0 87654321

(218736 898 212400 -2023406815 169)
0x 000000A9 87654321
0x 000356F0 87654321

(218736 898 212400 -2023406815 52137)
0x 0000CBA9 87654321
0x 000356D0 87654321

32-bit integers pass without a problem, but I can't seem to get the most significant integer of the 64-bit number.

#9

Anything else we might add? / address of list elements

June 20, 2007, 07:06:32 PM

I'm working with a DLL that takes a char** as an argument (an array of char*). It would be nice it I could keep the strings being passed in a list, and just pack the addresses of those list elements.



e.g.

Code Select Expand

(setq x '("a" "b" "c"))
(setq arg (eval (cons pack (cons (dup "ld" (length x)) (map address x)))))
(My_Dll_Func arg)

However, my tests don't suggest I'm getting the addresses of the list elements:

Code Select Expand


> (setq x '("a" "b" "c"))
("a" "b" "c")
> (address x)
4019592
> (address (x 0))
5341424
> (address (x 1))
5341424
> (address (x 2))
5341424
> (address (nth 0 x))
5341424
> (address (nth 1 x))
5341424
> (address (nth 2 x))
5341424
> (map address x)
(4044024 4044136 4044152)
> (map address x)
(4044152 4044136 4044024)
> (map address x)
(4044024 4044136 4044152)
>

Work-arounds I've considered:

* Put every string into a separate symbol so I can get the addresses.

* Pack every string into one big string, then get the address of this big string, and add the offsets of each substring.



Neither of these work-arounds make me very happy. Is there any better solution?

#10

Anything else we might add? / Syntax for jEdit

June 13, 2007, 12:06:29 PM

I've been using jEdit for newLISP development for quite some time now, and I must say it is the best (free) Windows editor for newLISP (of course vi or emacs lovers may disagree ;). jEdit is extremely customizable, and can even be configured so hyphens (-) are not considered word separators! (amazing!)



Since newLISP is always expanding and improving, I kept having to update my syntax file. So I took a different approach: I let newLISP automatically generate the syntax file for me.



I've been meaning to share this, and the inclusion of the Java-based Guiserver has spurred me to finally do so.



I wasn't sure where to share this, so I guess the forums is where it will go.

Code Select Expand

#!/usr/bin/newlisp

# ---newLISP jEdit mode generator---
#         ---version 0.41---
;;
;; Originally written for newLISP v9.1 and jEdit v4.2final
;;
;; Generates the xml for a jEdit newLISP edit mode.
;; All default primitives and symbols found in the MAIN context will be
;; added as keywords.
;;
;; Copy the file created with this program to your jEdit "modes" sub-directory
;; in your jEdit settings directory.
;; Your modes directory is:
;;  On Windows  %USERPROFILE%.jeditmodes
;;  On Linux    ~.jeditmodes
;;
;; Be sure to also include a line in your "catalog" file, also found in your
;; modes sub-directory.
;; e.g.
;; <MODE NAME="newlisp" FILE="newlisp9101-Win32.xml" FILE_NAME_GLOB="*.lsp" FIRST_LINE_GLOB="#!/*newlisp*"/>
;;                            ^^^^^^^^^^^^^^^^^^^^^
;;                            This should be the file
;;                            outputted by this program
;;
;; There are a number of ways you can customize jEdit's syntax highlighting.
;; For more information, see your jEdit documentation about writing edit modes.

(context 'JEDIT-MODE-GEN)

(set 'istk? (lambda? tk))
(set 'ver (sys-info -2))
(set 'isutf8? (not (zero? (& (sys-info -1) 128))))

; File name
(set 'outfile
(string "newlisp"
(if istk? "-tk" "")
ver
"-" ostype
(if isutf8? "-utf8" "")
".xml"))

; Open the file for writing
(device (open outfile "write"))

;------------------------------------------------------------------------------

;; Escapes forbidden XML characters: & < >
(define (encode-xml s)
(set 's (replace ">" (replace "<" (replace "&" s "&") "<") ">"))
(set '$0 nil) ; This helps keep the MAIN symbols untouched
s ; return
)

;------------------------------------------------------------------------------

;; Converts a newLISP symbol to jEdit xml
(define (sym-to-xml x)
; Figure out what type of cell it is by using the (dump) function.
; <http://www.alh.net/newlisp/phpbb/viewtopic.php?p=219>
; See newlisp.h in the source distribution for the full list of values.
(case (& 15 (nth 1 (dump (eval x))))
(0  ;; nil and other symbols
(if (= x 'nil)
"<KEYWORD2>nil</KEYWORD2>"
(if (starts-with (string x) "MAIN:")
nil ; tk has a leftover symbol (MAIN:result)
(append "<KEYWORD3>" (encode-xml (string x)) "</KEYWORD3>")
)
)
)
(1  ;; true (and other symbols that = true)
(if (= x 'true)
"<KEYWORD2>true</KEYWORD2>"
(append "<KEYWORD3>" (encode-xml (string x)) "</KEYWORD3>")
)
)
(4  ;; string (ostype)
(append "<KEYWORD3>" (encode-xml (string x)) "</KEYWORD3>")
)
(6  ;; contexts (MAIN, and SYS for tk)
; we don't want this context
(unless (= x 'JEDIT-MODE-GEN)
(append "<KEYWORD3>" (encode-xml (string x)) "</KEYWORD3>"))
)
(7  ;; primitive functions
(append "<KEYWORD1>" (encode-xml (string x)) "</KEYWORD1>")
)
(11 ;; expressions (i.e. lists)
(append "<KEYWORD3>" (encode-xml (string x)) "</KEYWORD3>")
)
(12 ;; lambda (exit in newlisp-tk)
(append "<KEYWORD1>" (encode-xml (string x)) "</KEYWORD1>")
)
(true
; New and exciting symbols must have been
; added since newLISP 9.1 that we don't
; have handling for.
(throw-error
(string "Unhandled symbol type "
(& 15 (nth 1 (dump (eval x))))
" for " x))
)
)
)

;------------------------------------------------------------------------------

;; Map all the symbols to the proper jEdit XML code
(define (symbols-mapped-to-xml)
(sort               ; 3. sort for easy reading
(filter string? ; 2. remove anything that isn't a string (nils)
(map sym-to-xml (symbols 'MAIN)))) ; 1. map the symbols to xml
)

;------------------------------------------------------------------------------

;; Prints all MAIN symbols as jEdit xml
(define (print-sym-xml)
(print
; combine into a big string
(join  (symbols-mapped-to-xml) "nttt" )
)
)

################################################################################
###                             Entry point                                  ###

; Write the header
(print
[text]<?xml version="1.0"?>
<!DOCTYPE MODE SYSTEM "xmode.dtd">
<!-- newLISP[/text]
(if istk? "-tk" "")
" v." ver " on " ostype
(if isutf8? " UTF-8" "")
[text] -->
<MODE>
<PROPS>
<PROPERTY NAME="lineComment" VALUE=";" />
<PROPERTY NAME="noWordSep" VALUE="_-+?!@$%^&*/|<>.~`" />

<!-- Auto indent setting -->
<PROPERTY NAME="indentOpenBrackets" VALUE="(" />
<PROPERTY NAME="indentCloseBrackets" VALUE=")" />
<PROPERTY NAME="doubleBracketIndent" VALUE="false" />
<PROPERTY NAME="lineUpClosingBracket" VALUE="true" />
</PROPS>

<RULES ESCAPE=""
IGNORE_CASE="TRUE"
HIGHLIGHT_DIGITS="TRUE"
DIGIT_RE="(0x[da-f]+|-?d+(.d+)?(e-?d+)?)"
NO_WORD_SEP="_-+?!@$%^&*/|<>.~`">

<!-- Comments -->
<EOL_SPAN TYPE="COMMENT1">;</EOL_SPAN>
<EOL_SPAN TYPE="COMMENT1">#</EOL_SPAN>

<!-- Text literals -->
<SPAN TYPE="LITERAL1">
<BEGIN>"</BEGIN>
<END>"</END>
</SPAN>

<SPAN TYPE="LITERAL2" NO_ESCAPE="TRUE">
<BEGIN>{</BEGIN>
<END>}</END>
</SPAN>

<SPAN TYPE="LITERAL2" NO_ESCAPE="TRUE">
<BEGIN>[/text]
"[text]"
[text]</BEGIN>
<END>[/text]
"[/text]"
[text]</END>
</SPAN>

<!-- [cmd] -->
<SPAN TYPE="LITERAL3" DELEGATE="MAIN">
<BEGIN>[cmd]</BEGIN>
<END>[/cmd]</END>
</SPAN>

<SEQ TYPE="OPERATOR">:</SEQ>

<!-- These enable the auto indent/unindent behavior
    (comment these out if you don't want it) -->
<SEQ TYPE="OPERATOR">)</SEQ>
<SEQ TYPE="OPERATOR">(</SEQ>

<!-- Built-in keywords -->
<KEYWORDS>[/text]
; fn and lambda aren't in the (symbols) list
[text]
<KEYWORD1>fn</KEYWORD1>
<KEYWORD1>lambda</KEYWORD1>
[/text]
)

; Write all the symbol keywords
(print-sym-xml)

; Write the footer
(print
[text]
</KEYWORDS>

<!-- Highlight bracketed symbols -->
<SPAN TYPE="LITERAL4" NO_ESCAPE="TRUE">
<BEGIN AT_WORD_START="TRUE">[</BEGIN>
<END>]</END>
</SPAN>
<!-- Uncomment for highlighting quoted symbols
<MARK_FOLLOWING TYPE="LITERAL4" EXCLUDE_MATCH="TRUE">'</MARK_FOLLOWING>
-->
</RULES>

</MODE>[/text]
)

(context 'MAIN)
(exit)

;; eof


#11

newLISP and the O.S. / Unicode path handling on Windows

June 06, 2007, 04:12:13 PM

Warning, huge post



In response to my troubles found http://www.alh.net/newlisp/phpbb/viewtopic.php?t=1673">here.



The following newLISP functions don't seem to work for Unicode paths on Windows:

directory?

file?

change-dir

delete-file

directory

file-info

make-dir

open

real-path

remove-dir

rename-file

read-file

write-file

append-file

save

Edit: forgot load!



As a result, I implemented equivalent functions that can work with Unicode paths, using direct calls to the Win32 API (and now with my luck, someone will post an easy, 30 second fix to this problem that would have saved me the trouble ;).



I'm throwing this code out here in the rare chance anyone needs it, and to increase awareness about encoding issues.





Some technical details:

The Win32 API "C Run-Time Libraries" (msvcrt.dll) provides Unicode versions of all the functions used in the newLISP source "nl-file.sys" (only exceptions being the opendir functions). These Unicode variants only accept UTF-16 strings as arguments. So I modeled this code after the newLISP source, with three main differences:

* First converts UTF-8 strings to UTF-16

* Uses the Win32 API Unicode functions

* Written in the awesome language of newLISP :)



Please forgive me if the form is terrible.

Code Select Expand

;;;
;;; Windows32 Wide Input/Output  v0.2
;;;
;;; Unicode substitutions for functions that read or write path names.
;;;
;;;  # Predicates #
;;;     directory?  -> wdirectory?
;;;     file?       -> wfile?
;;;
;;;  # Input/output and file operations #
;;;     change-dir  -> wchange-dir
;;;     delete-file -> wdelete-file
;;;     directory   -> wwin-dir *
;;;     file-info   -> wfile-info
;;;     load        -> ***
;;;     make-dir    -> wmake-dir
;;;     open        -> wopen
;;;     real-path   -> wreal-path
;;;     remove-dir  -> wremove-dir
;;;     rename-file -> wrename-file
;;;    
;;;  # File and directory management #
;;;     read-file   -> wread-file
;;;     write-file  -> wwrite-file
;;;     append-file -> wappend-file
;;;     save        -> **
;;;
;;; All functions work the same, accepting UTF-8 strings, and should be
;;; pretty fast, as they are simple wrappers. Exceptions are directory and
;;; save:
;;; *  wwin-dir works like the windows dir command, and doesn't
;;;    provide regex filtering. It is also pretty slow.
;;; ** I didn't feel like making an alternative save function.
;;; *** Forgot about load
;;;
;;;
;;; Note:
;;;  All comments regarding header files refer to the
;;;  Microsoft Visual Studio files, gleaned from
;;;  MSDN documentation.
;;;

(unless utf8 (throw-error "Module W32-WIO requires UTF-8 enabled newLISP."))

(context 'W32-WIO)

## Globals #####################################################################

(constant 'SIZEOF_WCHAR 2) ; assumption

## Conversion: UTF-8 <-> UTF-16 ################################################

# // Declared in <winnls.h>
(constant 'CP_UTF8 65001) ; code page 65001 = UTF-8

;...............................................................................

# // Declared in <winnls.h>; include <windows.h>
# int MultiByteToWideChar(
#   UINT CodePage,
#   DWORD dwFlags,        
#   LPCSTR lpMultiByteStr,
#   int cbMultiByte,      
#   LPWSTR lpWideCharStr,  
#   int cchWideChar        
# );
(import "kernel32.dll" "MultiByteToWideChar")

;...............................................................................

# This function takes the place of WideCharToMultiByte
(define (utf16->utf32 s , len)
    (setq s
        (map
            (fn (c) (pack "u" c) )
            ; Windows returns little-endian ("<u") encoding
            (unpack (dup "<u" (>> (length s) 1)) s)
        )
    )
    ; Find the end of the string (double NULL)
    (setq len (+ (find "0000" s) 1))
    (if len
        ; Trim off the excess
        (append (join (slice s 0 len) "0000") "0000")
        ; If no end found, add our own (quad NULL)
        (append (join s "0000") "00000000")
    )
)

;...............................................................................

(define (utf8->16 lpMultiByteStr , cchWideChar lpWideCharStr ret)

    ; calculate the size of buffer (in WCHAR's)
    (setq cchWideChar (MultiByteToWideChar
        CP_UTF8 ; from UTF-8
        0       ; no flags necessary
        lpMultiByteStr
        -1      ; convert until NULL is encountered
        0
        0
    ))
   
    ; allocate the buffer
    (setq lpWideCharStr (dup " " (* cchWideChar SIZEOF_WCHAR)))
   
    ; convert
    (setq ret (MultiByteToWideChar
        CP_UTF8 ; from UTF-8
        0       ; no flags necessary
        lpMultiByteStr
        -1      ; convert until NULL is encountered
        lpWideCharStr
        cchWideChar
    ))
    (if (> ret 0) lpWideCharStr nil)
)

## wdirectory? #################################################################

(constant 'S_IFDIR 0040000)

;...............................................................................

(define (wdirectory? str-path)
    (=
        (&
            ((wfile-info str-path) 1)
            S_IFDIR
        )
        S_IFDIR
    )
)

## wfile? ######################################################################

(define (wfile? str-name)
    (true? (wfile-info str-name))
)

;...............................................................................


## wchange-dir #################################################################

# // Declared in <direct.h> or <wchar.h>
# int _wchdir(
#    const wchar_t *dirname
# );
(import "msvcrt.dll" "_wchdir")

;...............................................................................

(define (wchange-dir str-path)
    (case (_wchdir (utf8->16 str-path))
        (0 true)
        (-1 nil)
        (true (throw-error "???"))
    )
)

## wdelete-file ################################################################

# // Declared in <io.h> or <wchar.h>
# int _wunlink(
#    const wchar_t *filename
# );
(import "msvcrt.dll" "_wunlink")

;...............................................................................

(define (wdelete-file str-file-name)
    (case (_wunlink (utf8->16 str-file-name))
        (0 true)
        (-1 nil)
        (true (throw-error "???"))
    )
)

## wwin-dir ####################################################################

# // Declared in <io.h> or <wchar.h>
# intptr_t _wfindfirst(
#    const wchar_t *filespec,
#    struct _wfinddata_t *fileinfo
# );
; Note: MinGW library has the function _wopendir(),
; which I assume calls _wfindfirst
(import "msvcrt.dll" "_wfindfirst")

# // Declared in <io.h> or <wchar.h>
# int _wfindnext(
#    intptr_t handle,
#    struct _wfinddata_t *fileinfo
# );
(import "msvcrt.dll" "_wfindnext")

# // Declared in <io.h> or <wchar.h>
# int _findclose(
#    intptr_t handle
# );
(import "msvcrt.dll" "_findclose")

;...............................................................................

# // Declared in <sys/stat.h>
# typedef long time_t;    
# typedef unsigned long _fsize_t;

# // Declared in <io.h> or <wchar.h>
# struct _wfinddata_t {
#     unsigned    attrib;       // 4
#     time_t      time_create;  // 4
#     time_t      time_access;  // 4  
#     time_t      time_write;   // 4
#     _fsize_t    size;         // 4
#     wchar_t     name[260];    // 260 * SIZEOF_WCHAR = 520
# };

(constant 'SIZEOF_wfinddata_t (+ 4 4 4 4 4 520))

(define (unpack_wfinddata_t str-data )
    (unpack "lu ld ld ld ld s520" str-data)
)

;...............................................................................


;; wwin-dir provides information like directory, but has a different interface.
;; This was due to how much trouble it was trying to replicate the directory
;; interface, and how slow the function was becoming as a result.
;; It accepts only one optional argument: str-path
;; str-path works like the one argument to the dir command in the console:
;;   (wwin-dir "*")       =  dir *
;;   (wwin-dir "*.txt")   =  dir *.txt
;;   (wwin-dir "c:\*.*") =  dir c:*.*
;;
;; If you want regex filtering, you'll have to manually do it on the
;; returned list.
(define (wwin-dir (str-path "*") , info handle dirlist)
    (setq str-path (utf8->16 str-path))
    ; allocate space for info
    (setq info (dup " " SIZEOF_wfinddata_t))
    ; get the first directory entry
    (setq handle (_wfindfirst str-path info))
    (if (!= handle -1)
        (begin
            (setq dirlist '())
            (do-while (zero? (_wfindnext handle info))
                (push
                    (utf8 (utf16->utf32 (last (unpack_wfinddata_t info))))
                    dirlist -1
                )
                (setq info (dup " " SIZEOF_wfinddata_t))
            )
            (_findclose handle)
            dirlist
        )
        nil
    )
)

## wfile-info ##################################################################


# // Declared in <systypes.h>
# typedef unsigned int _dev_t;
# typedef unsigned short _ino_t;
# typedef long _off_t;

# // Declared in <sysstat.h>
# typedef long time_t;    
# typedef unsigned long _fsize_t;
#
# struct _stati64 {                    ofs  size
#         _dev_t st_dev;            // (0   lu     = 4)
#         _ino_t st_ino;            // (4   u      = 2)
#         unsigned short st_mode;   //  6   u      = 2
#         short st_nlink;           // (8   d->u   = 2)
#         short st_uid;             //  10  d->u   = 2
#         short st_gid;             //  12  d->u   = 2
#                                   // (14  n2     = 2)
#         _dev_t st_rdev;           //  16  lu     = 4
#                                   // (20  n4     = 4)
#         __int64 st_size;          //  24  L->Lu  = 8
#         time_t st_atime;          //  32  ld->lu = 4
#         time_t st_mtime;          //  36  ld->lu = 4
#         time_t st_ctime;          //  40  ld->lu = 4
#         };

(constant 'SIZEOF_stat 44)

(define (unpack_stat data)
    (unpack "lu u u u u u n2 lu n4 Lu lu lu lu" data)
)

;...............................................................................

# // Declared in <sysstat.h>
# int _wstati64(
#    const wchar_t *path,
#    struct _stat *buffer
# );
(import "msvcrt.dll" "_wstati64")

;...............................................................................

(define (wfile-info str_name , fileInfo)
    ; allocate space for file info
    (setq fileInfo (dup "00" SIZEOF_stat))
    (case (_wstati64 (utf8->16 str_name) fileInfo)
        (0 (select (unpack_stat fileInfo)  '(7 2 6 4 5 8 9 10)))
        (-1 nil)
        (true (throw-error "???"))
    )
)

## wmake-dir ###################################################################

# // Declared in <direct.h> or <wchar.h>
# int _wmkdir(
#    const wchar_t *dirname
# );
(import "msvcrt.dll" "_wmkdir")

;...............................................................................

(define (wmake-dir str-dir-name)
    (case (_wmkdir (utf8->16 str-dir-name))
        (0 true)
        (-1 nil)
        (true (throw-error "???"))
    )
)

## wopen #######################################################################

# // Declared in <io.h> or <wchar.h>
# int _wopen(
#    const wchar_t *filename,
#    int oflag [,
#    int pmode]
# );
(import "msvcrt.dll" "_wopen")

;...............................................................................

# // Declared in <fcntl.h>
(constant 'O_RDONLY 0x0000)
(constant 'O_WRONLY 0x0001)
(constant 'O_RDWR   0x0002)
(constant 'O_APPEND 0x0008)
(constant 'O_CREAT  0x0100)
(constant 'O_TRUNC  0x0200)
(constant 'O_EXCL   0x0400)
(constant 'O_TEXT   0x4000)
(constant 'O_BINARY 0x8000)

# // Declared in <sys/stat.h>
(constant 'S_IFMT   0170000)
(constant 'S_IFDIR  0040000)
(constant 'S_IFCHR  0020000)
(constant 'S_IFIFO  0010000)
(constant 'S_IFREG  0100000)
(constant 'S_IREAD  0000400)
(constant 'S_IWRITE 0000200)
(constant 'S_IEXEC  0000100)

;...............................................................................

(define (wopen str-path-file str-access-mode , handle)
    (setq str-path-file (utf8->16 str-path-file))
    (setq handle
        (if
            (starts-with str-access-mode "r")
            (_wopen str-path-file (| O_RDONLY O_BINARY ) 0)
           
            (starts-with str-access-mode "w")
            (_wopen str-path-file
                (| O_WRONLY O_CREAT O_TRUNC O_BINARY )
                (| S_IREAD S_IWRITE)
            )
           
            (starts-with str-access-mode "u")
            (_wopen str-path-file (| O_RDWR O_BINARY) 0)
           
            (starts-with str-access-mode "a")
            (_wopen str-path-file
                (| O_RDWR O_APPEND O_BINARY O_CREAT)
                (| S_IREAD S_IWRITE)
            )
           
            -1
        )
    )
    (if (= handle -1) nil handle)
)

## wreal-path ##################################################################

# // Declared in <windef.h>
(constant 'MAX_PATH 260)

# // Declared in <winbase.h>; include <windows.h>.
# DWORD GetFullPathName(
#   LPCTSTR lpFileName,
#   DWORD nBufferLength,
#   LPTSTR lpBuffer,
#   LPTSTR* lpFilePart
# );
(import "kernel32.dll" "GetFullPathNameW")

;...............................................................................

(define (wreal-path (str-path ".") , realpath len)
    ; allocate space for real path
    (setq realpath (dup "00" (* MAX_PATH SIZEOF_WCHAR)))
    ; returns length of the string
    (setq len (GetFullPathNameW (utf8->16 str-path) MAX_PATH realpath 0 ))
    (case len
        (0 nil )
        (true
            ; trim the result
            (utf8 (utf16->utf32 (slice realpath 0 (* (+ len 1) SIZEOF_WCHAR))))
        )
    )
)

## wremove-dir #################################################################

# // Declared in <direct.h> or <wchar.h>
# int _wrmdir(
#    const wchar_t *dirname
# );
(import "msvcrt.dll" "_wrmdir")

;...............................................................................

(define (wremove-dir str-path)
    (case (_wrmdir (utf8->16 str-path))
        (0 true)
        (-1 nil)
        (true (throw-error "???"))
    )
)

## wrename-file ################################################################

# // Declared in <stdio.h> or <wchar.h>
# int _wrename(
#    const wchar_t *oldname,
#    const wchar_t *newname
# );
(import "msvcrt.dll" "_wrename")

;...............................................................................

(define (wrename-file str-path-old str-path-new)
    (case (_wrename (utf8->16 str-path-old) (utf8->16 str-path-new))
        (0 true)
        (-1 nil)
        (true (throw-error "???"))
    )
)

## wread-file ##################################################################

(define (wread-file str-file-name , buff tmp-buff handle)
    (if (setq handle (wopen str-file-name "r")) ; open file
        (begin
            (setq buff ""  tmp-buff "")
            (if (read-buffer handle 'buff 0xFFFF) ; open wide
                (while (read-buffer handle 'tmp-buff 0xFFFF)
                    (write-buffer buff tmp-buff)
                )
            )
            (close handle)
            buff
        )
        nil ; couldn't open file
    )
)

## wwrite-file #################################################################

(define (wwrite-file str-file-name str-buffer , handle ret)
    (if (setq handle (wopen str-file-name "w")) ; open file
        (begin
            (setq ret (write-buffer handle str-buffer))
            (close handle)
            ret
        )
        nil ; couldn't open file
    )
)

## wappend-file ################################################################

(define (wappend-file str-filename str-buffer , handle ret)
    (if (setq handle (wopen str-filename "a")) ; open file
        (begin
            (setq ret (write-buffer handle str-buffer))
            (close handle)
            ret
        )
        nil ; couldn't open file
    )
)

################################################################################

(context 'MAIN)


;; Quick and dirty test of the functions in this module.
;; It is by no means comprehensive.
;; You're welcome to monitor the %TEMP% directory as things change.
(define (test-W32-WIO)
    (setq tmpdir (env "TEMP"))
    (unless tmpdir (throw-error "Couldn't find a temp directory to test in."))
   
    (setq unifile "230162182230181166231148177232168152")
    (setq unifile2 "notunicode")
   
    (setq unidir (append tmpdir "\" unifile))
   
    (println "Making unicode dir")
    (unless (W32-WIO:wmake-dir unidir)
        (throw-error "failed! (does the dir already exist?)"))
    (println "ok")(read-line)
       
    (println "Is it a directory?")
    (unless (W32-WIO:wdirectory? unidir) (throw-error "failed!"))
    (println "Yes")(read-line)
   
    (println "Is it a file?")
    (unless (W32-WIO:wfile? unidir) (throw-error "failed!"))
    (println "Yes")(read-line)
   
    (println "Change dir to uni dir")
    (unless (W32-WIO:wchange-dir unidir)  (throw-error "failed!"))
    (println "ok")(read-line)
   
    (println "Current path:")
    (println (W32-WIO:wreal-path))
    (read-line)
   
    (println "Writing a file")
    (unless (W32-WIO:wwrite-file unifile "Hello unicode")
        (throw-error "failed!"))
    (println "ok")(read-line)
   
    (println "Is it a file?")
    (unless (W32-WIO:wfile? unifile) (throw-error "failed!"))
    (println "Yes")(read-line)
   
    (println "Is it a directory?")
    (if (W32-WIO:wdirectory? unifile) (throw-error "failed!"))
    (println "No")(read-line)
   
    (println "Appending to the file")
    (unless (W32-WIO:wappend-file unifile "  Hello again")
        (throw-error "failed!"))
    (println "ok")(read-line)
   
    (println "Read the file:")
    (println (W32-WIO:wread-file unifile))
    (read-line)
   
    (println "File info:")
    (println (W32-WIO:wfile-info unifile))
    (read-line)
   
    (println "Directory list:")
    (println (W32-WIO:wwin-dir))
    (read-line)
   
    (println "Rename file")
    (unless (W32-WIO:wrename-file unifile unifile2)  (throw-error "failed!"))
    (println "ok")(read-line)
   
    (println "Delete file")
    (unless (W32-WIO:wdelete-file unifile2)  (throw-error "failed!"))
    (println "ok")(read-line)
   
    (println "Backing up from the uni dir")
    (unless (W32-WIO:wchange-dir "..")   (throw-error "failed!"))
    (println "ok")(read-line)
   
    (println "Real path of the uni dir again")
    (println (W32-WIO:wreal-path unifile))
    (read-line)
   
    (println "Removing uni dir")
    (unless (W32-WIO:wremove-dir unidir) (throw-error "failed!"))
    (println "ok")(read-line)
    (println "Done.")
)

Assuming that using the Win32 API (or the equivalent interface functions in MinGW) is the correct approach to accessing Unicode paths on Windows, it would be really nice if this could be added to newLISP by default :D

#12

Anything else we might add? / newlisp object system

March 29, 2007, 04:24:44 PM

I have been porting some code from Python to newlisp during the last few weeks. During this process I have recreated some of the Python libraries. I have also taken a good long look at how I want to mimic the object-oriented functionality of Python. This is what I came up with.



This function does most of the work when it creates a new instance.

Code Select Expand

;; Create a new instance of a class (i.e. context)
(define (.new ctx)
(local (new-instance class-counter instance-num _me)
; get the class counter
(set 'class-counter (sym "instance~count" ctx))
(unless (eval class-counter)
(set class-counter 0))
(set 'instance-num (inc class-counter))
; create the new instance
(set 'new-instance
(sym (string ctx "~instance~" instance-num) MAIN))
(new ctx new-instance)
(set 'new-instance (eval new-instance))
; add the self _me
(set 'new-instance:_me new-instance)
; call the (new) function if it exists
(if new-instance:new
; pass any args into the new function
(eval (append (list new-instance:new) (args))))
new-instance ; return
)
)
(constant (global '.new))




I can then use this simple object template when writing a class.

Code Select Expand

(context '__YOUR_CONTEXT_NAME_HERE__)
; Optional base class(es)
;(new __BASE_CLASS_HERE__) ; Base class


; Constructor and parameters -----------v
(define (__YOUR_CONTEXT_NAME_HERE__:new   )

; Your init code here
; e.g. (set 'instance-val "value")

)

(context 'MAIN)

Using this approach is very easy. e.g.

Code Select Expand

(load "StringIO.lsp")
(set 'memstream (.new StringIO))         => StringIO~instance~1
(memstream:write "Hello")                => 5
(memstream:seek 0)                       => 0
(memstream:read)                         => "Hello"


If I want an object to pass itself as a parameter (like self, Me, this, etc. in other languages), I use the _me field that was added when the object was created.

Code Select Expand

(some-function _me)

If I want to call a function in the parent class that was overloaded (overwritten) in a child class, I can do something like this

Code Select Expand

(context 'MyStringIOChild)
(new StringIO) ; Base class

(define (write str)
; Call the parent function
(local (parent.function)
(def-new 'StringIO:write 'parent.function)
(parent.function str)
)

(println "You wrote " str)
)

(context 'MAIN)

And with all this, I have a very simple and working object system that resembles the object system of many other languages.





There's just one problem I'm having: because contexts don't use ORO, all objects created must be manually deleted. If I don't delete them, I essentially have a memory leak.



I would love to have an object system that uses ORO. I made an attempt at it, where I would serialize objects using the (source) function. Whenever I wanted to interact with the object, I would deserialize it into a temporary context, perform the operations, then re-serialize it, and delete the context. Unfortunately my partial implementation of that approach was so terribly ugly that I couldn't bring myself to finish it.



Does anyone have any thoughts on creating a garbage-collected or ORO object system in newlisp?

#13

newLISP and the O.S. / binary data through stdin

March 21, 2007, 05:00:25 PM

I currently have a need to read binary data that is piped in from stdin in Windows (in particular I'm writing some cgi scripts). I've had this need before when running transformations on binary data piped from the command-line.



Unfortunately, since this is Windows, and since stdin is open in text mode, all "rn" byte combinations are read as "n".



Since I couldn't think of any other good solutions to this problem, I tried adding a new primitive function (set-mode). I gave it a shot and it seems to be working well.

Code Select Expand


#ifdef WINCC
CELL * p_setmode(CELL * params)
{
UINT handle;
UINT mode;
int result;

params = getInteger(params, &handle);
getInteger(params, &mode);

if (mode == 0)
result = setmode( handle, O_TEXT );
else if (mode == 1)
result = setmode( handle, O_BINARY );
else
return(nilCell);

if (result == O_TEXT)
return(stuffInteger(0));
else if (result == O_BINARY)
return(stuffInteger(1));
else
return(nilCell);
}
#endif


Is there any other way around this short of adding a new function to change the mode?

Pages1