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.