level1/38_c4s_str.f

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; UrForth level 1: self-hosting 32-bit Forth compiler
   3 ;; Copyright (C) 2020 Ketmar Dark // Invisible Vector
   4 ;; GPLv3 ONLY
   5 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   6
   7 vocabulary-nohash C4S
   8 voc-set-active C4S
   9
  10 ;; terminate c4s with zero (but don't increment length)
  11 : zterm  ( addr -- )
  12   count + 0c!
  13 ;
  14
  15 ;; copy c4s
  16 : copy  ( addrsrc addrdest -- )
  17   >r dup count-only cell+ r> swap 0 max cmove
  18 ;
  19
  20 ;; copy counted string to c4s
  21 : copy-counted  ( addrsrc count addrdest -- )
  22   swap 0 max swap 2dup !
  23   cell+ swap cmove
  24 ;
  25 alias copy-counted copy-a-c
  26
  27 ;; cat counted string to c4s
  28 : cat-counted  ( addr count addrdest -- )
  29   over +if
  30     dup >r count + swap dup >r 0 max cmove
  31     r> r> +!
  32   else 2drop drop endif
  33 ;
  34 alias cat-counted cat-a-c
  35
  36 ;; cat c4s to another c4s
  37 : cat  ( addrsrc addrdest -- )
  38   swap count rot cat-counted
  39 ;
  40
  41 ;; append char to c4s
  42 : cat-char  ( char addr -- )
  43   dup >r count + c! r> 1+!
  44 ;
  45
  46 ;; append slash to c4s (but only if it doesn't end with slash, and is not empty)
  47 ;; useful for path manipulation
  48 : add-slash  ( addr -- )
  49   dup count-only +if
  50     dup count + dup 1- c@ [char] / = ifnot [char] / swap c! 1+! else 2drop endif
  51   else drop endif
  52 ;
  53
  54 : skip-aligned  ( addr -- nextaddr )  count + 3 + -4 and ;
  55 : skip-alignedz  ( addr -- nextaddr )  count + 4+ -4 and ;
  56
  57 voc-set-active FORTH