;;-*-Lisp-*- (in-package goal) ;; name: gstring.gc ;; name in dgo: gstring ;; dgos: KERNEL ;; DECOMP BEGINS (defmethod length ((this string)) (let ((v1-0 (-> this data))) (while (nonzero? (-> v1-0 0)) (nop!) (nop!) (nop!) (set! v1-0 (&-> v1-0 1)) ) (&- v1-0 (the-as uint (-> this data))) ) ) (defmethod asize-of ((this string)) (+ (-> this allocated-length) 1 (-> string size)) ) (defun copy-string<-string ((arg0 string) (arg1 string)) "Copy data from one string to another, like strcpy" (let ((v1-0 (-> arg0 data))) (let ((a1-1 (-> arg1 data))) (while (nonzero? (-> a1-1 0)) (set! (-> v1-0 0) (-> a1-1 0)) (set! v1-0 (&-> v1-0 1)) (set! a1-1 (&-> a1-1 1)) ) ) (set! (-> v1-0 0) (the-as uint 0)) ) arg0 ) (defmethod new string ((allocation symbol) (type-to-make type) (arg0 int) (arg1 string)) "Create a new string of the given size. If other is not #f, copy data from it." (cond (arg1 (let* ((s2-1 (max (length arg1) arg0)) (a0-4 (object-new allocation type-to-make (+ s2-1 1 (-> type-to-make size)))) ) (set! (-> a0-4 allocated-length) s2-1) (copy-string<-string a0-4 arg1) ) ) (else (let ((v0-2 (object-new allocation type-to-make (+ arg0 1 (-> type-to-make size))))) (set! (-> v0-2 allocated-length) arg0) v0-2 ) ) ) ) (defun string= ((arg0 string) (arg1 string)) "Does str-a hold the same data as str-b?. If either string is null, returns #f." (let ((a2-0 (-> arg0 data)) (v1-0 (-> arg1 data)) ) (if (or (zero? arg0) (zero? arg1)) (return #f) ) (while (and (nonzero? (-> a2-0 0)) (nonzero? (-> v1-0 0))) (if (!= (-> a2-0 0) (-> v1-0 0)) (return #f) ) (set! a2-0 (&-> a2-0 1)) (set! v1-0 (&-> v1-0 1)) ) (and (zero? (-> a2-0 0)) (zero? (-> v1-0 0))) ) ) (defun string-prefix= ((arg0 string) (arg1 string)) "Is the first string a prefix of the second? (string-prefix= 'foo' 'foobar') = #t" (let ((v1-0 (-> arg0 data))) (let ((a2-0 (-> arg1 data))) (if (or (zero? arg0) (zero? arg1)) (return #f) ) (while (and (nonzero? (-> v1-0 0)) (nonzero? (-> a2-0 0))) (if (!= (-> v1-0 0) (-> a2-0 0)) (return #f) ) (set! v1-0 (&-> v1-0 1)) (set! a2-0 (&-> a2-0 1)) ) ) (zero? (-> v1-0 0)) ) ) (defun charp-prefix= ((arg0 (pointer uint8)) (arg1 (pointer uint8))) "Is the first cstring a prefix of the second?" (while (and (nonzero? (-> arg0 0)) (nonzero? (-> arg1 0))) (if (!= (-> arg0 0) (-> arg1 0)) (return #f) ) (set! arg0 (&-> arg0 1)) (set! arg1 (&-> arg1 1)) ) (zero? (-> arg0 0)) ) (defun string-suffix= ((arg0 string) (arg1 string)) "Is the _second_ string a suffix of the first?" (let ((s5-0 (-> arg0 data)) (gp-0 (-> arg1 data)) ) (if (or (zero? arg0) (zero? arg1)) (return #f) ) (let ((s4-0 (length arg0)) (v1-5 (length arg1)) ) (if (< s4-0 v1-5) (return #f) ) (let ((v1-7 (&+ s5-0 (- s4-0 v1-5)))) (while (and (nonzero? (-> v1-7 0)) (nonzero? (-> gp-0 0))) (if (!= (-> v1-7 0) (-> gp-0 0)) (return #f) ) (set! v1-7 (&-> v1-7 1)) (set! gp-0 (&-> gp-0 1)) ) (zero? (-> v1-7 0)) ) ) ) ) (defun string-position ((arg0 string) (arg1 string)) "Find the position of the first string in the second." (let ((s5-0 0) (s4-0 (-> arg1 data)) ) (while (nonzero? (-> s4-0 0)) (if (charp-prefix= (-> arg0 data) s4-0) (return s5-0) ) (+! s5-0 1) (set! s4-0 (&-> s4-0 1)) ) ) -1 ) (defun string-charp= ((arg0 string) (arg1 (pointer uint8))) "Is the data in str equal to the C string charp?" (let ((v1-0 (-> arg0 data))) (while (and (nonzero? (-> v1-0 0)) (nonzero? (-> arg1 0))) (if (!= (-> v1-0 0) (-> arg1 0)) (return #f) ) (set! v1-0 (&-> v1-0 1)) (set! arg1 (&-> arg1 1)) ) (and (zero? (-> v1-0 0)) (zero? (-> arg1 0))) ) ) ;; definition for function name= ;; ERROR: function was not converted to expressions. Cannot decompile. (defun name= ((arg0 object) (arg1 object)) "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 (= (rtype-of arg0) string) (= (rtype-of arg1) string)) (string= (the-as string arg0) (the-as string arg1)) ) ((and (= (rtype-of arg0) string) (= (rtype-of arg1) symbol)) (string= (the-as string arg0) (symbol->string arg1)) ) ((and (= (rtype-of arg1) string) (= (rtype-of arg0) symbol)) (string= (the-as string arg1) (symbol->string arg0)) ) ;; no need to check symbol - symbol, that would have passed the first check. ) ) (defun copyn-string<-charp ((arg0 string) (arg1 (pointer uint8)) (arg2 int)) "Copy data from a charp to a GOAL string. Copies len chars, plus a null." (let ((v1-0 (-> arg0 data))) (dotimes (a3-0 arg2) (set! (-> v1-0 0) (-> arg1 0)) (set! v1-0 (&-> v1-0 1)) (set! arg1 (&-> arg1 1)) ) (set! (-> v1-0 0) (the-as uint 0)) ) arg0 ) (defun string<-charp ((arg0 string) (arg1 (pointer uint8))) "Copy all chars from a char* to a GOAL string. Does NO length checking." (let ((v1-0 (-> arg0 data))) (while (nonzero? (-> arg1 0)) (set! (-> v1-0 0) (-> arg1 0)) (set! v1-0 (&-> v1-0 1)) (set! arg1 (&-> arg1 1)) ) (set! (-> v1-0 0) (the-as uint 0)) ) arg0 ) (defun charp<-string ((arg0 (pointer uint8)) (arg1 string)) "Copy a GOAL string into a character array." (let ((v1-0 (-> arg1 data))) (while (nonzero? (-> v1-0 0)) (set! (-> arg0 0) (-> v1-0 0)) (set! arg0 (&-> arg0 1)) (set! v1-0 (&-> v1-0 1)) ) ) (set! (-> arg0 0) (the-as uint 0)) 0 ) (defun copyn-charp<-string ((arg0 (pointer uint8)) (arg1 string) (arg2 int)) "Copy n chars from string to character array." (let ((v1-0 (-> arg1 data))) (while (and (nonzero? (-> v1-0 0)) (< 1 arg2)) (set! (-> arg0 0) (-> v1-0 0)) (set! arg0 (&-> arg0 1)) (set! v1-0 (&-> v1-0 1)) (set! arg2 (+ arg2 -1)) ) ) (while (> arg2 0) (set! (-> arg0 0) (the-as uint 0)) (set! arg0 (&-> arg0 1)) (set! arg2 (+ arg2 -1)) ) 0 (none) ) (defun copy-charp<-charp ((arg0 (pointer uint8)) (arg1 (pointer uint8))) "C string copy." (while (nonzero? (-> arg1 0)) (set! (-> arg0 0) (-> arg1 0)) (set! arg0 (&-> arg0 1)) (set! arg1 (&-> arg1 1)) ) (set! (-> arg0 0) (the-as uint 0)) arg0 ) (defun cat-string<-string ((arg0 string) (arg1 string)) "Append b to a. No length checks" (let ((v1-0 (-> arg0 data))) (let ((a1-1 (-> arg1 data))) (while (nonzero? (-> v1-0 0)) (nop!) (nop!) (nop!) (set! v1-0 (&-> v1-0 1)) ) (while (nonzero? (-> a1-1 0)) (set! (-> v1-0 0) (-> a1-1 0)) (set! v1-0 (&-> v1-0 1)) (set! a1-1 (&-> a1-1 1)) ) ) (set! (-> v1-0 0) (the-as uint 0)) ) arg0 ) (defun catn-string<-charp ((arg0 string) (arg1 (pointer uint8)) (arg2 int)) "Append b to a, exactly len chars" (let ((v1-0 (-> arg0 data))) (while (nonzero? (-> v1-0 0)) (nop!) (nop!) (nop!) (set! v1-0 (&-> v1-0 1)) ) (dotimes (a3-2 arg2) (set! (-> v1-0 0) (-> arg1 0)) (set! v1-0 (&-> v1-0 1)) (set! arg1 (&-> arg1 1)) ) (set! (-> v1-0 0) (the-as uint 0)) ) arg0 ) (defun cat-string<-string_to_charp ((arg0 string) (arg1 string) (arg2 (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 ((v1-0 (-> arg1 data)) (v0-0 (-> arg0 data)) ) (while (nonzero? (-> v0-0 0)) (nop!) (nop!) (nop!) (set! v0-0 (&-> v0-0 1)) ) (while (and (>= (the-as int arg2) (the-as int v1-0)) (nonzero? (-> v1-0 0))) (set! (-> v0-0 0) (-> v1-0 0)) (set! v0-0 (&-> v0-0 1)) (set! v1-0 (&-> v1-0 1)) ) (set! (-> v0-0 0) (the-as uint 0)) v0-0 ) ) (defun append-character-to-string ((arg0 string) (arg1 uint8)) "Append char to the end of the given string." (let ((v1-0 (-> arg0 data))) (while (nonzero? (-> v1-0 0)) (nop!) (nop!) (nop!) (set! v1-0 (&-> v1-0 1)) ) (set! (-> v1-0 0) (the-as uint arg1)) (set! (-> v1-0 1) (the-as uint 0)) ) 0 0 ) (defun charp-basename ((arg0 (pointer uint8))) "Like basename in C" (let ((v1-0 arg0)) (while (nonzero? (-> v1-0 0)) (set! v1-0 (&-> v1-0 1)) ) (while (< (the-as int arg0) (the-as int v1-0)) (set! v1-0 (&-> v1-0 -1)) (if (or (= (-> v1-0 0) 47) (= (-> v1-0 0) 92)) (return (&-> v1-0 1)) ) ) ) arg0 ) (defun clear ((arg0 string)) "Make string empty" (set! (-> arg0 data 0) (the-as uint 0)) arg0 ) ;; NOTE: these string comparisons are a little broken. ;; ex: (string arg0 data v1-4) (-> arg1 data v1-4)) (return #t) ) ((< (-> arg1 data v1-4) (-> arg0 data v1-4)) (return #f) ) ) ) ) #f ) (defun string>? ((arg0 string) (arg1 string)) "In dictionary order, is a > b?" (let ((s4-1 (min (length arg0) (length arg1)))) (dotimes (v1-4 s4-1) (cond ((< (-> arg0 data v1-4) (-> arg1 data v1-4)) (return #f) ) ((< (-> arg1 data v1-4) (-> arg0 data v1-4)) (return #t) ) ) ) ) #f ) (defun string<=? ((arg0 string) (arg1 string)) (let ((s4-1 (min (length arg0) (length arg1)))) (dotimes (v1-4 s4-1) (cond ((< (-> arg0 data v1-4) (-> arg1 data v1-4)) (return #t) ) ((< (-> arg1 data v1-4) (-> arg0 data v1-4)) (return #f) ) ) ) ) #t ) (defun string>=? ((arg0 string) (arg1 string)) (let ((s4-1 (min (length arg0) (length arg1)))) (dotimes (v1-4 s4-1) (cond ((< (-> arg0 data v1-4) (-> arg1 data v1-4)) (return #f) ) ((< (-> arg1 data v1-4) (-> arg0 data v1-4)) (return #t) ) ) ) ) #t ) ;; temporary string for argument functions (define *string-tmp-str* (new 'global 'string 128 (the-as string #f))) (defun string-skip-to-char ((arg0 (pointer uint8)) (arg1 uint)) "Return pointer to first instance of char in C string, or to the null terminator if none" (while (and (nonzero? (-> arg0 0)) (!= (-> arg0 0) arg1)) (set! arg0 (&-> arg0 1)) ) arg0 ) (defun string-cat-to-last-char ((arg0 string) (arg1 string) (arg2 uint)) "Append append-str to the end of base-str, up to the last occurance of char in append-str" (let ((s4-0 (&-> (the-as (pointer uint8) arg1) 3))) (let ((v1-0 (string-skip-to-char (-> arg1 data) arg2))) (when (= (-> v1-0 0) arg2) (until (!= (-> v1-0 0) arg2) (set! s4-0 v1-0) (set! v1-0 (string-skip-to-char (&-> v1-0 1) arg2)) ) ) ) (cat-string<-string_to_charp arg0 arg1 s4-0) ) ) (defmacro is-whitespace-char? (c) ;; 32 = space ;; 9 = \t ;; 13 = \r ;; 10 = \n `(or (= ,c 32) (= ,c 9) (= ,c 13) (= ,c 10) ) ) (defmacro not-whitespace-char? (c) `(not (is-whitespace-char? ,c)) ) (defun string-skip-whitespace ((arg0 (pointer uint8))) "Skip over spaces, tabs, r's and n's" ;; 32 = space ;; 9 = \t ;; 13 = \r ;; 10 = \n (while (and (nonzero? (-> arg0 0)) (or (= (-> arg0 0) 32) (= (-> arg0 0) 9) (= (-> arg0 0) 13) (= (-> arg0 0) 10))) (set! arg0 (&-> arg0 1)) ) arg0 ) (defun string-suck-up! ((arg0 string) (arg1 (pointer uint8))) "Remove character between the start of string and location. The char pointed to by location is now the first." (when (!= arg1 (-> arg0 data)) (let ((v1-2 (-> arg0 data))) (while (nonzero? (-> arg1 0)) (set! (-> v1-2 0) (-> arg1 0)) (set! v1-2 (&-> v1-2 1)) (set! arg1 (&-> arg1 1)) ) (set! (-> v1-2 0) (the-as uint 0)) ) 0 ) #f ) (defun string-strip-leading-whitespace! ((arg0 string)) "Remove whitespace at the front of a string" (let ((a1-0 (string-skip-whitespace (-> arg0 data)))) (string-suck-up! arg0 a1-0) ) #f ) (defun string-strip-trailing-whitespace! ((arg0 string)) "Remove whitespace at the end of a string" (when (nonzero? (length arg0)) (let ((v1-6 (&+ (-> arg0 data) (+ (length arg0) -1)))) (while (and (>= (the-as int v1-6) (the-as int (-> arg0 data))) (or (= (-> v1-6 0) 32) (= (-> v1-6 0) 9) (= (-> v1-6 0) 13) (= (-> v1-6 0) 10)) ) (set! v1-6 (&-> v1-6 -1)) ) (set! (-> v1-6 1) (the-as uint 0)) ) 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-upcase ((arg0 string) (arg1 string)) "Uppercase the given string." (let* ((a0-1 (-> arg0 data)) (a3-0 (-> a0-1 0)) (a2-0 1) (v1-0 0) ) (while (nonzero? a3-0) (if (and (>= a3-0 (the-as uint 97)) (>= (the-as uint 122) a3-0)) (+! a3-0 -32) ) (set! (-> arg1 data v1-0) a3-0) (set! a3-0 (-> a0-1 a2-0)) (+! a2-0 1) (+! v1-0 1) ) (set! (-> arg1 data v1-0) (the-as uint 0)) ) 0 (none) ) (defun string-get-arg!! ((arg0 string) (arg1 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." (let ((s4-0 (string-skip-whitespace (-> arg1 data)))) (cond ((= (-> s4-0 0) 34) (let ((s4-1 (&-> s4-0 1))) (let ((v1-3 s4-1)) (while (and (nonzero? (-> s4-1 0)) (!= (-> s4-1 0) 34)) (set! s4-1 (&-> s4-1 1)) ) (copyn-string<-charp arg0 v1-3 (&- s4-1 (the-as uint v1-3))) ) (if (= (-> s4-1 0) 34) (set! s4-1 (&-> s4-1 1)) ) (let ((a1-3 (string-skip-whitespace s4-1))) (string-suck-up! arg1 a1-3) ) ) (return #t) ) ((nonzero? (-> s4-0 0)) (let ((v1-11 s4-0)) (while (and (nonzero? (-> s4-0 0)) (!= (-> s4-0 0) 32) (!= (-> s4-0 0) 9) (!= (-> s4-0 0) 13) (!= (-> s4-0 0) 10)) (set! s4-0 (&-> s4-0 1)) ) (copyn-string<-charp arg0 v1-11 (&- s4-0 (the-as uint v1-11))) ) (let ((a1-9 (string-skip-whitespace s4-0))) (string-suck-up! arg1 a1-9) ) (return #t) ) ) ) #f ) (defun string->int ((arg0 string)) "String to int. Supports binary, hex, and decimal. Negative is implemented for decimal and hex But I think it's broken?" (let ((a0-1 (-> arg0 data)) (v0-0 0) (v1-0 #f) ) (cond ((= (-> a0-1 0) 35) (let ((a0-2 (&-> a0-1 1))) (cond ((or (= (-> a0-2 0) 120) (= (-> a0-2 0) 88)) (let ((a0-3 (&-> a0-2 1))) (when (= (-> a0-3 1) 45) (set! v1-0 #t) (set! a0-3 (&-> a0-3 1)) ) (while (or (and (>= (-> a0-3 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-3 0))) (and (>= (-> a0-3 0) (the-as uint 65)) (>= (the-as uint 70) (-> a0-3 0))) (and (>= (-> a0-3 0) (the-as uint 97)) (>= (the-as uint 102) (-> a0-3 0))) ) (cond ((and (>= (-> a0-3 0) (the-as uint 65)) (>= (the-as uint 70) (-> a0-3 0))) (set! v0-0 (the-as int (+ (-> a0-3 0) -55 (* v0-0 16)))) ) ((and (>= (-> a0-3 0) (the-as uint 97)) (>= (the-as uint 102) (-> a0-3 0))) (set! v0-0 (the-as int (+ (-> a0-3 0) -87 (* v0-0 16)))) ) (else (set! v0-0 (the-as int (+ (-> a0-3 0) -48 (* v0-0 16)))) ) ) (set! a0-3 (&-> a0-3 1)) ) ) ) ((or (= (-> a0-2 0) 98) (= (-> a0-2 0) 66)) (let ((a0-4 (&-> a0-2 1))) (while (and (>= (-> a0-4 0) (the-as uint 48)) (>= (the-as uint 49) (-> a0-4 0))) (set! v0-0 (the-as int (+ (-> a0-4 0) -48 (* v0-0 2)))) (set! a0-4 (&-> a0-4 1)) ) ) ) ) ) ) (else (when (= (-> a0-1 1) 45) (set! v1-0 #t) (set! a0-1 (&-> a0-1 1)) ) (while (and (>= (-> a0-1 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-1 0))) (set! v0-0 (the-as int (+ (-> a0-1 0) -48 (* 10 v0-0)))) (set! a0-1 (&-> a0-1 1)) ) ) ) (cond (v1-0 (- v0-0) ) (else (empty) v0-0 ) ) ) ) (defun string->float ((arg0 string)) "They implemented it! This even supports exponential notation" (let ((a0-1 (-> arg0 data)) (f0-0 0.0) (v1-0 #f) ) (when (= (-> a0-1 0) 45) (set! v1-0 #t) (set! a0-1 (&-> a0-1 1)) ) (while (and (>= (-> a0-1 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-1 0))) (set! f0-0 (+ (* 10.0 f0-0) (the float (+ (-> a0-1 0) -48)))) (set! a0-1 (&-> a0-1 1)) ) (when (= (-> a0-1 0) 46) (set! a0-1 (&-> a0-1 1)) (let ((a2-4 #xf4240) (a1-12 0) ) (while (and (>= (-> a0-1 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-1 0))) (+! a1-12 (* (+ (-> a0-1 0) -48) (the-as uint a2-4))) (set! a2-4 (/ a2-4 10)) (set! a0-1 (&-> a0-1 1)) ) (+! f0-0 (* 0.0000001 (the float a1-12))) ) ) (when (= (-> a0-1 0) 101) (let ((a1-16 (&-> a0-1 1)) (f1-5 0.0) (a0-2 #f) ) (cond ((= (-> a1-16 0) 45) (set! a0-2 #t) (set! a1-16 (&-> a1-16 1)) ) ((= (-> a1-16 0) 43) (set! a1-16 (&-> a1-16 1)) ) ) (while (and (>= (-> a1-16 0) (the-as uint 48)) (>= (the-as uint 57) (-> a1-16 0))) (set! f1-5 (+ (* 10.0 f1-5) (the float (+ (-> a1-16 0) -48)))) (set! a1-16 (&-> a1-16 1)) ) (when (!= f1-5 0.0) (let ((f2-6 1.0)) (cond (a0-2 (dotimes (a0-3 (the int f1-5)) (set! f2-6 (* 0.1 f2-6)) (nop!) (nop!) ) ) (else (dotimes (a0-6 (the int f1-5)) (set! f2-6 (* 10.0 f2-6)) (nop!) (nop!) ) ) ) (set! f0-0 (* f0-0 f2-6)) ) ) ) ) (if v1-0 (- f0-0) f0-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)) "Get a float from a list of arguments." (cond ((string-get-arg!! *string-tmp-str* arg1) (set! (-> arg0 0) (string->float *string-tmp-str*)) #t ) (else #f ) ) ) (defun string-get-flag!! ((arg0 (pointer symbol)) (arg1 string) (arg2 string) (arg3 string)) "Get a flag argument (either arg2 or arg3) from a list of arugments." (cond ((string-get-arg!! *string-tmp-str* arg1) (cond ((or (string= *string-tmp-str* arg2) (string= *string-tmp-str* arg3)) (set! (-> arg0 0) (string= *string-tmp-str* arg2)) #t ) (else #f ) ) ) (else #f ) ) ) (kmemopen global "gstring-globals") (define *debug-draw-pauseable* #f) (define *stdcon0* (new 'global 'string #x4000 (the-as string #f))) (define *stdcon1* (new 'global 'string #x4000 (the-as string #f))) (define *stdcon* *stdcon0*) ;; up from 256 bytes in jak 1 (define *temp-string* (new 'global 'string 2048 (the-as string #f))) (define *pc-cpp-temp-string* "A convenient place to retrieve a string from C++" (new 'global 'string 2048 (the-as 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* ) ) (defmacro temp-string-format (buf &rest args) "Like [[string-format]], but takes a string as an argument." `(begin (format (clear ,buf) ,@args) ,buf ) ) (define *pc-encoded-temp-string* (new 'global 'string 2048 (the-as string #f))) (kmemclose)