src/lib_5_strings.4th

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