level1/39_c1s_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 C1S
   8 voc-set-active C1S
   9
  10 ;; terminate c1s with zero (but don't increment length)
  11 : zterm  ( addr -- )
  12   bcount + 0c!
  13 ;
  14
  15 ;; make sure that srccount fits into byte length
  16 : clamp-count  ( srccount destcount -- srccount-clamped )
  17   over +if
  18     0 max dup 255 < if
  19       over + dup 255 u> if 255 - - 0 max else drop endif
  20     else 2drop 0 endif
  21   else 2drop 0 endif
  22 ;
  23
  24 ;; copy c1s
  25 : copy  ( addrsrc addrdest -- )
  26   >r dup bcount-only 1+ r> swap cmove
  27 ;
  28
  29 ;; copy counted string to c1s
  30 : copy-counted  ( addrsrc count addrdest -- )
  31   swap 0 255 clamp swap
  32   2dup c!
  33   1+ swap cmove
  34 ;
  35
  36 ;; cat counted string to c1s
  37 : cat-counted  ( addr count addrdest -- )
  38   over +if
  39     dup >r bcount-only clamp-count
  40     r@ bcount + swap dup >r cmove
  41     r> r> +c!
  42   else 2drop drop endif
  43 ;
  44
  45 ;; cat c1s to another c1s
  46 : cat  ( addrsrc addrdest -- )
  47   swap bcount rot cat-counted
  48 ;
  49
  50 ;; append char to c1s
  51 : cat-char  ( char addr -- )
  52   dup bcount-only 255 < if
  53     dup >r bcount + c! r> 1+c!
  54   else 2drop endif
  55 ;
  56
  57 ;; append slash to c1s (but only if it doesn't end with slash, and is not empty)
  58 ;; useful for path manipulation
  59 : add-slash  ( addr -- )
  60   dup bcount-only 1 255 within if
  61     dup bcount + dup 1- c@ [char] / = ifnot [char] / swap c! 1+c! else 2drop endif
  62   else drop endif
  63 ;
  64
  65 : skip-aligned  ( addr -- nextaddr )  bcount + 3 + -4 and ;
  66 : skip-alignedz  ( addr -- nextaddr )  bcount + 4+ -4 and ;
  67
  68 voc-set-active FORTH