Skip to content

Latest commit

 

History

History
394 lines (314 loc) · 9.71 KB

bios.b4a.org

File metadata and controls

394 lines (314 loc) · 9.71 KB

the b4 bios

scope of the bios

  • define dictionary of programs and enable running a program by name
  • provide a basic interactive shell for launching programs (when the system is running in standalone mode)

structure

# note: bios.b4a is generated from bios.b4a.org
# I'm keeping it in version control until I have
# a decent command-line build step for tangling
# the org file, because the pascal code requires it.

#--- begin bios -------------------\
<<term-ops>>
<<initial-words>>
<<b4-repl>>
<<string-table>>
#--- end of bios ------------------/
'- '- '- 'e 'n 'd '- 'o 'f '- 'b 'i 'o 's '- '- '-
<<main>>

^X : eXecute

The very first thing we want is an op to let us call a function dynamically.

There’s a hidden “dynamic jump” operation, in the form of pushing an address to the control stack and then invoking the “return” operation.

So we call that ^X for execute.

:X dc rt             # (f-?) execute f by pushing to ctrl stack and "returning"

word lists

@^ holds the dictionary

Here the dictionary is a linked list. The pointer to the last entry is traditionally called “last” in forth. In b4, we still pronource it “last” but it’s actually stored in the ^^ (“carat”) register, and we can just fetch its value directly with @^.

There is a corresponding assembler macro called .^ which can assemble a linked list for us as we go along.

accessors

Entries in the dictionary are records with several fields:

namesizepurpose
(no name)4 bytesaddress previous entry
e-nmvariescounted string
e-xtvariesstart of the data/code for entry
:e-nm lb 04 ad rt                  # (e-s) address of name relative to entry
:e-xt e-nm du rb c1 ad ad rt        # (e-a) address of code for entry "execution token"

looking up a word with “find”

:nz? c0 eq nt rt                    # (x-0|1) was x non-zero?
:find                               # (s - 0|e) find s in dictionary
  @T dc !T @^                       # (s - e :-T)
  .w du nz? .d                      # (se - se?)  while e!=0 do:
     du e-nm @T ^Q                  # (see -sen) fetch name, test condition ^Q
        .i cd !T rt .t              #          return if matched
     ri .o                          # (e - e') otherwise, move on to next entry
  cd !T rt                          # (0) e=0 so return it as fail result

string compare

:n1 c0 nt rt                        # n1: negative 1
:s-eq? ^Q rt                        # (st-?) are strings s and t the same?

:s-eq?-main                         # -- python translation:
   @S @T eq .i                      # if s is t:
      n1 rt .t                      #    return -1
   c1 +S rb @T rb eq .i             # if len(s) == len(t):
      c1 +T rb .f                   #    for s,t
         c1 +S rb c1 +T rb          #    in zip(s,t):
         eq nt .i                   #       if s!=t:
            cd zp                   #          <drop internal loop counter>
            c0 rt .t .n             #          return 0
   .e c0 rt .t                      # else: return 0
   n1 rt                            # return -1

# !! This is experiment in style. I plan to make a nice syntax
#    for this register capture/restore behavior.
:Q @T dc !T                         # capture arg T
      @S dc !S                      # capture arg S
         s-eq?-main
      cd !S                         # restore S
   cd !T                            # restore T
   rt

dynamic execution

Once we’ve found a dictionary entry to execute, we just need to fetch its xt field and then call ^X.

:exec e-xt dc rt

^@ to build tokens


^Y: yield (so we can do different things with the word list)

list the words

The word words reads from last to find the end of the chain, then walks the chain backwards, printing each name.

:words @^                          # list known words, starting at last entry.
  .w du nz? .d                     # while address != 0
     du e-nm puts sp               # print the word followed by a space
     ri .o                         # move to next entry
  zp rt                            # drop the final null pointer

terminal device

These were previously opcodes in the pascal version, now consolidating into an individual “op”:

:tg lb 'g tm rt # (xy-) goto xy
:ta lb 'a tm rt # (a-) set terminal attribute ((fg << 4) + bg))
:E :tw lb 'e tm rt # write (emit) char
:tr lb 'r tm rt # readkey
:tk lb 'k tm rt # keypressed?
:ts lb 's tm rt # clear screen
:tl lb 'l tm rt # clear line
:tc lb 'p tm rt # (-xy) fetch cursor position

main code

This is the part at the bottom of the file that actually executes.

The :\ assigns the ^\ register to this address, indicating where the emulator should set the initial instruction pointer.

At runtime, we need to initialize some variables:

:\ # start of execution.
# show word list and enter repl.
lb 0E ta li `words$ e-nm puts lb ': tw sp lb 07 ta words nl
repl

text i/o

:sp lb 20 ^E rt                    # emit space
:nl lb 0A ^E lb 0D ^E rt           # emit CRLF
:puts @S dc !S                     # given address of counted string s, write s
  c1 +S rb .f c1 +S rb ^E .n
  cd !S rt

numerals

:base 10 :digits  '0'1'2'3'4'5'6'7'8'9'A'B'C'D'E'F
:putn # (n - )
  du c0 eq .i lb '0 tw rt
  .e c0 sw                         # ( n-kn) k:digit count=0
     .w du nz? .d                  # while n!=0 do
        li `base rb dvm            # (kn-kdm) divmod
        li `digits ad rb dc        # (kdm-kd|c) push char to retn stack
        sw inc sw .o               # k++, d is new n
      zp                           # (kd-k)
      .f cd cd tw dc .n .t         # loop through the characters
  rt
:digit?                            # (c-d1) or (c-0)
   du lb '0 lb ': between? .i
      lb '0 sb c1 rt .t
   du lb 'A lb 'G between? .i
      lb 'A sb lb 0A ad c1 rt .t
   zp c0 rt

:try-num                           # (s-n) try to parse string as number
  !S c0 !R
  c1 +S rb .f
     c1 +S rb digit?
        .i @R li `base rb ml ad !R
        .e unknown
           cd zp  # drop loop counter
           rt .t
  .n
  @R rt                         # (pr-r)

the repl

main logic

:B 00 # length byte, plus 64-byte buffer
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00

:eol 01                            # end of line flag
:eol? li `eol rb rt
:eol0 lb 00 li `eol wb rt
:eol1 lb 01 li `eol wb rt

:ctrl? lb 20 lt rt

:on-space tw # (20 - )
   eol1
   @B find
   du nz?
      .i exec
      .e zp @B try-num .t
   rt

:@ :on-ascii              # can't call ^@ directly. 00=no-op
   du tw c1 +C wb
   @B rb inc @B wb
   rt

:D bye       # exit on ^D
:G db rt     # debug on ^G

# :H # ^H is backspace

:on-ctrl
   lb 04 ml ri du nz?
      .i dc rt
      .e zp rt .t

:on-key
   du lb 20 eq
      .i on-space rt
      .e du ctrl?
         .i on-ctrl rt       # register dispatch for ctrl keys
         .e on-ascii rt .t .t
   rt

:repl
   .w c1 .d
      eol?
      .i eol0 c0 @B wb @B inc !C b4> .t  # show prompt if new line
      tr on-key                     # read char from terminal
   .o

the prompt

:b4>
  nl lb 02 ta                      # green on black
  lb 'b tw lb '4 tw lb '> tw       # echo 'b4>'
  sp lb 07 ta                      # gray on black for user input.
 rt

“bye” word

:bye nl lb 01 ta                   # red
  lb 'e tw lb 'n tw lb 'd tw       # echo 'end'
  nl hl

repl: unknown word

:unkno-s 0D 'u'n'k'n'o'w'n' 'w'o'r'd'.
:unknown
  lb 08 ta sp li `unkno-s puts nl rt

math library

public words

:inc c1 ad rt
:dec c1 sb rt

private words

:dvm  # n d
   ov ov md      # (xy-xy|m)
   dc dv cd rt   # (xy|m-dm|)

:between?        # (xlh-?)
   # -xl:xh    -?:xh    -??         -?
   dc ov dc     lt nt    cd cd lt   an rt

initial dictionary

<<^X>>
<<n1>>
<<nz?>>

.^ 04 'e'-'n'm
  <<e-nm>>
.^ 04 'e'-'x't
  <<e-xt>>

.^ 03 'i'n'c
  <<inc>>
.^ 03 'd'e'c
  <<dec>>
.^ 04 'f'i'n'd
  <<find>>
.^ 04 's'-'e'q
  <<s-eq?>>
.^ 04 'e'x'e'c
  <<exec>>

  <<b4-math>>
  <<b4-io-words>>
.^ 03 'b'y'e
  <<bye>>
  <<b4-prompt>>
.^ 04 'e'm'i't
  <<emit>>
.^ 04 'p'u't's
  <<puts>>

:words$ .^ 05 'w'o'r'd's
  <<words>>
  <<unknown>>
  <<base/digits>>
.^ 04 'p'u't'n
  <<putn>>
  <<try-num>>