PROGRAM
ECHO ON
EMPTY
OOPS MESSAGES
RUNTIME
DAP!
: DP? DAP U? CR
;
: DPTOP DAP @ U? CR
;
INCLUDE MESSAGES
ASSEMBLER DEFINITIONS
: FIELDLOAD	( OFFS -- )
	DAP *LOAD 4 / LDNL
;
FORTH DEFINITIONS
super Nil
var Int X
var Int Y
10 array Int IARRAY
var Int Z
class Definition POINT
	dummy	begin code Method	 			( DO NOTHING QUICKLY )
			end code Method
	dummy2	begin colon Method
			end colon Method			( DO NOTHING SLOWLY )
	GETX 	begin code Method
(				DAP *LOAD X LDNL
				X FIELDLOAD
				SP PUSH
			end code Method
	GETY 	begin code Method
				Y FIELDLOAD
				SP PUSH
			end code Method
	SETX 	begin colon Method X ! end colon Method
	SETY 	begin colon Method Y ! end colon Method
end Definition

instance POINT APOINT
instance POINT BPOINT
." SETX = " SETX M> U.
MESSAGE GETRAD	MESSAGE SETRAD
PATH
super POINT
var	Int RADIUS
class Definition	CIRCLE
	GETRAD begin colon Method RADIUS @ end colon Method
	SETRAD begin colon Method RADIUS ! end colon Method
	CLEARXY begin colon Method
	DDUP
			1 SETX super Method
			2 SETY super Method
	DDROP
			3 SETRAD self Method
			end colon Method
end Definition
HEX
instance CIRCLE	ACIRCLE
 : TEST
 5 SETX		ACIRCLE 
 6 SETY		ACIRCLE 
 7 SETRAD	ACIRCLE 
 GETX 		ACIRCLE .
 GETY 		ACIRCLE .
 GETRAD		ACIRCLE . CR
 CLEARXY	ACIRCLE
 GETX 		ACIRCLE .
 GETY 		ACIRCLE .
 GETRAD		ACIRCLE . CR

;
DECIMAL
VARIABLE EMPTYTIME
: SPEEDTEST
DECIMAL CR
	GETTIMER
	100000 0 DO LOOP
	GETTIMER - EMPTYTIME !
	GETTIMER
	100000 0 DO dummy ACIRCLE LOOP
	GETTIMER -  EMPTYTIME @ SWAP -
	." 100000 ** dummy ACIRCLE ** CALLS IN " 64 * .
	." MICRO-SEC ( ASSEMBLER ) " CR
	GETTIMER
	100000 0 DO dummy2 ACIRCLE LOOP
	GETTIMER -  EMPTYTIME @ SWAP - 
	." 100000 ** dummy ACIRCLE ** CALLS IN " 64 * .
	." MICRO-SEC ( FORTH ) " CR
;
HEX
DEBUGSTUFF
MESSAGE INIT	MESSAGE ADDNUM	MESSAGE TRACE
super Nil
REMOTE
	var Ptr LINK
	var Int SAVENUM
( SAVESIZE PACKETSIZE
LOCAL
	var Ptr FIRSTLINK
class Definition LINKLIST
	INIT	begin colon Method
				MINT ." FIRST LINK " FIRSTLINK .S !
			end colon Method
	ADDNUM	begin colon Method				( NUM --> 
				HERE			( NUM LINKADDR --> 
				FIRSTLINK @ ,	( NUM LINKADDR --> 		LINK TO PREVIOUS )
				FIRSTLINK !		( NUM --> 			REMEMBER RECENT LINK )
				,				( OLDHERE --> 		SAVE DATA )
			end colon Method
	TRACE	begin colon Method
				CR
				FIRSTLINK @
				BEGIN
					MAKELOCAL
					SAVENUM ? CR
					LINK @ DUP
				MINT= 
				UNTIL
				DROP
			end colon Method
end Definition

instance LINKLIST ALIST
INIT ALIST
1234 ADDNUM ALIST
5678 ADDNUM ALIST
4303  ADDNUM ALIST
2825939 ADDNUM ALIST
TRACE ALIST
MESSAGE O1 MESSAGE O2 MESSAGE O3 MESSAGE O4
MESSAGE S1 MESSAGE S2 MESSAGE S3 MESSAGE S4

super Nil
object Definition SUBTEST
O1 begin colon Method ." ONE " CR end colon Method 
O2 begin colon Method ." TWO " CR end colon Method 
	O3 begin sub Method
	S1 begin colon Method ." SUBONE " CR end colon Method 
	S2 begin colon Method ." SUBTWO " CR end colon Method 
	S3 begin colon Method ." SUBTHREE " CR end colon Method 
    	S4 begin sub Method
		S1 begin colon Method ." SSONE " CR end colon Method 
		S2 begin colon Method ." SSTWO " CR end colon Method 
		S3 begin colon Method
				S1 S4 O3 self Method
 ." SSTHREE " CR end colon Method 
		end sub Method
	end sub Method
O4 begin colon Method ." FOUR " CR end colon Method 
end Definition
DEBUG OFF
END.