Commit b8557345 authored by Anton Ertl's avatar Anton Ertl

moved char/[char] to utf8.fs; replaced usages of char/[char] with 'X'

parent bb176f20
......@@ -164,18 +164,18 @@ s" debugger aborted" exception Constant end-debug#
BEGIN
Unnest @ IF 0 ELSE key THEN
CASE
[char] a OF dup 256 cr dump cr ENDOF
[char] b OF 2dup cr dump cr ENDOF
[char] c OF Unnest on true EXIT ENDOF
[char] d OF Leave-D cr ." Done..." cr
Nesting off
r> drop dbg-ip @ >r
EXIT ENDOF
[char] n OF dbg-ip @ @ nestXT EXIT ENDOF
[char] s OF Leave-D end-debug# THROW ENDOF
[char] u OF Unnest on true EXIT ENDOF
[char] ? OF dbg-help ENDOF
( Default) drop true EXIT
'a' OF dup 256 cr dump cr ENDOF
'b' OF 2dup cr dump cr ENDOF
'c' OF Unnest on true EXIT ENDOF
'd' OF Leave-D cr ." Done..." cr
Nesting off
r> drop dbg-ip @ >r
EXIT ENDOF
'n' OF dbg-ip @ @ nestXT EXIT ENDOF
's' OF Leave-D end-debug# THROW ENDOF
'u' OF Unnest on true EXIT ENDOF
'?' OF dbg-help ENDOF
( Default) drop true EXIT
ENDCASE
AGAIN ;
......
......@@ -29,7 +29,7 @@ decimal
\G delimited by a @code{)} (right parenthesis). Display the
\G string. This is often used to display progress information during
\G compilation; see examples below.
[char] ) parse type ; immediate
')' parse type ; immediate
\ VALUE 2>R 2R> 2R@ 17may93jaw
......@@ -63,7 +63,7 @@ decimal
\G (double quote). At run-time, return @i{c-addr} which
\G specifies the counted string @i{ccc}. Interpretation
\G semantics are undefined.
[char] " parse postpone CLiteral ; immediate restrict
'"' parse postpone CLiteral ; immediate restrict
\ [COMPILE] 17may93jaw
......
......@@ -490,7 +490,7 @@ synonym :} }
: -- ( vtaddr u latest latestxt wid 0 ... -- ) \ gforth dash-dash
}
BEGIN [char] } parse dup WHILE
BEGIN '}' parse dup WHILE
+ 1- c@ dup bl = swap ':' = or UNTIL
ELSE 2drop THEN ;
......
......@@ -174,7 +174,7 @@ has? ec has? primcentric 0= and [IF]
\ digit? 17dec92py
: digit? ( char -- digit true/ false ) \ gforth
toupper [char] 0 - dup 9 u> IF
toupper '0' - dup 9 u> IF
[ char A char 9 1 + - ] literal -
dup 9 u<= IF
drop false EXIT
......
......@@ -235,21 +235,6 @@ immediate restrict
: ALiteral ( compilation addr -- ; run-time -- addr ) \ gforth
postpone Literal ; immediate restrict
Defer char@ ( addr u -- char addr' u' )
:noname over c@ -rot 1 /string ; IS char@
: char ( '<spaces>ccc' -- c ) \ core
\G Skip leading spaces. Parse the string @i{ccc} and return @i{c}, the
\G display code representing the first character of @i{ccc}.
parse-name char@ 2drop ;
: [char] ( compilation '<spaces>ccc' -- ; run-time -- c ) \ core bracket-char
\G Compilation: skip leading spaces. Parse the string
\G @i{ccc}. Run-time: return @i{c}, the display code
\G representing the first character of @i{ccc}. Interpretation
\G semantics for this word are undefined.
char postpone Literal ; immediate restrict
\ \ threading 17mar93py
' noop Alias recurse
......@@ -354,7 +339,7 @@ include ./recognizer.fs
here over allot swap move ;
: ," ( "string"<"> -- )
[char] " parse s, ;
'"' parse s, ;
\ \ Header states 23feb93py
......
......@@ -49,7 +49,7 @@ Redefinitions-start
loadfile @ 0= IF postpone ( EXIT THEN
BEGIN
>in @
[char] ) parse nip
')' parse nip
>in @ rot - = \ is there no delimter?
WHILE
refill 0=
......
......@@ -91,7 +91,7 @@ decimal
hex 2 /string
1 >num-state @ or >num-state ! EXIT
endif
over c@ [char] # - dup 4 u<
over c@ '#' - dup 4 u<
IF
cells bases + @ base ! 1 /string
1 >num-state @ or >num-state !
......@@ -100,7 +100,7 @@ decimal
THEN ;
: sign? ( addr u -- addr1 u1 flag )
over c@ [char] - = >num-state @ 2 and 0= and dup >r
over c@ '-' = >num-state @ 2 and 0= and dup >r
IF
1 /string 2 >num-state +!
THEN
......@@ -199,7 +199,7 @@ Defer ?warn# ' noop is ?warn#
\G ** this will not get annotated. The alias in glocals.fs will instead **
\G It does not work to use "wordset-" prefix since this file is glossed
\G by cross.fs which doesn't have the same functionalty as makedoc.fs
[char] ) parse 2drop ; immediate
')' parse 2drop ; immediate
: \ ( compilation 'ccc<newline>' -- ; run-time -- ) \ thisone- core-ext,block-ext backslash
\G ** this will not get annotated. The alias in glocals.fs will instead **
......@@ -694,7 +694,7 @@ User error-stack 0 error-stack !
\G Display @i{u} as an unsigned hex number, prefixed with a "$" and
\G followed by a space.
\ !! not used...
[char] $ emit base @ swap hex u. base ! ;
'$' emit base @ swap hex u. base ! ;
: -trailing ( c_addr u1 -- c_addr u2 ) \ string dash-trailing
\G Adjust the string specified by @i{c-addr, u1} to remove all
......
......@@ -69,7 +69,7 @@ require ./io.fs
\G to the pictured numeric output string. Since the string is
\G built up ``backwards'' this is usually used immediately prior
\G to @code{#>}, as shown in the examples below.
0< IF [char] - hold THEN ;
0< IF '-' hold THEN ;
: # ( ud1 -- ud2 ) \ core number-sign
\G Used within @code{<#} and @code{#>}. Add the next
......@@ -82,7 +82,7 @@ require ./io.fs
\G to the string.
base @ ud/mod rot dup 9 u>
[ char A char 9 1+ - ] Literal and +
[char] 0 + hold ;
'0' + hold ;
: #s ( ud -- 0 0 ) \ core number-sign-s
\G Used within @code{<#} and @code{#>}. Convert all remaining digits
......
......@@ -133,7 +133,7 @@ User tfile
S" ./" string-prefix?
r> r> r> or or or ;
: pathsep? dup [char] / = swap [char] \ = or ;
: pathsep? dup '/' = swap '\' = or ;
: need/ ofile $@ 1- + c@ pathsep? 0= IF s" /" ofile $+! THEN ;
......
......@@ -43,22 +43,22 @@ require ./vars.fs
\G If any bit of @i{f} is non-zero, perform the function of @code{-2 throw},
\G displaying the string @i{ccc} if there is no exception frame on the
\G exception stack.
postpone if [char] " parse postpone cliteral postpone c(abort")
postpone if '"' parse postpone cliteral postpone c(abort")
dead-code on postpone then ; immediate restrict
: warning" ( compilation 'ccc"' -- ; run-time f -- ) \ gforth
\G if @i{f} is non-zero, display the string @i{ccc} as warning message.
postpone if [char] " parse postpone cliteral postpone c(warning")
postpone if '"' parse postpone cliteral postpone c(warning")
postpone then ; immediate restrict
\ create s"-buffer /line chars allot
:noname
[char] " parse
'"' parse
[ has? OS [IF] ]
save-mem
[ [THEN] ]
;
:noname [char] " parse postpone SLiteral ;
:noname '"' parse postpone SLiteral ;
interpret/compile: s" ( compilation 'ccc"' -- ; run-time -- c-addr u ) \ core,file s-quote
\G Compilation: Parse a string @i{ccc} delimited by a @code{"}
\G (double quote). At run-time, return the length, @i{u}, and the
......@@ -80,7 +80,7 @@ interpret/compile: ." ( compilation 'ccc"' -- ; run-time -- ) \ core dot-quote
\G for this word are undefined in ANS Forth. Gforth's interpretation
\G semantics are to display the string. This is the simplest way to
\G display a string from within a definition; see examples below.
\ [char] " parse type ;
\ '"' parse type ;
\ has? compiler [IF]
\ comp: drop [char] " parse postpone sLiteral postpone type ;
\ comp: drop '"' parse postpone sLiteral postpone type ;
\ [THEN]
......@@ -60,7 +60,7 @@ Variable /dump
: .chars ( addr -- )
/dump @ 0 max bounds
?DO I c@ dup 7f bl within
IF drop [char] . THEN emit
IF drop '.' THEN emit
LOOP ;
: .line ( addr -- )
......
......@@ -638,7 +638,7 @@ toupper ( c1 -- c2 ) gforth
is the equivalent upper-case character. All other characters are unchanged.""
c2 = toupper(c1);
:
dup [char] a - [ char z char a - 1 + ] Literal u< bl and - ;
dup 'a' - [ char z char a - 1 + ] Literal u< bl and - ;
capscompare ( c_addr1 u1 c_addr2 u2 -- n ) gforth
""Compare two strings lexicographically. If they are equal, @i{n} is 0; if
......
......@@ -421,7 +421,7 @@ VARIABLE C-Pass
count 2dup + aligned -rot
Display?
IF bl cemit 0 .string
[char] " cemit bl cemit
'"' cemit bl cemit
ELSE 2drop
THEN ;
......@@ -625,8 +625,8 @@ VARIABLE C-Pass
count 2dup + aligned -rot
Display?
IF S" ABORT" .struc
[char] " cemit bl cemit 0 .string
[char] " cemit bl cemit
'"' cemit bl cemit 0 .string
'"' cemit bl cemit
ELSE 2drop
THEN ;
......
......@@ -49,10 +49,20 @@ $80 Constant max-single-byte
\ plug-in so that char and '<char> work for UTF-8
[ifundef] char@ \ !! bootstrapping help
Defer char@ ( addr u -- char addr' u' )
:noname over c@ -rot 1 /string ; IS char@
[then]
Defer char@ ( addr u -- char addr' u' )
:noname over c@ -rot 1 /string ; IS char@
: char ( '<spaces>ccc' -- c ) \ core
\G Skip leading spaces. Parse the string @i{ccc} and return @i{c}, the
\G display code representing the first character of @i{ccc}.
parse-name char@ 2drop ;
: [char] ( compilation '<spaces>ccc' -- ; run-time -- c ) \ core bracket-char
\G Compilation: skip leading spaces. Parse the string
\G @i{ccc}. Run-time: return @i{c}, the display code
\G representing the first character of @i{ccc}. Interpretation
\G semantics for this word are undefined.
char postpone Literal ; immediate restrict
:noname ( addr u -- char addr' u' )
\ !! the if here seems to work around some breakage, but not
......
......@@ -26,8 +26,8 @@ decimal
: #esc[ ( -- ) '[' hold #esc hold ;
: pn base @ swap decimal 0 u.r base ! ;
: ;pn [char] ; emit pn ;
: ESC[ #esc emit [char] [ emit ;
: ;pn ';' emit pn ;
: ESC[ #esc emit '[' emit ;
: vt100-at-xy ( u1 u2 -- ) \ facility at-x-y
\G Position the cursor so that subsequent text output will take
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment