- 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)
# 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>>
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"
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.
Entries in the dictionary are records with several fields:
name | size | purpose |
---|---|---|
(no name) | 4 bytes | address previous entry |
e-nm | varies | counted string |
e-xt | varies | start 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"
: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
: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
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
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
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
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
: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
: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)
: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
: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 nl lb 01 ta # red
lb 'e tw lb 'n tw lb 'd tw # echo 'end'
nl hl
: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
:inc c1 ad rt
:dec c1 sb rt
: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
<<^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>>