diff --git a/doc/standard.md b/doc/standard.md index 9e5d102..ea5c969 100644 --- a/doc/standard.md +++ b/doc/standard.md @@ -1287,7 +1287,7 @@ System clock time in seconds from the epoch. Empty the data stack. - - - -#### dropn +#### ndrop ( i*x n*x n -- i*x ) Drop the top `n` data stack elements. diff --git a/src/post4.c b/src/post4.c index 439aa6f..3dc30aa 100755 --- a/src/post4.c +++ b/src/post4.c @@ -2592,7 +2592,8 @@ p4EvalString(P4_Ctx *ctx, const char *str, size_t len) input->length = len; input->offset = 0; input->blk = 0; - input->path = "data:"; + /* RFC 2397 "data:," equals "data:text/plain;charset=US-ASCII," */ + input->path = "data:,"; rc = p4Repl(ctx, P4_THROW_OK); P4_INPUT_POP(ctx->input); return rc; diff --git a/src/post4.p4 b/src/post4.p4 index 14fadb0..a857903 100644 --- a/src/post4.p4 +++ b/src/post4.p4 @@ -334,10 +334,10 @@ END-STRUCTURE : R@ R> R> DUP >R SWAP >R ; $1101 _pp! \ (S: xn ... x1 n -- ) -: dropn CELLS dsp@ SWAP - CELL- dsp! ; $10 _pp! +: ndrop CELLS dsp@ SWAP - CELL- dsp! ; $10 _pp! \ ( i*x -- ) -: dropall DEPTH dropn ; +: dropall DEPTH ndrop ; \ (S: -- ) : DECIMAL #10 BASE ! ; @@ -488,22 +488,18 @@ MAX-U MAX-N 2CONSTANT MAX-D $02 _pp! \ (S: nu1 nu2 -- flag ) : = - 0= ; $21 _pp! - -\ (S: nu1 nu2 -- flag ) : <> = 0= ; $21 _pp! \ (S: n1 n2 -- flag ) : > SWAP < ; $21 _pp! - -\ (S: n1 n2 -- flag ) -: U> SWAP U< ; $21 _pp! - -\ (S: n1 n2 -- flag ) : <= > 0= ; $21 _pp! - -\ (S: n1 n2 -- flag ) : >= < 0= ; $21 _pp! +\ (S: u1 u2 -- flag ) +: U> SWAP U< ; $21 _pp! +: U<= U> 0= ; $21 _pp! +: U>= U< 0= ; $21 _pp! + \ ... WITHIN ... \ \ (S: nu1 nu2 nu3 -- flag ) @@ -915,6 +911,8 @@ MAX-U MAX-N 2CONSTANT MAX-D $02 _pp! \ (S: caddr -- caddr' x ) : C@+ DUP CHAR+ SWAP C@ ; $12 _pp! +: C@- DUP CHAR- SWAP C@ ; $12 _pp! +: C-@ CHAR- DUP C@ ; $12 _pp! \ (S: x addr -- addr' ) : !+ DUP CELL+ -rot ! ; $21 _pp! @@ -1115,16 +1113,30 @@ MAX-U MAX-N 2CONSTANT MAX-D $02 _pp! : isalpha toupper 'A' [ 'Z' 1+ ] LITERAL WITHIN ; $11 _pp! : isalnum DUP isalpha isdigit OR ; $11 _pp! -\ (S: caddr u delim -- caddr | 0 ) +\ (S: caddr u delim -- caddr' u' ) +\ Find first occurence of delim. : strchr - >R bounds \ S: c" c R: d - BEGIN - 2DUP U> DUP C@ R@ <> AND \ S: c" c R: d - WHILE \ S: c" c R: d - 1 CHARS + \ S: c" c' R: d - REPEAT - rdrop \ S: c" c - TUCK = IF DUP - THEN \ S: c | 0 + >R CHARS bounds + BEGIN 2DUP U> WHILE C@+ R@ = UNTIL + \ Found. Return trailing string. + CHAR- TUCK - + ELSE + \ Nothing found. + drop 0 + THEN rdrop +; $31 _pp! + +\ (S: caddr u delim -- caddr' u' ) +\ Find last occurence of delim. +: strrchr + >R STOW CHARS OVER + + BEGIN 2DUP U<= WHILE C-@ R@ = UNTIL + \ Found. Return leading string. + CHAR+ SWAP - + ELSE + \ Nothing found. + 2DROP 0 + THEN rdrop ; $31 _pp! \ ( caddr u -- ) @@ -1489,6 +1501,9 @@ VARIABLE _pic_off \ Copy and NUL terminate string. : strncpy 2DUP CHARS + >R MOVE 0 R> C! ; +\ (S: sd.0 -- sd.1 ) +: strndup DUP 1+ ALLOCATE THROW SWAP 2DUP 2>R strncpy 2R> ; $22 _pp! + \ Maximum for octet addressable units. MAX-CHAR CONSTANT /COUNTED-STRING @@ -2012,9 +2027,6 @@ VARIABLE SCR ! \ S: -- ; $30 _pp! -\ (S: sd.0 -- sd.1 ) -: strndup DUP 1+ ALLOCATE THROW SWAP 2DUP 2>R strncpy 2R> ; $22 _pp! - \ (S: -- sd.path ) file-path source-base-path diff --git a/test/string.p4 b/test/string.p4 index 5649196..ea86a02 100644 --- a/test/string.p4 +++ b/test/string.p4 @@ -87,6 +87,26 @@ T{ tw_str_2 tw_str_3 COMPARE -> 1 }T T{ tw_str_3 tw_str_2 COMPARE -> -1 }T test_group_end +.( strchr strrchr ) test_group +: tw_empty S" " ; +: tw_no_delim S" foobar" ; +: tw_leading_delim S" /foo/bar" ; +: tw_middle_delim S" foo/bar" ; +: tw_trailing_delim S" foo/bar/" ; + +t{ tw_empty '/' strchr tw_empty COMPARE -> 0 }t +t{ tw_no_delim '/' strchr tw_empty COMPARE -> 0 }t +t{ tw_leading_delim '/' strchr tw_leading_delim COMPARE -> 0 }t +t{ tw_middle_delim '/' strchr S" /bar" COMPARE -> 0 }t +t{ tw_trailing_delim '/' strchr S" /bar/" COMPARE -> 0 }t + +t{ tw_empty '/' strrchr tw_empty COMPARE -> 0 }t +t{ tw_no_delim '/' strrchr tw_empty COMPARE -> 0 }t +t{ tw_leading_delim '/' strrchr S" /foo/" COMPARE -> 0 }t +t{ tw_middle_delim '/' strrchr S" foo/" COMPARE -> 0 }t +t{ tw_trailing_delim '/' strrchr tw_trailing_delim COMPARE -> 0 }t +test_group_end + .( starts-with ) test_group T{ s" " s" " starts-with -> TRUE }T T{ s" " s" foo" starts-with -> FALSE }T