From 1aa4eb4976630fdb6882bb3aacb97aa09f69571e Mon Sep 17 00:00:00 2001 From: Phil Burk Date: Sun, 28 Nov 2021 19:19:49 -0700 Subject: [PATCH] add s\" (#105) This ANS word was missing. Use ANS reference implementation. Fixes #95 --- fth/loadp4th.fth | 1 + fth/slashqt.fth | 165 ++++++++++++++++++++++++++++++++++++++++++++++ fth/t_strings.fth | 26 ++++++++ 3 files changed, 192 insertions(+) create mode 100644 fth/slashqt.fth diff --git a/fth/loadp4th.fth b/fth/loadp4th.fth index bbb380e..e794c60 100644 --- a/fth/loadp4th.fth +++ b/fth/loadp4th.fth @@ -30,6 +30,7 @@ include? [if] condcomp.fth include? save-input save-input.fth include? read-line file.fth include? require require.fth +include? s\" slashqt.fth \ load floating point support if basic support is in kernel exists? F* diff --git a/fth/slashqt.fth b/fth/slashqt.fth new file mode 100644 index 0000000..7f25aca --- /dev/null +++ b/fth/slashqt.fth @@ -0,0 +1,165 @@ +\ S\" implementation for pForth +\ +\ Copied from ANS reference implementation at: +\ http://www.forth200x.org/escaped-strings.html +\ +\ The code was not modified except for the use of private{ }private +\ +\ Added November 2021 by Phil Burk + +ANEW TASK-SLASHQT.FTH + +private{ + +decimal + +: c+! \ c c-addr -- +\ *G Add character C to the contents of address C-ADDR. + tuck c@ + swap c! +; + +: addchar \ char string -- +\ *G Add the character to the end of the counted string. + tuck count + c! + 1 swap c+! +; + +: append \ c-addr u $dest -- +\ *G Add the string described by C-ADDR U to the counted string at +\ ** $DEST. The strings must not overlap. + >r + tuck r@ count + swap cmove \ add source to end + r> c+! \ add length to count +; + +: extract2H \ c-addr len -- c-addr' len' u +\ *G Extract a two-digit hex number in the given base from the +\ ** start of the string, returning the remaining string +\ ** and the converted number. + base @ >r hex + 0 0 2over drop 2 >number 2drop drop + >r 2 /string r> + r> base ! +; + +create EscapeTable \ -- addr +\ *G Table of translations for \a..\z. + 7 c, \ \a BEL (Alert) + 8 c, \ \b BS (Backspace) + char c c, \ \c + char d c, \ \d + 27 c, \ \e ESC (Escape) + 12 c, \ \f FF (Form feed) + char g c, \ \g + char h c, \ \h + char i c, \ \i + char j c, \ \j + char k c, \ \k + 10 c, \ \l LF (Line feed) + char m c, \ \m + 10 c, \ \n (Unices only) + char o c, \ \o + char p c, \ \p + char " c, \ \q " (Double quote) + 13 c, \ \r CR (Carriage Return) + char s c, \ \s + 9 c, \ \t HT (horizontal tab} + char u c, \ \u + 11 c, \ \v VT (vertical tab) + char w c, \ \w + char x c, \ \x + char y c, \ \y + 0 c, \ \z NUL (no character) + +create CRLF$ \ -- addr ; CR/LF as counted string + 2 c, 13 c, 10 c, + +: addEscape \ c-addr len dest -- c-addr' len' +\ *G Add an escape sequence to the counted string at dest, +\ ** returning the remaining string. + over 0= \ zero length check + if drop exit then + >r \ -- caddr len ; R: -- dest + over c@ [char] x = if \ hex number? + 1 /string extract2H r> addchar exit + then + over c@ [char] m = if \ CR/LF pair + 1 /string 13 r@ addchar 10 r> addchar exit + then + over c@ [char] n = if \ CR/LF pair? (Windows/DOS only) + 1 /string crlf$ count r> append exit + then + over c@ [char] a [char] z 1+ within if + over c@ [char] a - EscapeTable + c@ r> addchar + else + over c@ r> addchar + then + 1 /string +; + +: parse\" \ c-addr len dest -- c-addr' len' +\ *G Parses a string up to an unescaped '"', translating '\' +\ ** escapes to characters. The translated string is a +\ ** counted string at *\i{dest}. +\ ** The supported escapes (case sensitive) are: +\ *D \a BEL (alert) +\ *D \b BS (backspace) +\ *D \e ESC (not in C99) +\ *D \f FF (form feed) +\ *D \l LF (ASCII 10) +\ *D \m CR/LF pair - for HTML etc. +\ *D \n newline - CRLF for Windows/DOS, LF for Unices +\ *D \q double-quote +\ *D \r CR (ASCII 13) +\ *D \t HT (tab) +\ *D \v VT +\ *D \z NUL (ASCII 0) +\ *D \" double-quote +\ *D \xAB Two char Hex numerical character value +\ *D \\ backslash itself +\ *D \ before any other character represents that character + dup >r 0 swap c! \ zero destination + begin \ -- caddr len ; R: -- dest + dup + while + over c@ [char] " <> \ check for terminator + while + over c@ [char] \ = if \ deal with escapes + 1 /string r@ addEscape + else \ normal character + over c@ r@ addchar 1 /string + then + repeat then + dup \ step over terminating " + if 1 /string then + r> drop +; + +create pocket \ -- addr +\ *G A tempory buffer to hold processed string. +\ This would normally be an internal system buffer. + +s" /COUNTED-STRING" environment? 0= [if] 256 [then] +1 chars + allot + +: readEscaped \ "ccc" -- c-addr +\ *G Parses an escaped string from the input stream according to +\ ** the rules of *\fo{parse\"} above, returning the address +\ ** of the translated counted string in *\fo{POCKET}. + source >in @ /string tuck \ -- len caddr len + pocket parse\" nip + - >in +! + pocket +; + +}private + +: S\" \ "string" -- caddr u +\ *G As *\fo{S"}, but translates escaped characters using +\ ** *\fo{parse\"} above. + readEscaped count state @ + if postpone sliteral then +; IMMEDIATE + +privatize \ hide the internal words + diff --git a/fth/t_strings.fth b/fth/t_strings.fth index bd5e3e6..7f7b9cf 100644 --- a/fth/t_strings.fth +++ b/fth/t_strings.fth @@ -103,4 +103,30 @@ ALIGN T{ : T.SLITERAL.1 [ FAKE-STRING 5 ] SLITERAL ; T.SLITERAL.1 FAKE-STRING 5 COMPARE }T{ 0 }T +\ ----------------------------------------------------- S\" +HEX +T{ : GC5 S\" \a\b\e\f\l\m\q\r\t\v\x0F0\x1Fa\xaBx\z\"\\" ; }T{ }T +T{ GC5 SWAP DROP }T{ 14 }T \ String length +T{ GC5 DROP C@ }T{ 07 }T \ \a BEL Bell +T{ GC5 DROP 1 CHARS + C@ }T{ 08 }T \ \b BS Backspace +T{ GC5 DROP 2 CHARS + C@ }T{ 1B }T \ \e ESC Escape +T{ GC5 DROP 3 CHARS + C@ }T{ 0C }T \ \f FF Form feed +T{ GC5 DROP 4 CHARS + C@ }T{ 0A }T \ \l LF Line feed +T{ GC5 DROP 5 CHARS + C@ }T{ 0D }T \ \m CR of CR/LF pair +T{ GC5 DROP 6 CHARS + C@ }T{ 0A }T \ LF of CR/LF pair +T{ GC5 DROP 7 CHARS + C@ }T{ 22 }T \ \q " Double Quote +T{ GC5 DROP 8 CHARS + C@ }T{ 0D }T \ \r CR Carriage Return +T{ GC5 DROP 9 CHARS + C@ }T{ 09 }T \ \t TAB Horizontal Tab +T{ GC5 DROP A CHARS + C@ }T{ 0B }T \ \v VT Vertical Tab +T{ GC5 DROP B CHARS + C@ }T{ 0F }T \ \x0F Given Char +T{ GC5 DROP C CHARS + C@ }T{ 30 }T \ 0 0 Digit follow on +T{ GC5 DROP D CHARS + C@ }T{ 1F }T \ \x1F Given Char +T{ GC5 DROP E CHARS + C@ }T{ 61 }T \ a a Hex follow on +T{ GC5 DROP F CHARS + C@ }T{ AB }T \ \xaB Insensitive Given Char +T{ GC5 DROP 10 CHARS + C@ }T{ 78 }T \ x x Non hex follow on +T{ GC5 DROP 11 CHARS + C@ }T{ 00 }T \ \z NUL No Character +T{ GC5 DROP 12 CHARS + C@ }T{ 22 }T \ \" " Double Quote +T{ GC5 DROP 13 CHARS + C@ }T{ 5C }T \ \\ \ Back Slash +DECIMAL + }test -- 2.30.2