dict.tasm

# dict -- forth-like dictionary definition and lookup

#>>>>>>to do
# routines:
#	def
#		(must trim off trailing char)
# check if lookup ignores trailing char. it should.
# ...
# check for old stack names slipping through:
#	Edit ,y/#.*/x/b[s]tack/=
#	Edit ,y/#.*/y/stackreg1bak/x/[^a-z][s]tack/=
# if any found, convert: bstack->dstack, stack->rstack
# speaking of old names, i hope i've fully recovered from 
#	accidentally global replace: ,x/def(\.name)?/c/memcopy/
# update namespace comment



### dictionary entry format
# 1 codeword
# 1 next entry
# 1 namelen
# n namechars
# 1 deflen
# n def
#
# 'null' next entry is +++++++++.
#	can't use 0. mni is reasonable, but mpi is more so;
#	an entry won't fit if it starts at mpi.
# xt points to codeword? i guess that's right.


# tests & behaviour specification in dict.tests

# namespace usage:
# stack* dstack* rstack* dpush dpop rpush rpop
# dict* key* word* lookup* alloc*

# commands:
# (not really doing built-in words yet.)
# def
#	the next word is the name.
#	following words are the definition, up to '-d-'.

# internal routines:
# word
#	read a word
#	i think i want this first
#	i think word should set up key interrupts, spin while the word is typed, 
#	and then clear interrupts and return. yes.
# lookup
# 	find a word in the dictionary
# alloc
#	alloc memory
# swap
#	stack operation

# how to arrange memory?
# stacks at top, of course.
# dict needs to grow somewhere.
# input buffer also required.
# i guess input buffer can be a fixed size. 
# in fact, it should be, thats the simple way.
# what size?
# 216 = 3 lines. hmm.
# if it reads a word at a time, words in a definition can go in the dictionary 
# as soon as they're entered. interpreting forth similarly would run each 
# word after it is read. no need for big buffer. yay!
# now what size? :)
# mpi of 3 trits is 13. 13 characters would be quite indulgent
# for a real language on a 19KW machine.
# 13 it is, then. -- note: now includes terminating space or enter.
# oh that's 14 including the 0. ok then.
# also need alloc routine for dict.
# buffer can be alloc'd too.


gotodata;>start


#######################
### stack data

null;+++++++++;rstackbase
null;;rstacktop
null;;stackreg1bak
null;++++-----;dstackbase
null;;dstacktop

# some dstackbase values with space for
# the 2 stacks and remaining memory:
# ++++-----	242		19441	1%
# +++------	728  		18955	3%
# ++-------	2186		17497	11%
# +--------	6560		13123	33% lol


#######################
### dict global data

null;;dict
null;;alloc.next


#######################
### stack init

romread1;>rstackbase;start
setdata;>rstacktop
# if not using bstack omit remainder
romread1;>dstackbase
setdata;>dstacktop
# underflow marker for data stack:
setreg1;-+-+-+-+-
gotodata;>dpush


#######################
### dict init

setreg1;>alloc.base
setdata;>alloc.next

monofill;-------00
setreg1;00000+---
setdata;>word.buflen
gotodata;>dpush
gotodata;>alloc
gotodata;>dpop
setdata;>word.bufaddr

## intern def
# alloc 7 words for an entry with an empty definition
setreg1;000000+-+
gotodata;>dpush
gotodata;>alloc
gotodata;>dpop
# it's the head of the dictionary now
setdata;>dict
ptset
# set the codeword
setreg1;>def
ptwri
# set the 'next' field to null
ptinc
setreg1;+++++++++
ptwri
# name length
ptinc
setreg1;0000000+0
ptwri
# set the name
# not sure if the chars will work like this
ptinc
setreg1;:d
ptwri
ptinc
setreg1;:e
ptwri
ptinc
setreg1;:f
ptwri
# set the definition length
ptinc
setreg1;000000000
ptwri


#######################
### dict main loop

setreg1;>mainloop.ret.1;mainloop
gotodata;>rpush
gotodata;>word

setreg1;>mainloop.ret.2;mainloop.ret.1
gotodata;>rpush
gotodata;>lookup

## pop and test xt
gotodata;>dpop;mainloop.ret.2
setreg2;>+++++++++
gotodataif;>mainloop.badword

# fetch codeword, call it
setdata;>mainloop.getcw
# cheat with the return address:
setreg1;>mainloop
gotodata;>rpush
romread1;000000000;mainloop.getcw
gotoreg1

# called routine needs word address.
# it can fetch it from mainloop.getcw.
# i'm not sure there's a better way to do that.
# maybe i'll find one later.

TTYwrite;:?;mainloop.badword
TTYwrite;:space
gotodata;>mainloop


#######################
### dict routines

# if unstated, these preserve mempoint but use reg1 & reg2.

###########
## alloc
# subroutine
# ( size -- address )

#romread1;>alloc.next;alloc
#gotodata;>dpush
#gotodata;>swap
#gotodata;>dpop
#romread2;>alloc.next
#add
#setdata;>alloc.next
#gotodata;>rpop
#gotoreg1

# alternative alloc doesnt call swap.
# uses a location for temporary storage, 
# which swap did anyway.
romread1;>alloc.next;alloc
setdata;>alloc.tmp
gotodata;>dpop
romread2;>alloc.next
add
setdata;>alloc.next
romread1;>alloc.tmp
gotodata;>dpush
gotodata;>rpop
gotoreg1
null;;alloc.tmp


###########
## strsee -- codeword for textual defs
# subroutine
# ( - )
# uses mempoint
# gets current word address from mainloop.getcw

romread1;>mainloop.getcw;strsee
ptset
ptinc
ptinc
ptread
copy1to2
# namelen in 2
ptinc
ptget
# addr of namechars in 1
add
# addr of deflen in 1
ptset
ptread
copy1to2
# deflen in 2
ptinc
ptget
# addr of def in 1
add
copy1to2
# end of def in 2

ptread;;strsee.loop
# cheap. ought to use offsetlen
setdata;>strsee.write
TTYwrite;;strsee.write

ptinc
ptget
gotodataif;>strsee.done
gotodata;>strsee.loop

gotodata;>rpop;strsee.done
gotoreg1


###########
## memcopy
# subroutine
# ( source dest length -- )
# uses mempoint

# copies data from one memory region to another.
# overlap is safe only if dest <= source.

setreg1;000000000;memcopy
setdata;>memcopy.count
gotodata;>dpop
setdata;>memcopy.length
gotodata;>dpop
setdata;>memcopy.dest
gotodata;>dpop
setdata;>memcopy.source

romread1;>memcopy.source;memcopy.loop
romread2;>memcopy.count
add
ptset
ptread
setdata;>memcopy.char
romread1;>memcopy.dest
romread2;>memcopy.count
add
ptset
romread1;>memcopy.char
ptwri
romread1;>memcopy.count
setreg2;00000000+
add
romread2;>memcopy.length
gotodataif;>memcopy.done
setdata;>memcopy.count
gotodata;>memcopy.loop

gotodata;>rpop;memcopy.done
gotoreg1

null;;memcopy.source
null;;memcopy.dest
null;;memcopy.length
null;;memcopy.count
null;;memcopy.data


###########
## def -- define words interactively
# subroutine
# ( - )
# uses mempoint
# uses alloc.next, writing to memory before using alloc 
#	to claim the space. not terribly good practice, i know.

# stages:
# 1: read word for name
# 2: read any number of words for definition

###
# begin building new entry
romread1;>alloc.next;def
setdata;>def.e.base
ptset
setreg1;>strsee
ptwri
ptinc
romread1;>dict
ptwri

###
# get name, inter that
ptinc
ptget
setdata;>def.e.here
# here now points to namelen

setreg1;>def.ret.name
gotodata;>rpush
gotodata;>word
# fetch length, but don't write it to entry yet because
# we're going to check if it needs pruning.
gotodata;>dpop;def.ret.name
setdata;>def.len
gotodata;>dpop
setdata;>def.s.base

# prune last char from name
# check if last char is space or newline.
# if yes, prune, if no, beep and don't prune.
romread2;>def.len
add
ptset
ptdec
ptread
setreg2;:space
gotodataif;>def.prune
setreg2;:enter
gotodataif;>def.prune

buzzer;---0-----
romread1;>def.len
gotodata;>def.setnamelen

romread1;>def.len;def.prune
setreg2;00000000-
add
setdata;>def.len

romread1;>def.e.here;def.setnamelen
ptset
romread1;>def.len
ptwri

# copy name in
ptinc
ptget
setdata;>def.e.here
# here now points to start of name

romread1;>def.s.base
gotodata;>dpush
romread1;>def.e.here
dotodata;>dpush
romread1;>def.len
gotodata;>dpush
setreg1;>def.name.copied
gotodata;>rpush
gotodata;>memcopy

# oh oh oh oh! found a major bug when making copy code its 
# own subroutine: the name would have overwritten the header.
# big argument for not making monolithic routines.

###
# get words, inter them
# loop getting words, copying them in, checking for -d- to end.
# keep a running count of the length.

romread1;>def.e.here;def.name.copied
romread2;>def.len
add
setdata;>def.e.here
# here now points to deflen

>>>>>>>>>>

# set head of dictionary to new definition, and return
romread1;>def.e.base
setdata;>dict
gotodata;>rpop
gotoreg1

# def.e is the new entry
null;;def.e.base
null;;def.e.here
# def.s is source string
null;;def.s.base
# some apply to both
null;;def.len

###########
## lookup
# subroutine
# ( addr len -- xt )
# uses mempoint

gotodata;>dpop;lookup
setdata;>lookup.charcount
gotodata;>dpop
setdata;>lookup.s.base

romread1;>dict

setdata;>lookup.e.xt;lookup.entryloop
ptset
ptinc
# "next"
ptread
setdata;>lookup.e.next
ptinc
# "namelen"
ptread
romread2;>lookup.charcount
gotodataif;>lookup.lenmatch
gotodata;>lookup.nextentry

ptinc;lookup.lenmatch
# "namechars"; want the address this time.
ptget
setdata;>lookup.e.base
setreg1;000000000
setdata;>lookup.i

romread1;>lookup.e.base;lookup.charloop
romread2;>lookup.i
add
ptset
# i'd like to use offsetlen to get only the 6 trits,
# but i don't want to add 4 more instructions for every character.
# i suppose masking the register after load would be better this time,
# only 2 instructions.
ptread
setdata;>lookup.char

romread1;>lookup.s.base
romread2;>lookup.i
add
ptset
ptread
setreg2;000000000;lookup.char
gotodataif;>lookup.charloop.next
gotodata;>lookup.nextentry

# char matched, try the next one.
# if there's no next one, we got a match!
romread1;>lookup.i;lookup.charloop.next
setreg2;00000000+
add
setdata;>lookup.i
romread2;>lookup.charcount
gotodataif;>lookup.gotmatch
gotodata;>lookup.charloop

romread1;>lookup.e.xt;lookup.gotmatch
gotodata;>dpush
gotodata;>rpop
gotoreg1

# length or some char didn't match, so
# fetch & check the next entry pointer.
# if null, return failure.
romread1;>lookup.e.next;lookup.nextentry
setreg2;+++++++++
gotodataif;>lookup.notfound

# valid pointer, so fetch the next xt & put it in reg1
ptset
ptread
gotodata;>lookup.entryloop

copy2to1;lookup.notfound
gotodata;>dpush
gotodata;>rpop
gotoreg1

null;;lookup.s.base
null;;lookup.charcount
null;;lookup.i
null;;lookup.e.xt
null;;lookup.e.base
null;;lookup.e.next


###########
## swap
# subroutine
# ( a b -- b a )
# exchange the top two elements of the data stack
# from scal

# 44 instructions counting the push and pop routines.
# could write a much more efficient one by using mempoint,
# but this is not used since i changed alloc.

#gotodata;>dpop;swap
#setdata;>swap.a
#gotodata;>dpop
#setdata;>swap.b
#romread1;>swap.a
#gotodata;>dpush
#romread1;>swap.b
#gotodata;>dpush
#gotodata;>rpop
#gotoreg1
#
#null;;swap.a
#null;;swap.b


###########
## word
# subroutine
# ( -- address length )
# uses mempoint

# input a word from the keyboard.
# return a string, including the terminating space or enter.
# sets up interrupts and clears them again; lots of lines!
# this is basically a blocking read from the keyboard. 

monofill;-------00;word
setreg1;000000000
setdata;>word.count
setkeyint;:1
keyint;>key.1
setkeyint;:2
keyint;>key.2
setkeyint;:3
keyint;>key.3
setkeyint;:4
keyint;>key.4
setkeyint;:5
keyint;>key.5
setkeyint;:6
keyint;>key.6
setkeyint;:7
keyint;>key.7
setkeyint;:8
keyint;>key.8
setkeyint;:9
keyint;>key.9
setkeyint;:0
keyint;>key.0
setkeyint;:-
keyint;>key.neg
setkeyint;:+
keyint;>key.pos
setkeyint;:a
keyint;>key.a
setkeyint;:b
keyint;>key.b
setkeyint;:c
keyint;>key.c
setkeyint;:d
keyint;>key.d
setkeyint;:e
keyint;>key.e
setkeyint;:f
keyint;>key.f
setkeyint;:g
keyint;>key.g
setkeyint;:h
keyint;>key.h
setkeyint;:i
keyint;>key.i
setkeyint;:j
keyint;>key.j
setkeyint;:k
keyint;>key.k
setkeyint;:z
keyint;>key.z
setkeyint;:l
keyint;>key.l
setkeyint;:m
keyint;>key.m
setkeyint;:n
keyint;>key.n
setkeyint;:o
keyint;>key.o
setkeyint;:p
keyint;>key.p
setkeyint;:q
keyint;>key.q
setkeyint;:r
keyint;>key.r
setkeyint;:s
keyint;>key.s
setkeyint;:t
keyint;>key.t
setkeyint;:u
keyint;>key.u
setkeyint;:v
keyint;>key.v
setkeyint;:w
keyint;>key.w
setkeyint;:x
keyint;>key.x
setkeyint;:y
keyint;>key.y
setkeyint;:z
keyint;>key.z
setkeyint;:space
keyint;>key.space
setkeyint;:enter
keyint;>key.enter

# near-white rectangle to signify ready:
setmonovect;---0-0---
monorect;---0+0++-

gotodata;>word.spinloop;word.spinloop

clearkeyint;+++++++++;word.finalize
monofill;-------00
romread1;>word.bufaddr
gotodata;>dpush
romread1;>word.count
gotodata;>dpush
gotodata;>rpop
gotoreg1

null;;word.count
null;;word.bufaddr
null;;word.buflen


## key routines for word
# keyproc is common to all of them

setdata;>word.keytmp;word.keyproc
romread1;>word.bufaddr
romread2;>word.count
add
ptset
romread1;>word.keytmp
ptwri
setreg1;00000000+
add
# now reg1 contains count+1
setdata;>word.count

romread2;>word.buflen
gotodataif;>word.keyproc.beep
romread1;>word.keytmp
setreg2;:space
gotodataif;>word.finalize
setreg2;:enter
gotodataif;>word.finalize
gotodata;>word.spinloop

clearkeyint;+++++++++;word.keyproc.beep
#buzzer;----00000
# i do not want the delay of the buzzer instruction here.
# sfreq/splay/sstop would be no improvement, it's only 0.2ms until return.
# make a "bgbuzz" thread or an sstop thread.
gotodata;>word.finalize

null;;word.keytmp

## key interrupt routines:

TTYwrite;:space;key.space
setreg1;000-0-00+
gotodata;>word.keyproc
TTYwrite;:enter;key.enter
setreg1;000-0-000
gotodata;>word.keyproc
TTYwrite;:+;key.pos
setreg1;000--++-+
gotodata;>word.keyproc
TTYwrite;:-;key.neg
setreg1;000--++0+
gotodata;>word.keyproc

## autogenerate most key interrupt routines:
# the type of operation doesn't really accommodate sed -n
# with /regexp/p, it's shorter and easier to use grep.
# i could make it cover enter space + and - too,
# but it's not worth the extra code.

#	<grep '......[a-z0-9]$' ../textdocs/SBTCVM-6-trit-Text-encoding.txt | sed 's/(.+)(.)/TTYwrite;:\2;key.\2\nsetreg1;000\1\ngotodata;>word.keyproc/'
#[
TTYwrite;:a;key.a
setreg1;000------
gotodata;>word.keyproc
TTYwrite;:b;key.b
setreg1;000-----0
gotodata;>word.keyproc
TTYwrite;:c;key.c
setreg1;000-----+
gotodata;>word.keyproc
TTYwrite;:d;key.d
setreg1;000----0-
gotodata;>word.keyproc
TTYwrite;:e;key.e
setreg1;000----00
gotodata;>word.keyproc
TTYwrite;:f;key.f
setreg1;000----0+
gotodata;>word.keyproc
TTYwrite;:g;key.g
setreg1;000----+-
gotodata;>word.keyproc
TTYwrite;:h;key.h
setreg1;000----+0
gotodata;>word.keyproc
TTYwrite;:i;key.i
setreg1;000----++
gotodata;>word.keyproc
TTYwrite;:j;key.j
setreg1;000---0--
gotodata;>word.keyproc
TTYwrite;:k;key.k
setreg1;000---0-0
gotodata;>word.keyproc
TTYwrite;:l;key.l
setreg1;000---0-+
gotodata;>word.keyproc
TTYwrite;:m;key.m
setreg1;000---00-
gotodata;>word.keyproc
TTYwrite;:n;key.n
setreg1;000---000
gotodata;>word.keyproc
TTYwrite;:o;key.o
setreg1;000---00+
gotodata;>word.keyproc
TTYwrite;:p;key.p
setreg1;000---0+-
gotodata;>word.keyproc
TTYwrite;:q;key.q
setreg1;000---0+0
gotodata;>word.keyproc
TTYwrite;:r;key.r
setreg1;000---0++
gotodata;>word.keyproc
TTYwrite;:s;key.s
setreg1;000---+--
gotodata;>word.keyproc
TTYwrite;:t;key.t
setreg1;000---+-0
gotodata;>word.keyproc
TTYwrite;:u;key.u
setreg1;000---+-+
gotodata;>word.keyproc
TTYwrite;:v;key.v
setreg1;000---+0-
gotodata;>word.keyproc
TTYwrite;:w;key.w
setreg1;000---+00
gotodata;>word.keyproc
TTYwrite;:x;key.x
setreg1;000---+0+
gotodata;>word.keyproc
TTYwrite;:y;key.y
setreg1;000---++-
gotodata;>word.keyproc
TTYwrite;:z;key.z
setreg1;000---++0
gotodata;>word.keyproc
TTYwrite;:0;key.0
setreg1;000--0++0
gotodata;>word.keyproc
TTYwrite;:1;key.1
setreg1;000--0+++
gotodata;>word.keyproc
TTYwrite;:2;key.2
setreg1;000--+---
gotodata;>word.keyproc
TTYwrite;:3;key.3
setreg1;000--+--0
gotodata;>word.keyproc
TTYwrite;:4;key.4
setreg1;000--+--+
gotodata;>word.keyproc
TTYwrite;:5;key.5
setreg1;000--+-0-
gotodata;>word.keyproc
TTYwrite;:6;key.6
setreg1;000--+-00
gotodata;>word.keyproc
TTYwrite;:7;key.7
setreg1;000--+-0+
gotodata;>word.keyproc
TTYwrite;:8;key.8
setreg1;000--+-+-
gotodata;>word.keyproc
TTYwrite;:9;key.9
setreg1;000--+-+0
gotodata;>word.keyproc
#]


#######################
### stack routines

## rpush
# pushes reg1 to the return stack
# trashes reg1, reg2

setdata;>stackreg1bak;rpush

romread1;>rstacktop
setdata;>rstackpushme
romread1;>stackreg1bak
setdata;000000000;rstackpushme

romread1;>rstacktop
setreg2;00000000-
add
setdata;>rstacktop

continue

## rpop
# pops top of return stack into reg1
# trashes reg2

romread1;>rstacktop;rpop
setreg2;00000000-
subtract
setdata;>rstacktop
setdata;>rstackpopme
romread1;000000000;rstackpopme
continue

## dpush
# pushes reg1 to b stack
# trashes reg1, reg2

setdata;>stackreg1bak;dpush
romread1;>dstacktop
setdata;>dstackpushme
romread1;>stackreg1bak
setdata;000000000;dstackpushme
romread1;>dstacktop
setreg2;00000000+
add
setdata;>dstacktop
romread1;>stackreg1bak
continue

## dpop
# pops top of b stack into reg1
# trashes reg2

romread1;>dstacktop;dpop
setreg2;00000000+
subtract
setdata;>dstacktop
setdata;>dstackpopme
romread1;000000000;dstackpopme
continue


#######################
### end of code

stop;;alloc.base