PageRenderTime 24ms CodeModel.GetById 28ms RepoModel.GetById 0ms app.codeStats 0ms

/fth/t_strings.fth

https://github.com/cataska/pforth
Forth | 106 lines | 88 code | 18 blank | 0 comment | 0 complexity | 387983f627f77d85470ab4c34835878d MD5 | raw file
    

  1. \ @(#) t_strings.fth 97/12/10 1.1

    2. 

  2. \ Test ANS Forth String Word Set

    3. 

  3. \

    4. 

  4. \ Copyright 1994 3DO, Phil Burk

    5. 

  5. 

    6. 

  6. include? }T{  t_tools.fth

    7. 

  7. 

    8. 

  8. marker task-t_string.fth

    9. 

  9. 

    10. 

  10. decimal

    11. 

  11. 

    12. 

  12. test{

    13. 

  13. 

    14. 

  14. echo off

    15. 

  15. 

    16. 

  16. \ ==========================================================

    17. 

  17. \ test is.ok?

    18. 

  18. T{ 1 2 3 }T{ 1 2 3 }T

    19. 

  19. 

    20. 

  20. : STR1  S" Hello    " ;

    21. 

  21. : STR2  S" Hello World" ;

    22. 

  22. : STR3  S" " ;

    23. 

  23. 

    24. 

  24. \  ----------------------------------------------------- -TRAILING

    25. 

  25. T{ STR1 -TRAILING }T{ STR1 DROP 5 }T

    26. 

  26. T{ STR2 -TRAILING }T{ STR2 }T

    27. 

  27. T{ STR3 -TRAILING }T{ STR3 }T

    28. 

  28. 

    29. 

  29. \  ----------------------------------------------------- /STRING

    30. 

  30. T{ STR2  6  /STRING  }T{ STR2 DROP 6 CHARS +   STR2 NIP 6 -  }T

    31. 

  31. 

    32. 

  32. 

    33. 

  33. \  ----------------------------------------------------- BLANK

    34. 

  34. : T.COMMA.SEQ  ( n -- , lay down N sequential bytes )

    35. 

  35. 	0 ?DO I C, LOOP

    36. 

  36. ;

    37. 

  37. CREATE T-BLANK-DATA   64 T.COMMA.SEQ

    38. 

  38. T{ T-BLANK-DATA 8 + C@ }T{ 8 }T

    39. 

  39. T-BLANK-DATA 7 + 3 BLANK

    40. 

  40. T{ T-BLANK-DATA 6 + C@ }T{ 6 }T

    41. 

  41. T{ T-BLANK-DATA 7 + C@ }T{ BL }T

    42. 

  42. T{ T-BLANK-DATA 8 + C@ }T{ BL }T

    43. 

  43. T{ T-BLANK-DATA 9 + C@ }T{ BL }T

    44. 

  44. T{ T-BLANK-DATA 10 + C@ }T{ 10 }T

    45. 

  45. FORGET T.COMMA.SEQ

    46. 

  46. 

    47. 

  47. \  ----------------------------------------------------- CMOVE

    48. 

  48. : T.COMMA.SEQ  ( n -- , lay down N sequential bytes )

    49. 

  49. 	0 ?DO I C, LOOP

    50. 

  50. ;

    51. 

  51. CREATE T-BLANK-DATA   64 T.COMMA.SEQ

    52. 

  52. T-BLANK-DATA 7 + T-BLANK-DATA 6 + 3 CMOVE

    53. 

  53. T{ T-BLANK-DATA 5 + C@ }T{ 5 }T

    54. 

  54. T{ T-BLANK-DATA 6 + C@ }T{ 7 }T

    55. 

  55. T{ T-BLANK-DATA 7 + C@ }T{ 8 }T

    56. 

  56. T{ T-BLANK-DATA 8 + C@ }T{ 9 }T

    57. 

  57. T{ T-BLANK-DATA 9 + C@ }T{ 9 }T

    58. 

  58. FORGET T.COMMA.SEQ

    59. 

  59. 

    60. 

  60. \  ----------------------------------------------------- CMOVE>

    61. 

  61. : T.COMMA.SEQ  ( n -- , lay down N sequential bytes )

    62. 

  62. 	0 ?DO I C, LOOP

    63. 

  63. ;

    64. 

  64. CREATE T-BLANK-DATA   64 T.COMMA.SEQ

    65. 

  65. T{ T-BLANK-DATA 6 + T-BLANK-DATA 7 + 3 CMOVE>

    66. 

  66. T{ T-BLANK-DATA 5 + C@ }T{ 5 }T

    67. 

  67. T{ T-BLANK-DATA 6 + C@ }T{ 6 }T

    68. 

  68. T{ T-BLANK-DATA 7 + C@ }T{ 6 }T

    69. 

  69. T{ T-BLANK-DATA 8 + C@ }T{ 7 }T

    70. 

  70. T{ T-BLANK-DATA 9 + C@ }T{ 8 }T

    71. 

  71. T{ T-BLANK-DATA 10 + C@ }T{ 10 }T

    72. 

  72. FORGET T.COMMA.SEQ

    73. 

  73. 

    74. 

  74. \  ----------------------------------------------------- COMPARE

    75. 

  75. T{ : T.COMPARE.1 S" abcd" S" abcd"    compare ; t.compare.1 }T{   0 }T

    76. 

  76. T{ : T.COMPARE.2 S" abcd" S" abcde"   compare ; t.compare.2 }T{  -1 }T

    77. 

  77. T{ : T.COMPARE.3 S" abcdef" S" abcde" compare ; t.compare.3 }T{   1 }T

    78. 

  78. T{ : T.COMPARE.4 S" abGd" S" abcde"   compare ; t.compare.4 }T{  -1 }T

    79. 

  79. T{ : T.COMPARE.5 S" abcd" S" aXcde"   compare ; t.compare.5 }T{   1 }T

    80. 

  80. T{ : T.COMPARE.6 S" abGd" S" abcd"    compare ; t.compare.6 }T{  -1 }T

    81. 

  81. T{ : T.COMPARE.7 S" World" S" World"  compare ; t.compare.7 }T{   0 }T

    82. 

  82. FORGET T.COMPARE.1

    83. 

  83. 

    84. 

  84. \  ----------------------------------------------------- SEARCH

    85. 

  85. : STR-SEARCH S" ABCDefghIJKL" ;

    86. 

  86. T{ : T.SEARCH.1 STR-SEARCH S" ABCD" SEARCH ; T.SEARCH.1 }T{ STR-SEARCH TRUE }T

    87. 

  87. T{ : T.SEARCH.2 STR-SEARCH S" efg"  SEARCH ; T.SEARCH.2 }T{

    88. 

  88. 	 STR-SEARCH 4 - SWAP 4 CHARS + SWAP TRUE }T

    89. 

  89. T{ : T.SEARCH.3 STR-SEARCH S" IJKL" SEARCH ; T.SEARCH.3 }T{

    90. 

  90. 	 STR-SEARCH DROP 8 CHARS + 4 TRUE }T

    91. 

  91. T{ : T.SEARCH.4 STR-SEARCH STR-SEARCH SEARCH ; T.SEARCH.4 }T{

    92. 

  92. 	 STR-SEARCH  TRUE }T

    93. 

  93. 

    94. 

  94. T{ : T.SEARCH.5 STR-SEARCH S" CDex" SEARCH ; T.SEARCH.5 }T{

    95. 

  95. 	 STR-SEARCH  FALSE }T

    96. 

  96. T{ : T.SEARCH.6 STR-SEARCH S" KLM" SEARCH ; T.SEARCH.6 }T{

    97. 

  97. 	 STR-SEARCH  FALSE }T

    98. 

  98. FORGET STR-SEARCH

    99. 

  99. 

    100. 

  100. \  ----------------------------------------------------- SLITERAL

    101. 

  101. CREATE FAKE-STRING  CHAR H C,   CHAR e C,  CHAR l C, CHAR l C, CHAR o C, 

    102. 

  102. ALIGN

    103. 

  103. T{ : T.SLITERAL.1  [ FAKE-STRING 5 ] SLITERAL ; T.SLITERAL.1   FAKE-STRING 5 COMPARE

    104. 

  104. 	 }T{ 0 }T

    105. 

  105. 	

    106. 

  106. }test

    107. 

  107.