Examples

Fibonacci

Calculate and return the nth element of the Fibonacci sequence. The result is held on the working stack.

:06 JMS:fibonacci HLT

( Return the nth fibonacci number. )
@fibonacci  ( n -- fib* )
  PSHr *:0000 *:0001
  &loop  ( a* b* : n )
    SWP* OVR* ADD*
    DECr DUPr JCNr:~loop
  SWP* POP* POPr JMPr

Fizzbuzz

Print the first n numbers. Print fizz if a number is divisible by 3, buzz if by 5, and fizzbuzz if by 15.

If a number is divisible by 3, print fizz. If a

( Assign names to device ports. )
%MATH.X          20 ;  %MATH.Y          22 ;
%MATH.QUOTIENT   2C ;  %MATH.REMAINDER  2E ;
%LOCAL.STREAM    86 ;

*:0020 JMS:fizzbuzz HLT

@fizzbuzz  ( n* -- )
  *:0000
  &loop  ( end* i* -- )
    INC*
    *:0003 JMS:is-factor? CPYr JCS:~print-fizz
    *:0005 JMS:is-factor? CPYr JCS:~print-buzz
    EQUr*:0000            PSH  JCS:~print-num
    :' ' STD:LOCAL.STREAM NQK* JCN:~loop
  POP* POP* JMPr
  &print-fizz *:~fizz JMP:print-string &fizz "fizz"
  &print-buzz *:~buzz JMP:print-string &buzz "buzz"
  &print-num  DUP*    JMP:print-decimal

@is-factor?  ( n* f* -- n* t? )
  OVR* STD*:MATH.X STD*:MATH.Y
  LDD*:MATH.REMAINDER GTH*:0000 JMPr

@print-string  ( addr* -- )
  DUP* LDA STD:LOCAL.STREAM
  INC* DUP* LDA JCN:print-string
  POP* JMPr

@print-decimal  ( n* -- )
  *:000A STD*:MATH.Y r:00
  &convert  ( n* : ... )
    STD*:MATH.X LDD*:MATH.QUOTIENT
    LDDr*:MATH.REMAINDER SWPr ADDr*:['0' 01]
    DUP* JCN*:~convert POP* POPr
  &print  ( : ... )
    STDr:LOCAL.STREAM
    JCNr:~print JMPr

Sort a list

Sort a list of doubles, using a passed sorting function ( a* b* -- t? )

Binary search

With custom equal function

Flow control

for-loop

%FOR:  PSH:         ;
%NEXT: DEC DUP JCN: ;

FOR:08 &loop
  ( ...do work... )
  NEXT:~loop
POP

if-else

Text conversions

Print string

Print a null-terminated string of zero or more characters from an address.

*:my-string JMS:print-string HLT

@print-string  ( text* -- )
  JMP:~start
  &loop
    STD:86 INC* &start
    DUP* LDA DUP JCN:~loop
  POP POP* JMPr

@my-string "This is a string."

Starting from the &start label, the function loads the current character, continues if the character is not zero, prints the character to the local stream, and then increments to the next character.

Convert to uppercase

@convert-to-uppercase
  IOR:20


DUP* JMS:convert-to-uppercase

Byte to string

@byte-to-hex-string  ( byte -- text* )
  DUP SHR:04 AND*:0f0f
  CALL:~to-hex-char SWP
  CALL:~to-hex-char SWP


  ADD:'0'  ( char1 char2 )
  STA:~string PSH*:~string RETURN  ( text*       )
  &string #02 00
  &to-hex-char  ( value -- char )
    DUP GTH:09 AND:07 ADD ADD:30 RETURN

Functional programming

Anonymous functions

Push the address of a function to the working stack.

This uses the block syntax to jump to the address after the function, using the JMS instruction in return mode to store the address at the start of the function to the working stack.

%λ: JMSr: ;

λ:{ RETURN } CALL

λ:{"This is a string."} JMS:print-string HLT

Map

Map a function over an array of bytes.

*:array λ:{ADD:10 JMPr} JMS:map HLT

@array [04] 00 01 02 03

@map  ( array* fn* -- )
  STA*:~fn CPYr* LDA INCr      ( len      : array* )
  &loop                        ( len      : array* )
    CPY* LDA JMS:[&fn #02]     ( len item : array* )
    CPY* STA INCr*             ( len      : array* )
    DEC DUP JCN:~loop          ( len      : array* )
  POP POPr* JMPr               (          :        )

@connect-client-mode  ( url* timeout* -- )
  λ:{"Connecting to: "} JMS:print-string
  OVR* JMS:print-string NEWLINE
  STD*:TIMER-1 JMS:open-client-connection


  &check-connection
    LDD:88 NOT JCN:~wait
    λ:{"Connected successfully"}
    JMS:print-string NEWLINE JMPr
  &wait
    *:1080 STD*:00
    LDD:02 EQU:08 JCN:~check-connection
    LDD*:TIMER-1 JCN*:~wait
  &timeout
    λ:{"Connection timed out"}
    JMS:print-string NEWLINE JMPr

@open-client-connection  ( string* -- )
  :89 JMP:write-string
@print-string  ( string* -- )
  :86 ( ...fall through... )

@write-string  ( string* port -- )
  STA:~port JMP:~start &loop
    STD:[&port 00] INC* &start
    DUP* LDA JCN:~loop
  POP POP* JMPr








> Draw scroll dot around the screen
```bedrock
*:0133 STD*:58           ( set background colour         )
*:1ffc STD*:58           ( set foreground colour         )
LDD*:54 SHR*:01 STD*:50  ( move screen cursor to center  )
LDD*:56 SHR*:01 STD*:52  ( move screen cursor to center  )

@start
  LDD:44 DUP GTH:7F SWP  ( convert h-scroll to double    )
  LDD*:50 ADD* STD*:50   ( add h-scroll to screen cursor )
  LDD:45 DUP GTH:7F SWP  ( convert v-scroll to double    )
  LDD*:52 ADD* STD*:52   ( add v-scroll to screen cursor )
  :41 STD:5E             ( draw line to the screen       )
  *:0800 STD*:00         ( wait for an input event       )
  JMP:start