Screen 0 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 1 not modified     
 0 \ Target compiler loadscr                         ks cas 09jun20
 1   Onlyforth   \needs Assembler   2 loadfrom asm.fb              
 2                                                                 
 3   : c+!     ( 8b addr -- )      dup c@ rot + swap c! ;          
 4                                                                 
 5   ' find $22 + @ Alias found                                    
 6                                                                 
 7   : search   ( string 'vocab -- acf n / string ff )             
 8      dup @ [ ' Forth @ ] Literal - Abort" no vocabulary"        
 9      >body (find IF  found exit  THEN  false ;                  
10                                                                 
11   3 &27 thru  Onlyforth savesystem meta.com                     
12                                                                 
13 cr .( Metacompiler saved as META.COM  )                         
14                                                                 
15                                                                 
Screen 2 not modified     
 0 \ Predefinitions loadscreen                       ks 30 apr 88  
 1                                                                 
 2   &28 load                                                      
 3                                                                 
 4 cr .( Predefinitions geladen ...) cr                            
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 3 not modified     
 0 \ Target header pointers                          ks 29 jun 87  
 1                                                                 
 2   Variable tfile      tfile off         \ handle of target file 
 3   Variable tdp        tdp off           \ target dp             
 4   Variable displace   displace off      \ diplacement of code   
 5   Variable ?thead     ?thead off        \ for headerless code   
 6   Variable tlast      tlast off         \ last name in target   
 7   Variable glast'     glast' off        \ acf of latest ghost   
 8   Variable tdoes>     tdoes> off        \ code addr of last does
 9   Variable tdodo      tdodo off         \ location of dodo      
10   Variable >in:       >in: off          \ last :-def            
11   Variable tvoc       tvoc off          \                       
12   Variable tvoc-link  tvoc-link off     \ voc-link in target    
13   Variable tnext-link tnext-link off    \ link for tracer       
14                                                                 
15                                                                 
Screen 4 not modified     
 0 \ Target header pointers                          ks 10 okt 87  
 1                                                                 
 2   : there  ( -- taddr )   tdp @ ;                               
 3                                                                 
 4   : new   pushfile  makefile   isfile@ tfile !                  
 5      tvoc-link off   tnext-link off                             
 6      $100 tdp !   $100 displace ! ;                             
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 5 not modified     
 0 \ Ghost-creating                                  ks 07 dez 87  
 1                                                                 
 2 0 | Constant <forw>          0 | Constant <res>                 
 3                                                                 
 4 | Create gname  $21 allot                                       
 5                                                                 
 6 | : >heap  ( from quan -- )   \ heap over - 1 and + \ align     
 7      dup hallot heap swap cmove ;                               
 8                                                                 
 9   : symbolic  ( string -- cfa.ghost )                           
10      count  dup 1 $1F uwithin not Abort" invalid Gname"         
11      gname place   BL gname append   align here >r  makeview ,  
12      state @ IF  context  ELSE  current  THEN @ @  dup @ ,      
13      gname count under here place   1+ allot align              
14      here r@ -   <forw> , 0 , 0 ,   r@ here over - >heap        
15      heap 2+ rot !   r> dp !   heap + ;                         
Screen 6 not modified     
 0 \ ghost words                                     ks 07 dez 87  
 1                                                                 
 2   : gfind  ( string -- cfa tf / string ff )                     
 3      >r   1 r@ c+!   r@ find   -1 r> c+! ;                      
 4                                                                 
 5   : ghost   ( -- cfa )   name gfind ?exit  symbolic ;           
 6                                                                 
 7   : gdoes>  ( cfa.ghost -- cfa.does )                           
 8      4 + dup @ IF  @ exit THEN                                  
 9      here  <forw> , 0 ,  dup 4 >heap                            
10      dp !   heap swap !  heap ;                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 7 not modified     
 0 \ ghost utilities                                 ks 29 jun 87  
 1                                                                 
 2   : g'  ( -- acf )   name gfind 0= Abort" ?T?" ;                
 3                                                                 
 4   : '.   g' dup @ <forw> case?                                  
 5      IF ." forw"  ELSE  <res> - Abort" ??" ."  res"  THEN       
 6      2+ dup @ 5 u.r      2+ @ ?dup                              
 7      IF dup @ <forw> case?                                      
 8         IF ."  fdef"  ELSE <res> - Abort"  ??" ."  rdef"  THEN  
 9         2+ @ 5 u.r THEN ;                                       
10                                                                 
11   ' ' Alias h'                                                  
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 8 not modified     
 0 \ .unresolved                                     ks 29 jun 87  
 1                                                                 
 2 | : forward? ( cfa -- cfa / exit&true )                         
 3      dup @ <forw> = 0=exit  dup 2+ @ 0=exit  drop true rdrop ;  
 4                                                                 
 5 | : unresolved? ( addr -- f )   2+                              
 6      dup count $1F and + 1- c@  bl =                            
 7      IF  name> forward? 4+ @  dup IF  forward?  THEN            
 8      THEN drop  false ;                                         
 9                                                                 
10 | : unresolved-words   ( thread -- )                            
11      BEGIN  @ ?dup WHILE dup unresolved?                        
12                          IF dup 2+ .name ?cr THEN  REPEAT ;     
13                                                                 
14   : .unresolved       voc-link @                                
15      BEGIN  dup 4 - unresolved-words  @ ?dup 0= UNTIL ;         
Screen 9 not modified     
 0 \ Extending Vocabularys for Target-Compilation    ks 29 jun 87  
 1                                                                 
 2   Vocabulary Ttools                                             
 3   Vocabulary Defining                                           
 4                                                                 
 5   : Vocabulary       Vocabulary 0 , here tvoc @ , tvoc ! ;      
 6                                                                 
 7   Vocabulary Transient    tvoc off                              
 8                                                                 
 9   Root definitions                                              
10                                                                 
11   : T Transient ; immediate                                     
12   : H Forth     ; immediate                                     
13   : D Defining  ; immediate                                     
14                                                                 
15   Forth definitions                                             
Screen 10 not modified     
 0 \ Image and byteorder                             ks 02 jul 87  
 1                                                                 
 2 | Code >byte  ( 16b -- 8b- 8b+ )   A A xor                      
 3      D- A- xchg   D+ D- xchg   A push   Next   end-code         
 4                                                                 
 5 | Code byte>  ( 8b- 8b+ -- 16b )                                
 6      A pop   D- D+ mov   A- D- xchg   Next   end-code           
 7                                                                 
 8 | : >target  ( addr1 -- daddr fcb )  displace @ - 0 tfile @  ;  
 9                                                                 
10   Transient definitions                                         
11                                                                 
12   : c@    ( addr -- 8b )   [ Dos ]                              
13      >target file@ dup 0< Abort" nie abgespeichert" ;           
14                                                                 
15   : c!    ( 8b addr -- )   [ Dos ] >target file! ;              
Screen 11 not modified     
 0 \ Transient primitives                            ks 09 jul 87  
 1   : @     ( addr -- n )    H dup T c@ swap 1+ c@ byte> ;        
 2   : !     ( n addr -- )    H >r  >byte r@ 1+ T c!  r> c! H ;    
 3                                                                 
 4   : cmove ( from.mem to.target quan -- )  [ Dos ]               
 5      >r >target fseek   ds@ swap r> tfile @ lfputs ;            
 6 \    bounds ?DO  dup c@   I T c! H 1+  LOOP  drop ;             
 7                                                                 
 8   : here  ( -- taddr )     H tdp @ ;                            
 9   : here! ( taddr -- )     H tdp ! ;                            
10   : allot ( n -- )         H tdp +! ;                           
11   : c,    ( 8b -- )        T here c! 1 allot H ;                
12   : ,     ( 16b -- )       T here !  2 allot H ;                
13   : align ( -- )           H ; immediate                        
14   : even  ( addr1 -- addr2 ) H ; immediate                      
15   : halign                 H ; immediate                        
Screen 12 not modified     
 0 \ Transient primitives                            ks 29 jun 87  
 1                                                                 
 2   : count ( addr1 -- addr2 len )  H dup 1+ swap T c@ H ;        
 3                                                                 
 4   : ,"    H here ," here   over dp !                            
 5      over - T here swap dup allot cmove H ;                     
 6                                                                 
 7   : fill  ( addr quan 8b -- )  H                                
 8      -rot bounds ?DO  dup I T c! H  LOOP  drop ;                
 9   : erase ( addr quan -- )    H  0 T fill H ;                   
10   : blank ( addr quan -- )    H bl T fill H ;                   
11                                                                 
12   : move-threads    H tvoc @   tvoc-link @                      
13      BEGIN  over ?dup                                           
14      WHILE  2- @ over 2- T !   @   H swap @ swap  REPEAT        
15      Error" some undef. Target-Vocs left" drop ;                
Screen 13 not modified     
 0 \ Resolving                                       ks 29 jun 87  
 1   Forth definitions                                             
 2                                                                 
 3   : resolve ( cfa.ghost cfa.target -- )   over dup @ <res> =    
 4      IF  space dup >name .name ." exists "  ?cr                 
 5          2+ !  drop exit  THEN   >r >r  2+ @ ?dup               
 6      IF  BEGIN  dup T @ H 2dup = Abort" resolve loop"           
 7                 r@ rot T ! H ?dup 0= UNTIL                      
 8      THEN  r> r>  <res> over !  2+ ! ;                          
 9                                                                 
10   : resdoes> ( acf.ghost acf.target -- )  swap gdoes>           
11      dup @ <res> = IF  2+ ! exit  THEN  swap resolve ;          
12                                                                 
13 here 2+ 0 ] Does> dup @ there rot ! T , H ;  ' <forw> >body !   
14 here 2+ 0 ] Does> @ T , H ;                  ' <res>  >body !   
15                                                                 
Screen 14 not modified     
 0 \ compiling names into targ.                      ks 10 okt 87  
 1                                                                 
 2 | : tlatest ( -- addr )       current @ 6 + ;                   
 3                                                                 
 4   : (theader   ?thead @ IF  1 ?thead +! exit  THEN              
 5      >in @  bl word  swap >in !  dup count upper                
 6      dup c@ 1 $20 uwithin  not Abort" inval. Tname"             
 7      blk @ $8400 or T align , H                                 
 8      there tlatest @ T , H tlatest !   there tlast !            
 9      there over c@ 1+  dup T allot cmove align H ;              
10                                                                 
11   : theader    tlast off                                        
12      (theader ghost   dup glast' !   there resolve ;            
13                                                                 
14                                                                 
15                                                                 
Screen 15 not modified     
 0 \ prebuild defining words                         ks 29 jun 87  
 1                                                                 
 2 | : (prebuild   >in @  Create  >in !                            
 3                 r> dup 2+ >r  @ here 2- ! ;                     
 4                                                                 
 5 | : tpfa,       there , ;                                       
 6                                                                 
 7   : prebuild   ( addr check# -- check# )  0 ?pairs              
 8      dup IF  compile (prebuild  dup ,  THEN                     
 9      compile theader   ghost gdoes> ,                           
10      IF  compile tpfa, THEN  0 ; immediate                      
11                                                                 
12   : dummy   0 ;                                                 
13                                                                 
14   : DO>   [compile] Does> here 3 - compile @  0 ] ;             
15                                                                 
Screen 16 not modified     
 0 \ Constructing defining words in Host            kks 07 dez 87  
 1                                                                 
 2 | : defcomp  ( string -- )  dup ['] Defining search ?dup        
 3      IF  0> IF  nip execute exit  THEN  drop dup  THEN          
 4      find ?dup IF  0< IF  nip , exit  THEN THEN                 
 5      drop  ['] Forth search ?dup                                
 6      IF  0< IF  , exit  THEN  execute exit  THEN                
 7      number? ?dup 0= Abort" ?"                                  
 8      0> IF  swap [compile] Literal  THEN  [compile] Literal ;   
 9                                                                 
10 | : definter ( string -- )  dup ['] Defining search ?dup        
11      IF  0< IF  nip execute exit  THEN THEN  drop               
12      find ?dup IF  1 and 0= Abort" compile only"  execute exit  
13                THEN  number? 0= Error" ?"  ;                    
14                                                                 
15                                                                 
Screen 17 not modified     
 0 \ Constructing defining words in Host             ks 22 dez 87  
 1                                                                 
 2 | : (;tcode      r> @   tlast @ T count +  ! H ;                
 3                                                                 
 4 Defining definitions                                            
 5                                                                 
 6   : ]  H ] ['] defcomp Is parser ;                              
 7                                                                 
 8   : [  H [compile] [ ['] definter Is parser ; immediate         
 9                                                                 
10   : ;  H [compile] ;  [compile] \\ ; immediate                  
11                                                                 
12   : Does>    H compile (;tcode  tdoes> @ ,                      
13      [compile] ; -2 allot [compile] \\ ; immediate              
14 D ' Does> Alias ;Code  immediate   H                            
15                                                                 
Screen 18 not modified     
 0 \ reinterpreting defining words                   ks 22 dez 87  
 1   Forth definitions                                             
 2                                                                 
 3   : ?reinterpret ( f -- )   0=exit                              
 4      state @ >r  >in @ >r   adr parser @ >r                     
 5      >in: @ >in !   :  D ] H interpret                          
 6      r> Is parser   r> >in !   r> state ! ;                     
 7                                                                 
 8   : undefined?  ( -- f )   glast' @ 4+ @ 0= ;                   
 9                                                                 
10 | : flag!  ( 8b -- )  tlast @ ?dup 0= IF  drop exit  THEN       
11      dup T c@ rot or swap c! H ;                                
12                                                                 
13 | : nfa? ( acf alf -- anf / acf ff )                            
14      BEGIN  dup WHILE  2dup 2+ T count $1F and + even H =       
15                        IF  2+ nip exit  THEN  T @ H REPEAT ;    
Screen 19 not modified     
 0 \ the 8086 Assembler                              ks 29 jun 87  
 1                                                                 
 2 | Create relocate ] T c, , here ! c! H [                        
 3                                                                 
 4 Transient definitions                                           
 5                                                                 
 6   : Assembler  H [ Assembler ] relocate >codes ! Assembler ;    
 7                                                                 
 8   : >label ( 16b -- )  H >in @ name gfind rot >in !             
 9      IF over resolve dup THEN drop Constant ;                   
10                                                                 
11   : Label      T here >label Assembler H ;                      
12                                                                 
13   : Code       H theader T here 2+ , Assembler H ;              
14                                                                 
15                                                                 
Screen 20 not modified     
 0 ( Transient primitives                           ks 17 dec 83 ) 
 1                                                                 
 2 ' exit Alias exit           ' load Alias load                   
 3 ' /    Alias /              ' thru Alias thru                   
 4 ' swap Alias swap           ' *    Alias *                      
 5 ' dup  Alias dup            ' drop Alias drop                   
 6 ' /mod Alias /mod           ' rot  Alias rot                    
 7 ' -rot Alias -rot           ' over Alias over                   
 8 ' 2*   Alias 2*             ' +    Alias +                      
 9 ' -    Alias -              ' 1+   Alias 1+                     
10 ' 2+   Alias 2+             ' 1-   Alias 1-                     
11 ' 2-   Alias 2-           ' negate Alias negate                 
12 ' 2swap Alias 2swap         ' 2dup Alias 2dup                   
13                                                                 
14                                                                 
15                                                                 
Screen 21 not modified     
 0 \ Transient primitives                           kks 29 jun 87  
 1                                                                 
 2        ' also Alias also         ' words Alias words            
 3 ' definitions Alias definitions    ' hex Alias hex              
 4 ' decimal     Alias decimal         ' (  Alias (  immediate     
 5        ' \    Alias \  immediate    ' \\ Alias \\ immediate     
 6        ' .(   Alias .( immediate    ' [  Alias [  immediate     
 7        ' cr   Alias cr                                          
 8 ' end-code    Alias end-code  ' Transient Alias Transient       
 9    ' +thru    Alias +thru        ' +load Alias +load            
10          ' .s Alias .s                                          
11                                                                 
12 Tools ' trace  Alias trace  immediate                           
13                                                                 
14                                                                 
15                                                                 
Screen 22 not modified     
 0 \ immediate words and branch primitives           ks 29 jun 87  
 1                                                                 
 2   : >mark     ( -- addr )  T here 0 , H ;                       
 3   : >resolve  ( addr -- )  T here over - swap ! H ;             
 4   : <mark     ( -- addr )  H there ;                            
 5   : <resolve  ( addr -- )  T here - , H ;                       
 6                                                                 
 7   : immediate     H $40 flag! ;                                 
 8   : restrict      H $80 flag! ;                                 
 9                                                                 
10                                                                 
11   : |             H ?thead @ ?exit ?thead on ;                  
12   : internal      H 1 ?thead ! ;                                
13   : external      H ?thead off ;                                
14                                                                 
15                                                                 
Screen 23 not modified     
 0 \ ' | compile  Alias  >name                       ks 29 jun 87  
 1                                                                 
 2   : '        ( -- acf )     H g' dup @ <res> -                  
 3                             IF  Error" undefined"  THEN  2+ @ ; 
 4                                                                 
 5   : compile       H ghost , ; immediate restrict                
 6                                                                 
 7   : >name ( acf -- anf / ff )  H tvoc                           
 8      BEGIN  @ dup WHILE  under 2- @ nfa? ?dup IF nip exit THEN  
 9             swap  REPEAT  nip ;                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 24 not modified     
 0 \ >name  Alias                                    ks 29 jun 87  
 1                                                                 
 2   : >body ( acf -- apf )   H 2+ ;                               
 3                                                                 
 4   : Alias ( n -- )   H tlast off                                
 5      (theader  ghost over resolve  T , H  $20 flag! ;           
 6                                                                 
 7   : on    ( addr -- )   H  true swap T ! H ;                    
 8   : off   ( addr -- )   H false swap T ! H ;                    
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 25 not modified     
 0 \ Target tools                                    ks  9 sep 86  
 1   Onlyforth                                                     
 2                                                                 
 3 | : .tfield ( taddr len quan -)  >r under Pad swap              
 4      bounds ?DO  dup T c@ I H c!  1+  LOOP  drop                
 5      Pad over type r> swap - 0 max spaces ;                     
 6                                                                 
 7   ' view Alias hview                                            
 8                                                                 
 9   Ttools also definitions                                       
10                                                                 
11 | : ?:  ( addr -- addr )   dup 4 u.r ." :" ;                    
12 | : @?  ( addr -- addr )   dup T @ H 6 u.r ;                    
13 | : c?  ( addr -- addr )   dup T c@ H 3 .r ;                    
14                                                                 
15                                                                 
Screen 26 not modified     
 0 \ Ttools for decompiling                          ks  9 sep 86  
 1                                                                 
 2   : s  ( addr -- addr+ )   ?: space c? 4 spaces                 
 3      T count 2dup + even -rot 18 .tfield ;                      
 4                                                                 
 5   : n  ( addr -- addr+2 )  ?: @? 2 spaces   dup T @ >name H     
 6      ?dup IF  T count H  ELSE  0 0  THEN                        
 7      $1F and  $18 .tfield 2+ ;                                  
 8                                                                 
 9   : d  ( addr n -- addr+n )  2dup swap ?: 3 spaces              
10      swap 0 DO  c? 1+  LOOP  4 spaces -rot dup .tfield ;        
11                                                                 
12   : l  ( addr -- addr+2 )  ?: 6 spaces @? 2+ 14 spaces ;        
13                                                                 
14   : c  ( addr -- addr+1 )  1 d 15 spaces ;                      
15                                                                 
Screen 27 not modified     
 0 \ Tools for decompiling                           ks 29 jun 87  
 1                                                                 
 2   : b  ( addr -- addr+2 )  ?: @? dup T @ H                      
 3      over + 6 u.r 2+ 14 spaces ;                                
 4                                                                 
 5   : dump ( addr n -- )                                          
 6      bounds ?DO cr I 10 d drop stop? IF LEAVE THEN  10 +LOOP ;  
 7                                                                 
 8   : view  T ' >name H ?dup 0=exit  4 - T @ H ?dup 0=exit edit ; 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 28 not modified     
 0 \ Predefinitions loadscreen                       ks 29 jun 87  
 1   Onlyforth                                                     
 2                                                                 
 3   : clear     H true Abort" There are ghosts" ;                 
 4                                                                 
 5                                                                 
 6   1 $B +thru                                                    
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 29 not modified     
 0 \ Literal ['] ?" ." "                             ks 29 jun 87  
 1   Transient definitions Forth                                   
 2                                                                 
 3   : Literal  ( n -- )   H dup $FF00 and                         
 4      IF  T compile lit , H exit THEN  T compile clit c, H ;     
 5   immediate                                                     
 6                                                                 
 7   : Ascii   H bl word 1+ c@  state @ 0=exit                     
 8             T [compile] Literal H ; immediate                   
 9                                                                 
10   : [']     T compile lit           H ; immediate               
11   : ."      T compile (."  ," align H ; immediate               
12   : "       T compile ("   ," align H ; immediate               
13                                                                 
14                                                                 
15                                                                 
Screen 30 not modified     
 0 \ Target compilation  ]                           ks 07 dez 87  
 1   Forth definitions                                             
 2                                                                 
 3 | : tcompile  ( string -- )   dup find ?dup                     
 4      IF  0> IF  nip execute exit  THEN THEN                     
 5      drop gfind IF  execute exit  THEN   number? ?dup           
 6      IF  0> IF  swap T [compile] Literal  THEN                  
 7                 [compile] Literal H exit  THEN                  
 8      symbolic execute ;                                         
 9                                                                 
10   Transient definitions                                         
11                                                                 
12   : ]    H ] ['] tcompile Is parser ;                           
13                                                                 
14                                                                 
15                                                                 
Screen 31 not modified     
 0 \ Target conditionals                             ks 10 sep 86  
 1                                                                 
 2   : IF        T compile ?branch >mark H 1 ; immediate restrict  
 3   : THEN      abs 1 ?pairs T >resolve H ;   immediate restrict  
 4   : ELSE      1 ?pairs T compile branch >mark                   
 5               swap >resolve H -1 ;          immediate restrict  
 6                                                                 
 7   : BEGIN     T <mark H 2 ;                 immediate restrict  
 8   : WHILE     2 ?pairs 2 T compile ?branch >mark H -2 2swap ;   
 9                                             immediate restrict  
10                                                                 
11 | : (repeat   2 ?pairs T <resolve H                             
12               BEGIN  dup -2 = WHILE  drop T >resolve H REPEAT ; 
13                                                                 
14   : UNTIL     T compile ?branch (repeat H ; immediate restrict  
15   : REPEAT    T compile  branch (repeat H ; immediate restrict  
Screen 32 not modified     
 0 \ Target conditionals   Abort" etc.               ks 09 feb 88  
 1                                                                 
 2   : DO        T compile (do  >mark H 3 ;    immediate restrict  
 3   : ?DO       T compile (?do >mark H 3 ;    immediate restrict  
 4   : LOOP      3 ?pairs T compile (loop                          
 5               compile endloop >resolve H ;  immediate restrict  
 6   : +LOOP     3 ?pairs T compile (+loop                         
 7               compile endloop >resolve H ;  immediate restrict  
 8                                                                 
 9   : Abort"    T compile (abort" ," align H ; immediate restrict 
10   : Error"    T compile (error" ," align H ; immediate restrict 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 33 not modified     
 0 \ Target does>  ;code                             ks 29 jun 87  
 1                                                                 
 2 | : dodoes>   T compile (;code                                  
 3      H glast' @ there resdoes>   there tdoes> ! ;               
 4                                                                 
 5   : Does>    H undefined? T dodoes>                             
 6      $E9 c,  H tdodo @ there - 2- T ,                           
 7      H ?reinterpret ; immediate restrict                        
 8                                                                 
 9   : ;Code  H 0 ?pairs undefined? T dodoes> H ?reinterpret       
10      T [compile] [ Assembler H ; immediate restrict             
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 34 not modified     
 0 \ User                                            ks 09 jul 87  
 1   Forth definitions                                             
 2                                                                 
 3   Variable torigin    torigin off       \ cold boot vector      
 4   Variable tudp       tudp off          \ user variable counter 
 5   : >user    ( addr1 -- addr2 )  T c@ H torigin @ + ;           
 6                                                                 
 7   Transient definitions Forth                                   
 8                                                                 
 9   : origin!  ( taddr -- )     H torigin !  tudp off ;           
10   : uallot   ( n -- offset )  H tudp @  swap tudp +! ;          
11                                                                 
12   DO> >user ;                                                   
13   : User      T prebuild User 2 uallot c, H ;                   
14                                                                 
15                                                                 
Screen 35 not modified     
 0 \ Variable  Constant  Create                      ks 01 okt 87  
 1                                                                 
 2   DO> ;                                                         
 3   : Variable T prebuild Create  2 allot H ;                     
 4                                                                 
 5   DO> T @ H ;                                                   
 6   : Constant T prebuild Constant  , H ;                         
 7                                                                 
 8   DO> ;                                                         
 9   : Create    T prebuild Create  H ;                            
10                                                                 
11   : Create:   T Create ] H end-code 0 ;                         
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 36 not modified     
 0 \ Defer  Is  Vocabulary                           ks 29 jun 87  
 1                                                                 
 2   DO> ;                                                         
 3   : Defer     T prebuild Defer  2 allot ;                       
 4   : Is        T ' >body H state @                               
 5      IF  T compile (is , H exit  THEN  T ! H ; immediate        
 6                                                                 
 7   dummy                                                         
 8   : Vocabulary   H >in @ Vocabulary >in !                       
 9      T prebuild Vocabulary  0 , 0 ,                             
10      H there   tvoc-link @ T , H   tvoc-link ! ;                
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 37 not modified     
 0 \ File                                            ks 19 m„r 88  
 1   Forth definitions                                             
 2                                                                 
 3   Variable tfile-link  tfile-link off                           
 4   Variable tfileno     tfileno off                              
 5   &45 Constant tb/fcb                                           
 6                                                                 
 7   Transient definitions Forth                                   
 8                                                                 
 9   dummy                                                         
10   : File   T prebuild File  here tb/fcb 0 fill                  
11      here H tfile-link @ T , H tfile-link !                     
12      1 tfileno +!  tfileno @ T c, 0 , 0 , 0 , 0 , 0 ,           
13      here dup >r  1+   tb/fcb &13 - allot   H tlast @           
14      T count dup r> c!                                          
15      H bounds ?DO  I T c@ over c! H 1+  LOOP drop ;             
Screen 38 not modified     
 0 \ : ; compile Host [compile]                      ks 29 jun 87  
 1                                                                 
 2   dummy                                                         
 3   : :        H >in @ >in: !   T prebuild : ] H end-code 0 ;     
 4                                                                 
 5   : ;        0 ?pairs T compile unnest                          
 6              [compile] [ H ; immediate restrict                 
 7                                                                 
 8   : compile  T compile compile H ; immediate restrict           
 9                                                                 
10   : Host     H Onlyforth ;                                      
11                                                                 
12   : Compiler H Onlyforth Transient also definitions ;           
13                                                                 
14   : [compile]  H ghost execute ; immediate restrict             
15                                                                 
Screen 39 not modified     
 0 \ Target                                          ks 29 jun 87  
 1                                                                 
 2   Onlyforth                                                     
 3                                                                 
 4   : Target   H vp off  Transient also definitions ;             
 5                                                                 
 6   Transient definitions                                         
 7                                                                 
 8   ghost c, drop                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 40 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 41 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 42 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 43 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 44 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 45 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 46 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 47 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 48 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 49 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 50 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 51 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 52 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
