home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / FFA.ZIP / META86.SEQ < prev    next >
Encoding:
Text File  |  1988-01-11  |  16.3 KB  |  525 lines
  1. \ META86.SEQ    The META compiler Source for DF.
  2. \  DF : Forth-83 with separated heads, handles, and sequential files.
  3. \  Meta compiler.  Loaded by DF to produce DKERNEL.COM.
  4. \  Loads KERNEL86.SEQ.
  5.  
  6. \ *************************************************************
  7. \ ***      ORIGINALLY   Based on F83 version 2.1.0 by       ***
  8. \ ***                                                       ***
  9. \ ***    Henry Laxen         and    Michael Perry           ***
  10. \ ***    1259 Cornell Avenue        1125 Bancroft Way       ***
  11. \ ***    Berkeley, California       Berkeley, California    ***
  12. \ ***    94706                      94702                   ***
  13. \ ***                                                       ***
  14. \ *************************************************************
  15. \     Heads separation by:     J. D. Hopper
  16. \                              P.O. Box 2782
  17. \                              Stanford, Ca.  94305
  18.  
  19. \     Handles and
  20. \     sequential files by:      Tom Zimmer          Hm  (408) 263-8859
  21. \                               292 Falcato Drive   Wk  (408) 432-4643
  22. \                               Milpitas, Ca. 95035
  23.  
  24. \     Direct Threaded Code
  25. \     conversion by:            Bob Smith and Tom Zimmer
  26. \
  27. \               Contact:        Tom Zimmer          Hm  (408) 263-8859
  28. \                               292 Falcato Drive   Wk  (408) 432-4643
  29. \                               Milpitas, Ca. 95035
  30.  
  31.  
  32. TIME-RESET
  33.  
  34. : ZSAVE         ( Addr len | filename -- ) \ Save code from external segment.
  35.                 SHNDL+ !HCB
  36.                 SHNDL+ HDELETE   DROP
  37.                 SHNDL+ HCREATE   ABORT" Save Create ERR!"
  38.                 SHNDL+ HWRITE 0= ABORT" Save Write  ERR!"
  39.                 SHNDL+ HCLOSE    ABORT" Save Close  ERR!" ;
  40.  
  41. WARNING OFF
  42. ONLY FORTH ALSO DEFINITIONS
  43.  
  44. 15 TABSIZE !    \ WIDER TABS
  45. 78 RMARGIN !    \ WIDER RIGHT MARGIN
  46.  0 LMARGIN !    \ LEFT MARGIN TO LEFT EDGE
  47. ?DARK           \ CLEAR SCREEN AND CLEAR #LINE
  48.  
  49. : .TITLE        CR
  50.                 ." Meta Compiled Direct Threaded Forth       "
  51.                 .DATE TAB .TIME
  52.                 CR CR ;
  53.  
  54. ONLY FORTH ALSO VOCABULARY META META ALSO META DEFINITIONS
  55.  
  56. VARIABLE YSEG
  57. VARIABLE XSEG
  58.  
  59. 32 CONSTANT #TTHREADS
  60.  
  61. : MEMCHK ABORT" Insufficient Memory" ;
  62.  
  63. HEX
  64.  
  65. : DOSVER 0 30 BDOS 0FF AND ;
  66.  
  67. : DOSCHK  DOSVER 2 < ABORT" Must have DOS >=2" ;
  68.  
  69.  DOSCHK
  70.                                      \ 800 hex is 32k decimal segments
  71. 800 alloc 8 = MEMCHK NIP YSEG !        \ 32k for target heads.
  72. 800 alloc 8 = MEMCHK NIP XSEG !          \ and for bodys
  73.  
  74. DECIMAL
  75.  
  76. : NYTH ( cfa -- ythread) 512 / 2* ;
  77.  
  78. : ?NEWPAGE      ( --- )
  79.                 PRINTING @ 0= IF EXIT THEN
  80.                 #LINE @ 60 >
  81.                 IF      CR
  82.                         12 SP@ 1 TYPE DROP #LINE OFF
  83.                         CR .TITLE
  84.                 THEN    ;
  85.  
  86. VARIABLE LABELS         LABELS OFF      \ DEFAULT TO NOT DISPLAY MAP
  87.  
  88. : ?LABELS       ( --- )
  89.                 CR CR ." Do you want LABELS printed Y/N [N]? "
  90.                 KEY BL OR ASCII y = DUP LABELS !
  91.                 IF      ." Y"
  92.                 ELSE    ." N"   THEN CR .TITLE TIME-RESET ;
  93.  
  94. ?LABELS
  95.  
  96. 3 CONSTANT BODY_SIZE                    \ SIZE OF BODY FIELD IN BYTES
  97.  
  98. : >BODY-T       ( A1 --- A2 )           \ Move to body of target
  99.                 BODY_SIZE + ;
  100.  
  101. VARIABLE DP-T
  102.  
  103. : [FORTH]        FORTH   ; IMMEDIATE
  104.  
  105. : [META]         META    ; IMMEDIATE
  106.  
  107. : [ASSEMBLER]    ASSEMBLER    ; IMMEDIATE
  108.  
  109. : SWITCH   ( -- )
  110.    NOOP ( Context )   NOOP ( Current )
  111.    DOES>
  112.       @ DUP X@ CONTEXT @   SWAP CONTEXT !   OVER X!   2+
  113.         DUP X@ CURRENT @   SWAP CURRENT !   SWAP X!   ;
  114.    SWITCH   ( Redefine itself )
  115.  
  116. 0 CONSTANT TARGET-ORIGIN
  117. : THERE   ( taddr -- addr )   TARGET-ORIGIN +   ;
  118. : C@-T    ( taddr -- char )   THERE C@ ;
  119. : @-T     ( taddr -- n )      THERE @  ;
  120. : C!-T    ( char taddr -- )   THERE C! ;
  121. : !-T     ( n taddr -- )      THERE !  ;
  122. : HERE-T  ( -- taddr )   DP-T @   ;
  123. : ALLOT-T ( n -- )       DP-T +!   ;
  124. : C,-T    ( char -- )   HERE-T C!-T   1 ALLOT-T   ;
  125. : ,-T     ( n -- )      HERE-T  !-T   2 ALLOT-T   ;
  126. : S,-T    ( addr len -- )
  127.    0 ?DO   COUNT C,-T   LOOP   DROP   ;
  128.  
  129. : XS:     ( taddr -- taddr tseg ) XSEG @ SWAP ;
  130. VARIABLE DP-X   0 DP-X !
  131. : C@-X    ( taddr -- char )   XS: C@L ;
  132. : @-X     ( taddr -- n )      XS: @L  ;
  133. : C!-X    ( char taddr -- )   XS: C!L ;
  134. : !-X     ( n taddr -- )      XS: !L  ;
  135. : HERE-X  ( -- taddr )   DP-X @   ;
  136. : ALLOT-X ( n -- )       DP-X +!   ;
  137. : C,-X    ( char -- )   HERE-X C!-X   1 ALLOT-X   ;
  138. : ,-X     ( n -- )      HERE-X  !-X   2 ALLOT-X   ;
  139. : S,-X    ( addr len -- )
  140.    0 ?DO   COUNT C,-X   LOOP   DROP   ;
  141.  
  142. : YS:   YSEG @ SWAP ;
  143. VARIABLE DP-Y    256 DP-Y !
  144. : C@-Y    ( yaddr -- char )   YS: C@L  ;
  145. : @-Y     ( yaddr -- n )      YS: @L  ;
  146. : C!-Y    ( char yaddr -- )   YS: C!L ;
  147. : !-Y     ( n yaddr -- )      YS: !L  ;
  148. : HERE-Y  ( -- yaddr )        DP-Y @ ;
  149. : ALLOT-Y ( n -- )    DP-Y +! ;
  150. : C,-Y    ( char -- ) HERE-Y C!-Y  1 ALLOT-Y  ;
  151. : ,-Y     ( n -- )    HERE-Y  !-Y  2 ALLOT-Y  ;
  152. : S,-Y    ( addr len )  0 ?DO COUNT C,-Y  LOOP  DROP  ;
  153. : CSET-Y  ( byte yaddr -- )  TUCK C@-Y OR SWAP C!-Y ;
  154.  
  155. : SVXSEG        ( - xstart )
  156.                 XSEG @ 0 ?CS: HERE-T  DUP >R THERE
  157.                 HERE-X CMOVEL R> ;
  158.  
  159. : SVYSEG        ( - ystart )
  160.                 YSEG @ 0 ?CS: HERE-T  DUP >R THERE
  161.                 HERE-Y CMOVEL R> ;
  162.  
  163. HEX
  164.  
  165. : CNHASH ( CFA-YA )  0FE00 AND FLIP ;  DECIMAL
  166.  
  167. VOCABULARY TARGET
  168. VOCABULARY TRANSITION
  169. VOCABULARY FORWARD
  170. VOCABULARY USER
  171.  
  172. ONLY DEFINITIONS FORTH ALSO META ALSO
  173.  
  174. : META          META ;
  175. : TARGET        TARGET ;
  176. : TRANSITION    TRANSITION ;
  177. : FORWARD       FORWARD ;
  178. : USER          USER   ;
  179. : ASSEMBLER     ASSEMBLER ;
  180.  
  181. ONLY FORTH ALSO META ALSO DEFINITIONS
  182.  
  183. : X?>MARK       ( -- f addr )   TRUE   HERE-X   0 ,-X   ;
  184. : X?>RESOLVE    ( f addr -- )   HERE-X SWAP !-X   ?CONDITION  ;
  185. : X?<MARK       ( -- f addr )   TRUE   HERE-X   ;
  186. : X?<RESOLVE    ( f addr -- )   ,-X   ?CONDITION   ;
  187.  
  188. : AM?>MARK      ( -- f addr )   TRUE   HERE-T   0 C,-T   ;
  189. : AM?>RESOLVE   ( f addr -- )   HERE-T OVER 1+ - SWAP C!-T   ?CONDITION   ;
  190. : AM?<MARK      ( -- f addr )   TRUE   HERE-T   ;
  191. : AM?<RESOLVE   ( f addr -- )   HERE-T 1+ - C,-T   ?CONDITION   ;
  192.  
  193. '   C,-T        ASSEMBLER IS  C,
  194. '    ,-T        ASSEMBLER IS   ,
  195. ' HERE-T        ASSEMBLER IS HERE
  196. ' AM?>MARK      ASSEMBLER IS ?>MARK
  197. ' AM?>RESOLVE   ASSEMBLER IS ?>RESOLVE
  198. ' AM?<MARK      ASSEMBLER IS ?<MARK
  199. ' AM?<RESOLVE   ASSEMBLER IS ?<RESOLVE
  200.  
  201. ONLY FORTH ALSO META ALSO DEFINITIONS
  202.  
  203. : LABEL         ( | NAME -- )
  204.                 0 ['] DROP A;!
  205.                 ['] RUN-A; IS RUN
  206.                 ASSEMBLER DEFINITIONS
  207.                 >IN @ >R HERE-T CONSTANT
  208.                 LABELS @
  209.                 IF      R> >IN !
  210.                         BL WORD DUP C@ 5 + ?LINE
  211.                         HERE-T H.
  212.                         COUNT TYPE TAB
  213.                         ?NEWPAGE
  214.                 ELSE    R> DROP  THEN ;
  215.  
  216. : XLABEL        ( | NAME -- )
  217.                 0 ['] DROP A;!
  218.                 ['] RUN-A; IS RUN
  219.                 ASSEMBLER DEFINITIONS
  220.                 >IN @ >R HERE-X CONSTANT
  221.                 LABELS @
  222.                 IF      R> >IN !
  223.                         BL WORD DUP C@ 5 + ?LINE
  224.                         HERE-T H.
  225.                         COUNT TYPE TAB
  226.                         ?NEWPAGE
  227.                 ELSE    R> DROP  THEN ;
  228.  
  229. : MAKE-CODE     ( PFA -- ) @ ,-X   ;                    \ Absolute address
  230. : MAKE-CODE-REL ( PFA -- ) @ HERE-T 2+ - ,-T   ;        \ Relative offset
  231.  
  232. : IN-TARGET     ( -- )          ONLY TARGET DEFINITIONS   ;
  233. : IN-TRANSITION ( -- )          ONLY FORWARD ALSO TARGET DEFINITIONS
  234.                                 ALSO TRANSITION   ;
  235. : IN-META       ( -- )          ONLY FORTH ALSO META DEFINITIONS ALSO   ;
  236. : IN-FORWARD    ( -- )          FORWARD DEFINITIONS   ;
  237. : LINK-BACKWARDS     ( PFA -- ) HERE-X OVER @ ,-X   SWAP !   ;
  238. : LINK-BACKWARDS-REL ( PFA -- ) HERE-T OVER @ ,-T   SWAP !   ;
  239. : RESOLVED?     ( pfa -- f )    2+ @   ;
  240.  
  241. : FORWARD-CODE  ( pfa -- )      DUP RESOLVED?
  242.                                 IF      MAKE-CODE
  243.                                 ELSE    LINK-BACKWARDS  THEN ;
  244.  
  245. : FORWARD-CODE-REL ( pfa -- )   DUP RESOLVED?
  246.                                 IF      MAKE-CODE-REL
  247.                                 ELSE    LINK-BACKWARDS-REL  THEN ;
  248.  
  249. : FORWARD:      ( -- )
  250.                 SWITCH   FORWARD DEFINITIONS
  251.                 CREATE SWITCH  0 , 0 , DOES>   FORWARD-CODE   ;
  252.  
  253. : FORWARD_REL:  ( -- )
  254.                 SWITCH   FORWARD DEFINITIONS
  255.                 CREATE SWITCH  0 , 0 , DOES>   FORWARD-CODE-REL ;
  256.  
  257. VARIABLE WIDTH  31 WIDTH !
  258. VARIABLE LAST-T
  259. VARIABLE CONTEXT-T
  260. VARIABLE CURRENT-T
  261.  
  262. : HASH          ( str-addr voc-addr -- thread )
  263.                 SWAP
  264.                 DUP C@ SWAP 1+ C@ +
  265. \ ****          1+ C@
  266.                 #TTHREADS 1- AND 2* +   ;
  267.  
  268. : HEADER        ( -- )
  269.                 BL WORD C@ 1+ WIDTH @ MIN   ?DUP
  270.         IF      ( HERE-Y 2- )   ( for ylink at end)
  271.                 ALIGN
  272.                 HERE-Y 2- @-Y CNHASH HERE-T CNHASH <> IF
  273.                 HERE-Y HERE-T CNHASH !-Y THEN  ( >NAME hash entry )
  274.                 LOADLINE @ ,-Y
  275.                 HERE CURRENT-T @ HASH DUP @-T ,-Y ( link )
  276.                 HERE-Y 2- SWAP !-T      ( point voc thread to link field )
  277.                 HERE-Y HERE ROT S,-Y   ALIGN   DUP LAST-T !
  278.                 128 SWAP CSET-Y   128 HERE-Y 1- CSET-Y
  279.                 HERE-T ,-Y              ( cfa ptr )
  280.                 HERE-Y HERE-T CNHASH 2+ !-Y     ( stopper >NAME hash entry )
  281.         THEN    ;
  282.  
  283. : TARGET-CREATE ( -- )
  284.                 >IN @ HEADER DUP >IN !
  285.                 LABELS @
  286.                 IF      BL WORD DUP C@ 5 + ?LINE
  287.                         HERE-T H.
  288.                         COUNT TYPE TAB ?NEWPAGE
  289.                 THEN    >IN !
  290.                 IN-TARGET CREATE IN-META  HERE-T , TRUE ,
  291.                 DOES>   MAKE-CODE   ;
  292.  
  293. : RECREATE      ( -- )  >IN @   TARGET-CREATE   >IN !   ;
  294.  
  295.  
  296. FORTH DEFINITIONS
  297.  
  298. : CODE          ( NAME --- )
  299.                 0 ['] DROP A;!
  300.                 ['] RUN-A; IS RUN
  301.                 TARGET-CREATE ASSEMBLER !CSP ;
  302.  
  303. ASSEMBLER ALSO DEFINITIONS
  304.  
  305. : END-CODE      ['] <RUN> IS RUN
  306.                 A; IN-META ?CSP ;
  307.  
  308. : C;            ['] <RUN> IS RUN
  309.                 A; IN-META ?CSP ;
  310.  
  311.  
  312. META IN-META
  313.  
  314. : 'T            ( -- cfa )
  315.                 CONTEXT @   TARGET DEFINED   ROT CONTEXT !
  316.                 0= ?MISSING   ;
  317.  
  318. : [TARGET]      ( -- )          'T X, ;   IMMEDIATE
  319.  
  320. : 'F            ( -- cfa )
  321.                 CONTEXT @   FORWARD DEFINED   ROT CONTEXT !
  322.                 0= ?MISSING   ;
  323.  
  324. : [FORWARD]     ( -- )  'F X, ;   IMMEDIATE
  325.  
  326. : T:            ( -- )
  327.                 SWITCH   TRANSITION DEFINITIONS
  328.                 CREATE   XHERE , SWITCH   ]
  329.                 DOES>    @ >R   ;
  330.  
  331. : T;            ( -- )
  332.                 SWITCH   TRANSITION DEFINITIONS   [COMPILE] ;    SWITCH   ;
  333.                 IMMEDIATE
  334.  
  335. : DIGIT?        ( CHAR -- F )   BASE @ DIGIT NIP   ;
  336.  
  337. : PUNCT?        ( CHAR -- F )
  338.                 ASCII . OVER = SWAP   ASCII - OVER = SWAP
  339.                 ASCII / OVER = SWAP   DROP OR OR ;
  340.  
  341. : NUMERIC?      ( ADDR LEN -- F )
  342.                 DUP 1 = IF    DROP C@ DIGIT?   EXIT   THEN
  343.                 1 -ROT   0 ?DO   DUP C@   DUP DIGIT? SWAP PUNCT? OR
  344.                 ROT AND SWAP 1+   LOOP   DROP   ;
  345.  
  346. T: (    [COMPILE] (     T;
  347. T: (    [COMPILE] (     T;
  348. T: \    [COMPILE] \     T;
  349.  
  350. : STRING,-T     ( -- )
  351.                 ASCII " PARSE  DUP C,-T  S,-T  ALIGN  ;
  352.  
  353.                 FORWARD: <(.")>
  354. T: ."           [FORWARD]  <(.")>  HERE-T ,-X STRING,-T   T;
  355.  
  356.                 FORWARD: <(")>
  357. T: "            [FORWARD] <(")>    HERE-T ,-X STRING,-T   T;
  358.  
  359.                 FORWARD: <(ABORT")>
  360. T: ABORT"       [FORWARD] <(ABORT")> HERE-T ,-X STRING,-T   T;
  361.  
  362.                 FORWARD_REL: <VARIABLE>
  363. : CREATE        RECREATE
  364.                 232 C,-T
  365.                 [FORWARD] <VARIABLE>   HERE-T CONSTANT   ;
  366.  
  367. : VARIABLE      ( | name -- ) CREATE   0 ,-T   ;
  368.  
  369.                 FORWARD_REL: <DEFER>
  370. : DEFER         ( -- )
  371.                 TARGET-CREATE
  372.                 232 C,-T                        \ CALL instruction
  373.                 [FORWARD] <DEFER>   0 ,-T   ;
  374.  
  375. FORTH
  376.  
  377. VARIABLE #USER-T
  378.  
  379. META ALSO USER DEFINITIONS
  380.  
  381. : ALLOT         ( n -- )
  382.                 #USER-T +!   ;
  383.  
  384.                 FORWARD_REL: <USER-VARIABLE>
  385. : VARIABLE      ( -- )
  386.                 SWITCH   RECREATE
  387.                 232 C,-T
  388.                 [FORWARD] <USER-VARIABLE>   #USER-T @
  389.                 DUP ,-T   2 ALLOT   META DEFINITIONS   CONSTANT   SWITCH   ;
  390.  
  391.                 FORWARD_REL: <USER-DEFER>
  392. : DEFER         ( -- )
  393.                 SWITCH   TARGET-CREATE
  394.                 232 C,-T
  395.                 [FORWARD] <USER-DEFER>   SWITCH
  396.                 #USER-T @ ,-T   2 ALLOT   ;
  397.  
  398. ONLY FORTH ALSO META ALSO DEFINITIONS
  399.  
  400. FORTH VARIABLE VOC-LINK-T META
  401.  
  402.                 FORWARD_REL: <VOCABULARY>
  403. : VOCABULARY    ( -- )
  404.                 RECREATE
  405.                 232 C,-T
  406.                 [FORWARD] <VOCABULARY>
  407.                 HERE-T   #TTHREADS 0 DO  0 ,-T  LOOP
  408.                 HERE-T VOC-LINK-T @ ,-T   VOC-LINK-T !
  409.                 CONSTANT DOES> @ CONTEXT-T !   ;
  410.  
  411. : IMMEDIATE     ( -- )
  412.                 WIDTH @
  413.                 IF ( Headers present? )
  414.                 64 ( Precedence Bit )   LAST-T @   CSET-Y   THEN   ;
  415.  
  416. FORWARD: <(;USES)>
  417.  
  418. FORTH
  419.  
  420. VARIABLE STATE-T
  421.  
  422. META
  423.  
  424. T: ;USES        ( -- )
  425.                 [FORWARD] <(;USES)>   IN-META ASSEMBLER
  426.                 !CSP   STATE-T OFF   T;
  427.  
  428. T: [COMPILE]    'T EXECUTE    T;
  429.  
  430.                 FORWARD: <(IS)>
  431. T: IS           [FORWARD] <(IS)>    T;
  432. :  IS           'T  ( CR HERE COUNT TYPE TAB OVER H. )
  433.                 >BODY @ >BODY-T !-T ;
  434.  
  435. T: ALIGN   T;
  436.  
  437. T: EVEN    T;
  438.  
  439. : .SYMBOLS      ( -- )
  440.                 TARGET   CONTEXT @ HERE #TTHREADS 2* CMOVE  CR
  441.                 BEGIN   HERE 4 LARGEST  DUP
  442.                 WHILE   DUP L>NAME  DUP Y@ 31 AND 2+ ?LINE
  443.                         ."  /  "  DUP .ID
  444.                         NAME> >BODY @ U.
  445.                         Y@ SWAP !
  446.                         KEY? IF   EXIT   THEN
  447.                 REPEAT  2DROP   IN-META   ;
  448.  
  449. : .UNRESOLVED   ( -- )
  450.                 FORWARD CONTEXT @ HERE #THREADS 2* CMOVE
  451.                 BEGIN   HERE #THREADS LARGEST   DUP
  452.                 WHILE   ?CR DUP L>NAME NAME> >BODY
  453.                         RESOLVED? 0=
  454.                         IF      >ATTRIB4 DUP L>NAME .ID >NORM
  455.                         THEN
  456.                         Y@  SWAP !
  457.                 REPEAT  2DROP  IN-META ;
  458.  
  459. : FIND-UNRESOLVED ( -- cfa f )  'F    DUP  >BODY RESOLVED?     ;
  460.  
  461. DECIMAL
  462.  
  463. : RESOLVE       ( taddr cfa -- )
  464.                 >BODY   2DUP   TRUE OVER 2+ !   @
  465.                 BEGIN   DUP
  466.                 WHILE   2DUP @-T   -ROT SWAP
  467.                         DUP 1-  C@-T 232 =            \ IF PRECEEDED BY CALL
  468.                         IF      DUP 2+ ROT SWAP - SWAP \ SWITCH TO RELATIVE
  469.                         THEN    !-T
  470.                 REPEAT  2DROP  ! ;
  471.  
  472. : RESOLVES      ( taddr -- )
  473.                 FIND-UNRESOLVED
  474. \                #OUT @ 60 > IF CR THEN HERE COUNT TYPE SPACE
  475.                 IF      CR >NAME .ID ." Already Resolved" DROP
  476.                 ELSE    RESOLVE   THEN   ;
  477.  
  478. : :RESOLVE      ( taddr cfa -- )
  479.                 >BODY   2DUP   TRUE OVER 2+ !   @
  480.                 BEGIN   DUP
  481.                 WHILE   2DUP @-X   -ROT SWAP !-X
  482.                 REPEAT  2DROP  ! ;
  483.  
  484. : :RESOLVES     ( taddr -- )
  485.                 FIND-UNRESOLVED
  486.                 IF      CR >NAME .ID ." Already Resolved" DROP
  487.                 ELSE    :RESOLVE   THEN   ;
  488.  
  489. : H:    [COMPILE] :   ;
  490.  
  491. H: '     'T >BODY @   ;
  492. H: ,    ,-T ;
  493. H: C,  C,-T ;
  494. H: X,   ,-X ;
  495. H: XC, C,-X ;
  496.  
  497. H: HERE         HERE-T ;
  498. H: XHERE        HERE-X ;
  499. H: ALLOT        ALLOT-T   ;
  500. H: DEFINITIONS  DEFINITIONS   CONTEXT-T @ CURRENT-T !   ;
  501.  
  502. ONLY FORTH DEFINITIONS ALSO
  503.  
  504. .( Meta Compiler Loaded )
  505.  
  506. CR .ELAPSED CR
  507.  
  508. FLOAD KERNEL1.SEQ
  509. FLOAD VIDEO.SEQ
  510. FLOAD KERNEL2.SEQ
  511. FLOAD KERNEL3.SEQ
  512. FLOAD HANDLES.SEQ
  513. FLOAD SEQREAD.SEQ
  514. FLOAD DEFAULT.SEQ
  515. FLOAD KERNEL4.SEQ
  516.  
  517. CAPS ON
  518.  8 TABSIZE !    \ RESTORE TABS
  519. 70 RMARGIN !    \ RESTORE RIGHT MARGIN
  520. #OUT @ #LINE @  \ Save where we are on screen.
  521. ?PAGE           \ NEW PAGE
  522. PRINTING OFF    \ NO PRINTING ANY MORE
  523. 2- AT CR        \ Go back there.
  524.  
  525.