src/lib_5_strings.4th

   1 \ Strings
   2
   3 : CMOVE ( src dest length -- )
   4
   5         DUP 0<= IF
   6                 EXIT
   7         THEN
   8
   9         -ROT OVER -         ( length src (dest-src) )
  10         -ROT DUP ROT + SWAP ( (dest-src) (src+length) src )
  11
  12         DO
  13                 I @         ( (dest-src) i@ )
  14                 OVER I +    ( (dest-src) i@ (dest-src+i) )
  15                 !           ( (dest-src) )
  16         LOOP
  17
  18         DROP
  19 ;
  20
  21 : S" IMMEDIATE          ( -- addr len )
  22         STATE @ IF      ( compiling? )
  23                 ['] LITSTRING ,   ( compile LITSTRING )
  24                 HERE          ( save the address of the length word on the stack )
  25                 0 ,             ( dummy length - we don't know what it is yet )
  26
  27                 BEGIN
  28                         >IN @ #TIB @ >= IF      \ End of TIB?
  29                                 QUERY           \ Get next line
  30                         THEN
  31
  32                         TIB >IN @ + @ 1 >IN +!  \ Get char from TIB
  33
  34                         DUP [CHAR] " <>
  35                 WHILE
  36                         C,              ( copy character )
  37                 REPEAT
  38                 DROP            ( drop the double quote character at the end )
  39                 DUP             ( get the saved address of the length word )
  40                 HERE SWAP -   ( calculate the length )
  41                 1-              ( subtract 1 (because we measured from the start of the length word) )
  42                 SWAP !          ( and back-fill the length location )
  43         ELSE            ( immediate mode )
  44                 HERE          ( get the start address of the temporary space )
  45
  46                 BEGIN
  47                         >IN @ #TIB @ >= IF      \ End of TIB?
  48                                 QUERY           \ Get next line
  49                         THEN
  50
  51                         TIB >IN @ + @ 1 >IN +!  \ Get char from TIB
  52
  53                         DUP [CHAR] " <>
  54                 WHILE
  55                         OVER C!         ( save next character )
  56                         1+              ( increment address )
  57                 REPEAT
  58                 DROP            ( drop the final " character )
  59                 HERE -        ( calculate the length )
  60                 HERE          ( push the start address )
  61                 SWAP            ( addr len )
  62         THEN
  63 ;
  64
  65 : ." IMMEDIATE          ( -- )
  66         [COMPILE] S"    ( read the string, and compile LITSTRING, etc. )
  67         ['] TYPE ,      ( compile the final TYPE )
  68 ;
  69
  70 : .(
  71         BEGIN
  72                 >IN @ #TIB @ >= IF      \ End of TIB?
  73                         QUERY           \ Get next line
  74                 THEN
  75
  76                 TIB >IN @ + @ 1 >IN +!  \ Get char from TIB
  77
  78                 DUP [CHAR] ) = IF
  79                         DROP    ( drop the double quote character )
  80                         EXIT    ( return from this function )
  81                 THEN
  82                 EMIT
  83         AGAIN
  84 ;
  85
  86 ( Converts address of counted string into address of
  87   start of string and length of string. )
  88 : COUNT ( addr1 -- addr2 n )
  89         DUP 1+ SWAP @ ;
  90
  91