mirror of
https://github.com/open-goal/jak-project.git
synced 2024-10-20 11:26:18 -04:00
734 lines
20 KiB
Common Lisp
734 lines
20 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; name: gstring.gc
|
|
;; name in dgo: gstring
|
|
;; dgos: KERNEL
|
|
|
|
|
|
;; The GOAL string type is like a C string plus a length field.
|
|
;; The number of bytes stored is the length + 1 for the null terminator.
|
|
;; Note that string is a bit of a special type, and the compiler assumes there is no
|
|
;; child type of string ever created.
|
|
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; String methods
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defmethod length string ((obj string))
|
|
"Get the length of a string. Like strlen"
|
|
(let ((str-ptr (-> obj data)))
|
|
(while (!= 0 (-> str-ptr 0))
|
|
(set! str-ptr (the (pointer uint8) (&+ str-ptr 1)))
|
|
)
|
|
(- (the int str-ptr) (the int (-> obj data)))
|
|
)
|
|
)
|
|
|
|
(defmethod asize-of string ((obj string))
|
|
"get the size in bytes of a string."
|
|
(+ (-> obj allocated-length) 1 (-> string size))
|
|
)
|
|
|
|
(defun copy-string<-string ((dst string) (src string))
|
|
"Copy data from one string to another, like strcpy"
|
|
(let ((dst-ptr (-> dst data))
|
|
(src-ptr (-> src data))
|
|
)
|
|
(while (!= 0 (-> src-ptr))
|
|
(set! (-> dst-ptr) (-> src-ptr))
|
|
(&+! dst-ptr 1)
|
|
(&+! src-ptr 1)
|
|
)
|
|
)
|
|
dst
|
|
)
|
|
|
|
(defmethod new string ((allocation symbol) (type-to-make type) (size int) (other string))
|
|
"Create a new string of the given size. If other is not #f, copy data from it."
|
|
(cond
|
|
(other
|
|
(let* ((desired-size (max (length other) size))
|
|
(new-obj (object-new allocation type-to-make (+ desired-size 1 (-> type-to-make size))))
|
|
)
|
|
(set! (-> new-obj allocated-length) size)
|
|
(copy-string<-string new-obj other)
|
|
new-obj
|
|
)
|
|
)
|
|
(else
|
|
(let ((new-obj (object-new allocation type-to-make (+ 1 size (-> type-to-make size)))))
|
|
(set! (-> new-obj allocated-length) size)
|
|
new-obj
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; String comparison
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defun string= ((str-a string) (str-b string))
|
|
"Does str-a hold the same data as str-b?.
|
|
If either string is null, returns #f."
|
|
(let ((a-ptr (-> str-a data))
|
|
(b-ptr (-> str-b data))
|
|
)
|
|
(if (or (zero? str-a) (zero? str-b))
|
|
(return #f)
|
|
)
|
|
(while (and (nonzero? (-> a-ptr 0)) (nonzero? (-> b-ptr 0)))
|
|
(if (!= (-> a-ptr 0) (-> b-ptr 0))
|
|
(return #f)
|
|
)
|
|
(set! a-ptr (&-> a-ptr 1))
|
|
(set! b-ptr (&-> b-ptr 1))
|
|
)
|
|
;; only equal if both end here.
|
|
(and (zero? (-> a-ptr 0)) (zero? (-> b-ptr 0)))
|
|
)
|
|
)
|
|
|
|
(defun string-charp= ((str string) (charp (pointer uint8)))
|
|
"Is the data in str equal to the C string charp?"
|
|
(let ((str-ptr (-> str data)))
|
|
(while (and (nonzero? (-> str-ptr 0)) (nonzero? (-> charp 0)))
|
|
(if (!= (-> str-ptr 0) (-> charp 0))
|
|
(return #f)
|
|
)
|
|
(set! str-ptr (&-> str-ptr 1))
|
|
(set! charp (&-> charp 1))
|
|
)
|
|
(and (zero? (-> str-ptr 0)) (zero? (-> charp 0)))
|
|
)
|
|
)
|
|
|
|
(defun name= ((arg0 basic) (arg1 basic))
|
|
"Do arg0 and arg1 have the same name?
|
|
This can use either strings or symbols"
|
|
(cond
|
|
((= arg0 arg1)
|
|
;; Either same symbols, or same string objects, fast check pass!
|
|
#t)
|
|
((and (= (-> arg0 type) string) (= (-> arg1 type) string))
|
|
(string= (the-as string arg0) (the-as string arg1))
|
|
)
|
|
((and (= (-> arg0 type) string) (= (-> arg1 type) symbol))
|
|
(string= (the-as string arg0) (symbol->string arg1))
|
|
)
|
|
((and (= (-> arg1 type) string) (= (-> arg0 type) symbol))
|
|
(string= (the-as string arg1) (symbol->string arg0))
|
|
)
|
|
;; no need to check symbol - symbol, that would have passed the first check.
|
|
)
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; String copying
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defun copyn-string<-charp ((str string) (charp (pointer uint8)) (len int))
|
|
"Copy data from a charp to a GOAL string. Copies len chars, plus a null."
|
|
(let ((str-ptr (-> str data)))
|
|
(dotimes (i len)
|
|
(set! (-> str-ptr 0) (-> charp 0))
|
|
(set! str-ptr (&-> str-ptr 1))
|
|
(set! charp (&-> charp 1))
|
|
)
|
|
(set! (-> str-ptr 0) (the-as uint 0))
|
|
)
|
|
str
|
|
)
|
|
|
|
(defun string<-charp ((str string) (charp (pointer uint8)))
|
|
"Copy all chars from a char* to a GOAL string.
|
|
Does NO length checking."
|
|
(let ((str-ptr (-> str data)))
|
|
(while (nonzero? (-> charp 0))
|
|
(set! (-> str-ptr 0) (-> charp 0))
|
|
(set! str-ptr (&-> str-ptr 1))
|
|
(set! charp (&-> charp 1))
|
|
)
|
|
(set! (-> str-ptr 0) (the-as uint 0))
|
|
)
|
|
str
|
|
)
|
|
|
|
(defun charp<-string ((dst (pointer uint8)) (src-string string))
|
|
"Copy a GOAL string into a character array."
|
|
(let ((src (-> src-string data)))
|
|
(while (!= 0 (-> src))
|
|
(set! (-> dst) (-> src))
|
|
(&+! dst 1)
|
|
(&+! src 1)
|
|
)
|
|
(set! (-> dst) 0)
|
|
0
|
|
)
|
|
)
|
|
|
|
(defun copy-charp<-charp ((dst (pointer uint8)) (src (pointer uint8)))
|
|
"C string copy."
|
|
(while (nonzero? (-> src 0))
|
|
(set! (-> dst 0) (-> src 0))
|
|
(set! dst (&-> dst 1))
|
|
(set! src (&-> src 1))
|
|
)
|
|
(set! (-> dst 0) 0)
|
|
dst
|
|
)
|
|
|
|
(defun cat-string<-string ((a string) (b string))
|
|
"Append b to a. No length checks"
|
|
(let ((a-ptr (-> a data)))
|
|
(let ((b-ptr (-> b data)))
|
|
(while (nonzero? (-> a-ptr 0))
|
|
(nop!)
|
|
(nop!)
|
|
(nop!)
|
|
(set! a-ptr (&-> a-ptr 1))
|
|
)
|
|
(while (nonzero? (-> b-ptr 0))
|
|
(set! (-> a-ptr 0) (-> b-ptr 0))
|
|
(set! a-ptr (&-> a-ptr 1))
|
|
(set! b-ptr (&-> b-ptr 1))
|
|
)
|
|
)
|
|
(set! (-> a-ptr 0) (the-as uint 0))
|
|
)
|
|
a
|
|
)
|
|
|
|
(defun catn-string<-charp ((a string) (b (pointer uint8)) (len int))
|
|
"Append b to a, exactly len chars"
|
|
(let ((a-ptr (-> a data)))
|
|
(while (nonzero? (-> a-ptr 0))
|
|
(set! a-ptr (&-> a-ptr 1))
|
|
)
|
|
(dotimes (i len)
|
|
(set! (-> a-ptr 0) (-> b 0))
|
|
(set! a-ptr (&-> a-ptr 1))
|
|
(set! b (&-> b 1))
|
|
)
|
|
(set! (-> a-ptr 0) (the-as uint 0))
|
|
)
|
|
a
|
|
)
|
|
|
|
(defun cat-string<-string_to_charp ((a string) (b string) (end-ptr (pointer uint8)))
|
|
"Append b to a, using chars of b up to (and including) the one pointed to by end-ptr,
|
|
or, until the end of b, whichever comes first."
|
|
|
|
(let ((b-ptr (-> b data))
|
|
(a-ptr (-> a data))
|
|
)
|
|
;; seek to end of a
|
|
(while (nonzero? (-> a-ptr 0))
|
|
(nop!)
|
|
(nop!)
|
|
(nop!)
|
|
(set! a-ptr (&-> a-ptr 1))
|
|
)
|
|
(while (and (>= (the-as int end-ptr) (the-as int b-ptr))
|
|
(nonzero? (-> b-ptr 0)))
|
|
(set! (-> a-ptr 0) (-> b-ptr 0))
|
|
(set! a-ptr (&-> a-ptr 1))
|
|
(set! b-ptr (&-> b-ptr 1))
|
|
)
|
|
(set! (-> a-ptr 0) 0)
|
|
a-ptr
|
|
)
|
|
)
|
|
|
|
|
|
(defun append-character-to-string ((str string) (char uint8))
|
|
"Append char to the end of the given string."
|
|
(let ((str-ptr (-> str data)))
|
|
(while (nonzero? (-> str-ptr 0))
|
|
(nop!)
|
|
(nop!)
|
|
(nop!)
|
|
(set! str-ptr (&-> str-ptr 1))
|
|
)
|
|
(set! (-> str-ptr 0) char)
|
|
(set! (-> str-ptr 1) 0)
|
|
0
|
|
)
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; String utilities
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defun charp-basename ((charp (pointer uint8)))
|
|
"Like basename in C"
|
|
(let ((ptr charp))
|
|
;; seek to end
|
|
(while (nonzero? (-> ptr 0))
|
|
(set! ptr (&-> ptr 1))
|
|
)
|
|
;; and back up...
|
|
(while (< (the-as int charp) (the-as int ptr))
|
|
(set! ptr (&-> ptr -1))
|
|
;; (if (or (zero? (+ (-> ptr 0) -47)) (zero? (+ (-> ptr 0) -92)))
|
|
;; check for equal to / or \
|
|
(if (or (= (-> ptr 0) #\/) (= (-> ptr 0) #\\))
|
|
;; return the next char after that
|
|
(return (&-> ptr 1))
|
|
)
|
|
)
|
|
;; didn't find any slashes, return the whole thing.
|
|
charp
|
|
)
|
|
)
|
|
|
|
(defun clear ((a0-0 string))
|
|
"Make string empty"
|
|
(set! (-> a0-0 data 0) 0) a0-0
|
|
)
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; String ordering
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; NOTE: these string comparisons are a little broken.
|
|
;; ex: (string<? "asd" "asdf") = #f
|
|
;; (string<? "asdf" "asd") = #f
|
|
;; these comparisons do not properly order strings.
|
|
|
|
(defun string<? ((a string) (b string))
|
|
"In dictionary order, is a < b?"
|
|
(let ((len (min (length a) (length b))))
|
|
(dotimes (i len)
|
|
(cond
|
|
((< (-> a data i) (-> b data i))
|
|
(return #t)
|
|
)
|
|
((< (-> b data i) (-> a data i))
|
|
(return #f)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
|
|
(defun string>? ((a string) (b string))
|
|
"In dictionary order, is a > b?"
|
|
(let ((len (min (length a) (length b))))
|
|
(dotimes (i len)
|
|
(cond
|
|
((< (-> a data i) (-> b data i))
|
|
(return #f)
|
|
)
|
|
((< (-> b data i) (-> a data i))
|
|
(return #t)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
|
|
(defun string<=? ((a string) (b string))
|
|
(let ((len (min (length a) (length b))))
|
|
(dotimes (i len)
|
|
(cond
|
|
((< (-> a data i) (-> b data i))
|
|
(return #t)
|
|
)
|
|
((< (-> b data i) (-> a data i))
|
|
(return #f)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
#t
|
|
)
|
|
|
|
(defun string>=? ((a string) (b string))
|
|
(let ((len (min (length a) (length b))))
|
|
(dotimes (i len)
|
|
(cond
|
|
((< (-> a data i) (-> b data i))
|
|
(return #f)
|
|
)
|
|
((< (-> b data i) (-> a data i))
|
|
(return #t)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
#t
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; String argument parsing
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; temporary string for argument functions
|
|
(define *string-tmp-str* (new 'global 'string 128 (the string #f)))
|
|
|
|
(defun string-skip-to-char ((str (pointer uint8)) (char uint))
|
|
"Return pointer to first instance of char in C string, or to the null terminator if none"
|
|
(while (and (nonzero? (-> str 0)) (!= (-> str 0) char))
|
|
(set! str (&-> str 1))
|
|
)
|
|
str
|
|
)
|
|
|
|
(defun string-cat-to-last-char ((base-str string) (append-str string) (char uint))
|
|
"Append append-str to the end of of base-str, up to the last occurance of char in append-str"
|
|
(local-vars
|
|
(location-of-char (pointer uint8))
|
|
(end-of-append (pointer uint8))
|
|
)
|
|
|
|
;; point to one before the beginning of the append string (kind of a hack)
|
|
(set! end-of-append (&-> (the-as (pointer uint8) append-str) 3))
|
|
;; try to find char in append-str
|
|
(set! location-of-char (string-skip-to-char (-> append-str data) char))
|
|
(when (= (-> location-of-char 0) char)
|
|
;; found it!
|
|
(until
|
|
(begin
|
|
;; update the location of the last find
|
|
(set! end-of-append location-of-char)
|
|
;; try to find another
|
|
(set! location-of-char (string-skip-to-char (&-> location-of-char 1) char))
|
|
;; did we succeed?
|
|
(!= (-> location-of-char 0) char)
|
|
)
|
|
(none)
|
|
)
|
|
)
|
|
;; now location-of-char points to the last occurance.
|
|
;; or to 1 before the start of append-str if we never found it.
|
|
(cat-string<-string_to_charp base-str append-str end-of-append)
|
|
)
|
|
|
|
(defmacro is-whitespace-char? (c)
|
|
;; 32 = space
|
|
;; 9 = \t
|
|
;; 13 = \r
|
|
;; 10 = \n
|
|
`(or (= ,c 32)
|
|
(= ,c 9)
|
|
(= ,c 13)
|
|
(= ,c 10)
|
|
)
|
|
)
|
|
|
|
(defun string-skip-whitespace ((arg0 (pointer uint8)))
|
|
"Skip over spaces, tabs, r's and n's"
|
|
(while
|
|
(and (nonzero? (-> arg0 0))
|
|
(is-whitespace-char? (-> arg0 0))
|
|
)
|
|
(set! arg0 (&-> arg0 1))
|
|
)
|
|
arg0
|
|
)
|
|
|
|
(defun string-suck-up! ((str string) (location (pointer uint8)))
|
|
"Remove character between the start of string and location.
|
|
The char pointed to by location is now the first."
|
|
;; fast check to do nothing if location points to start already.
|
|
(when (!= location (-> str data))
|
|
(let ((str-ptr (-> str data)))
|
|
;; copy back
|
|
(while (nonzero? (-> location 0))
|
|
(set! (-> str-ptr 0) (-> location 0))
|
|
(set! str-ptr (&-> str-ptr 1))
|
|
(set! location (&-> location 1))
|
|
)
|
|
;; null terminate
|
|
(set! (-> str-ptr 0) 0)
|
|
)
|
|
'#f
|
|
)
|
|
)
|
|
|
|
(defun string-strip-leading-whitespace! ((str string))
|
|
"Remove whitespace at the front of a string"
|
|
(let ((start-loc (string-skip-whitespace (-> str data))))
|
|
(string-suck-up! str start-loc)
|
|
)
|
|
#f
|
|
)
|
|
|
|
(defun string-strip-trailing-whitespace! ((str string))
|
|
"Remove whitespace at the end of a string"
|
|
(local-vars (ptr (pointer uint8)))
|
|
(when (nonzero? ((method-of-type string length) str))
|
|
(set! ptr (&+ (-> str data)
|
|
(the-as uint (+ ((method-of-type string length) str) -1)))
|
|
)
|
|
(while (and (>= (the-as int ptr) (the-as int (-> str data)))
|
|
(is-whitespace-char? (-> ptr 0))
|
|
)
|
|
(set! ptr (&-> ptr -1))
|
|
)
|
|
(set! (-> ptr 1) 0)
|
|
)
|
|
'#f
|
|
)
|
|
|
|
(defun string-strip-whitespace! ((arg0 string))
|
|
"Remove whitespace at the beginning and end of a string"
|
|
(string-strip-trailing-whitespace! arg0)
|
|
(string-strip-leading-whitespace! arg0)
|
|
'#f
|
|
)
|
|
|
|
(defun string-get-arg!! ((a-str string) (arg string))
|
|
"Get the first argument from a whitespace separated list of arguments.
|
|
The arguments can be in quotes or not.
|
|
Removes argument from arg string, sucks up white space before the next one
|
|
Outputs argument to a-str."
|
|
|
|
;; seek to first arg
|
|
(let ((arg-word-start (string-skip-whitespace (-> arg data))))
|
|
(cond
|
|
((= (-> arg-word-start 0) 34) ;; starts with quote
|
|
;; seek past quote
|
|
(let ((arg-end (&-> arg-word-start 1)))
|
|
;; now find end
|
|
(let ((arg-start arg-end))
|
|
(while (and (nonzero? (-> arg-end 0)) (!= (-> arg-end 0) 34)) ;; close quote
|
|
(set! arg-end (&-> arg-end 1))
|
|
)
|
|
;; copy to output
|
|
(copyn-string<-charp a-str arg-start (&- arg-end (the-as uint arg-start)))
|
|
)
|
|
|
|
;; if we got a close quote, seek past it.
|
|
(if (= (-> arg-end 0) 34)
|
|
(set! arg-end (&-> arg-end 1))
|
|
)
|
|
|
|
;; kill leading white space
|
|
(let ((a1-3 (string-skip-whitespace arg-end)))
|
|
(string-suck-up! arg a1-3)
|
|
)
|
|
)
|
|
(return #t)
|
|
)
|
|
((nonzero? (-> arg-word-start 0))
|
|
(let ((v1-11 arg-word-start))
|
|
;; find end
|
|
(while (and
|
|
(nonzero? (-> arg-word-start 0))
|
|
(!= (-> arg-word-start 0) 32)
|
|
(!= (-> arg-word-start 0) 9)
|
|
(!= (-> arg-word-start 0) 13)
|
|
(!= (-> arg-word-start 0) 10)
|
|
)
|
|
(set! arg-word-start (&-> arg-word-start 1))
|
|
)
|
|
(copyn-string<-charp a-str v1-11 (&- arg-word-start (the-as uint v1-11)))
|
|
)
|
|
(let ((a1-9 (string-skip-whitespace arg-word-start)))
|
|
(string-suck-up! arg a1-9)
|
|
)
|
|
(return #t)
|
|
)
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
|
|
(defun string->int ((str string))
|
|
"String to int. Supports binary, hex, and decimal. Negative is implemented for decimal and hex
|
|
But I think it's broken?"
|
|
(local-vars
|
|
(result int)
|
|
(negative symbol)
|
|
(str-ptr (pointer uint8))
|
|
(next-char-1 (pointer uint8))
|
|
(next-char-2 (pointer uint8))
|
|
(a0-4 (pointer uint8))
|
|
(a0-5 symbol)
|
|
(a1-14 uint)
|
|
(a1-16 symbol)
|
|
(a1-20 uint)
|
|
(a1-23 uint)
|
|
(a1-33 symbol)
|
|
(a1-44 symbol)
|
|
(a1-47 (pointer uint8))
|
|
)
|
|
(set! str-ptr (-> str data))
|
|
(set! result 0)
|
|
(set! negative '#f)
|
|
(cond
|
|
((= (-> str-ptr 0) 35) ;; #
|
|
;; starts with #.
|
|
(set! next-char-1 (&-> str-ptr 1))
|
|
(cond
|
|
((or (= (-> next-char-1 0) #\x) (= (-> next-char-1 0) #\X))
|
|
;; starts with #x or #X
|
|
(set! next-char-2 (&-> next-char-1 1))
|
|
(when (= (-> next-char-2 1) #\-)
|
|
;; negate!
|
|
(set! negative '#t)
|
|
(set! next-char-2 (&-> next-char-2 1))
|
|
)
|
|
(while
|
|
(or
|
|
;; is in [0-9]
|
|
(and
|
|
(>= (-> next-char-2 0) #\0)
|
|
(>= (the-as uint #\9) (-> next-char-2 0))
|
|
)
|
|
;; is in [A-F]
|
|
(and
|
|
(>= (-> next-char-2 0) (the-as uint 65))
|
|
(>= (the-as uint 70) (-> next-char-2 0))
|
|
)
|
|
;; is in [a-f]
|
|
(and
|
|
(>= (-> next-char-2 0) (the-as uint 97))
|
|
(>= (the-as uint 102) (-> next-char-2 0))
|
|
)
|
|
)
|
|
(cond
|
|
;; is in [A-F]
|
|
((and
|
|
(>= (-> next-char-2 0) (the-as uint 65))
|
|
(>= (the-as uint 70) (-> next-char-2 0))
|
|
)
|
|
(set!
|
|
result
|
|
(the int (+ (+ (-> next-char-2 0) -55) (the-as uint (shl result 4))))
|
|
)
|
|
)
|
|
(else
|
|
(set!
|
|
a1-16
|
|
(and
|
|
(>= (-> next-char-2 0) (the-as uint 97))
|
|
(>= (the-as uint 102) (-> next-char-2 0))
|
|
)
|
|
)
|
|
(cond
|
|
(a1-16
|
|
;; in [a-f]
|
|
(set! result
|
|
(the int (+ (+ (-> next-char-2 0) -87) (the-as uint (shl result 4))))
|
|
)
|
|
)
|
|
(else
|
|
;; numeric
|
|
(set! result
|
|
(the int (+ (+ (-> next-char-2 0) -48) (the-as uint (shl result 4))))
|
|
)
|
|
) ;; end numeric
|
|
) ;; end numeric or [a-f]
|
|
) ;; end not [A-F]
|
|
) ;; end cond
|
|
(set! next-char-2 (&-> next-char-2 1))
|
|
) ;; end while
|
|
)
|
|
((or (zero? (+ (-> next-char-1 0) -98)) (zero? (+ (-> next-char-1 0) -66)))
|
|
;; is #b (I guess we can't do negative binary?)
|
|
(set! a0-4 (&-> next-char-1 1))
|
|
(while (and (>= (-> a0-4 0) (the-as uint 48)) (>= (the-as uint 49) (-> a0-4 0)))
|
|
(set! result (the int (+ (+ (-> a0-4 0) -48) (the-as uint (shl result 1)))))
|
|
(set! a0-4 (&-> a0-4 1))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(else
|
|
;; decimal
|
|
|
|
;; check for negative
|
|
(when (= (-> str-ptr 1) 45)
|
|
(set! negative '#t)
|
|
(set! str-ptr (&-> str-ptr 1))
|
|
(set! a1-47 str-ptr)
|
|
)
|
|
|
|
(while (and
|
|
(>= (-> str-ptr 0) (the-as uint 48))
|
|
(>= (the-as uint 57) (-> str-ptr 0))
|
|
)
|
|
(set! result (the int (+ (+ (-> str-ptr 0) -48) (the-as uint (* 10 result)))))
|
|
(set! str-ptr (&-> str-ptr 1))
|
|
)
|
|
)
|
|
)
|
|
(cond (negative (- result)) (else result))
|
|
)
|
|
|
|
(defun string->float ((arg0 string))
|
|
"Convert a string to a float, but it is not implemented."
|
|
(format 0 "string->float left as an excersize for the reader~%")
|
|
0.0
|
|
)
|
|
|
|
(defun string-get-int32!! ((arg0 (pointer int32)) (arg1 string))
|
|
"Get an int32 from a list of arguments"
|
|
(cond
|
|
((string-get-arg!! *string-tmp-str* arg1)
|
|
(set! (-> arg0 0) (string->int *string-tmp-str*))
|
|
'#t
|
|
)
|
|
(else '#f)
|
|
)
|
|
)
|
|
|
|
(defun string-get-float!! ((arg0 (pointer float)) (arg1 string))
|
|
(cond
|
|
((string-get-arg!! *string-tmp-str* arg1)
|
|
(set! (-> arg0 0) (string->float *string-tmp-str*))
|
|
'#t
|
|
)
|
|
(else '#f)
|
|
)
|
|
)
|
|
|
|
(defun string-get-flag!! ((result (pointer symbol)) (in string) (first-flag string) (second-flag string))
|
|
(local-vars (v1-0 symbol))
|
|
(cond
|
|
((string-get-arg!! *string-tmp-str* in)
|
|
(cond
|
|
((or (string= *string-tmp-str* first-flag)
|
|
(string= *string-tmp-str* second-flag)
|
|
)
|
|
(set! (-> result 0) (string= *string-tmp-str* first-flag))
|
|
'#t
|
|
)
|
|
(else '#f)
|
|
)
|
|
)
|
|
(else '#f)
|
|
)
|
|
)
|
|
|
|
;; what is this?
|
|
(define *debug-draw-pauseable* #f)
|
|
|
|
;; console buffers. not sure what the two are for.
|
|
(define *stdcon0* (new 'global 'string 16384 (the string #f)))
|
|
(define *stdcon1* (new 'global 'string 16384 (the string #f)))
|
|
(define *stdcon* *stdcon0*)
|
|
|
|
;; shared temporary string.
|
|
(define *temp-string* (new 'global 'string 256 (the string #f)))
|
|
|
|
(defmacro string-format (&rest args)
|
|
"Formats into *temp-string* and returns it, for in-place string formating.
|
|
DO NOT USE *temp-string* WITH THIS MACRO! It is read as input AFTER all of the args evaluate."
|
|
|
|
`(begin
|
|
(format (clear *temp-string*) ,@args)
|
|
*temp-string*
|
|
)
|
|
)
|
|
|