The Commando Forth Compiler

In addition, there is an optional post optimizer script. The compiler automatically reads 1forth.lib (see Listing Two) to get the definition for most words, and, finally, there is a shell script to drive the whole thing. The compiler looks for a starting word and generates code for it.

	ORG 512
;Prolog goes here
_main:
	
	LDRIQ 0x7ff,FSTK_SP
	LDRIQ 0x1ff,FDSTK_SP
	MOV FIMMV,R(17)  ; R17 is top of stack
; R16 is temp storage, R18 is _here
	CALLQ _POST_INIT4
	CALLQ _L0
	JMPQ _main
;End prolog
_L0:
; main definition
	LDRI  _S1,  FDSTK_PUSH 
	CALLQ  _L1 ; ."
_J1:
	
	LDIQ  1000 ; 1000
	MOV FIMMV,FDSTK_PUSH
	MOV 0x900,FDSTK_PUSH   ; push 16
	CALLQ  _L2 ; !
	MOV 0x100,FDSTK_PUSH   ; push 1
	LDIQ  17 ; 17
	MOV FIMMV,FDSTK_PUSH
	CALLQ  _L2 ; !
	MOV 0x100,FDSTK_PUSH   ; push 1
	LDIQ  18 ; 18
	MOV FIMMV,FDSTK_PUSH
	CALLQ  _L2 ; !
	MOV 0x100,FIO_DISP ; (optimized push/pop) 
	CALLQ  _L3 ; playloop
	LDRI  _S6,  FDSTK_PUSH 
	CALLQ  _L1 ; ."
	CALLQ  _L4 ; key
	LDRIQ 'n', FDSTK_PUSH
	CALLQ  _L5 ; =
	MOV FDSTK_POP,FACC
	JMPZQ _J1
	MOV  FZERO,  FPC_INTVECTOR 
	INTDISABLE 
	MOV  FZERO,  FPC 
	RETURN
_L1:
; ." definition
	MOV  FDSTK_POP,FPC_PGMRDADD 
_J2:
	
	CALLQ  _L6 ; @f-next
	CALLQ  _L7 ; dup
	MOV FDSTK_POP,FACC
	JMPZQ _J3
	CALLQ  _L8 ; emit
	JMPQ _J2
_J3:
	
	MOV  FDSTK_POP,0 
	RETURN
_L4:
; key definition
	CALLR  59 
	MOV  FACC_VALUE,FDSTK_PUSH 
	RETURN
_L2:
; ! definition
	MOV  FDSTK_POP,FMEM_MP1 
	MOV  FDSTK_POP,FIMMV 
	MOV  FIMMV,FMEM_VALUE1 
	RETURN
_L5:
; = definition
	CALLQ  _L9 ; -
; fall through to not
_L10:
; not definition
	MOV  FDSTK_POP,FACC_VALUE 
	MOVZ  FCON_1,FDSTK_PUSH 
	MOVNZ  FCON_0,FDSTK_PUSH 
	RETURN
_L3:
; playloop definition
	LDRI  _S2,  FDSTK_PUSH 
	CALLQ  _L1 ; ."
	MOV 0x100,FDSTK_PUSH   ; push 1
_J4:
	
	MOV FDSTK_POP,FACC
	JMPZQ _J5
	CALLQ  _L11 ; turn
	JMPQ _J4
_J5:
	
; fall through to iwin
_L12:
; iwin definition
	LDRI  _S5,  FDSTK_PUSH 
	CALLQ  _L1 ; ."
	LDIQ  18 ; 18
	MOV FIMMV,FDSTK_PUSH
	CALLQ  _L13 ; @
	CALLQ  _L14 ; .
	JMPR  60  ; hidden return (opt)
_L11:
; turn definition
	LDRI  _S3,  FDSTK_PUSH 
	CALLQ  _L1 ; ."
	MOV 0x900,FDSTK_PUSH   ; push 16
	CALLQ  _L13 ; @
	LDIQ  17 ; 17
	MOV FIMMV,FDSTK_PUSH
	CALLQ  _L13 ; @
	CALLQ  _L15 ; +
	MOV 0x100,FDSTK_PUSH   ; push 1
	CALLQ  _L16 ; swap
	CALLQ  _L17 ; shr
	CALLQ  _L7 ; dup
	CALLQ  _L14 ; .
	CALLR  60 
; fall through to doquery
_L18:
; doquery definition
	LDRI  _S4,  FDSTK_PUSH 
	CALLQ  _L1 ; ."
	CALLQ  _L4 ; key
	CALLQ  _L7 ; dup
	LDRIQ 'c', FDSTK_PUSH
	CALLQ  _L5 ; =
	MOV FDSTK_POP,FACC
	JMPZQ _J6
	MOV  FDSTK_POP,0 
	MOV 0x000,FDSTK_PUSH   ; push 0
_J6:
	
	CALLQ  _L7 ; dup
	LDRIQ 'h', FDSTK_PUSH
	CALLQ  _L5 ; =
	MOV FDSTK_POP,FACC
	JMPZQ _J7
	MOV  FDSTK_POP,0 
	MOV 0x900,FDSTK_PUSH   ; push 16
	CALLQ  _L2 ; !
	CALLQ  _L19 ; bump
	MOV 0x100,FDSTK_PUSH   ; push 1
	return 
_J7:
	
	CALLQ  _L7 ; dup
	LDRIQ 'l', FDSTK_PUSH
	CALLQ  _L5 ; =
	MOV FDSTK_POP,FACC
	JMPZQ _J8
	MOV  FDSTK_POP,0 
	LDIQ  17 ; 17
	MOV FIMMV,FDSTK_PUSH
	CALLQ  _L2 ; !
	CALLQ  _L19 ; bump
	MOV 0x100,FDSTK_PUSH   ; push 1
	return 
_J8:
	
	RETURN
_L8:
; emit definition
	MOV  FDSTK_POP,FACC_VALUE 
	JMPR  62 
; return optimized out
_L7:
; dup definition
	MOV  FDSTK_LOCAL1,FIMMV 
	MOV  FIMMV,FDSTK_PUSH 
	RETURN
_L9:
; - definition
	MOV  FDSTK_POP,FIMMV 
	MOV  FDSTK_POP,FACC_VALUE 
	MOV  FIMMV,FACC_SUB 
	MOV  FACC_VALUE,FDSTK_PUSH 
	RETURN
_L14:
; . definition
	CALLQ  _L7 ; dup
	CALLQ  _L20 ; 0<
	MOV FDSTK_POP,FACC
	JMPZQ _J9
	LDRIQ '-', FDSTK_PUSH
	CALLQ  _L8 ; emit
	CALLQ  _L21 ; negate
_J9:
	
	CALLQ  _L7 ; dup
	CALLQ  _L10 ; not
	MOV FDSTK_POP,FACC
	JMPZQ _J10
	LDRIQ '0', FDSTK_PUSH
	CALLQ  _L8 ; emit
	CALLQ  _L22 ; space
	MOV  FDSTK_POP,0 
	JMPQ _J11
_J10:
	
	MOV 0x100,FDSTK_PUSH   ; push 1
_J12:
	
	CALLQ  _L23 ; 2dup
	CALLQ  _L24 ; >=
	MOV FDSTK_POP,FACC
	JMPZQ _J13
	CALLQ  _L25 ; 10*
	JMPQ _J12
_J13:
	
	MOV 0xA00,FDSTK_PUSH   ; push 10
	CALLQ  _L26 ; /
_J14:
	
	CALLQ  _L7 ; dup
	CALLQ  _L27 ; -rot
	CALLQ  _L28 ; /mod
	CALLQ  _L29 ; .0-9
	CALLQ  _L16 ; swap
	MOV 0xA00,FDSTK_PUSH   ; push 10
	CALLQ  _L26 ; /
	CALLQ  _L7 ; dup
	CALLQ  _L30 ; 0<>
	MOV FDSTK_POP,FACC
	JMPZQ _J15
	JMPQ _J14
_J15:
	
	CALLQ  _L31 ; 2drop
	CALLQ  _L22 ; space
_J11:
	
	RETURN
_L6:
; @f-next definition
	MOV  FZERO,FPC_PGMRD 
	MOV  FIMMV,FDSTK_PUSH 
	RETURN
_L13:
; @ definition
	MOV  FDSTK_POP,FMEM_MP1 
	MOV  FMEM_VALUE1,FIMMV 
	MOV  FIMMV,  FDSTK_PUSH 
	RETURN
_L30:
; 0<> definition
	CALLQ  _L10 ; not
	JMPQ  _L10 ; not
_L29:
; .0-9 definition
	LDIQ  48 ; 48
	MOV FIMMV,FDSTK_PUSH
	CALLQ  _L15 ; +
	JMPQ  _L8 ; emit
_L16:
; swap definition
	MOV  FDSTK_POP,FIMMV 
	MOV  FDSTK_POP,R(16) 
	MOV  FIMMV,FDSTK_PUSH 
	MOV  R(16),FDSTK_PUSH 
	RETURN
_L23:
; 2dup definition
	CALLQ  _L32 ; over
; fall through to over
_L32:
; over definition
	MOV  FDSTK_LOCAL2,FIMMV 
	MOV  FIMMV,FDSTK_PUSH 
	RETURN
_L28:
; /mod definition
	MOV 0x000,FIMMV ; (optimized push/pop) 
	MOV  FIMMV,FSTK_PUSH 
_J16:
	
	CALLQ  _L23 ; 2dup
	CALLQ  _L24 ; >=
	MOV FDSTK_POP,FACC
	JMPZQ _J17
	CALLQ  _L7 ; dup
	CALLQ  _L27 ; -rot
	CALLQ  _L9 ; -
	CALLQ  _L16 ; swap
	MOV  FSTK_POP,FIMMV 
	MOV  FIMMV,FDSTK_PUSH 
	MOV 0x100,FDSTK_PUSH   ; push 1
	CALLQ  _L15 ; +
	MOV  FDSTK_POP,FIMMV 
	MOV  FIMMV,FSTK_PUSH 
	JMPQ _J16
_J17:
	
	MOV  FDSTK_POP,0 
	MOV  FSTK_POP,FIMMV 
	MOV  FIMMV,FDSTK_PUSH 
	RETURN
_L21:
; negate definition
	MOV 0x000,FDSTK_PUSH   ; push 0
	CALLQ  _L16 ; swap
	JMPQ  _L9 ; -
_L20:
; 0< definition
	MOV  FDSTK_POP,  FACC_VALUE 
	MOVN  FCON_1,FDSTK_PUSH 
	MOVP  FCON_0,FDSTK_PUSH 
	RETURN
_L15:
; + definition
	MOV  FDSTK_POP,FACC_VALUE 
	MOV  FDSTK_POP,FACC_ADD 
	MOV  FACC_VALUE,  FDSTK_PUSH 
	RETURN
_L24:
; >= definition
	CALLQ  _L9 ; -
; fall through to 0>=
_L33:
; 0>= definition
	MOV  FDSTK_POP,  FACC_VALUE 
	MOVN  FCON_0,FDSTK_PUSH 
	MOVP  FCON_1,FDSTK_PUSH 
	RETURN
_L19:
; bump definition
	LDIQ  18 ; 18
	MOV FIMMV,FDSTK_PUSH
	CALLQ  _L13 ; @
	MOV 0x100,FDSTK_PUSH   ; push 1
	CALLQ  _L15 ; +
	CALLQ  _L7 ; dup
	MOV  FDSTK_POP,FIO_DISP 
	LDIQ  18 ; 18
	MOV FIMMV,FDSTK_PUSH
	JMPQ  _L2 ; !
_L26:
; / definition
	CALLQ  _L28 ; /mod
	CALLQ  _L16 ; swap
	MOV  FDSTK_POP,0 
	RETURN
_L17:
; shr definition
	MOV  FDSTK_POP,FACC_VALUE 
	MOV  FDSTK_POP,FACC_SHR 
	MOV  FACC_VALUE,FDSTK_PUSH 
	RETURN
_L27:
; -rot definition
	MOV  FDSTK_POP,  FIMMV 
	MOV  FDSTK_POP,  FACC2_VALUE 
	MOV  FDSTK_POP,  R(16) 
	MOV  FIMMV,  FDSTK_PUSH 
	MOV  R(16),  FDSTK_PUSH 
	MOV  FACC2_VALUE,  FDSTK_PUSH 
	RETURN
_L25:
; 10* definition
	MOV 0x100,FDSTK_PUSH   ; push 1
	CALLQ  _L16 ; swap
	CALLQ  _L34 ; shl
	CALLQ  _L7 ; dup
	MOV 0x200,FDSTK_PUSH   ; push 2
	CALLQ  _L16 ; swap
	CALLQ  _L34 ; shl
	JMPQ  _L15 ; +
_L22:
; space definition
	LDIQ  32 ; 32
	MOV FIMMV,FDSTK_PUSH
	JMPQ  _L8 ; emit
_L31:
; 2drop definition
	MOV  FDSTK_POP,0 
	MOV  FDSTK_POP,0 
	RETURN
_L34:
; shl definition
	MOV  FDSTK_POP,FACC_VALUE 
	MOV  FDSTK_POP,FACC_SHL 
	MOV  FACC_VALUE,FDSTK_PUSH 
	RETURN
;Epilog goes here
_POST_INIT4:
	LDRIQ 16,R(18)
; init low = 1
	MOV 0x100,FDSTK_PUSH   ; push 1
	LDIQ  17 ; 17
	MOV FIMMV,FDSTK_PUSH
	CALLQ  _L2 ; !
; init high = 1000
	LDIQ  1000 ; 1000
	MOV FIMMV,FDSTK_PUSH
	MOV 0x900,FDSTK_PUSH   ; push 16
	JMPQ  _L2 ; ! ; hidden return (opt)
_S4:
	
STRING "Is that <H>igh, <L>ow, or <C>orrect? \040\000"
_S4_end:
	
_S5:
	
STRING "I win!\r\nTries:\040\000"
_S5_end:
	
_S6:
	
STRING "\015\012Play again (<N> to quit)\015\012\000"
_S6_end:
	
_S1:
	
STRING "Welcome to Hi Lo by Al Williams. A game written using just one instruction!\015\012\000"
_S1_end:
	
_S2:
	
STRING "\015\012Think of a number from 1 to 999...\015\012\000"
_S2_end:
	
_S3:
	
STRING "I guess: \000"
_S3_end:
	
	END

After that, it finds all the words main used and processes them in the same way. Of course, after that generation there will be more words pending and those are generated until there are no more words to process. Because the compiler only translates words that are used, it is acceptable to include things like 1forth.lib that contain many words -- only words that are used will appear in the output.

The compiler is largely compatible with the Forth standard with a few exceptions:

• Source files can only contain comments, colon definitions, constants, and variables/values.
• Immediate words are built in intrinsics and are the only words that can read forward in the input stream
• Words that read the next word (like :, for example) must not be split across lines.
• The macro keyword prevents the compiler from actually compiling a new word, but inlines the word everywhere it appears (you can use the word inline as a synonym for macro).
• Colon definitions must be the first thing on a line. They can span lines, but the ; must be at the end of the last line in the definition.
• Only digits can appear before a constant. Constants and variables can only appear on a line by themselves.
• A variable can have a constant offset to add to the here pointer at compile time.
• Constants look like "C" or assembler constants (there is no BASE variable).
• Strings have an unusual syntax to accommodate awk.