\    ZEN 1.9  Forth to MASM translator
\    C 1989 by Martin Tracy
\
\*   Last modified: 12.10.89 by MJT
\*   Last Modified: 02/19/90 by MAW to produce COM executable

 Notes:
   1. Words may not be named as numbers.
   2. Words may not be redefined.
   3. Vocabularies are not supported.
   4. ASSEMBLER copies until END-CODE
   5. Reserved words are only recognized in all caps.
   6. MHERE and MTHERE put label on a separate line.
   8. ." yields the string  2,".",34,""
   9. M\* should be more selective.

*\

\ Display the vocabularies in the search order.
: ORDER   \ RESERVED
   BASE @   HEX
   CONTEXT  BEGIN  DUP @ WHILE  DUP @ U.  CELL+ REPEAT  DROP  BASE ! ;


\ V O C A B U L A R I E S

\ Forth words with altered meaning go here.
VOCABULARY MAGIC

\ Make these vocabularies IMMEDIATE:
: [FORTH]   POSTPONE FORTH ;  IMMEDIATE
: [MAGIC]   POSTPONE MAGIC ;  IMMEDIATE


\ W R I T E   F I L E S

FILE TARGET   \ MASM  source file
FILE VARFIL   \ variable intermediate file
FILE DATFIL   \ create   intermediate file
FILE HONFIL   \ words used in header

\ Write string with guarantee.
: F.WRITE ( a u fcb)
   OVER >R  WRITE-FILE SWAP  R> - OR ABORT" Bad write" ;

\ Write end-of-line sequence with guarantee.
: F.CR ( fcb)
   CRLF COUNT  ROT F.WRITE ;

\ Write line with guarantee.
: F.LINE ( a u fcb)
   DUP >R  F.WRITE  R> F.CR ;


\ W R I T E   T A R G E T

80 CONSTANT #LEN   \ Maximum length of TARGET line

VARIABLE CTR   \ # of chars written to TARGET line
VARIABLE DW?   \ true if dw field already written to TARGET line
VARIABLE M\?   \ true if run of backslash comments in column zero

\ Write end-of-line sequence to TARGET.  Reset CTR DW?
: T.CR
   TARGET F.CR   CTR OFF  DW? OFF ;

\ Force TARGET to new line if necessary.
: T.CR?
   CTR @ IF  T.CR  THEN ;

\ Write string to TARGET and update CTR
\ Force new line if this line would be too long.
: T.WRITE ( a u)
\  DUP CTR @ + #LEN > IF  T.CR  THEN
   DUP CTR +!  TARGET F.WRITE ;

\ Write line to TARGET
: T.LINE ( a u)
   T.WRITE  T.CR ;

\ Write n spaces, up to 8 at a time.
: T.SPACES ( +n)
   8 /MOD  0 ?DO  "         "           T.WRITE  LOOP
                  "         " DROP SWAP T.WRITE ;

\ Tab to  dw  field.
: TAB1
    8 CTR @ - 1 MAX T.SPACES ;


\ C O P Y   L I N E S

\ Read next word, reading new source lines as needed.
: NEXT.WORD ( ch - 'str)
   BEGIN  DUP WORD  DUP C@ IF  NIP EXIT  THEN
          INQUIRE
   WHILE  DROP  REPEAT  NIP ;

\ Copy lines from SOURCE to TARGET,
\ stopping at the first line beginning with the given string.
: COPY.LINES ( a u)
   BEGIN  INQUIRE
   WHILE  BL WORD COUNT  2OVER COMPARE
   WHILE  >IN OFF  ( Reread) 01 PARSE T.LINE
   REPEAT THEN  2DROP ;

: ASSEMBLER
   01 PARSE EVALUATE ( rest of line)
   T.CR?  " END-CODE" COPY.LINES ;


\ W R I T E   S Y M B O L S

: DW.TAB
   TAB1  " dw    " T.WRITE  DW? ON ;
: DB.TAB
   TAB1  " db    " T.WRITE ;
: EQ.TAB
   TAB1  " EQU   " T.WRITE ;

\ Special formats:
: (UD) ( d - a u)
   BASE @ >R  DECIMAL  <# #S #>  R> BASE ! ;

: 0####h ( n - a u)
   BASE @ >R  HEX
   0 <# [CHAR] h HOLD # # # # # #>  R> BASE ! ;

: (####h) ( n - a u)
   BASE @ >R  HEX
   0 <# [CHAR] ) HOLD [CHAR] h HOLD # # # # #
        [CHAR] ( HOLD #>  R> BASE ! ;

: L#### ( n - a u)
   BASE @ >R  HEX
   0 <# # # # # [CHAR] L HOLD #>  R> BASE ! ;

: ##, ( n - a u)
   BASE @ >R  DECIMAL
   0 <# [CHAR] , HOLD # #S #>  R> BASE ! ;


\ X L A T E   S Y M B O L S

VARIABLE JOT   80 CELL - ALLOT   \ temporary string buffer.

\ Imbed string in quotes.  Uses JOT
: <QUOTED> ( a u - a2 u2)
   >R  JOT R@ 2 + [CHAR] " FILL  JOT 1+ R@ CMOVE  JOT R> 2 + ;

\ Quote string and precede with count.
: ##,QUOTED ( a u - a2 u2)
   DUP ##,  2SWAP <QUOTED> STRCAT ;

\ Quote string and precede with count.
\ Replace a single embedded quote with its ASCII equivalent.
: DEQUOTED ( a u - a2 u2)
   DUP ##,  2SWAP  2DUP [CHAR] " SCAN NIP  ?DUP
   IF  OVER SWAP - >R   OVER R@ 1+ STRCPY
       " ,34," STRCAT  2SWAP R> /STRING  STRCAT
   THEN  <QUOTED> STRCAT ;

\ Append character to symbol on string stack:
: Q+ ( a u - a2 u2)
   " q" STRCAT ;
: K+ ( a u - a2 u2)
   " :" STRCAT ;
: V+ ( a u - a2 u2)
   " v" STRCAT ;
: Z+ ( a u - a2 u2)
   " z" STRCAT ;
: H+ ( a u - a2 u2)
   " c" STRCAT ;

\ Counted string array defining word.  See numerous examples.
: SETS
   CREATE ( n)             0 ?DO  BL WORD COUNT ",  LOOP
   DOES> ( n - a u)  SWAP  0 ?DO  COUNT +           LOOP  COUNT ;

 8 SETS Ascii1A   Store Quote Sharp Dollar Percent Ampersand Tick LParen
 7 SETS Ascii1B   RParen Star Plus Comma Minus Dot Slash

10 SETS Numbers   Zero One Two Three Four Five Six Seven Eight Nine

 7 SETS Ascii2   Colon Semi Less Equals Great Query Fetch

 6 SETS Ascii3   LBracket Backslash RBracket Caret Uscore LTick

 4 SETS Ascii4   LCurly Bar RCurly Tilde


\ Use C! to translate char into string.
VARIABLE ONE.CHAR

\ Translate any non-printable chars into printable string
: X.LETTER ( char - a u)
   DUP [CHAR] 0 [CHAR] 9 1+ WITHIN
       IF  [CHAR] 0 - Numbers  EXIT  THEN
   DUP [CHAR] ! [CHAR] ( 1+ WITHIN
       IF  [CHAR] ! - Ascii1A  EXIT  THEN
   DUP [CHAR] ) [CHAR] / 1+ WITHIN
       IF  [CHAR] ) - Ascii1B  EXIT  THEN
   DUP [CHAR] : [CHAR] @ 1+ WITHIN
       IF  [CHAR] : - Ascii2   EXIT  THEN
   DUP [CHAR] [ [CHAR] ` 1+ WITHIN
       IF  [CHAR] [ - Ascii3   EXIT  THEN
   DUP [CHAR] { [CHAR] ~ 1+ WITHIN
       IF  [CHAR] { - Ascii4   EXIT  THEN
   ONE.CHAR C!  ONE.CHAR 1 ;

\ Reserved words.  Don't add spaces to end of line.
: ResName
   "  DUP ? ABS MOD AND OR XOR NOT BL TYPE ERR WORD DP " ;
: ResName2
   "  IF ELSE LEAVE LOOP WARN LOCAL PAGE ALIGN " ;

\ Translate reserved words by appending an underscore.
\ True if reserved.
: RESERVED? ( a u - a2 u2 f)
   2DUP  ResName  2OVER STRNDX  0<
   IF    ResName2 2OVER STRNDX  0< IF  2DROP 0  EXIT THEN
   THEN  2DROP  " _" 2SWAP STRCAT  TRUE ;


VARIABLE OLD.NAM1   32 CELL - ALLOT   \ original symbol name
VARIABLE OLD.NAM2   32 CELL - ALLOT   \ original symbol name
VARIABLE NEW.NAME  128 CELL - ALLOT   \ readable symbol name

\ Pseudo-vocabulary support:
VARIABLE VOC#   \ 0 = Forth  1 = Root

: XFORTH   FORTH ;

: MFORTH   0 VOC# !  MAGIC ;
: MROOT    1 VOC# ! ;
: MDEFINITIONS   DEFINITIONS ;

: OLD.NAME
   VOC# @ IF  OLD.NAM1  ELSE  OLD.NAM2  THEN ;

\ Translate string to readable string2 saved in NEW.NAME
\ Reserved words need no further translation.
: X.NAME ( a u - a2 u2)
   RESERVED?
   IF    NEW.NAME PLACE
   ELSE  NEW.NAME 1+ SWAP  31 MIN 0
     ?DO  OVER C@ X.LETTER ( len) >R
          OVER R@ CMOVE  R> + SWAP 1+ SWAP
     LOOP  NEW.NAME 1+ - 31 MIN NEW.NAME C!  DROP
   THEN    NEW.NAME COUNT ;



\ T O K E N S

\ Add symbol to "dw" line.
: DW+ ( a u)
   DUP CTR @ + ( comma) 2 + #LEN > IF  T.CR  THEN
   DW? @ NOT IF  DW.TAB  ELSE  " , " 2SWAP STRCAT  THEN
   T.WRITE ;

\ Literals.
: MLITERAL ( n)
   " Lit, "  ROT 0####h STRCAT  DW+ ;

\ Address literals.
: M[']
   " Tic, "  BL WORD COUNT X.NAME STRCAT  DW+ ;

\ Words that look like numbers confuse the forward reference.
: ResNumber
   " 1+ 2+ 1- 2- 2/" ;

\ Like VAL? but single char non-digit punctuation "-" "." etc
\ are not recognized as numbers.
: MVAL? ( a u - d 2 , n 1 , 0)
   DUP 1-
   IF    2DUP ResNumber  2SWAP STRNDX 0<
   ELSE  OVER C@  DUP  [CHAR] : =
         SWAP [CHAR] , [CHAR] / 1+ WITHIN  OR NOT
   THEN  IF  VAL?  ELSE  2DROP 0  THEN ;

\ Compile tokens and numbers.
: DW, ( a u)
   2DUP MVAL?  ?DUP
   IF  1 = ( single precision?)
       IF  MLITERAL  ELSE  SWAP MLITERAL MLITERAL  THEN  2DROP
   ELSE  X.NAME DW+  THEN ;

\ Write label with colon to left of new target line.
: LABEL: ( a u)
   T.CR?  K+ T.WRITE ;


\ H E A D E R S

VARIABLE LAST     \ last name field count byte
  2 CELLS ALLOT   \ file location of last count byte
                  \ Used by  MIMMEDIATE

\ Write link field.
: LINK.FIELD ( a u)
   T.CR?  T.WRITE  DW.TAB  OLD.NAME COUNT T.WRITE ;

\ Write name field.  Save info for possible IMMEDIATE
: NAME.FIELD ( a u)
   T.CR?  DB.TAB  TARGET FILEPOS LAST CELL+ 2!  DUP LAST !
   DEQUOTED T.WRITE ;

VARIABLE T>IN   \ Remembers >IN for possible later TWINing.

\ Restores input stream to the position of the last header name.
\ Input stream must be on the same line as before.
: TWIN
   T>IN @ >IN ! ;

VARIABLE MHEAD   \ True if header is to be compiled.

: M|   MHEAD OFF ;

VARIABLE ENDHON   \ True if header is to be compiled.

: HON3  ENDHON @ IF T.CR? " ENDIF" T.LINE THEN ENDHON OFF ;

: HON2  TARGET FILEPOS (UD) HONFIL F.LINE  ENDHON ON ;

: HON1  HON3
    T.CR? " IFNDEF " T.WRITE
      2DUP X.NAME  2DUP  H+ T.LINE
    "  0 " STRCAT  TARGET FCB>N STRCAT
      "  " STRCAT  HONFIL F.WRITE ;

\ Create link and name fields.
: MHEADER
   >IN @ T>IN ! ( possible reread)  M\? OFF
   BL WORD COUNT   MHEAD @
   IF  HON1
       " IFNDEF HEADS_OFF" T.LINE
       2DUP X.NAME Q+
       2DUP LINK.FIELD  OLD.NAME PLACE  NAME.FIELD
       T.CR?  " ENDIF" T.LINE
       HON2
   ELSE  HON1 HON2
       X.NAME 2DROP ( set NEW.NAME)  MHEAD ON
   THEN ;

\ Mark a word as IMMEDIATE by altering its count byte.
\ Headerless words must not be marked as IMMEDIATE.
: MIMMEDIATE
   TARGET FILEPOS  LAST CELL+ 2@   -1 TARGET SEEK-FILE  DROP 2DROP
   LAST @ 32 + ##, TARGET F.WRITE  -1 TARGET SEEK-FILE  DROP 2DROP
   T.CR?   " ; IMMEDIATE" T.LINE ;

\ Construct code field.
\ String is normally macro name, eg ISCOLON
: CODE.FIELD ( a u)
   NEW.NAME COUNT LABEL:  TAB1  T.WRITE  T.CR ;


\ H E R E  and  T H E R E

VARIABLE LABEL#   \ next label number

\ Unique label number.
: NEW.LABEL# ( - n)
   LABEL# @  1 LABEL# +! ;

\ Unique label string.
: MAKE.LABEL ( - a u)
   NEW.LABEL# L#### ;


\ Next available variable location.
: MTHERE ( - a u)
   MAKE.LABEL  2DUP K+ VARFIL F.LINE ;

\ Next available table location.
: MHERE ( - a u)
   MAKE.LABEL  2DUP K+ DATFIL F.LINE ;


\ Reserve n bytes in uninitialized variable file.
: MALLOT ( n)
   "         db    "  ROT (####h) STRCAT "  DUP (?)" STRCAT
   VARFIL F.LINE ;

\ Add n to initialized data file.
: MC, ( n)
   "         db    "  ROT 0####h STRCAT  DATFIL F.LINE ;
: M,  ( n)
   "         dw    "  ROT 0####h STRCAT  DATFIL F.LINE ;


\ D E F I N I N G   W O R D S

: MCODE
   MHEADER  " " CODE.FIELD  ASSEMBLER  ;

\ Create a constant whose value is a string.
: $CONSTANT
   CREATE  ( a u)    ",
   DOES>   ( - a u)  COUNT ;

\ Factor of MLABEL and MVARIABLE
: OD:$ ( a u)
   " OFFSET DGROUP: " 2SWAP STRCAT
    2DUP DW+  T.CR  TWIN $CONSTANT ;

\ Format a  dw ?  line beginning with the given label.
: V.DW?.LINE ( a u - a2 u2)
   DUP  "         " ROT - 1 MAX STRCAT  " dw    ?" STRCAT ;


: MCREATE
   MHEADER  " ISCREATE" CODE.FIELD  MHERE ( a u)
   2DUP DW+  T.CR  TWIN $CONSTANT   ;

\ Create a token whose value is a string.
: MLABEL ( a u)
   STRCPY ( protect from MHEADER)
   MHEADER  " ISCONSTANT" CODE.FIELD   OD:$  ;

: MVARIABLE
   MHEADER  " ISVARIABLE" CODE.FIELD
   NEW.NAME COUNT V+  OD:$
   NEW.NAME COUNT V+ V.DW?.LINE  VARFIL F.LINE  ;

: MVALUE
   MHEADER  " ISVALUE" CODE.FIELD
   NEW.NAME COUNT V+  OD:$
   NEW.NAME COUNT V+ V.DW?.LINE  VARFIL F.LINE  ;

: M2VARIABLE
   MVARIABLE  2 ( ie MCELL) MALLOT ;

: MFILE
   MVARIABLE  50 ( ie FCB#-2 in FILES.SRC ) MALLOT ;

: MVOCABULARY
   MHEADER  " jmp   VOCABULARYqz ; VOCABULARY" CODE.FIELD
   NEW.NAME COUNT V+  " OFFSET DGROUP: " 2SWAP STRCAT DW+  T.CR
   NEW.NAME COUNT V+ V.DW?.LINE  VARFIL F.LINE  ;


\ Headerless constant.
: MEQU ( n)
   CONSTANT ;

: MCONSTANT ( n)
   MHEADER  " ISCONSTANT" CODE.FIELD
   T.CR  DUP 0####h DW+ T.CR
   TWIN CONSTANT  ;


\ C O M M E N T S

: MCOMMENT ( a u) 2DROP ;
\ drop comments
\   CTR @ IF "  ; " ELSE " ; " THEN
\   2SWAP STRCAT T.LINE ;

: M(
   " ( " [CHAR] ) WORD COUNT STRCAT " ) " STRCAT MCOMMENT ;
: M\
   M\? @ 0= >IN @ 2 = AND IF  T.CR  M\? ON  THEN
            >IN @ 2 =     IF  T.CR?         THEN
   01 PARSE MCOMMENT ;

\ If not true, treat text as backslash comment.
: M\IF ( f)
   NOT IF  POSTPONE \   THEN ;

\ If not true, treat text as multi-line comment.
: M\*IF ( f)
   NOT IF  POSTPONE \*  THEN ;

: *\   ;


\ F L O W   O F   C O N T R O L

\ Build branch to label.
: BRANCH, ( n a u)
   ROT L#### STRCAT DW+  T.CR ;

: MBRANCH  ( n)   " Branch, "   BRANCH, ;
: MZBRANCH ( n)   " ZBranch, "  BRANCH, ;

\ Write numeric label with colon to left of new target line.
: L####: ( n)
  L#### LABEL: ;

VARIABLE bal   \ flow of control balance check

: huh?   0= ABORT" ??" ;
: ?bal   bal @ < huh? ;
: -bal   bal @   huh?  -1 bal +! ;

: MBEGIN   NEW.LABEL#  DUP L####:    1 bal +! ;
: MIF      NEW.LABEL#  DUP MZBRANCH  1 bal +! ;
: MTHEN   0 ?bal  -1 bal +!  L####: ;
: MELSE   0 ?bal  NEW.LABEL#  DUP MBRANCH  SWAP L####: ;

: MAGAIN   -bal  MBRANCH ;
: MUNTIL   -bal  MZBRANCH ;
: MWHILE    bal @ huh?  MIF  SWAP ;
: MREPEAT   1 ?bal  MAGAIN  MTHEN ;

VARIABLE LEAF   20 CELLS ALLOT   \ LEAVE label stack
VARIABLE LP                      \ LEAVE stack pointer

: PUSHL ( n)     LP @ LEAF + !  CELL LP +! ;
: COPYL ( - n)   LP @ CELL - LEAF + @ ;
: POPL  ( - n)   COPYL   CELL NEGATE LP +! ;

\ Add LEAVE label to leaf string.
: LEAVE.LABEL
   NEW.LABEL# PUSHL ;

\ Resolve LEAVE label.
: LEFT
   POPL L####: ;


: MDO
   " RDo" DW+  MBEGIN  LEAVE.LABEL ;
: M?DO
   " QueryGreat" DW+   LEAVE.LABEL  COPYL MZBRANCH
   " RDo" DW+  MBEGIN ;

: MLEAVE   " UNLOOP" dw+  COPYL MBRANCH ;

: MLOOP    -bal  " RLoop, " BRANCH,  LEFT ;
: M+LOOP   -bal  " PLoop, " BRANCH,  LEFT ;



\ I N T E R P R E T  and  C O M P I L E

\ Search MAGIC only.  Only IMMEDIATE words are found.
: MFIND ( 'str - cfa true | 'str 0)
   DUP C@
   IF  DUP [ ' MAGIC >BODY ] LITERAL @ THREAD  0>
       IF  NIP TRUE  ELSE  DROP 0  THEN
   ELSE  DROP  ['] EXIT TRUE  THEN ;

\ Compiler translator proper.
: M]
   BEGIN  BL NEXT.WORD MFIND
      IF  EXECUTE  ELSE  COUNT DW,  THEN
   AGAIN ;

: MTO
   BL WORD COUNT X.NAME " +3" STRCAT DW+ ;


\ C O L O N  and  S E M I C O L O N

: M:
   MHEADER  " ISCOLON" CODE.FIELD
   bal OFF  LP OFF   M]  ;

: M;   bal @ ABORT" Unbalanced"  " EXIT" DW+  T.CR
       2R> 2DROP ;

: M[   2R> 2DROP ;


\ C O M P I L E R   S U P P O R T

: MDOES>
   " PIPE" DW+
   T.CR  OLD.NAME COUNT Z+ K+ T.WRITE
   TAB1  " call  DoDoes" T.WRITE  T.CR ;


: MPOSTPONE
   BL WORD  DUP COUNT X.NAME  ROT MFIND  NIP
   IF  ( [COMPILE])  DW+
   ELSE ( COMPILE) " Tic, " 2SWAP STRCAT DW+
      " XComma" DW+
   THEN ;

: M[CHAR] ( - ch)
   BL WORD 1+ C@ MLITERAL ;

\ Compile delimited counted string.
: MSTRING ( ch)
   "         db    " ROT WORD COUNT ##,QUOTED STRCAT
   DATFIL F.LINE ;

: M" ( - a u)
   " SLit" DW+  MHERE DW+  [CHAR] " MSTRING ;

: M."   M"  " _TYPE" DW+ ;

: MABORT"   MIF  M"  " _ERR" DW+  MTHEN ;


\ I N T E R P R E T    A L I A S E S

: MDEFN
   CREATE ' ,   DOES> PERFORM ;

MAGIC DEFINITIONS
MDEFN IMMEDIATE MIMMEDIATE
MDEFN HERE MHERE     MDEFN THERE MTHERE
MDEFN ALLOT MALLOT   MDEFN ,  M,        MDEFN C,  MC,
MDEFN CODE      MCODE
MDEFN CREATE    MCREATE
MDEFN CONSTANT  MCONSTANT
MDEFN VARIABLE  MVARIABLE
MDEFN 2VARIABLE M2VARIABLE
MDEFN FILE MFILE
MDEFN VALUE     MVALUE
MDEFN EQU  MEQU      MDEFN LABEL MLABEL
MDEFN \  M\          MDEFN (  M(
MDEFN \IF  M\IF      MDEFN \*IF  M\*IF
MDEFN ]  M]          MDEFN :  M:        MDEFN |  M|
MDEFN VOCABULARY  MVOCABULARY
MDEFN DEFINITIONS MDEFINITIONS
MDEFN FORTH MFORTH   MDEFN ROOT MROOT
XFORTH DEFINITIONS


\ C O M P I L E R   A L I A S E S

: MCOMP   CREATE  ' ,  IMMEDIATE   DOES> PERFORM ;

MAGIC DEFINITIONS
MCOMP BEGIN MBEGIN   MCOMP WHILE MWHILE   MCOMP REPEAT MREPEAT
MCOMP UNTIL MUNTIL   MCOMP AGAIN MAGAIN
MCOMP IF    MIF      MCOMP ELSE  MELSE    MCOMP THEN   MTHEN
MCOMP DO    MDO      MCOMP LOOP  MLOOP    MCOMP +LOOP  M+LOOP
MCOMP ?DO   M?DO
MCOMP LEAVE MLEAVE   MCOMP LITERAL MLITERAL
MCOMP \  M\          MCOMP (  M(
MCOMP \IF   M\IF
MCOMP [  M[          MCOMP ;  M;
MCOMP "     M"       MCOMP ."    M."
MCOMP [']   M[']     MCOMP POSTPONE MPOSTPONE
MCOMP DOES>  MDOES>
MCOMP [CHAR] M[CHAR]
MCOMP ABORT" MABORT"
MCOMP TO     MTO
XFORTH DEFINITIONS


\ T R A N S L A T E   F I L E S

\ Make file with guarantee.
: FMUST.MAKE ( a u w fcb)
   DUP >R  FMAKE NIP  R> SWAP
   IF  FCB>N TYPE CR  TRUE ABORT" Can't make"  THEN  DROP ;

\  hard (single) drive version *********************************************

\ Translate one file by name.
: SINGLE ( a u)
   DECIMAL  DW? OFF  M\? OFF   MHEAD ON
   2DUP " .INC" STRCAT R/W TARGET FMUST.MAKE
   CR ." Including " 2DUP TYPE    MAGIC DEFINITIONS
        " .SRC" STRCAT INCLUDE-FILE  HON3  FORTH DEFINITIONS
   TARGET CLOSE-FILE DROP ;


: MSTART
   " HON.DAT" W/O HONFIL FMUST.MAKE
   " VAR.INC" W/O VARFIL FMUST.MAKE
   " TBL.INC" W/O DATFIL FMUST.MAKE
   MROOT  " 0" OLD.NAME PLACE
   MFORTH " 0" OLD.NAME PLACE  LABEL# OFF
   ENDHON OFF ;

: MFINIS
   HONFIL CLOSE-FILE DROP
   VARFIL CLOSE-FILE DROP
   DATFIL CLOSE-FILE DROP ;

\ Translate all kernel files.
: AUTO
   MSTART
   " INTERNL3" SINGLE
   " CONTROL"  SINGLE     " STACKMEM" SINGLE
   " LOGIMATH" SINGLE     " STRINGS"  SINGLE
   " DEVICE"   SINGLE     " INPUTOUT" SINGLE
   " INTRPRET" SINGLE     " COMPILER" SINGLE
   " STRINGS2" SINGLE
   " FILES"    SINGLE     " APP" SINGLE
   " FINALE3"  SINGLE
   MFINIS  CR ;
\

\* two drive version ********************************************************

\ Translate one file by name.
: SINGLE ( a u)
   DECIMAL  DW? OFF  M\? OFF   MHEAD ON
   2DUP SWAP 2 + SWAP 2 - " B:" 2SWAP STRCAT
     " .INC" STRCAT R/W TARGET FMUST.MAKE
   CR ." Including " 2DUP TYPE    MAGIC DEFINITIONS
        " .SRC" STRCAT INCLUDE-FILE  HON3  FORTH DEFINITIONS
   TARGET CLOSE-FILE DROP ;


: MSTART
   " B:HON.DAT" W/O HONFIL FMUST.MAKE
   " B:VAR.INC" W/O VARFIL FMUST.MAKE
   " B:TBL.INC" W/O DATFIL FMUST.MAKE
   MROOT  " 0" OLD.NAME PLACE
   MFORTH " 0" OLD.NAME PLACE  LABEL# OFF
   ENDHON OFF ;

: MFINIS
   HONFIL CLOSE-FILE DROP
   VARFIL CLOSE-FILE DROP
   DATFIL CLOSE-FILE DROP ;

\ Translate all kernel files.
: AUTO
   MSTART
   " B:INTERNL3" SINGLE
   " A:CONTROL"  SINGLE     " A:STACKMEM" SINGLE
   " A:LOGIMATH" SINGLE     " A:STRINGS"  SINGLE
   " A:DEVICE"   SINGLE     " A:INPUTOUT" SINGLE
   " A:INTRPRET" SINGLE     " A:COMPILER" SINGLE
   " A:STRINGS2" SINGLE
   " A:FILES"    SINGLE     " B:APP" SINGLE
   " B:FINALE3"  SINGLE
   MFINIS  CR ;
*\