1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: UFFI Example file to strtol
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Mar 2002
10 ;;;; Copyright (c) 2002 Kevin M. Rosenberg
12 ;;;; $Id: strtol.cl,v 1.6 2002/03/10 11:13:07 kevin Exp $
14 ;;;; This file is part of UFFI.
16 ;;;; UFFI is free software; you can redistribute it and/or modify
17 ;;;; it under the terms of the GNU General Public License (version 2) as
18 ;;;; published by the Free Software Foundation.
20 ;;;; UFFI is distributed in the hope that it will be useful,
21 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ;;;; GNU General Public License for more details.
25 ;;;; You should have received a copy of the GNU General Public License
26 ;;;; along with UFFI; if not, write to the Free Software Foundation, Inc.,
27 ;;;; 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
28 ;;;; *************************************************************************
32 (uffi:def-type char-ptr (* :char))
34 ;; This example does not use :cstring to pass the input string since
35 ;; the routine needs to do pointer arithmetic to see how many characters
38 (uffi:def-function ("strtol" c-strtol)
44 (defun strtol (str &optional (base 10))
45 "Returns a long int from a string. Returns number and condition flag.
46 Condition flag is T if all of string parses as a long, NIL if
47 their was no string at all, or an integer indicating position in string
48 of first non-valid character"
49 (let* ((str-native (uffi:convert-to-foreign-string str))
50 (endptr (uffi:allocate-foreign-object char-ptr))
51 (value (c-strtol str-native endptr base))
52 (endptr-value (uffi:deref-pointer endptr 'char-ptr))
53 (next-char-value (uffi:deref-pointer endptr-value :char))
54 (chars-parsed (- (uffi:pointer-address endptr-value)
55 (uffi:pointer-address str-native))))
56 (uffi:free-foreign-object str-native)
57 (uffi:free-foreign-object endptr)
61 ((uffi:null-char-p next-char-value)
64 (values value chars-parsed)))))
69 (flet ((print-results (str)
70 (multiple-value-bind (result flag) (strtol str)
71 (format t "~&(strtol ~S) => ~S,~S" str result flag))))
73 (print-results "55.3")