Subversion Repositories Kolibri OS

Rev

Blame | Last modification | View Log | Download | RSS feed

  1. ( 28.Mar.2000 Andrey Cherezov  Copyright [C] RU FIG
  2.  
  3.   Èñïîëüçîâàíû èäåè ñëåäóþùèõ àâòîðîâ:
  4.   Ruvim Pinka; Dmitry Yakimov; Oleg Shalyopa; Yuriy Zhilovets;
  5.   Konstantin Tarasov; Michail Maximov.
  6.  
  7.   !! Ðàáîòàåò òîëüêî â SPF4.
  8. )
  9.  
  10. ( Ïðîñòîå ðàñøèðåíèå ÑÏ-Ôîðòà ëîêàëüíûìè ïåðåìåííûìè.
  11.   Ðåàëèçîâàíî áåç èñïîëüçîâàíèÿ LOCALS ñòàíäàðòà 94.
  12.  
  13.   Îáúÿâëåíèå âðåìåííûõ ïåðåìåííûõ, âèäèìûõ òîëüêî âíóòðè
  14.   òåêóùåãî ñëîâà è îãðàíè÷åííûõ âðåìåíåì âûçîâà äàííîãî
  15.   ñëîâà âûïîëíÿåòñÿ ñ ïîìîùüþ ñëîâà "{". Âíóòðè îïðåäåëåíèÿ
  16.   ñëîâà èñïîëüçóåòñÿ êîíñòðóêöèÿ, ïîäîáíàÿ ñòåêîâîé íîòàöèè Ôîðòà
  17.   { ñïèñîê_èíèöèàëèçèðîâàííûõ_ëîêàëîâ \ ñï.íåèíèö.ëîêàëîâ -- ÷òî óãîäíî }
  18.   Íàïðèìåð:
  19.  
  20.   { a b c d \ e f -- i j }
  21.  
  22.   Èëè { a b c d \ e f[ EVALUATE_âûðàæåíèå ] -- i j }
  23.   Ýòî çíà÷èò ÷òî äëÿ ïåðåìåííîé f[ áóäåò âûäåëåí íà ñòåêå âîçâðàòîâ ó÷àñòîê
  24.   ïàìÿòè äëèíîé n áàéò. Èñïîëüçîâàíèå ïåðåìåííîé f[ äàñò àäðåñ íà÷àëà ýòîãî
  25.   ó÷àñòêà. \ ñòèëå MPE\
  26.  
  27.   Èëè { a b c d \ e [ 12 ] f -- i j }
  28.   Ýòî çíà÷èò ÷òî äëÿ ïåðåìåííîé f áóäåò âûäåëåí íà ñòåêå âîçâðàòîâ ó÷àñòîê
  29.   ïàìÿòè äëèíîé 12 áàéò. Èñïîëüçîâàíèå ïåðåìåííîé f äàñò àäðåñ íà÷àëà ýòîãî
  30.   ó÷àñòêà.
  31.  
  32.   ×àñòü "\ ñï.íåèíèö.ëîêàëîâ" ìîæåò îòñóòñòâîâàòü, íàïðèìåð:
  33.  
  34.   { item1 item2 -- }
  35.  
  36.   Ýòî çàñòàâëÿåò ÑÏ-Ôîðò àâòîìàòè÷åñêè âûäåëÿòü ìåñòî â
  37.   ñòåêå âîçâðàòîâ äëÿ ýòèõ ïåðåìåííûõ â ìîìåíò âûçîâà ñëîâà
  38.   è àâòîìàòè÷åñêè îñâîáîæäàòü ìåñòî ïðè âûõîäå èç íåãî.
  39.  
  40.   Îáðàùåíèå ê òàêèì ëîêàëüíûì ïåðåìåííûì - êàê ê VALUE-ïåðåìåííûì
  41.   ïî èìåíè. Åñëè íóæåí àäðåñ ïåðåìåííîé, òî èñïîëüçóåòñÿ "^ èìÿ"
  42.   èëè "AT èìÿ".
  43.  
  44.  
  45.   Âìåñòî \ ìîæíî èñïîëüçîâàòü |
  46.   Âìåñòî -> ìîæíî èñïîëüçîâàòü TO
  47.  
  48.   Ïðèìåðû:
  49.  
  50.   : TEST { a b c d \ e f -- } a . b . c .  b c + -> e  e .  f .  ^ a @ . ;
  51.    Ok
  52.   1 2 3 4 TEST
  53.   1 2 3 5 0 1  Ok
  54.  
  55.   : TEST { a b -- } a . b . CR 5 0 DO I . a . b . CR LOOP ;
  56.    Ok
  57.   12 34 TEST
  58.   12 34
  59.   0 12 34
  60.   1 12 34
  61.   2 12 34
  62.   3 12 34
  63.   4 12 34
  64.    Ok
  65.  
  66.   : TEST { a b } a . b . ;
  67.    Ok
  68.   1 2 TEST
  69.   1 2  Ok
  70.  
  71.   : TEST { a b \ c } a . b . c . ;
  72.    Ok
  73.   1 2 TEST
  74.   1 2 0  Ok
  75.  
  76.   : TEST { a b -- } a . b . ;
  77.    Ok
  78.   1 2 TEST
  79.   1 2  Ok
  80.  
  81.   : TEST { a b \ c -- d } a . b . c . ;
  82.    Ok
  83.   1 2 TEST
  84.   1 2 0  Ok
  85.  
  86.   : TEST { \ a b } a . b .  1 -> a  2 -> b  a . b . ;
  87.    Ok
  88.   TEST
  89.   0 0 1 2  Ok
  90.  
  91.   Èìåíà ëîêàëüíûõ ïåðåìåííûõ ñóùåñòâóþò â äèíàìè÷åñêîì
  92.   âðåìåííîì ñëîâàðå òîëüêî â ìîìåíò êîìïèëÿöèè ñëîâà, à
  93.   ïîñëå ýòîãî âû÷èùàþòñÿ è áîëåå íåäîñòóïíû.
  94.  
  95.   Èñïîëüçîâàòü êîíñòðóêöèþ "{ ... }" âíóòðè îäíîãî îïðåäåëåíèÿ ìîæíî
  96.   òîëüêî îäèí ðàç.
  97.  
  98.   Êîìïèëÿöèÿ ýòîé áèáëèîòåêè äîáàâëÿåò â òåêóùèé ñëîâàðü êîìïèëÿöèè
  99.   Òîëüêî äâà ñëîâà:
  100.   ñëîâàðü "vocLocalsSupport" è "{"
  101.   Âñå îñòàëüíûå äåòàëè "ñïðÿòàíû" â ñëîâàðå, èñïîëüçîâàòü èõ
  102.   íå ðåêîìåíäóåòñÿ.
  103. )
  104.  
  105. MODULE: vocLocalsSupport
  106.  
  107. USER widLocals
  108. USER uLocalsCnt
  109. USER uLocalsUCnt
  110. USER uPrevCurrent
  111. USER uAddDepth
  112.  
  113. : (Local^) ( N -- ADDR )
  114.   RP@ +
  115. ;
  116. : LocalOffs ( n -- offs )
  117.   uLocalsCnt @ SWAP - CELLS CELL+ uAddDepth @ +
  118. ;
  119.  
  120. BASE @ HEX
  121. : CompileLocalsInit
  122.   uPrevCurrent @ SET-CURRENT
  123.   uLocalsCnt  @ uLocalsUCnt @ - ?DUP IF CELLS LIT, POSTPONE DRMOVE THEN
  124.   uLocalsUCnt @ ?DUP
  125.   IF
  126.      LIT, POSTPONE (RALLOT)
  127.   THEN
  128.   uLocalsCnt  @ ?DUP
  129.   IF CELLS RLIT, ['] (LocalsExit) RLIT, THEN
  130. ;
  131.  
  132. : CompileLocal@ ( n -- )
  133.  ['] DUP MACRO,
  134.   LocalOffs DUP  SHORT?
  135.   OPT_INIT SetOP
  136.   IF    8B B, 44 B, 24 B, B, \ mov eax, offset [esp]
  137.   ELSE  8B B, 84 B, 24 B,  , \ mov eax, offset [esp]
  138.   THEN  OPT
  139.   OPT_CLOSE
  140. ;
  141.  
  142. \ : CompileLocal@ ( n -- )
  143. \   LocalOffs LIT, POSTPONE RP+@
  144. \ ;
  145.  
  146. : CompileLocal! ( n -- )
  147.   LocalOffs DUP  SHORT?
  148.   OPT_INIT SetOP
  149.   IF    89 B, 44 B, 24 B, B, \ mov  offset [esp], eax
  150.   ELSE  89 B, 84 B, 24 B,  , \ mov  offset [esp], eax
  151.   THEN  OPT
  152.   OPT_CLOSE
  153.   ['] DROP MACRO,
  154. ;
  155.  
  156. : CompileLocalRec ( u -- )
  157.  LocalOffs DUP
  158.  ['] DUP MACRO,
  159.   SHORT?
  160.   OPT_INIT SetOP
  161.   IF    8D B, 44 B, 24 B, B, \ lea eax, offset [esp]
  162.   ELSE  8D B, 84 B, 24 B,  , \ lea eax, offset [esp]
  163.   THEN  OPT
  164.   OPT_CLOSE
  165. ;
  166.  
  167. BASE !
  168.  
  169. : LocalsStartup
  170.   TEMP-WORDLIST widLocals !
  171.   GET-CURRENT uPrevCurrent !
  172.   ALSO vocLocalsSupport
  173.   ALSO widLocals @ CONTEXT ! DEFINITIONS
  174.   uLocalsCnt 0!
  175.   uLocalsUCnt 0!
  176.   uAddDepth 0!
  177. ;
  178. : LocalsCleanup
  179.   PREVIOUS PREVIOUS
  180.   widLocals @ FREE-WORDLIST
  181. ;
  182.  
  183. : ProcessLocRec ( "name" -- u )
  184.   [CHAR] ] PARSE
  185.   STATE 0!
  186.   EVALUATE CELL 1- + CELL / \ äåëàåì êðàòíûì 4
  187.   -1 STATE !
  188.   DUP uLocalsCnt +!
  189.   uLocalsCnt @ 1-
  190. ;
  191.  
  192. : CreateLocArray
  193.   ProcessLocRec
  194.   CREATE ,
  195. ;
  196.  
  197. : LocalsRecDoes@ ( -- u )
  198.   DOES> @ CompileLocalRec
  199. ;
  200.  
  201. : LocalsRecDoes@2 ( -- u )
  202.   ProcessLocRec ,
  203.   DOES> @ CompileLocalRec
  204. ;
  205.  
  206. : LocalsDoes@
  207.   uLocalsCnt @ ,
  208.   uLocalsCnt 1+!
  209.   DOES> @ CompileLocal@
  210. ;
  211.  
  212. : ;; POSTPONE ; ; IMMEDIATE
  213.  
  214.  
  215. : ^
  216.   ' >BODY @
  217.  CompileLocalRec
  218. ; IMMEDIATE
  219.  
  220.  
  221. : -> ' >BODY @ CompileLocal!  ; IMMEDIATE
  222.  
  223. WARNING DUP @ SWAP 0!
  224.  
  225. : AT
  226.   [COMPILE] ^
  227. ; IMMEDIATE
  228.  
  229. : TO ( "name" -- )
  230.   >IN @ NextWord widLocals @ SEARCH-WORDLIST 1 =
  231.   IF >BODY @ CompileLocal! DROP
  232.   ELSE >IN ! [COMPILE] TO
  233.   THEN
  234. ; IMMEDIATE
  235.  
  236. WARNING !
  237.  
  238. : â POSTPONE -> ; IMMEDIATE
  239.  
  240. WARNING @ WARNING 0!
  241. \ ===
  242. \ ïåðåîïðåäåëåíèå ñîîòâåòñòâóþùèõ ñëîâ äëÿ âîçìîæíîñòè èñïîëüçîâàòü
  243. \ âðåìåííûå ïåðåìåííûå âíóòðè  öèêëà DO LOOP  è íåçàâèñèìî îò èçìåíåíèÿ
  244. \ ñîäåðæèìîãî ñòåêà âîçâðàòîâ  ñëîâàìè   >R   R>
  245.  
  246. : DO    POSTPONE DO     [  3 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
  247. : ?DO   POSTPONE ?DO    [  3 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
  248. : LOOP  POSTPONE LOOP   [ -3 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
  249. : +LOOP POSTPONE +LOOP  [ -3 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
  250. : >R    POSTPONE >R     [  1 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
  251. : R>    POSTPONE R>     [ -1 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
  252. : RDROP POSTPONE RDROP  [ -1 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
  253. : 2>R   POSTPONE 2>R    [  2 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
  254. : 2R>   POSTPONE 2R>    [ -2 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
  255.  
  256. \ ===
  257.  
  258. \ { ... | ... -- _____ }
  259. : ParseLocals3
  260.   BEGIN
  261.    PARSE-NAME
  262.    DUP 0= ABORT" Locals bad syntax (3)"
  263.    2DUP S" }" COMPARE 0= IF 2DROP EXIT THEN
  264.    2DROP
  265.   AGAIN
  266. ;
  267.  
  268. \ { ... | _____ -- ... }
  269. : ParseLocals2
  270.   BEGIN
  271.    PARSE-NAME
  272.    DUP 0= ABORT" Locals bad syntax (2)"
  273.    2DUP S" --" COMPARE 0= IF 2DROP ParseLocals3 EXIT THEN
  274.    2DUP S" }" COMPARE 0= IF 2DROP EXIT THEN
  275.    2DUP S" [" COMPARE 0=
  276.    IF
  277.      2DROP CreateLocArray LocalsRecDoes@
  278.    ELSE
  279.      CREATED
  280.      LATEST DUP C@ CHARS + C@
  281.      [CHAR] [ =
  282.      IF
  283.        LocalsRecDoes@2
  284.      ELSE
  285.        LocalsDoes@ 1
  286.      THEN
  287.    THEN
  288.    uLocalsUCnt +! IMMEDIATE
  289.   AGAIN
  290. ;
  291.  
  292. \ { _____ | ... -- ... }
  293. : ParseLocals1
  294.   BEGIN
  295.     PARSE-NAME
  296.     DUP 0= ABORT" Locals bad syntax (1)"
  297.     2DUP S" |" COMPARE 0= IF 2DROP ParseLocals2 EXIT THEN
  298.     2DUP S" \" COMPARE 0= IF 2DROP ParseLocals2 EXIT THEN
  299.    2DUP S" --" COMPARE 0= IF 2DROP ParseLocals3 EXIT THEN
  300.    2DUP S" }" COMPARE 0= IF 2DROP EXIT THEN
  301.  
  302.    CREATED LocalsDoes@ IMMEDIATE
  303.  AGAIN ;
  304.  
  305. \ uLocalsCnt  @ ?DUP
  306. \ IF CELLS RLIT, ['] (LocalsExit) RLIT, THEN
  307.  
  308. : ;  LocalsCleanup
  309.     S" ;" EVAL-WORD
  310. ; IMMEDIATE
  311.  
  312. WARNING !
  313.  
  314. \ =====================================================================
  315.  
  316. EXPORT
  317.  
  318. : {
  319.  LocalsStartup
  320.  ParseLocals1
  321.  CompileLocalsInit
  322. ;; IMMEDIATE
  323.  
  324. ;MODULE
  325.