6502.org • View topic - Christmas Challenge

View unanswered posts | View active topics

Board index » 6502.org Users Forum » Programming

All times are UTC

Christmas Challenge

Page 2 of 3

[ 37 posts ]

Go to page Previous 1, 2, 3 Next

Previous topic | Next topic

Author

Message

okwatts

Post subject: Re: Christmas Challenge

Posted: Mon Dec 20, 2021 4:32 pm

Joined: Wed Nov 11, 2020 10:42 pm
Posts: 104
Location: Kelowna Canada

I'm a forth newb and a first time contest entrant but it reminded me of the example from "Starting Forth"
I did it in a simple minded way, I'm sure there is an elegant way using loops to do the 1,3,5,7,etc as two loops with i=0to 3 and j=0 to i except for the last 2 rows of 3. I just couldn't get my head around the logic in the time available. No excuse now though!
Nowhere near 40 or 50 bytes though at 153 bytes.
Edit: Sorry I added the attachment before I figured out how to include code with keeping the formatting.

Code:

> .......
CRCMon ver 0.8eps2w 12/07/21

> boot applications
1--EhBASIC,
2--Memory Diag,
3--CRCFig-Forth,
4--Secnd9-Forth 3 press Return to execute command

CRC65 FIG-FORTH SYM 2021
3 load OK
words DUMP HEXOUT NYBOUT ?ASCII WORDS FREE DUMPBLK 2/ 2* >> << J T.S .S P REPLACE-LINE -MOVE LINE TEXT MON VLIST TRIAD INDEX LIST ? . .R D. D.R #S # SIGN #> <# SPACES WHILE ELSE IF REPEAT AGAIN END UNTIL +LOOP LOOP DO THEN ENDIF BEGIN BACK FORGET ' R/W -BCD --> LOAD MESSAGE .LINE (LINE) BLOCK BUFFER EMPTY-BUFFERS FLUSH UPDATE +BUF PREV USE M/MOD */ */MOD MOD / /MOD * M/ M* MAX MIN DABS ABS D+- +- S->D COLD ABORT QUIT ( DEFINITIONS FORTH VOCABULARY IMMEDIATE INTERPRET ?STACK DLITERAL LITERAL [COMPILE] CREATE ID. ERROR (ABORT) -FIND NUMBER (NUMBER) UPPER WORD PAD HOLD BLANKS ERASE FILL  QUERY EXPECT ." (.") -TRAILING TYPE COUNT DOES> <BUILDS ;CODE (;CODE) DECIMAL HEX SMUDGE ] [ COMPILE ?LOADING ?CSP ?PAIRS ?EXEC ?COMP ?ERROR !CSP PFA NFA CFA LFA LATEST TRAVERSE -DUP SPACE ROT > < U< = - C, , ALLOT HERE 2+ 1+ HLD R# CSP FLD DPL BASE STATE CURRENT CONTEXT OFFSET SCR OUT IN BLK VOC-LINK DP FENCE WARNING WIDTH TIB +ORIGIN B/SCR B/BUF LIMIT FIRST C/L BL 3 2 1 0 USER VARIABLE CONSTANT ; : C! ! C@ @ TOGGLE +! DUP SWAP DROP OVER DMINUS MINUS D+ + 0< 0= R R> >R LEAVE ;S RP! SP! SP@ XOR OR AND U/ U* CMOVE CR ?TERMINAL KEY EMIT ENCLOSE (FIND) DIGIT I (DO) (+LOOP) (LOOP) 0BRANCH BRANCH EXECUTE CLIT LIT OK
free 
22250 Bytes available
OK
8 load OK
8 list 
SCR#8 
 0 ( Christmas Challenge )
 1 : star dup 0 do 42 emit loop ;
 2 : sline dup 61 swap - 2 / dup spaces swap star spaces cr ;
 3 
 4 : ntree cr 1 sline 3 sline 5 sline 7 sline 3 sline 7 sline
 5 11 sline 15 sline 5 sline 11 sline 17 sline 23 sline
 6 3 sline 3 sline ;
 7 
 8 
 9 
10 
11 
12 
13 
14 
15 
OK
ntree 
                              * 
                             ***   
                            *****     
                           *******       
                             ***   
                           *******       
                         ***********           
                       ***************               
                            *****     
                         ***********           
                      *****************                 
                   ***********************                       
                             ***   
                             ***   
OK
free 
22097 Bytes available
OK

Attachments:

ccontested.txt [2.36 KiB]
Downloaded 62 times

Top

IamRob

Post subject: Re: Christmas Challenge

Posted: Mon Dec 20, 2021 5:21 pm

Joined: Sun Apr 26, 2020 3:08 am
Posts: 357

Applesoft one. This one comes in at 77 bytes

2 READ J: IF J THEN HTAB 20-J/2: FOR K=1 TO J: ? "*";: NEXT : ?: GOTO 2: DATA 1,3,5,7,3,7,11,15,5,11,17,23,3,3,0

ML one

with the Monitor bug is 50 bytes
without the bug is 43 bytes

Code:

 ORG  $300 
 SHT 
  
 LDY  #13  
]LOOP  LDA  STARS,Y
 LSR
 EOR  #$FF
 ADC  #20
 TAX
 JSR  $F94A

 LDX  STARS,Y
 LDA  #"*"+$80
 JSR  APBUG      ; could have been a call to $F94C

 JSR  $FD8E
 DEY
 BPL  ]LOOP
 RTS

STARS  DFB  3,3,23,17,11,5,15,11,7,3,7,5,3,1

   LDA #$A0      ; this is the bug in the Monitor, where the BNE below branches here instead and forces the character to a space
APBUG   JSR $FDED
   DEX
   BNE APBUG
   RTS

Top

John West

Post subject: Re: Christmas Challenge

Posted: Tue Dec 21, 2021 12:08 am

Joined: Tue Sep 03, 2002 12:58 pm
Posts: 336

I knew I could do better. 36 'bytes' (of 16 bits each).

This one stores the run-lengths of spaces and stars in 6 bit fields, packed 5 to a 32 bit word. The runs of spaces include enough to wrap to the next line after each run of stars. There's no explicit end-of-data marker: the code follows immediately, and I've sneakily arranged that the top bit of the first 32 bit value in the code is set. So if the data is negative, we can exit the loop.

Before printing each run of characters, it switches to the other character with eor #$0a. That's an 8 bit instruction which clears the rest of the register, so the $802a loaded by the first instruction (which needed an operand with bit 15 set, so it can act as an 'end' mark when interpreted as data) becomes an 8 bit value before it's given to chrout.

The only other trick is hiding the RTS instruction in the data table. There happens to be a value of $2460 in there, and in the current version of the processor, the top 8 bits of RTS are ignored. I score points for interpreting data as code AND code as data, right?

Code:

                                 109    * = $f000
0000f000:                        110 treedata
0000f000: 0e53 2460              111    .long %100100_000011_100110_000001_010011
0000f002: 8845 0398              112    .long %000011_100010_001001_100001_000101
0000f004: 2de3 1bf1              113    .long %011011_001011_011111_000111_100011
0000f006: 784f 0d77              114    .long %001101_011110_000111_011101_001111
0000f008: 65d8 1a24              115    .long %011010_011001_010010_010011_011000
0000f00a: 4c43 0039              116    .long %000000_010011_000011_100101_000011
0000f00c:                        117 tree
0000f00c: 01a9 802a              118    ldr.w a0, #$802a
0000f00e: a4fc                   119    sub a1, a1
0000f00f:                        120 loop
0000f00f: 16b4 f000              121    ldr.l y0, treedata, a1
0000f011: 0030 00ee              122    bmi treedata+1
0000f013: 36e8                   123    inc.l a1, #2
0000f014:                        124 branches
0000f014: 30a8                   125    mov y1, y0
0000f015: 2037 003f              126    and y1, #63
0000f017: 0049 000a              127    eor a0, #$0a
0000f019:                        128 chars
0000f019: 90f0 f24e              129    bra.l chrout
0000f01b: 0488                   130    dec y1
0000f01c: 00d0 00fb              131    bne chars
0000f01e: 2242 0006              132    lsr.l y0, #6
0000f020: 00d0 00f2              133    bne branches
0000f022: 80f0 00eb              134    bra loop

Top

IamRob

Post subject: Re: Christmas Challenge

Posted: Tue Dec 21, 2021 4:43 am

Joined: Sun Apr 26, 2020 3:08 am
Posts: 357

I like the one entry using the inline variable and has got my vote for the best entry. Here it is converted to Applesoft at 75 bytes.

0 ACEGCGKOEKQWCC=0: FOR I=0 TO 13: X= PEEK(2053+I)-64: FOR J=1 TO X:? TAB(20-X/2)"*";: NEXT: ?: NEXT

Top

okwatts

Post subject: Re: Christmas Challenge

Posted: Tue Dec 21, 2021 11:44 pm

Joined: Wed Nov 11, 2020 10:42 pm
Posts: 104
Location: Kelowna Canada

I cleaned up my code to correct some stack creep and made an attempt to be a bit more "algorythmic". Still takes 152 bytes and perhaps losing some readability but I'm not anywhere close to the smallest code even if those examples stretch my ability to comprehend what is taking place.
( PS I am having an issue with my code loading going into nether regions hence the need to stick in a deliberate error in the screen. <sigh> more debugging required! )

Code:

forget stars OK
free 
21971 Bytes available
OK
29 load 
21819 Bytes available
.s [0 ] OK
free 
21819 Bytes available
OK
29 list 
SCR#29 
 0 ( Christmas Challenge variable corrected )
 1 : stars 0 do 42 emit loop ;
 2 : sline dup 61 swap - 2 / dup spaces swap stars spaces cr ;
 3 
 4 0 variable cl
 5 : sp cl ! 4 0 do cl @ dup 1 + i * + sline loop ;
 6 : ctree cr 1 sp 3 sp 5 sp 3 sline 3 sline ;
 7 free
 8 ; ( required to get control back ??? )
 9 
10 
11 
12 
13 
14 
15 
OK
ctree 
                              *                              
                             ***                             
                            *****                            
                           *******                           
                             ***                             
                           *******                           
                         ***********                         
                       ***************                       
                            *****                            
                         ***********                         
                      *****************                      
                   ***********************                   
                             ***                             
                             ***                             
OK
.s [0 ] OK

Top

IamRob

Post subject: Re: Christmas Challenge

Posted: Wed Dec 22, 2021 1:52 am

Joined: Sun Apr 26, 2020 3:08 am
Posts: 357

okwatts wrote:

I took the one posted code and converted it to Forth.

10 FOR X=1 TO 5: FOR Y=1 TO 4: A=X*Y: IF X>3 then A=2:Y=4
20 PRINT TAB(21-A): for z=1 to A+A-1: ?"*";: next: ?: next: next

Here is the smallest I got in Forth at 102 bytes

: t 6 1 do i 5 1 do dup dup i * swap 3 > if drop R> R> drop 1 >R >R
2 then dup 20 swap - spaces dup + 1- 0 do 42 emit loop cr loop loop ;

Top

IamRob

Post subject: Re: Christmas Challenge

Posted: Wed Dec 22, 2021 2:27 am

Joined: Sun Apr 26, 2020 3:08 am
Posts: 357

Here is the another conversion to Forth from another entry comes in at 99 bytes

: IT ;
: ACEGCGKOEKQWCCC ' IT 4 + 15 1 DO 1+ DUP C@ 64 - DUP 2 / 20 SWAP - SPACES
0 DO 42 EMIT LOOP CR LOOP DROP ;

Top

Dr Jefyll

Post subject: Re: Christmas Challenge

Posted: Wed Dec 22, 2021 4:34 am

Joined: Fri Dec 11, 2009 3:50 pm
Posts: 3367
Location: Ontario, Canada

Adapted from the above, and about a dozen bytes shorter...

HERE
: ACEGCGKOEKQWCCC [ LITERAL ] 15 1 DO 1+ DUP C@ 64 - DUP 2 / 20 SWAP - SPACES
0 DO 42 EMIT LOOP CR LOOP DROP ;

_________________
In 1988 my 65C02 got six new registers and 44 new full-speed instructions!
https://laughtonelectronics.com/Arcana/ ... mmary.html

Top

IamRob

Post subject: Re: Christmas Challenge

Posted: Wed Dec 22, 2021 7:01 am

Joined: Sun Apr 26, 2020 3:08 am
Posts: 357

Yeah, but now try typing the word in to try to forget it. I just have to type FORGET IT.

Top

beethead

Post subject: Re: Christmas Challenge

Posted: Wed Dec 22, 2021 12:01 pm

Joined: Tue Dec 03, 2019 11:39 am
Posts: 9

I'm too late but my attempt comes in at 66 bytes on the C256 Foenix's 65816 using my own assembler.

Code:

cpu '65816'
org $60
const width=72
const treepattern=array(1,3,5,9,3,7,11,15,19,5,11,17,23,3,3)
PUTC             = $001018
main:
   phk
   plb
   sep #$30
   ldy #sizeof(treepattern)-1
   -
      lda #' '
      ldx treedata,y,b
      jsr draw
      lda #'*'
      ldx tree,y,b
      jsr draw
      dey
      bpl -
   rtl
draw:
   pha
   jsl PUTC
   pla
   dex
   bne draw
   rts
var space1,space2=0
var treespace=array()
for i=0 to sizeof(treepattern)-1
   space1=trunc((width-treepattern[i])/2)
   treespace[i]=space1+space2
   space2=width-(space1+treepattern[i])
next
treedata:
   for i=sizeof(treepattern)-1 to 0 step-1
      byte treespace[i]
   next
tree:
   for i=sizeof(treepattern)-1 to 0 step-1
      byte treepattern[i]
   next

Attachments:

Foenix IDE 2021-12-22 3_21_42 AM.png [ 19.09 KiB | Viewed 1350 times ]

Top

drogon

Post subject: Re: Christmas Challenge

Posted: Wed Dec 22, 2021 8:29 pm

Joined: Wed Feb 14, 2018 2:33 pm
Posts: 1488
Location: Scotland

Just because you can doesn't mean you should.... (famous last words!)

So I thought just because... I'll do it in Sweet16... Naively thinking it might be smaller than some of the 6502 asm versions here, however, at $54 or decimal 84 bytes, then sadly no. Much is taken up by switching into and out of sweet16 mode, also given that sweet16 doesn't have any logical operators (e.g. shift) then my standard (terminal width - stars) / 2 calculation to get the leading spaces was going to be tricky, and I couldn't be bothered being clever, so I implemented a 2nd table.

The output is as it ought to be:

Code:

* load tree 8000
* go
Starting program at $8000 (Emulation)
                                       *
                                      ***
                                     *****
                                    *******
                                      ***
                                    *******
                                  ***********
                                ***************
                                     *****
                                  ***********
                               *****************
                            ***********************
                                      ***
                                      ***

The source code... OK, here it is....

Code:

; runTree.s:
;********************************************************************************

   .include   "sw16.h"
   .include   "sw16regs.h"
   .include   "runTree.h"
   .include   "osVectors.h"

.proc   runTree

   goSweet16

   set   r12,$0100   ; Sweet16 stack pointer
   set   r2,1      ; Constant 1
   set   r3,40      ; Constant 40 - width / 2
   set   r8,treeData   ; Address of the tree data table
   set   r9,spaceData   ; Address of the tree branch spaces

loop:
   ld   @r9      ; Loads and increments r9
   bz   done      ; Reached the end
   set   r7,' '      ; r7 has character to print
   bs   printIt   
   ld   @r8      ; Loads and increments r8
   set   r7,'*'
   bs   printIt

; Newline

   rtn         ; Back to 6502 land
   .setcpu "65c02"

   jsr   osNewl

   jsr   _sweet16   ; Back to sweet16 land
   .setcpu   "sweet16"

   br   loop

; printIt:
;    Print Acc's worth of r7's...

printIt:
   rtn         ; Back to 6502 land
   .setcpu "65c02"

   lda   r7l      ; r7l has character to print
   jsr   osWrch

   jsr   _sweet16   ; Back to sweet16 land
   .setcpu   "sweet16"

   sub   r2      ; Subtract r1 (1) from Acc
   bnz   printIt
   rs         ; Return from subroutine

done:
   exSweet16
   rts

.endproc


; treeData:
;********************************************************************************

treeData:
   .byte   1,3,5,7, 3,7,11,15, 5,11,17,23, 3,3

spaceData:
   .byte   39,38,37,36,38,36,34,32,37,34,31,28,38,38,0

So if anyone ever wanted to know what sweet16 looks like then there you are ;-)

Oh, small confession, actually the whole thing is rather longer as my Ruby 816 OS no-longer has Sweet16 as a part of it (the 6502 version still has, but I'm running this on my '816 board), so I had to include the sweet16 code too (my version which can be assembled anywhere), as well as the standard code header I use (to make it an Acorn compatible ROM. That takes it to

Code:

-rw-rw-r-- 1 gordon gordon 782 Dec 22 20:21 tree

So, 782 bytes in total... But then I could also include the Ruby 816 OS, but where would you stop...

Cheers,

-Gordon

_________________
--
Gordon Henderson.
See my Ruby 6502 and 65816 SBC projects here: https://projects.drogon.net/ruby/

Top

barrym95838

Post subject: Re: Christmas Challenge

Posted: Thu Dec 23, 2021 9:07 am

Joined: Sun Jun 30, 2013 10:26 pm
Posts: 1949
Location: Sacramento, CA, USA

Regarding:

Code:

set r2,1
...
sub r2

I think

Code:

dcr r0

should be your friend here (unless I messed up and dcr doesn't affect flags). Also, I noticed that there are always an odd number of stars, so you could go back to a single table with entries of (stars-1)/2 and then

Code:

ld @r8
st r1
set r0,20
sub r1

for your space count and

Code:

ld r1
add r1
inr r0

for your star count (or something like that ...)

_________________
Got a kilobyte lying fallow in your 65xx's memory map? Sprinkle some VTL02C on it and see how it grows on you!

Mike B. (about me) (learning how to github)

Last edited by barrym95838 on Thu Dec 23, 2021 9:16 am, edited 1 time in total.

Top

drogon

Post subject: Re: Christmas Challenge

Posted: Thu Dec 23, 2021 9:14 am

Joined: Wed Feb 14, 2018 2:33 pm
Posts: 1488
Location: Scotland

barrym95838 wrote:

Regarding:

Code:

set r2,1
...
sub r2

I think

Code:

dcr r0

should be your friend here.

Duh! Why did I forget the inr/dcr instructions. Obviously had too many sherrys last night, or something!

I'll have a look at the rest when I've done the morning tasks (dog, horse, house, etc.)

Cheers,

-Gordon

Quote:

Also, I noticed that there are always an odd number of stars, so you could go back to a single table with entries of (stars-1)/2 and then

Code:

ld @r8
st r1
set r0,20
sub r1

for your space count and

Code:

ld r1
add r1
inr r0

for your star count (or something like that ...)

_________________
--
Gordon Henderson.
See my Ruby 6502 and 65816 SBC projects here: https://projects.drogon.net/ruby/

Top

drogon

Post subject: Re: Christmas Challenge

Posted: Thu Dec 23, 2021 11:19 am

Joined: Wed Feb 14, 2018 2:33 pm
Posts: 1488
Location: Scotland

barrym95838 wrote:

Regarding:

Code:

set r2,1
...
sub r2

I think

Code:

dcr r0

Code:

ld @r8
st r1
set r0,20
sub r1

for your space count and

Code:

ld r1
add r1
inr r0

for your star count (or something like that ...)

And yes, that works. Output:

Code:

* ftp get tree
*load tree 8000
* go
Starting program at $8000 (Emulation)
                                        *
                                       ***
                                      *****
                                     *******
                                       ***
                                     *******
                                   ***********
                                 ***************
                                      *****
                                   ***********
                                *****************
                             ***********************
                                       ***
                                       ***

code length is now $47, or decimal 71 bytes.

Code:

; runTree.s:
;********************************************************************************

   .include   "sw16.h"
   .include   "sw16regs.h"
   .include   "runTree.h"
   .include   "osVectors.h"

.proc   runTree

   goSweet16

   set   r12,$0100   ; Sweet16 stack pointer
   set   r3,40      ; Constant 40 - tWidth / 2, also end of data marker
   set   r8,treeData   ; Address of the tree data table

loop:
   ld   @r8      ; Fetch data into Acc; Loads and increments r8
   cpr   r3      ; End of data?
   bz   done      ; Reached the end
   st   r1      ; Temp. store

   ld   r3      ; 40 -> Acc
   sub   r1      ; To get No. spaces
   set   r7,' '      ; r7 has character to print
   bs   printIt      ; Subroutine to print leading spaces

   ld   r1      ; Get original table data
   add   r1      ; double it
   inr   r0      ; Add 1
   set   r7,'*'
   bs   printIt      ; Subroutine to print a banch of cones

; Newline
   exSweet16      ; To 6502 land
   jsr   osNewl
   goSweet16      ; Back to sweet16 land
   br   loop

printIt:
   exSweet16      ; To 6502 land

   lda   r7l      ; r7l has character to print
   jsr   osWrch

   goSweet16      ; Back to sweet16 land

   dcr   r0      ; Subtract 1 from Acc
   bnz   printIt
   rs         ; Return from subroutine

done:
   exSweet16
   rts
.endproc


; treeData:
;   As per the suggestion iof  barrym95838, we're storing a computed
;   number here - it's the number (stars - 1) / 2.
;   So the number of spaces is 40 - n
;   and the numbe of stars  is n + n + 1.
;********************************************************************************

treeData:
   .byte   0,1,2,3, 1,3, 5, 7, 2, 5, 8,11, 1,1, 40
;   .byte   1,3,5,7, 3,7,11,15, 5,11,17,23, 3,3

Minor improvements can be made by utilising the 3 unused sweet16 non-register opcodes - e.g. one could be print new line and another could be print Acc - that saves the jump to 6502 land and back again twice, however is that overstepping the mark?

for those wondering, exSweet16 and goSweet16 are macros:

Code:

.macro   goSweet16
       jsr   _sweet16
   .setcpu "sweet16"
.endmacro

.macro   exSweet16
   rtn
   .setcpu "65c02"
.endmacro

Anyway, that is I think, enough for now!

Cheers,

-Gordon

_________________
--
Gordon Henderson.
See my Ruby 6502 and 65816 SBC projects here: https://projects.drogon.net/ruby/

Top

barrym95838

Post subject: Re: Christmas Challenge

Posted: Thu Dec 23, 2021 4:23 pm

Joined: Sun Jun 30, 2013 10:26 pm
Posts: 1949
Location: Sacramento, CA, USA

drogon wrote:

Trade-offs are part of the game. Charlie liked Sweet16 enough to install an optimized (!) version on his PET and added opcodes for EXT, a DTC Forth NEXT, DUP and DROP. I hope he's doing well ... I haven't heard from him in months.

_________________
Got a kilobyte lying fallow in your 65xx's memory map? Sprinkle some VTL02C on it and see how it grows on you!

Mike B. (about me) (learning how to github)

Top

Page 2 of 3

[ 37 posts ]

Go to page Previous 1, 2, 3 Next

Board index » 6502.org Users Forum » Programming

All times are UTC

Who is online

Users browsing this forum: No registered users and 12 guests

You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot post attachments in this forum