Millfork

[zbyti]

My attempt to System Off in Millfork:

java -jar $HOME/Programs/Millfork/millfork.jar -Xr -t a8 your_code.mfk

// ================================================
//
// antic_nmien = $40
//
// %01000000 $40 VBI
// %10000000 $80 DLI
// %11000000 $c0 VBI + DLI
//
// ================================================
//
// pia_portb = $fe
//
// PORTB_BASIC_OFF + PORTB_SELFTEST_OFF + %01111100
//
// PORTB_SELFTEST_OFF = %10000000; portb bit value to turn Self-Test off
// PORTB_BASIC_OFF    = %00000010; portb bit value to turn Basic off
// PORTB_SYSTEM_ON    = %00000001; portb bit value to turn System on
//
// ================================================

byte nmien = $c0

byte rti       @ $15 // default routine for VBI & DLI
word vbivec    @ $10 // vector for VBI
word vdslst    @ $16 // vector for DLI

// simple display list; LMS = $e000
const array(byte) dl align(32) = [
  $70,$70,$70,
  $42,$00,$e0,2,2,$f0,2,2,2,$f0,2,2,2,
  $41,@word[dl.addr]
]

// init procedure
void system_off(){
  asm { sei }                 // turn off IRQ
  antic_nmien = 0             // turn off NMI
  pia_portb = $fe             // turn off ROM
  rti = $40                   // set RTI opcode
  vbivec = rti.addr           // set address for VBI routine
  vdslst = rti.addr           // set address for DLI routine
  os_NMIVEC = nmi.addr        // set address for custom NMI handler
  antic_nmien = nmien
}

// custom NMI handler
asm void nmi(){
  bit antic_nmist             // test nmist
  bpl .vblclock               // if 7-bit not set handle VBI
  jmp (vdslst)                // indirect jump to DLI routine
  .vblclock:                  // RTCLOK maintainer
  inc os_RTCLOK.b2
  bne .tickend
  inc os_RTCLOK.b1
  bne .tickend
  inc os_RTCLOK.b0
  .tickend:
  jmp (vbivec)                // indirect jump to VBI routine
}

// example dli
interrupt asm void dli_first(){
  pha
  lda #$2a
  sta gtia_colpf2
  sta antic_wsync
  lda #<dli_second.addr
  sta vdslst.lo
  lda #>dli_second.addr
  sta vdslst.hi
  pla
  rti
}

// example dli
interrupt void dli_second(){
  gtia_colpf2 = $de
  antic_wsync = $de
  vdslst = dli_first.addr
}

// wait for VBLANK
asm void pause() {
  lda os_RTCLOK.b2
  .rt_check:
  cmp os_RTCLOK.b2
  beq .rt_check
  rts
}

// wait 0-255 frames
noinline asm void wait(byte register(a) f) {
  clc
  adc os_RTCLOK.b2
  .rt_check:
  cmp os_RTCLOK.b2
  bne .rt_check
  rts
}

// example vbi
interrupt void vbi(){
  gtia_colpf2 = os_RTCLOK.b2
}

// main procedure
void main(){
  system_off()                // turn off OS

  wait(100)                   // waint 2 sec on PAL for fun
  antic_dlist = dl.addr       // set custom display list
  wait(100)                   // waint 2 sec on PAL for the lulz
  vbivec = vbi.addr           // set custom VBI
  wait(100)                   // waint 2 sec on PAL because we can
  vdslst = dli_first.addr     // set custom DLI

  while(true){
    wait(100)
    nmien ^= %10000000        // toggle DLI
    antic_nmien = nmien
  }
}

 

systemoff-example.mfk systemoff-example.xex

 

EDIT: My repository with examples https://github.com/zbyti/a8-millfork-playground

Edited September 23, 2020 by zbyti
repository with examples

[zbyti]

Endless scroll:

const word dlAddr = $3000
const word lms1Addr = $4000
const word lms2Addr = $4060
const word lms3Addr = $40c0

array(byte) dl @ dlAddr = [
  $70,$70,$70,
  $52, @word[lms1Addr],
  $52, @word[lms2Addr],
  $52, @word[lms3Addr],
  $41,lo(dlAddr),hi(dlAddr)
]

noinline asm void wait(byte register(a) f) {
  clc
  adc os_RTCLOK.b2
  .rt_check:
  cmp os_RTCLOK.b2
  bne .rt_check
  rts
}

void main() {
  word lms1 @ dlAddr + 4
  word lms2 @ dlAddr + 7
  word lms3 @ dlAddr + 10
  byte hscroli @ $80, a, b, c
  pointer screeni @ $82

  hscroli = $f
  screeni = lms1Addr

  wait(1)
  os_SDLST = dl.addr

  while true {
    if hscroli == $b {
      a = (pokey_random & 15) + 33
      b = (pokey_random & 15) + 33
      c = (pokey_random & 15) + 33

      screeni[0] = a
      screeni[$60] = b
      screeni[$c0] = c

      screeni[$30] = a
      screeni[$30 + $60] = b
      screeni[$30 + $c0] = c

      lms1 += 1
      lms2 += 1
      lms3 += 1
      screeni += 1

      if lms1 == lms1Addr + $30 {
        lms1 = lms1Addr
        lms2 = lms2Addr
        lms3 = lms3Addr
        screeni = lms1Addr
      }

      hscroli = $f
    }
    antic_hscrol = hscroli
    hscroli -= 1
    wait(1)
  }
}

 

endless_scroll.mfk endless_scroll.xex

Edited September 16, 2020 by zbyti
add gif

[zbyti]

Chessboard Benchmark 150 frames:

const word lmsAddr1 = $8400
const word lmsAddr2 = $6010

byte i@$e0, j@$e2, k@$e4, count@$e6
pointer screen@$e8

const array(byte) dl align(256) = [
  $70,$70,$70,
  $4f,@word[lmsAddr2],
  $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
  $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
  $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
  $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
  $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
  $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
  $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
  $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
  $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
  $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
  $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
  $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
  $0f,$0f,$0f,$0f,$0f,
  $4f,0,lmsAddr2.hi + $10,
  $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
  $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
  $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
  $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
  $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
  $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
  $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
  $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
  $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
  $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
  $0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,
  $0f,
  $41,@word[dl.addr]
]

const array(byte) dlPrint align(16) = [
  $70,$70,$70,
  $42,@word[lmsAddr1],
  $41,@word[dlPrint.addr]
]

asm void pause() {
  LDA os_RTCLOK.b2
  .rt_check:
  CMP os_RTCLOK.b2
  BEQ .rt_check
  RTS
}

//print HEX value
void printScore() {
  array(byte) tmp[2]
  byte iter

  screen = lmsAddr1
  os_SDLST = dlPrint.addr

  tmp[0] = count >> 4
  tmp[1] = count & %00001111

  for iter:tmp {
    if tmp[iter] < 10 {
      screen[iter] = tmp[iter] + $10
    } else {
      screen[iter] = tmp[iter] + $17
    }
  }
}

void drawBoard() {
  screen = lmsAddr2
  os_SDLST = dl.addr

  for i,7,downto,0 {
    for j,23,downto,0 {
      for k,3,downto,0 {
        screen[0] = 255
        screen[1] = 255
        screen[2] = 255
        screen += 6
      }
      screen += 16
    }
    if (i & 1) != 0 {
      screen += 3
    } else {
      screen -= 3
    }
  }
}

void main() {
  count = 0

  pause()
  os_RTCLOK.b2 = 0

  while os_RTCLOK.b2 < 150 {
    drawBoard()
    count += 1
  }

  printScore()

  while (true){}
}

 

chessboard.mfk chessboard.xex

Edited September 17, 2020 by zbyti
add gif

[zbyti]

Chessboard Benchmarki print result in HEX, on my emulator it's $52 = 82

Edited September 16, 2020 by zbyti
hex score info

[zbyti]

Old, good SIEVE 1899. Result printed in HEX.

const word size = 8192

word RTCLOK @ $13, SAVMSC @ $58
word i@$e0, prime@$e2, k@$e4, count@$e6
pointer screen@$e8

asm void pause() {
  LDA $14
  rt_check:
  CMP $14
  BEQ rt_check
  RTS
}

void printScore() {
  array(byte) tmp[4]
  byte iter

  screen = SAVMSC

  tmp[0] = RTCLOK.lo >> 4
  tmp[1] = RTCLOK.lo & %00001111
  tmp[2] = RTCLOK.hi >> 4
  tmp[3] = RTCLOK.hi & %00001111

  for iter:tmp {
    if tmp[iter] < 10 {
      screen[iter] = tmp[iter] + $10
    } else {
      screen[iter] = tmp[iter] + $17
    }
  }
}

void main() {
  array(byte) flags[size] align(1024)
  byte iter

  pause()
  RTCLOK = 0

  for iter,9,downto,0 {

    count = 0

    for i:flags {
      flags[i] = 1
    }

    for i:flags {
      if flags[i] != 0 {
        prime = (i * 2) + 3
        k = i + prime
        while k <= size {
          flags[k] = 0
          k += prime
        }
        count += 1
      }
    }

  }

  printScore()

  while true {}
}

 

sieve1899.mfk sieve1899.xex

[zbyti]

DLI example:

const word dlAddr = $3000
const word dliAddr = $3100

const array(byte) dl @ dlAddr = [
  $70,$70,$70,
  $42,$00,$40,2,2,2,2,$f0,2,2,2,2,
  $41,@word[dlAddr]
]

volatile word SDLST @ $230

interrupt void dli() @ dliAddr {
  gtia_colpf2 = $de
  antic_wsync = 1
}

void main() {
  SDLST = dl.addr
  os_VDSLST = dli.addr
  antic_nmien = $c0

  while true {}
}

 

dli-example.xex dli_example.mfk

[zbyti]

The above are my examples in practice form to show the different possibilities of the language.

 

I'm still learning :]

[fantômas]

20 hours ago, zbyti said:

The above are my examples in practice form to show the different possibilities of the language.

 

I'm still learning :]

Really interesting! Do you think this new language is worth it compared to all available C compilers?

[ilmenit]

14 minutes ago, fantômas said:

Really interesting! Do you think this new language is worth it compared to all available C compilers?

Millfork looks very interesting. It seems to be a good solution if you aim for program without dependency on OS, because OS and standard library support for A8 is almost non-existing. Also it's a custom language so you cannot have the same codebase for Atari and Mac/Linux/Window. It also means debugging will be very complicated and Millfork I think still does not generate symbols that can be loaded by Altirra debugger.

[zbyti]

On 9/17/2020 at 4:25 PM, fantômas said:

Do you think this new language is worth it compared to all available C compilers?

I'm no C expert by any means I only did some benchmarks (C code provide @ilmenit) learning A8 platform.

 

I'm consider Mad Pascal most mature language on 8-bit Atari but for now my language of choice is Millfork due to his flexibility and multiplatformity (targets).

 

From my point of view CC65 required from programmer good knowledge about compiler and it's not as fast as Mad Pascal and Millfork.

 

Only one feature (which Millfork haven't) is worth to consider: write & run logic on PC and then compile tested code to 8-bit platform. Mad Pascal and C compilers have this feature but I don't need this possibility for that moment.

Edited September 18, 2020 by zbyti
that moment

[fantômas]

27 minutes ago, ilmenit said:

Millfork looks very interesting. 

 

22 minutes ago, zbyti said:

I'm consider Mad Pascal most mature language on 8-bit Atari but my language of choice it's now Millfork due to his flexibility and multiplatformity.

 

Thank you for your answers. I'll take a closer look.

 

There's another project I'm following with great attention: KickC (C-compiler that creates optimized 6502 assembler)

 

[zbyti]

FOR Countdown Benchmark:

byte RTCLOK @ 0
byte iter0B @ 1
word iter0W @ 2
bool start_counter @ 4

byte zpr_0 @ $24, zpr_1 @ $23, zpr_2 @ $22, zpr_3 @ $21, zpr_4 @ $20
byte zpc_0 @ $47, zpc_1 @ $46, zpc_2 @ $45, zpc_3 @ $44, zpc_4 @ $43, zpc_5 @ $42, zpc_6 @ $41

const array(byte) dl align(16) = [
  $70,$70,$70,
  $42,$20,0,
  $41,@word[dl.addr]
]

void system_off(){
  asm { sei }
  antic_nmien = 0
  pia_portb = $fe
  os_NMIVEC = vbi.addr
  start_counter = false
  antic_nmien = $40
}

asm void pause() {
  lda RTCLOK
  .rt_check:
  cmp RTCLOK
  beq .rt_check
  rts
}

interrupt void vbi(){
  RTCLOK += 1
  if start_counter{
    zpr_0 += 1
    if zpr_0 == 10 {
      zpr_1 += 1
      zpr_0 = 0
    }
    if zpr_1 == 10 {
      zpr_2 += 1
      zpr_1 = 0
    }
    if zpr_2 == 10 {
      zpr_3 += 1
      zpr_2 = 0
    }
    if zpr_3 == 10 {
      zpr_4 += 1
      zpr_3 = 0
    }
  }
}

void copy_block(pointer src, pointer dsc, word size){
  for iter0W,0,to,size-1{
    dsc[iter0W] = src[iter0W]
  }
}

void set_block(pointer from, word size, byte val){
  for iter0W,0,to,size-1{
    from[iter0W] = val
  }
}

void main(){
  copy_block($e080,$4000,80)
  system_off()
  set_block($20,40,255)
  set_block($20,5,0)
  set_block($41,7,0)

  pause()
  antic_chbase = $40
  antic_dlist = dl.addr

  start_counter = true

  for zpc_6,1,downto,0{
    for zpc_5,9,downto,0{
      for zpc_4,9,downto,0{
        for zpc_3,9,downto,0{
          for zpc_2,9,downto,0{
            for zpc_1,9,downto,0{
              for zpc_0,9,downto,0{
              }
            }
          }
        }
      }
    }
  }

  start_counter = false

  while true {}
}

countdown_for_benchmark.mfk countdown_for_benchmark.xex

Edited September 18, 2020 by zbyti
add screen

[zbyti]

WHILE Countdown Benchmark

 

 

countdown_while_benchmark.mfk countdown_while_benchmark.xex

[zbyti]

Well... This is my playground https://github.com/zbyti/a8-millfork-playground

[zbyti]

Vertical Scroll:

const array text align(64) = "...MILLFORK RULEZ..." atariscr

const array(byte) dl align(16) = [
  $70,$70,$70,$70,
  $67,@word[text.addr],
  $41,@word[dl.addr]
]

noinline asm void wait(byte register(a) f) {
  clc
  adc os_RTCLOK.b2
  .rt_check:
  cmp os_RTCLOK.b2
  bne .rt_check
  rts
}

void main(){
  byte i0B @ $80

  i0B = $f
  os_SDLST = dl.addr

  while true {
    while (i0B != 0){
      i0B -= 1
      antic_vscrol = i0B
      wait(3)
    }
    wait(50)
    while (i0B < $f){
      i0B += 1
      antic_vscrol = i0B
      wait(2)
    }
  }
}

 

vertical_scroll.mfk vertical_scroll.xex

[zbyti]

Monte Carlo PI estimation benchmark (multiplication):

 

const word probe = 9999
const word radius = 127 * 127
pointer screen @ $80

asm void pause() {
  lda os_RTCLOK.b2
  .rt_check:
  cmp os_RTCLOK.b2
  beq .rt_check
  rts
}

// print in HEX
void printScore(word val) {
  array(byte) tmp[4]
  byte iter

  tmp[0] = val.hi >> 4
  tmp[1] = val.hi & %00001111
  tmp[2] = val.lo >> 4
  tmp[3] = val.lo & %00001111

  for iter:tmp {
    if tmp[iter] < 10 {
      screen[iter] = tmp[iter] + $10
    } else {
      screen[iter] = tmp[iter] + $17
    }
  }
  screen += 40
}

void main() {
  array(bool) flags[size] align(1024)
  word i@$e0, bingo@$e2
  word x@$e4, y@$e6, n@$e8, p@$ea

  screen = os_SAVMSC

  x = 0
  y = 0
  bingo = 0

  pause()
  os_RTCLOK = 0

  for i,0,to,probe {
    n = pokey_random & 127
    x = n * n
    n = pokey_random & 127
    y = n * n
    if ((x+y) <= radius) {
      bingo += 1
    }
  }
  p = 4 * bingo

  n = os_RTCLOK.b2 + (os_RTCLOK.b1 * 256)

  printScore(n)
  printScore(p)

  while true {}
}

 

montecarlo_pi_benchmark.mfk montecarlo_pi_benchmark.xex

 

I am aware of the difference in single results, but what interests me is the multiplication procedure implemented in a given language, then you can see a significant difference.

Edited September 19, 2020 by zbyti

[zbyti]

I want to share some knowledge from the author of the Millfork about byte multiplication:

Quote

byte*byte produces a byte, this is by design. An arithmetic operator never promotes the result to a type larger that the type of its arguments.

 

In order to get a word, you need to explicitly cast one of the arguments to word: x = n*word(n)
This causes a call to __mul_u16u8u16, which is defined in m6502/zp_reg.mfk.
The same file also contains __mul_u16u16u16 and __mul_u8u8u8, plus all the division and modulo implementations.

 

Refactored code below.

 

montecarlo_pi_benchmark.mfk montecarlo_pi_benchmark.xex

Edited September 20, 2020 by zbyti
new score added

[zbyti]

 

[Preppie]

Anyone who post OLC gets a like from me

[zbyti]

Horizontal Stars on missile.

void main(){
  array(byte) stars[256] align(fast)
  byte i

  os_PCOLR0 = $e
  gtia_grafm = $e

  for i:stars {
    stars[i] = pokey_random
  }

  while true {
    if antic_vcount == 0 {
      for i:stars {
        antic_wsync = 1
        gtia_hposm0 = stars[i]
        stars[i] += 1
      }
    }
  }
}

 

Idea taken from @bocianu https://gitlab.com/bocianu/various-doodles

horizontal_stars.mfk horizontal_stars.xex

Edited September 22, 2020 by zbyti
top secret

[zbyti]

More life in the empty space

void main(){
  array(byte) stars[256] align(fast)
  array(byte) speed[256] align(fast)
  byte i

  os_PCOLR0 = $e
  gtia_grafm = $e

  for i:stars {
    stars[i] = pokey_random
    speed[i] = (pokey_random & 3) + 1
  }

  while true {
    if antic_vcount == 0 {
      for i:stars {
        antic_wsync = i
        gtia_hposm0 = stars[i]
        stars[i] += speed[i]
      }
    }
  }
}

 

horizontal_stars.mfk horizontal_stars.xex

Edited September 24, 2020 by zbyti
antic_wsync = i

[zbyti]

Grand Ttheft Antic

byte i @ $b0
pointer screen @ $b2
array(word) scores[17] @ $80

asm void openmode(byte register(a) m) @ $ef9c extern

asm void pause() {
  lda os_RTCLOK.b2
  .rt_check:
  cmp os_RTCLOK.b2
  beq .rt_check
  rts
}

// print in HEX
void printScore(word val) {
  array(byte) tmp[4]
  byte iter

  tmp[0] = val.hi >> 4
  tmp[1] = val.hi & %00001111
  tmp[2] = val.lo >> 4
  tmp[3] = val.lo & %00001111

  for iter:tmp {
    if tmp[iter] < 10 {
      screen[iter] = tmp[iter] + $10
    } else {
      screen[iter] = tmp[iter] + $17
    }
  }

  if i < 16 {
    screen[4] = 0
    screen[5] = 'G' atariscr
    screen[6] = 'R' atariscr
    screen[7] = '.' atariscr
    if i < 10 {
      screen[8] = i + $10
    } else {
      screen[8] = i + $17
    }
  } else {
    screen[4] = 0
    screen[5] = 'O' atariscr
    screen[6] = 'F' atariscr
    screen[7] = 'F' atariscr
  }

  screen += 40
}


void main(){
  for i:scores {
    scores[i] = 0
  }

  for i,0,to,15 {
    openmode(i)
    pause()
    os_RTCLOK.b2 = 0
    while os_RTCLOK.b2 < 100 {
      scores[i] += 1
    }
  }

  os_SDMCTL = 0
  i = 16
  pause()
  os_RTCLOK.b2 = 0
  while os_RTCLOK.b2 < 100 {
    scores[i] += 1
  }
  os_SDMCTL = $22

  openmode(0)
  screen = os_SAVMSC

  for i:scores {
    printScore(scores[i])
  }

  while true {}
}

 

grand_theft_antic.mfk grand_theft_antic.xex

Edited September 23, 2020 by zbyti

[zbyti]

Bubble Sort (255 elements) benchmark ($81 frames) with kind of preprocessing example:

pointer screen @ $84
byte i @ $80, n1 @ $81, n2 @ $82, t @ $83
array(byte) sorttable align(fast) = [for x,255,downto,1 [x]]

asm void pause() {
  lda os_RTCLOK.b2
  .rt_check:
  cmp os_RTCLOK.b2
  beq .rt_check
  rts
}

// print in HEX
void printScore(byte val) {
  array(byte) tmp[2]
  byte iter

  tmp[0] = val >> 4
  tmp[1] = val & %00001111
  for iter:tmp {
    if tmp[iter] < 10 {
      screen[0] = tmp[iter] + $10
    } else {
      screen[0] = tmp[iter] + $17
    }
    screen += 1
  }
  screen[0] = 0
  screen += 1
}

void main(){
  screen = os_SAVMSC
  for i:sorttable {
    printScore(sorttable[i])
  }

  pause()
  os_RTCLOK.b2 = 0

  for t,253,downto,0{
    for i,0,to,253{
      n1 = sorttable[i]
      n2 = sorttable[i+1]
      if n1>n2 {
        sorttable[i] = n2
        sorttable[i+1] = n1
      }
    }
  }

  t = os_RTCLOK.b2

  screen = os_SAVMSC
  for i:sorttable {
    printScore(sorttable[i])
  }
  printScore(t) // print jiffies

  while true {}
}

 

bubble_sort.mfk bubble_sort.xex

Edited September 24, 2020 by zbyti
change i to x

[zbyti]

Quatari Landscape

 

Idea & code taken from @ilmenit https://demozoo.org/productions/280623/

alias prev_x = os_OLDCOL.lo
alias cursor_x = os_COLCRS.lo
alias prev_y = os_OLDROW
alias cursor_y = os_ROWCRS
alias color = os_ATACHR

byte i

array(byte) color_height = [
  170,150,144,144,122,122,110,110,94,94,86,86,82,80
]

asm void openmode(byte register(a) m) @ $ef9c extern
asm void drawto() @ $f9c2 extern

void main(){
  openmode(9)
  os_COLOR4 = $b0

  for i,0,to,79 {
    cursor_x = i
    prev_x = i
    color = 13
    prev_y = 1

    while color != $ff {
      cursor_y = color_height[color]
      if (pokey_random & 1) != 0 {
        color_height[color] += 1
      } else {
        if (pokey_random & 1) != 0 {
          color_height[color] -= 1
        }
      }
      drawto()
      color -= 1
    }
  }

  while true {}
}

 

landscape.mfk landscape.xex

Edited September 25, 2020 by zbyti
Quatari

[zbyti]

Well, so many examples are enough for start to anyone. It's time for me to dive into chess programming