Skip to content

Commit 1a2e989

Browse files
chitselbchitselb
committed
...
1 parent 8118ab4 commit 1a2e989

File tree

7 files changed

+107
-98
lines changed

7 files changed

+107
-98
lines changed

‎doc/sizes.csv0

+2
Original file line numberDiff line numberDiff line change
@@ -208,6 +208,8 @@ CMDOFF,""
208208
XY@,""
209209
BYE,""
210210
MON,""
211+
PLANTS6,""
212+
PLANTS,""
211213
HEX,""
212214
DECIMAL,""
213215
DO2CONST,""

‎pettil.d64

0 Bytes
Binary file not shown.

‎pettil0.d64

0 Bytes
Binary file not shown.

‎src/core/core-double.a65

+28-12
Original file line numberDiff line numberDiff line change
@@ -58,23 +58,38 @@ name=DNEGATE
5858
stack=( d -- -d )
5959
tags=primitive,forth-83,double,math
6060
Negate the double on the stack
61+
62+
```
63+
dodnegate
64+
sec ;[2]
65+
lda stackl,x ;[4]
66+
eor #$FF ;[2]
67+
adc #0 ;[2]
68+
sta stackl,x ;[4]
69+
lda stackh,x ;[4]
70+
eor #$FF ;[2]
71+
adc #0 ;[2]
72+
sta stackh,x ;[4]
73+
jmp neg2 ;[3]
74+
;[20 bytes, 29 cycles] chitselb OG
75+
```
6176
#endif
6277
dnegate
6378
lda #>(next-1)
6479
pha
6580
lda #<(next-1)
6681
pha
6782
dodnegate
68-
sec
69-
lda stackl,x
70-
eor #$FF
71-
adc #0
72-
sta stackl,x
73-
lda stackh,x
74-
eor #$FF
75-
adc #0
76-
sta stackh,x
77-
jmp neg2
83+
sec ;[2]
84+
lda #0 ;[2]
85+
sbc stackl,x ;[4]
86+
sta stackl,x ;[4]
87+
lda #0 ;[2]
88+
sbc stackh,x ;[4]
89+
sta stackh,x ;[4]
90+
jmp neg2 ;[3]
91+
;~~~code golf~~~
92+
;[-4 bytes, -4 cycles] barrym95838 2020-04-07
7893

7994
;--------------------------------------------------------------
8095
#if 0
@@ -115,17 +130,18 @@ dabs01
115130
;--------------------------------------------------------------
116131
#if 0
117132
name=2DUP
118-
stack=( n1 n2 -- n1 n2 n1 n2 )
133+
stack=( d -- d d )
119134
tags=primitive,forth-83,double
120135
Make a copy of the double on top of stack
136+
121137
#endif
122138
twodup
123139
sec
124140
.byt $24 ; BIT z.p. opcode, fall through
125141
;--------------------------------------------------------------
126142
#if 0
127143
name=2OVER
128-
stack=( n1 n2 n3 n4 -- n1 n2 n3 n4 n1 n2 )
144+
stack=( d2 d1 -- d2 d1 d2 )
129145
tags=primitive,double,stack,forth-83
130146
Copy the double underneath the double on top of stack to become the new top of stack
131147
#endif

‎src/core/core-extra.a65

+44
Original file line numberDiff line numberDiff line change
@@ -710,3 +710,47 @@ mon
710710
brk
711711
;
712712
jmp restart
713+
714+
;--------------------------------------------------------------
715+
#if 0
716+
name=PLANTS6
717+
tags=subroutine,locals,nosymbol
718+
Return 3 locals to the stack
719+
720+
#endif
721+
plants6
722+
ldy #6
723+
.byt $2C ; BIT abs
724+
; fall through
725+
;--------------------------------------------------------------
726+
#if 0
727+
name=PLANTS
728+
tags=subroutine,locals,nosymbol
729+
Pushes N area back onto stack ~ untested
730+
731+
Input
732+
733+
* Y = how many words *2 to push to the stack, e.g. Y=6 pushes 3 words
734+
735+
Returns
736+
737+
* Y = 0
738+
* TOS unchanged
739+
* Z flag set
740+
* C flag unchanged
741+
742+
|Y: 0|Z: set|TOS: unchanged|C: unchanged|
743+
#endif
744+
plants
745+
ldy #2
746+
;
747+
dex
748+
lda n-1,y
749+
sta stackh-1,x
750+
lda n-2,y
751+
sta stackl-1,x
752+
dey
753+
dey
754+
bne plants
755+
dex
756+
rts

‎src/core/core-inner.a65

+33-73
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,7 @@ Sets the system number base to hexadecimal
1010
#endif
1111
hex
1212
lda #$10
13-
.byt $2c ; BIT addr to skip next two bytes
13+
.byt $2C ; BIT addr to skip next two bytes
1414
; fall through
1515
;--------------------------------------------------------------
1616
#if 0
@@ -23,7 +23,8 @@ Sets the system number base to decimal
2323
decimal
2424
lda #10
2525
sta userbase
26-
bne rpstore99 ; jmp next
26+
rpstore99
27+
jmp next
2728

2829
;--------------------------------------------------------------
2930
#if 0
@@ -61,8 +62,7 @@ rpstore
6162
ldx userrp0
6263
txs
6364
tax
64-
rpstore99
65-
jmp next
65+
bne rpstore99
6666

6767
;--------------------------------------------------------------
6868
#if 0
@@ -392,10 +392,7 @@ name=R>
392392
stack=( -- n ) ( R; n -- )
393393
tags=primitive,forth-83,nucleus,stack
394394
Remove the top value from the return stack and leave it on the
395-
computation stack. See >R and R@
396-
397-
* it is important to note that bytes on the return stack are inverted, that is
398-
the high byte is at the lower address, in contravention of stack convention
395+
computation stack. See `>r` and `r@`
399396

400397
!!! pronounced: "r-from"
401398
#endif
@@ -790,54 +787,27 @@ stack=( -- )
790787
tags=inner,nosymbol
791788
Performs 'secondary' words defined by `:`, pushes IP+2 to the return stack and nests into a secondary.
792789

793-
794-
```
795-
enter
796-
txa ;[2]
797-
pha ;[3]
798-
tsx ;[2]
799-
;
800-
lda pip ;[3]
801-
clc ;[2]
802-
adc #2 ;[2]
803-
ldy $0102,x ;[4]
804-
sta $0102,x ;[5]
805-
iny ;[2]
806-
bne enter02 ;[3]
807-
inc $0103,x
808-
enter02
809-
sty pip ;[3]
810-
lda pip+1 ;[3]
811-
ldy $0103,x ;[4]
812-
sta $0103,x ;[5]
813-
sty pip+1 ;[3]
814-
;
815-
pla ;[4]
816-
tax ;[2]
817-
jmp nexto ;[3]
818-
;[55 clocks]
819-
```
820790
#endif
821791
enter
822-
lda pip+1 ;[3]
823-
sta z ;[3]
824-
ldy pip ;[3] preserve IP in Z,Y
825-
pla ;[4]
826-
clc ;[2]
827-
adc #1 ;[2]
828-
sta pip ;[3]
829-
pla ;[4]
830-
adc #0 ;[2]
831-
sta pip+1 ;[3] replace IP with RS +1
832-
cpy #$FE ;[2]
833-
iny ;[2]
834-
iny ;[2]
835-
lda z ;[3]
836-
adc #0 ;[2]
837-
pha ;[3]
838-
tya ;[2]
839-
pha ;[3]
840-
jmp nexto ;[3]
792+
lda pip+1
793+
sta z
794+
ldy pip
795+
pla
796+
clc
797+
adc #1
798+
sta pip
799+
pla
800+
adc #0
801+
sta pip+1
802+
cpy #$FE
803+
iny
804+
iny
805+
lda z
806+
adc #0
807+
pha
808+
tya
809+
pha
810+
jmp nexto
841811
;[50]
842812

843813
;--------------------------------------------------------------
@@ -910,30 +880,20 @@ toforth01
910880
#if 0
911881
name=EXIT
912882
stack=( -- )
913-
tags=inner,forth-83,nosymbol
883+
tags=inner,forth-83
914884
The runtime behavior of ;
915-
Exits a colon definition, pop one level of the return stack to `pip`
916-
917-
PURPOSE:
918-
`exit` is compiled by `;` to terminate `:` definitions
919-
920-
METHOD:
921-
(RS)++ --> PIP
922-
923-
TRICKS:
924-
multiple entry points
885+
Exits a colon definition, pop one level of the return stack
925886

926887
#endif
927888
exit
928-
pla ;[4]
929-
tay ;[2]
930-
pla ;[4]
889+
pla
890+
tay
891+
pla
931892
jumpay
932-
sta pip+1 ;[3]
893+
sta pip+1
933894
exit03
934-
sty pip ;[3]
935-
jmp nexto ;[3]
936-
;[19]
895+
sty pip
896+
jmp nexto
937897

938898
;--------------------------------------------------------------
939899
#if 0
@@ -1315,7 +1275,7 @@ paday01
13151275
;--------------------------------------------------------------
13161276
#if 0
13171277
name=TOPFAS
1318-
stack=( -- n )
1278+
stack=( -- )
13191279
tags=ext,subroutine,nosymbol
13201280
To the parameter field address!
13211281

‎src/studio/pettil-dictionary.a65

-13
Original file line numberDiff line numberDiff line change
@@ -1,19 +1,6 @@
11
; pettil-dictionary.a65
22
;#echo . pettil-dictionary.a65 Dictionary
33

4-
/*
5-
src/studio/pettil-dictionary.a65:name=-@
6-
src/studio/pettil-dictionary.a65:name=NAME>
7-
src/studio/pettil-dictionary.a65:name=>NAME
8-
src/studio/pettil-dictionary.a65:name=EXISTS?
9-
src/studio/pettil-dictionary.a65:name='
10-
src/studio/pettil-dictionary.a65:name=REHASH
11-
src/studio/pettil-dictionary.a65:name=FORGET
12-
src/studio/pettil-dictionary.a65:name=DEFINITIONS
13-
src/studio/pettil-dictionary.a65:name=FORTH
14-
*/
15-
16-
174
;--------------------------------------------------------------
185
#if 0
196
name=SYMTHREAD

0 commit comments

Comments
 (0)