;;-*-Lisp-*- (in-package goal) ;; definition for method 4 of type string (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))) ) ) ;; definition for method 5 of type string (defmethod asize-of ((this string)) (+ (-> this allocated-length) 1 (-> string size)) ) ;; definition for function copy-string<-string (defun copy-string<-string ((arg0 string) (arg1 string)) (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 ) ;; definition for method 0 of type string (defmethod new string ((allocation symbol) (type-to-make type) (arg0 int) (arg1 string)) (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 ) ) ) ) ;; definition for function string= (defun string= ((str-a string) (str-b string)) (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)) ) (and (zero? (-> a-ptr 0)) (zero? (-> b-ptr 0))) ) ) ;; definition for function string-charp= (defun string-charp= ((str string) (charp (pointer uint8))) (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))) ) ) ;; definition for function name= (defun name= ((arg0 basic) (arg1 basic)) (cond ((= arg0 arg1) #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 (the-as symbol arg1))) ) ((and (= (-> arg1 type) string) (= (-> arg0 type) symbol)) (string= (the-as string arg1) (symbol->string (the-as symbol arg0))) ) ) ) ;; definition for function copyn-string<-charp (defun copyn-string<-charp ((str string) (charp (pointer uint8)) (len int)) (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 ) ;; definition for function string<-charp (defun string<-charp ((str string) (charp (pointer uint8))) (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 ) ;; definition for function charp<-string (defun charp<-string ((charp (pointer uint8)) (str string)) (let ((str-ptr (-> str data))) (while (nonzero? (-> str-ptr 0)) (set! (-> charp 0) (-> str-ptr 0)) (set! charp (&-> charp 1)) (set! str-ptr (&-> str-ptr 1)) ) ) (set! (-> charp 0) (the-as uint 0)) 0 ) ;; definition for function copy-charp<-charp (defun copy-charp<-charp ((dst (pointer uint8)) (src (pointer uint8))) (while (nonzero? (-> src 0)) (set! (-> dst 0) (-> src 0)) (set! dst (&-> dst 1)) (set! src (&-> src 1)) ) (set! (-> dst 0) (the-as uint 0)) dst ) ;; definition for function cat-string<-string (defun cat-string<-string ((a string) (b string)) (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 ) ;; definition for function catn-string<-charp (defun catn-string<-charp ((a string) (b (pointer uint8)) (len int)) (let ((a-ptr (-> a data))) (while (nonzero? (-> a-ptr 0)) (nop!) (nop!) (nop!) (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 ) ;; definition for function cat-string<-string_to_charp (defun cat-string<-string_to_charp ((a string) (b string) (end-ptr (pointer uint8))) (let ((b-ptr (-> b data)) (a-ptr (-> a data)) ) (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) (the-as uint 0)) a-ptr ) ) ;; definition for function append-character-to-string (defun append-character-to-string ((str string) (char uint8)) (let ((str-ptr (-> str data))) (while (nonzero? (-> str-ptr 0)) (nop!) (nop!) (nop!) (set! str-ptr (&-> str-ptr 1)) ) (set! (-> str-ptr 0) (the-as uint char)) (set! (-> str-ptr 1) (the-as uint 0)) ) 0 0 ) ;; definition for function charp-basename (defun charp-basename ((charp (pointer uint8))) (let ((ptr charp)) (while (nonzero? (-> ptr 0)) (set! ptr (&-> ptr 1)) ) (while (< (the-as int charp) (the-as int ptr)) (set! ptr (&-> ptr -1)) (if (or (= (-> ptr 0) 47) (= (-> ptr 0) 92)) (return (&-> ptr 1)) ) ) ) charp ) ;; definition for function clear (defun clear ((arg0 string)) (set! (-> arg0 data 0) (the-as uint 0)) arg0 ) ;; definition for function string a data i) (-> b data i)) (return #t) ) ((< (-> b data i) (-> a data i)) (return #f) ) ) ) ) #f ) ;; definition for function string>? (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) ) ) ) ) #f ) ;; definition for function string<=? (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 ) ;; definition for function string>=? (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 ) ;; definition for symbol *string-tmp-str*, type string (define *string-tmp-str* (new 'global 'string 128 (the-as string #f))) ;; definition for function string-skip-to-char (defun string-skip-to-char ((arg0 (pointer uint8)) (arg1 uint)) (while (and (nonzero? (-> arg0 0)) (!= (-> arg0 0) arg1)) (set! arg0 (&-> arg0 1)) ) arg0 ) ;; definition for function string-cat-to-last-char (defun string-cat-to-last-char ((base-str string) (append-str string) (char uint)) (let ((end-of-append (&-> (the-as (pointer uint8) append-str) 3))) (let ((location-of-char (string-skip-to-char (-> append-str data) char))) (when (= (-> location-of-char 0) char) (until (!= (-> location-of-char 0) char) (set! end-of-append location-of-char) (set! location-of-char (string-skip-to-char (&-> location-of-char 1) char)) ) ) ) (cat-string<-string_to_charp base-str append-str end-of-append) ) ) ;; definition for function string-skip-whitespace (defun string-skip-whitespace ((arg0 (pointer uint8))) (while (and (nonzero? (-> arg0 0)) (or (= (-> arg0 0) 32) (= (-> arg0 0) 9) (= (-> arg0 0) 13) (= (-> arg0 0) 10))) (set! arg0 (&-> arg0 1)) ) arg0 ) ;; definition for function string-suck-up! (defun string-suck-up! ((str string) (location (pointer uint8))) (when (!= location (-> str data)) (let ((str-ptr (-> str data))) (while (nonzero? (-> location 0)) (set! (-> str-ptr 0) (-> location 0)) (set! str-ptr (&-> str-ptr 1)) (set! location (&-> location 1)) ) (set! (-> str-ptr 0) (the-as uint 0)) ) 0 ) #f ) ;; definition for function string-strip-leading-whitespace! (defun string-strip-leading-whitespace! ((arg0 string)) (let ((a1-0 (string-skip-whitespace (-> arg0 data)))) (string-suck-up! arg0 a1-0) ) #f ) ;; definition for function string-strip-trailing-whitespace! (defun string-strip-trailing-whitespace! ((str string)) (when (nonzero? (length str)) (let ((ptr (&+ (-> str data) (+ (length str) -1)))) (while (and (>= (the-as int ptr) (the-as int (-> str data))) (or (= (-> ptr 0) 32) (= (-> ptr 0) 9) (= (-> ptr 0) 13) (= (-> ptr 0) 10)) ) (set! ptr (&-> ptr -1)) ) (set! (-> ptr 1) (the-as uint 0)) ) 0 ) #f ) ;; definition for function string-strip-whitespace! (defun string-strip-whitespace! ((arg0 string)) (string-strip-trailing-whitespace! arg0) (string-strip-leading-whitespace! arg0) #f ) ;; definition for function string-get-arg!! (defun string-get-arg!! ((a-str string) (arg string)) (let ((arg-word-start (string-skip-whitespace (-> arg data)))) (cond ((= (-> arg-word-start 0) 34) (let ((arg-end (&-> arg-word-start 1))) (let ((arg-start arg-end)) (while (and (nonzero? (-> arg-end 0)) (!= (-> arg-end 0) 34)) (set! arg-end (&-> arg-end 1)) ) (copyn-string<-charp a-str arg-start (&- arg-end (the-as uint arg-start))) ) (if (= (-> arg-end 0) 34) (set! arg-end (&-> arg-end 1)) ) (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)) (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 ) ;; definition for function string->int (defun string->int ((str string)) (let ((str-ptr (-> str data)) (result 0) (negate #f) ) (cond ((= (-> str-ptr 0) 35) (let ((next-char-1 (&-> str-ptr 1))) (cond ((or (= (-> next-char-1 0) 120) (= (-> next-char-1 0) 88)) (let ((next-char-2 (&-> next-char-1 1))) (when (= (-> next-char-2 1) 45) (set! negate #t) (set! next-char-2 (&-> next-char-2 1)) ) (while (or (and (>= (-> next-char-2 0) (the-as uint 48)) (>= (the-as uint 57) (-> next-char-2 0))) (and (>= (-> next-char-2 0) (the-as uint 65)) (>= (the-as uint 70) (-> next-char-2 0))) (and (>= (-> next-char-2 0) (the-as uint 97)) (>= (the-as uint 102) (-> next-char-2 0))) ) (cond ((and (>= (-> next-char-2 0) (the-as uint 65)) (>= (the-as uint 70) (-> next-char-2 0))) (set! result (the-as int (+ (-> next-char-2 0) -55 (* result 16)))) ) ((and (>= (-> next-char-2 0) (the-as uint 97)) (>= (the-as uint 102) (-> next-char-2 0))) (set! result (the-as int (+ (-> next-char-2 0) -87 (* result 16)))) ) (else (set! result (the-as int (+ (-> next-char-2 0) -48 (* result 16)))) ) ) (set! next-char-2 (&-> next-char-2 1)) ) ) ) ((or (= (-> next-char-1 0) 98) (= (-> next-char-1 0) 66)) (let ((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-as int (+ (-> a0-4 0) -48 (* result 2)))) (set! a0-4 (&-> a0-4 1)) ) ) ) ) ) ) (else (when (= (-> str-ptr 1) 45) (set! negate #t) (set! str-ptr (&-> str-ptr 1)) ) (while (and (>= (-> str-ptr 0) (the-as uint 48)) (>= (the-as uint 57) (-> str-ptr 0))) (set! result (the-as int (+ (-> str-ptr 0) -48 (* 10 result)))) (set! str-ptr (&-> str-ptr 1)) ) ) ) (cond (negate (- result) ) (else (empty) result ) ) ) ) ;; definition for function string->float (defun string->float ((arg0 string)) (format 0 "string->float left as an excersize for the reader~%") 0.0 ) ;; definition for function string-get-int32!! (defun string-get-int32!! ((arg0 (pointer int32)) (arg1 string)) (cond ((string-get-arg!! *string-tmp-str* arg1) (set! (-> arg0 0) (string->int *string-tmp-str*)) #t ) (else #f ) ) ) ;; definition for function string-get-float!! (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 ) ) ) ;; definition for function string-get-flag!! (defun string-get-flag!! ((result (pointer symbol)) (in string) (first-flag string) (second-flag string)) (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 ) ) ) ;; definition for symbol *debug-draw-pauseable*, type symbol (define *debug-draw-pauseable* #f) ;; definition for symbol *stdcon0*, type string (define *stdcon0* (new 'global 'string #x4000 (the-as string #f))) ;; definition for symbol *stdcon1*, type string (define *stdcon1* (new 'global 'string #x4000 (the-as string #f))) ;; definition for symbol *stdcon*, type string (define *stdcon* *stdcon0*) ;; definition for symbol *temp-string*, type string (define *temp-string* (new 'global 'string 256 (the-as string #f)))