home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / FORTHCMP.ZIP / STRINGS2.4TH < prev    next >
Encoding:
Text File  |  1992-03-30  |  3.5 KB  |  106 lines
  1. \ STRING SUPPORT LIBRARY PART  2
  2. \ Contents Copyright (C) 1986 by Thomas Almy
  3.  
  4. \ Permission is granted to registered users of ForthCMP to sell or distribute
  5. \ computer programs incorporating the compiled contents of this file.
  6.  
  7. \ Load this before FORTHLIB
  8.  
  9. .( Loading STRINGS ) CR
  10. 10 DECIMAL DSEG
  11.  
  12. U: STRXTR >R  DUP >R - 0 MAX SWAP R> + SWAP R> MIN ;
  13. U: STRCPY OVER C@ 1+ CMOVE ;
  14. U: ASCIIZ COUNT DUP >R 1+ +STRBUF
  15.     STRBUF R@ CMOVE 0 STRBUF R> + C! STRBUF ;
  16. U: -ASCIIZ DUP 255 0 SCAN DROP OVER - DUP 1+ +STRBUF
  17.     DUP STRBUF C! STRBUF 1+ SWAP CMOVE STRBUF ;
  18. U: -EXT COUNT 2DUP -PATH 
  19.    ASCII . SCAN  0= IF DROP ELSE NIP OVER - THEN
  20.    STRPCK ;
  21. U: +EXT  OVER COUNT -PATH
  22.     ASCII . SCAN  0<> IF 2DROP EXIT THEN
  23.     DROP SWAP COUNT ROT COUNT STRCAT STRPCK ;
  24. U: -PATH BEGIN 2DUP  ASCII \ SCAN DUP WHILE  
  25.     2SWAP 2DROP   ASCII \ SKIP REPEAT 2DROP ;
  26. U: STRCMP >R >R ?DS: -ROT ?DS: R> R> STRCMPL ;
  27. U: STRCMPL 
  28.    >R ROT R@ OVER >R MIN cmpl ?DUP IF R> DROP R> DROP EXIT THEN
  29.    R> R> 2DUP > IF 2DROP 1 EXIT THEN
  30.    < ;
  31. SEPDSEG? #IF
  32. : argc 1 128 STR>DSEG COUNT 
  33.        BEGIN BL SKIP DUP WHILE BL SCAN ROT 1+ -ROT REPEAT 2DROP ;
  34. #ELSE
  35. : argc 1 128 COUNT BEGIN BL SKIP DUP WHILE BL SCAN ROT 1+ -ROT REPEAT 2DROP ;
  36. #THEN
  37.  
  38. ?DEFINE argv #IF
  39. VARIABLE argvM 1 argvM ! \ constant value
  40. SEPDSEG? #IF
  41. : argv DUP 1 < IF DROP 44 CS: @ DUP 0 1024 ?DS: argvM 2 STRNDXL
  42.          DUP 0< IF 2DROP 0 0 STRPCK EXIT THEN
  43.          2+ -ASCIIZL EXIT THEN
  44.     128 STR>DSEG 
  45.     COUNT BL SKIP ROT 1- 0 ?DO BL SCAN BL SKIP LOOP
  46.     2DUP BL SCAN DROP NIP OVER - STRPCK ;
  47. #ELSE
  48. : argv DUP 1 < IF DROP 44 @ DUP 0 1024 ?DS: argvM 2 STRNDXL
  49.          DUP 0< IF 2DROP 0 0 STRPCK EXIT THEN
  50.          2+ -ASCIIZL EXIT THEN
  51.     128 COUNT BL SKIP ROT 1- 0 ?DO BL SCAN BL SKIP LOOP
  52.     2DUP BL SCAN DROP NIP OVER - STRPCK ;
  53. #THEN #THEN
  54. SEPDSEG? #IF
  55. : getenv 
  56.    COUNT " ="  STR>DSEG COUNT STRCAT STRPCK >R
  57.    44 CS: @ 0 BEGIN  2DUP C@L WHILE
  58.     2DUP ?DS: R@ COUNT cmpl 0= IF R> COUNT NIP + -ASCIIZL EXIT THEN
  59.     BEGIN 1+ 2DUP C@L 0= UNTIL 1+ REPEAT 
  60.    R> DROP 2DROP 0 0 STRPCK ;
  61. #ELSE
  62. : getenv 
  63.    COUNT " =" COUNT STRCAT STRPCK >R
  64.    44 @ 0 BEGIN  2DUP C@L WHILE
  65.     2DUP ?DS: R@ COUNT cmpl 0= IF R> COUNT NIP + -ASCIIZL EXIT THEN
  66.     BEGIN 1+ 2DUP C@L 0= UNTIL 1+ REPEAT 
  67.    R> DROP 2DROP 0 0 STRPCK ;
  68. #THEN
  69. U: STRCAT DUP  3 PICK + DUP >R +STRBUF
  70.     2 PICK  STRBUF + SWAP CMOVE
  71.     STRBUF SWAP CMOVE STRBUF R> ;
  72. U: STRPCK DUP >R 1+ +STRBUF  STRBUF 1+ R@ CMOVE R> STRBUF C! STRBUF ;
  73. U: -ASCIIZL
  74.     2DUP BEGIN 2DUP C@L WHILE 1+ REPEAT
  75.     NIP OVER - DUP >R 1+ +STRBUF
  76.     ?DS: STRBUF 1+ R@ CMOVEL R> STRBUF C! STRBUF ;
  77. SEPDSEG? #IF
  78. U: STR>DSEG 
  79.    DUP CS: C@ 1+ DUP >R +STRBUF
  80.    ?CS: SWAP  ?DS: STRBUF R> CMOVEL STRBUF ;     #ELSE
  81. U: STR>DSEG  ( DUMMY ) ;
  82. #THEN
  83. U: +STRBUF DUP strend + strbufr  StringSize + U> IF
  84.       strbufr +  EQU strend  strbufr @ EQU STRBUF
  85.     ELSE 
  86.       strend DUP EQU STRBUF + EQU strend THEN ;
  87. ?DEFINE STRNDX ?DEFINE STRNDXL OR #IF
  88. VARIABLE strndX 4 ALLOT #THEN
  89. U: STRNDX TUCK strndX 2!  
  90.    - DUP 0< IF 2DROP -1 EXIT THEN
  91.    -1 -ROT ( save answer )
  92.    1+ 0 DO ?DS: OVER ?DS: strndX 2@ cmpl 0= IF DROP I SWAP LEAVE THEN 1+ LOOP
  93.    DROP ;
  94. U: STRNDXL
  95.     strndX ! strndX 2+ 2!
  96.     strndX @ - DUP 0< IF 2DROP DROP -1 EXIT THEN
  97.     >R -1 -ROT R>
  98.     1+ 0 DO 2DUP strndX 2+ 2@ strndX @ cmpl 0= IF DROP I -ROT LEAVE THEN 1+ LOOP
  99.    2DROP ;
  100. UNDEF cmpl
  101. CODE cmpl
  102.   BX POP DX DS <SEG CX POP DI POP ES POPSEG SI POP DS POPSEG
  103.   REPZ BYTE CMPS DX DS >SEG 0 # AX MOV =0 ~ IF,  <0 IF,
  104.    AX DEC ELSE, AX INC THEN, THEN, AX PUSH BX JMP END-CODE #THEN
  105. 16 = #IF HEX #THEN
  106.