forked from KolibriOS/kolibrios
169 lines
4.5 KiB
Forth
169 lines
4.5 KiB
Forth
( Слова форматной печати чисел.
|
||
Copyright [C] 1992-1999 A.Cherezov ac@forth.org
|
||
Преобразование из 16-разрядного в 32-разрядный код - 1995-96гг
|
||
Ревизия - сентябрь 1999 [переход на USER-переменные и
|
||
замена CODE-слов высокоуровневыми определениями]
|
||
)
|
||
|
||
4096 DUP CONSTANT NUMERIC-OUTPUT-LENGTH
|
||
USER-CREATE SYSTEM-PAD
|
||
USER-ALLOT \ Область форматного преобразования - обязательно перед PAD
|
||
|
||
: HEX ( -- ) \ 94 CORE EXT
|
||
\ Установить содержимое BASE равным шестнадцати.
|
||
16 BASE !
|
||
;
|
||
|
||
: DECIMAL ( -- ) \ 94
|
||
\ Установить основание системы счисления равным десяти.
|
||
10 BASE !
|
||
;
|
||
|
||
: HOLD ( char -- ) \ 94
|
||
\ Добавить char к началу форматной числовой строки.
|
||
\ Исключительная ситуация возникает, если использовать HOLD
|
||
\ вне <# и #>, ограничивающивающих преобразование чисел.
|
||
HLD @ 1- DUP HLD ! C!
|
||
;
|
||
|
||
: HOLDS ( addr u -- ) \ from eserv src
|
||
TUCK + SWAP 0 ?DO DUP I - 1- C@ HOLD LOOP DROP
|
||
;
|
||
|
||
: <# ( -- ) \ 94
|
||
\ Начать форматное преобразование чисел.
|
||
PAD 1- HLD !
|
||
0 PAD 1- C!
|
||
;
|
||
|
||
: DIGIT> ( c -- c1 )
|
||
DUP 10 < 0= IF 7 + THEN 48 + ;
|
||
|
||
: # ( ud1 -- ud2 ) \ 94
|
||
\ Делением ud1 на значение BASE выделить одну цифру с конца и
|
||
\ добавить ее в буфер форматного преобразования чисел,
|
||
\ оставив частное ud2.
|
||
\ Исключительная ситуация возникает, если использовать #
|
||
\ вне <# и #>, ограничивающивающих преобразование чисел.
|
||
0 BASE @ UM/MOD >R BASE @ UM/MOD R>
|
||
ROT DIGIT> HOLD
|
||
;
|
||
|
||
: #S ( ud1 -- ud2 ) \ 94
|
||
\ Выделять цифры D1 по слову # до получения нуля.
|
||
\ ud2 - ноль.
|
||
\ Исключительная ситуация возникает, если использовать #S
|
||
\ вне <# и #>, ограничивающивающих преобразование чисел.
|
||
BEGIN
|
||
# 2DUP D0=
|
||
UNTIL
|
||
;
|
||
|
||
: #> ( xd -- c-addr u ) \ 94
|
||
\ Убрать xd. Сделать буфер форматного преобразования доступным в виде
|
||
\ строки символов, заданной c-addr и u.
|
||
\ Программа может менять символы в этой строке.
|
||
2DROP HLD @ PAD OVER - 1-
|
||
;
|
||
|
||
: SIGN ( n -- ) \ 94
|
||
\ Если n отрицательно, добавить в строку форматного преобразования
|
||
\ чисел минус.
|
||
\ Исключительная ситуация возникает, если использовать SIGN
|
||
\ вне <# и #>, ограничивающивающих преобразование чисел.
|
||
0< IF [CHAR] - HOLD THEN
|
||
;
|
||
|
||
: (D.) ( d -- addr len ) DUP >R DABS <# #S R> SIGN #> ;
|
||
|
||
: D. ( d -- ) (D.) TYPE SPACE ;
|
||
|
||
: . ( n -- ) S>D D. ;
|
||
|
||
: D.R ( d w -- ) >R (D.) R> OVER - 0MAX SPACES TYPE ;
|
||
|
||
: .R ( n w -- ) >R S>D R> D.R ;
|
||
|
||
: U.R ( u w -- ) 0 SWAP D.R ;
|
||
|
||
: U. ( u -- ) \ 94
|
||
\ Напечатать u в свободном формате.
|
||
U>D D.
|
||
;
|
||
|
||
: .0
|
||
>R 0 <# #S #> R> OVER - 0 MAX DUP
|
||
IF 0 DO [CHAR] 0 EMIT LOOP
|
||
ELSE DROP THEN TYPE
|
||
;
|
||
|
||
: >PRT
|
||
DUP BL U< IF DROP [CHAR] . THEN
|
||
;
|
||
|
||
: PTYPE
|
||
0 DO DUP C@ >PRT EMIT 1+ LOOP DROP
|
||
;
|
||
|
||
: DUMP ( addr u -- ) \ 94 TOOLS
|
||
DUP 0= IF 2DROP EXIT THEN
|
||
BASE @ >R HEX
|
||
15 + 16 U/ 0 DO
|
||
CR DUP 4 .0 SPACE
|
||
SPACE DUP 16 0
|
||
DO I 4 MOD 0= IF SPACE THEN
|
||
DUP C@ 2 .0 SPACE 1+
|
||
LOOP SWAP 16 PTYPE
|
||
LOOP DROP R> BASE !
|
||
;
|
||
|
||
: (.") ( T -> )
|
||
COUNT TYPE
|
||
;
|
||
\ ' (.") TO (.")-CODE
|
||
|
||
: DIGIT ( C, N1 ->> N2, TF / FF )
|
||
\ N2 - значение литеры C как
|
||
\ цифры в системе счисления по основанию N1
|
||
>R
|
||
[CHAR] 0 - 10 OVER U<
|
||
IF
|
||
DUP [CHAR] A [CHAR] 0 - < IF RDROP DROP 0 EXIT THEN
|
||
DUP [CHAR] a [CHAR] 0 - 1- > IF [CHAR] a [CHAR] A - - THEN
|
||
[CHAR] A [CHAR] 0 - 10 - -
|
||
THEN R> OVER U> DUP 0= IF NIP THEN ;
|
||
|
||
: >NUMBER ( ud1 c-addr1 u1 -- ud2 c-addr2 u2 ) \ 94
|
||
\ ud2 - результат преобразования символов строки, заданной c-addr1 u1,
|
||
\ в цифры, используя число в BASE, и добавлением каждой к ud1 после
|
||
\ умножения ud1 на число в BASE. Преобразование продолжается слева
|
||
\ направо до первого непреобразуемого символа, включая символы "+" и "-",
|
||
\ или до полного преобразования строки.
|
||
\ c-addr2 - адрес первого непреобразумого символа или первого символа
|
||
\ за концом строки, если строка была полностью преобразована.
|
||
\ u2 - число непреобразованных символов в строке.
|
||
\ Неоднозначная ситуация возникает, если ud2 переполняется во время
|
||
\ преобразования.
|
||
BEGIN
|
||
DUP
|
||
WHILE
|
||
>R
|
||
DUP >R
|
||
C@ BASE @ DIGIT 0= \ ud n flag
|
||
IF R> R> EXIT THEN \ ud n ( ud = udh udl )
|
||
SWAP BASE @ UM* DROP \ udl n udh*base
|
||
ROT BASE @ UM* D+ \ (n udh*base)+(udl*baseD)
|
||
R> 1+ R> 1-
|
||
REPEAT
|
||
;
|
||
|
||
: SCREEN-LENGTH ( addr n -- n1 ) \ экранная-длина
|
||
\ дать длину строки при выводе (при печати)
|
||
\ - число знакомест, которое строка займет на экране.
|
||
\ addr n - строка. n1 число знакомест на экран.
|
||
0 -ROT OVER + SWAP ?DO
|
||
I C@ 9 = IF 3 RSHIFT 1+ 3 LSHIFT
|
||
ELSE 1+ THEN
|
||
LOOP
|
||
;
|