diff --git a/sources/6502/2words.fth b/sources/6502/2words.fth new file mode 100644 index 0000000..0a3f9ae --- /dev/null +++ b/sources/6502/2words.fth @@ -0,0 +1,28 @@ +\ 2! 2@ 2variable 2constant + +cr .( Loading 2words ...) + +\needs code INCLUDE" D:TAS65.FTH" + +code 2! ( d addr -- ) + tya setup jsr 3 # ldy + [[ sp )y lda n )y sta dey 0< ?] + 1 # ldy poptwo jmp end-code + +code 2@ ( addr -- d ) + sp x) lda n sta sp )y lda n 1+ sta + sp 2dec 3 # ldy + [[ n )y lda sp )y sta dey 0< ?] + xyNext jmp end-code + +: 2VARIABLE ( -- ) + create 4 allot ; + +: 2CONSTANT ( d -- ) + CREATE , , DOES> ( -- d ) 2@ ; + +\ 2dup exists +\ 2swap exists +\ 2drop exists + +cr .( 2Words loaded. ) diff --git a/sources/generic/minioof.fth b/sources/generic/minioof.fth index 13aaf9c..866c509 100644 --- a/sources/generic/minioof.fth +++ b/sources/generic/minioof.fth @@ -1,23 +1,23 @@ \ Mini-OOF by Bernd Paysan CR .( loading Mini-OOF ... ) - + : METHOD ( m v -- m' v ) CREATE OVER , SWAP 2+ SWAP DOES> ( ... o -- ... ) @ OVER @ + @ EXECUTE ; -: VAR ( m v size -- ) +: VAR ( m v size -- ) CREATE OVER , + - DOES> ( o -- addr ) + DOES> ( o -- addr ) @ + ; : CLASS ( class -- class methods vars ) DUP 2@ ; : END-CLASS ( -- class methods vars ) - CREATE HERE >R , DUP , - 4 ?DO ['] NOOP , 2 +LOOP + CREATE HERE >R , DUP , + 4 ?DO ['] NOOP , 2 +LOOP 2+ DUP 2+ R> ROT @ 4 /STRING MOVE ; : DEFINES ( xt class -- ) @@ -32,121 +32,3 @@ CR .( loading Mini-OOF ... ) CREATE OBJECT 2 , 4 , CR .( Mini-OOF loaded. ) - -\ Mini OOF Example - -\needs class INCLUDE" D:MINIOOF.F" - -CR .( loading OOF Example ) - -CR .( creating object class "animal" ) - -object class - 2 var sound - 2 var color - 2 var kind - method init - method say - method present -end-class animal - -CR .( Implementing Methods ) - -: m-say ( o -- ) - cr ." it says " - sound @ COUNT TYPE ; - -' m-say animal defines say - -: m-present ( o -- ) - cr ." This animal is a " - DUP color @ COUNT TYPE BL EMIT - kind @ COUNT TYPE ." !" ; - -' m-present animal defines present - -: m-init ( say color kind o -- ) - >R - R@ SOUND ! - R@ COLOR ! - R> KIND ! ; - -' m-init animal defines init - -CR .( creating animal objects ) - -animal new constant dog -animal new constant cat -animal new constant eagle - -CR .( initializing objects ) - -: S>A DROP 1- ; ( convert string to address ) - -S" MAMAL" S>A -S" BLACK" S>A -S" BARK BARK" S>A dog init - -S" MAMAL" S>A -S" SILVER" S>A -S" MEOW MEOW" S>A cat init - -S" BIRD" S>A -S" BROWN" S>A -S" ARK ARK" S>A eagle init - -CR .( now lets the objects speak ) - -CR - -dog present dog say -cat present cat say -eagle present eagle say - -CR .( Finish! ) -CR - -\ String Ext. - -CR .( loading String extensions ) - -: S" ASCII " PARSE - HERE 2DUP ! 1+ - OVER 1+ ALLOT - 2DUP 4 ROLL SWAP ROT - 1+ MOVE SWAP ; - -CR .( String extensions loaded ) - - -\ 2! 2@ 2variable 2constant - -cr .( Loading 2words ...) - -\needs code INCLUDE" D:TAS65.F" - -code 2! ( d addr -- ) - tya setup jsr 3 # ldy - [[ sp )y lda n )y sta dey 0< ?] - 1 # ldy poptwo jmp end-code - -code 2@ ( addr -- d ) - sp x) lda n sta sp )y lda n 1+ sta - sp 2dec 3 # ldy - [[ n )y lda sp )y sta dey 0< ?] - xyNext jmp end-code - -: 2VARIABLE ( -- ) - create 4 allot ; - -: 2CONSTANT ( d -- ) - CREATE , , DOES> ( -- d ) 2@ ; - -\ 2dup exists -\ 2swap exists -\ 2drop exists - -cr .( 2Words loaded. ) - - - diff --git a/sources/generic/oof-example.fth b/sources/generic/oof-example.fth new file mode 100644 index 0000000..2eba9dd --- /dev/null +++ b/sources/generic/oof-example.fth @@ -0,0 +1,72 @@ +\ Mini OOF Example + +\needs class INCLUDE" D:MINIOOF.F" + +CR .( loading OOF Example ) + +CR .( creating object class "animal" ) + +object class + 2 var sound + 2 var color + 2 var kind + method init + method say + method present +end-class animal + +CR .( Implementing Methods ) + +: m-say ( o -- ) + cr ." it says " + sound @ COUNT TYPE ; + +' m-say animal defines say + +: m-present ( o -- ) + cr ." This animal is a " + DUP color @ COUNT TYPE BL EMIT + kind @ COUNT TYPE ." !" ; + +' m-present animal defines present + +: m-init ( say color kind o -- ) + >R + R@ SOUND ! + R@ COLOR ! + R> KIND ! ; + +' m-init animal defines init + +CR .( creating animal objects ) + +animal new constant dog +animal new constant cat +animal new constant eagle + +CR .( initializing objects ) + +: S>A DROP 1- ; ( convert string to address ) + +S" MAMAL" S>A +S" BLACK" S>A +S" BARK BARK" S>A dog init + +S" MAMAL" S>A +S" SILVER" S>A +S" MEOW MEOW" S>A cat init + +S" BIRD" S>A +S" BROWN" S>A +S" ARK ARK" S>A eagle init + +CR .( now lets the objects speak ) + +CR + +dog present dog say +cat present cat say +eagle present eagle say + +CR .( Finish! ) +CR diff --git a/sources/generic/strings.fth b/sources/generic/strings.fth new file mode 100644 index 0000000..a38333a --- /dev/null +++ b/sources/generic/strings.fth @@ -0,0 +1,11 @@ +\ String Ext. + +CR .( loading String extensions ) + +: S" ASCII " PARSE + HERE 2DUP ! 1+ + OVER 1+ ALLOT + 2DUP 4 ROLL SWAP ROT + 1+ MOVE SWAP ; + +CR .( String extensions loaded )