Subversion Repositories Kolibri OS

Rev

Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
4867 leency 1 
\ 94 CORE EXT
2 
 
3 
: .R ( n1 n2 -- ) \ 94 CORE EXT
4 
\ Вывести на экран n1 выравненным вправо в поле шириной n2 символов.
5 
\ Если число символов, необходимое для изображения n1, больше чем n2,
6 
\ изображаются все цифры числа без ведущих пробелов в поле необходимой
7 
\ ширины.
8 
  >R DUP >R ABS
9 
  S>D <# #S R> SIGN #>
10 
  R> OVER - 0 MAX SPACES TYPE
11 
;
12 
: 0> ( n -- flag ) \ 94 CORE EXT
13 
\ flag "истина" тогда и только тогда, когда n больше нуля
14 
 
15 
;
16 
 
17 
: MARKER ( "name" -- ) \ 94 CORE EXT
18 
\ Пропустить ведущие пробелы. Выделить name, ограниченное пробелами.
19 
\ Создать определение с семантикой выполнения, описанной ниже.
20 
\ name Выполнение: ( -- )
21 
\ Восстановить распределение памяти словаря и указатели порядка поиска
22 
\ к состоянию, которое они имели перед определением name. Убрать
23 
\ определение name и все последующие определения. Не требуется
24 
\ обязательно восстанавливать любые оставшиеся структуры, которые
25 
\ могут быть связаны с удаленными определениями или освобожденным
26 
\ пространством данных. Никакая другая контекстуальная информация,
27 
\ как основание системы счисления, не изменяется.
28 
  HERE
29 
\  [C]HERE , [E]HERE ,
30 
  GET-CURRENT ,
31 
  GET-ORDER DUP , 0 ?DO DUP , @ , LOOP
32 
  CREATE ,
33 
  DOES> @ DUP \ ONLY
34 
\  DUP @ [C]DP ! CELL+
35 
\  DUP @ [E]DP ! CELL+
36 
  DUP @ SET-CURRENT CELL+
37 
  DUP @ >R R@ CELLS 2* + 1 CELLS - R@ 0
38 
  ?DO DUP DUP @ SWAP CELL+ @ OVER ! SWAP 2 CELLS - LOOP
39 
  DROP R> SET-ORDER
40 
  DP !
41 
;
42 
 
43 
: SAVE-INPUT ( -- xn ... x1 n )  \ 94 CORE EXT
44 
\ x1 - xn описывают текущее состояние спецификаций входного потока для
45 
\ последующего использования словом RESTORE-INPUT.
46 
  SOURCE-ID 0>
47 
  IF TIB #TIB @ 2DUP C/L 2 + ALLOCATE THROW DUP >R SWAP CMOVE
48 
     R> TO TIB  >IN @
49 
     SOURCE-ID FILE-POSITION THROW
50 
     5
51 
  ELSE BLK @ >IN @ 2 THEN
52 
;
53 
: RESTORE-INPUT ( xn ... x1 n -- flag ) \ 94 CORE EXT
54 
\ Попытка восстановить спецификации входного потока к состоянию,
55 
\ описанному x1 - xn. flag "истина", если спецификации входного
56 
\ потока не могут быть восстановлены.
57 
\ Неопределенная ситуация возникает, если входной поток,
58 
\ представленный аргументами не тот же, что и текущий входной поток.
59 
  SOURCE-ID 0>
60 
  IF DUP 5 <> IF 0 ?DO DROP LOOP -1 EXIT THEN
61 
     DROP SOURCE-ID REPOSITION-FILE ?DUP IF >R 2DROP DROP R> EXIT THEN
62 
     >IN ! #TIB ! TO TIB FALSE
63 
  ELSE DUP 2 <> IF 0 ?DO DROP LOOP -1 EXIT THEN
64 
     DROP >IN ! BLK ! FALSE
65 
  THEN
66 
;
67 
: U.R ( u n -- ) \ 94 CORE EXT
68 
\ Вывести на экран u выравненным вправо в поле шириной n символов.
69 
\ Если число символов, необходимое для изображения u, больше чем n,
70 
\ изображаются все цифры числа без ведущих пробелов в поле необходимой
71 
\ ширины.
72 
  >R  U>D <# #S #>
73 
  R> OVER - 0 MAX SPACES TYPE
74 
;
75 
\EOF
76 
: UNUSED ( -- u ) \ 94 CORE EXT
77 
\ u - объем памяти, оставшейся в области, адресуемой HERE,
78 
\ в байтах.
79 
  IMAGE-SIZE
80 
  HERE IMAGE-BASE - -
81 
;