# This is the assembler for a CPU emulator in ksh I just posted to
# comp.lang.forth
AB () { #> this is how to bang bits in sh. assemble byte.
AB byte [byte byte...]
for i in $*
do
echo -en "${oct[$i]}" >> a.out
let HERE+=1
done
}
LITAB () { #> heinous hack to use a shell string as code memory
#> and still be able to have literal zeros.
# Decimal value 122, 0x7a, 'z' is thus impossible
# instead of 0. This is the price of CPU emulation
# in sh.
for i in $*
do
if test $i == 0 ; then
i=122
echo "literal 0 byte being converted to 122/0x7a/z"
fi
echo -en "${oct[$i]}" >> a.out
let HERE+=1
done
}
oct[0]="\00" oct[1]="\01" oct[2]="\02" oct[3]="\03" oct[4]="\04"
oct[5]="\05" oct[6]="\06" oct[7]="\07" oct[8]="\010" oct[9]="\011" oct[10]="\012" oct[11]="\013" oct[12]="\014" oct[13]="\015" oct[14]="\016" oct[15]="\017" oct[16]="\020" oct[17]="\021" oct[18]="\022" oct[19]="\023" oct[20]="\024" oct[21]="\025" oct[22]="\026" oct[23]="\027" oct[24]="\030" oct[25]="\031" oct[26]="\032" oct[27]="\033" oct[28]="\034" oct[29]="\035" oct[30]="\036" oct[31]="\037" oct[32]="\040" oct[33]="\041" oct[34]="\042" oct[35]="\043" oct[36]="\044" oct[37]="\045" oct[38]="\046" oct[39]="\047" oct[40]="\050" oct[41]="\051" oct[42]="\052" oct[43]="\053" oct[44]="\054" oct[45]="\055" oct[46]="\056" oct[47]="\057" oct[48]="\060" oct[49]="\061" oct[50]="\062" oct[51]="\063" oct[52]="\064" oct[53]="\065" oct[54]="\066" oct[55]="\067" oct[56]="\070" oct[57]="\071" oct[58]="\072" oct[59]="\073" oct[60]="\074" oct[61]="\075" oct[62]="\076" oct[63]="\077"
oct[64]="\0100" oct[65]="\0101" oct[66]="\0102" oct[67]="\0103"
oct[68]="\0104" oct[69]="\0105" oct[70]="\0106" oct[71]="\0107"
oct[72]="\0110" oct[73]="\0111" oct[74]="\0112" oct[75]="\0113"
oct[76]="\0114" oct[77]="\0115" oct[78]="\0116" oct[79]="\0117"
oct[80]="\0120" oct[81]="\0121" oct[82]="\0122" oct[83]="\0123"
oct[84]="\0124" oct[85]="\0125" oct[86]="\0126" oct[87]="\0127"
oct[88]="\0130" oct[89]="\0131" oct[90]="\0132" oct[91]="\0133"
oct[92]="\0134" oct[93]="\0135" oct[94]="\0136" oct[95]="\0137"
oct[96]="\0140" oct[97]="\0141" oct[98]="\0142" oct[99]="\0143" oct[100]="\0144" oct[101]="\0145" oct[102]="\0146" oct[103]="\0147" oct[104]="\0150" oct[105]="\0151" oct[106]="\0152" oct[107]="\0153" oct[108]="\0154" oct[109]="\0155" oct[110]="\0156" oct[111]="\0157" oct[112]="\0160" oct[113]="\0161" oct[114]="\0162" oct[115]="\0163" oct[116]="\0164" oct[117]="\0165" oct[118]="\0166" oct[119]="\0167" oct[120]="\0170" oct[121]="\0171" oct[122]="\0172" oct[123]="\0173" oct[124]="\0174" oct[125]="\0175" oct[126]="\0176" oct[127]="\0177" oct[128]="\0200" oct[129]="\0201" oct[130]="\0202" oct[131]="\0203" oct[132]="\0204" oct[133]="\0205" oct[134]="\0206" oct[135]="\0207" oct[136]="\0210" oct[137]="\0211" oct[138]="\0212" oct[139]="\0213" oct[140]="\0214" oct[141]="\0215" oct[142]="\0216" oct[143]="\0217" oct[144]="\0220" oct[145]="\0221" oct[146]="\0222" oct[147]="\0223" oct[148]="\0224" oct[149]="\0225" oct[150]="\0226" oct[151]="\0227" oct[152]="\0230" oct[153]="\0231" oct[154]="\0232" oct[155]="\0233" oct[156]="\0234" oct[157]="\0235" oct[158]="\0236" oct[159]="\0237" oct[160]="\0240" oct[161]="\0241" oct[162]="\0242" oct[163]="\0243" oct[164]="\0244" oct[165]="\0245" oct[166]="\0246" oct[167]="\0247" oct[168]="\0250" oct[169]="\0251" oct[170]="\0252" oct[171]="\0253" oct[172]="\0254" oct[173]="\0255" oct[174]="\0256" oct[175]="\0257" oct[176]="\0260" oct[177]="\0261" oct[178]="\0262" oct[179]="\0263" oct[180]="\0264" oct[181]="\0265" oct[182]="\0266" oct[183]="\0267" oct[184]="\0270" oct[185]="\0271" oct[186]="\0272" oct[187]="\0273" oct[188]="\0274" oct[189]="\0275" oct[190]="\0276" oct[191]="\0277" oct[192]="\0300" oct[193]="\0301" oct[194]="\0302" oct[195]="\0303" oct[196]="\0304" oct[197]="\0305" oct[198]="\0306" oct[199]="\0307" oct[200]="\0310" oct[201]="\0311" oct[202]="\0312" oct[203]="\0313" oct[204]="\0314" oct[205]="\0315" oct[206]="\0316" oct[207]="\0317" oct[208]="\0320" oct[209]="\0321" oct[210]="\0322" oct[211]="\0323" oct[212]="\0324" oct[213]="\0325" oct[214]="\0326" oct[215]="\0327" oct[216]="\0330" oct[217]="\0331" oct[218]="\0332" oct[219]="\0333" oct[220]="\0334" oct[221]="\0335" oct[222]="\0336" oct[223]="\0337" oct[224]="\0340" oct[225]="\0341" oct[226]="\0342" oct[227]="\0343" oct[228]="\0344" oct[229]="\0345" oct[230]="\0346" oct[231]="\0347" oct[232]="\0350" oct[233]="\0351" oct[234]="\0352" oct[235]="\0353" oct[236]="\0354" oct[237]="\0355" oct[238]="\0356" oct[239]="\0357" oct[240]="\0360" oct[241]="\0361" oct[242]="\0362" oct[243]="\0363" oct[244]="\0364" oct[245]="\0365" oct[246]="\0366" oct[247]="\0367" oct[248]="\0370" oct[249]="\0371" oct[250]="\0372" oct[251]="\0373" oct[252]="\0374" oct[253]="\0375" oct[254]="\0376" oct[255]="\0377"
# That's how you send a binary byte to a file in ksh/bash,
# or without the -e in dash
LEAQ () { #> little endian quad AB as binary bytes
let f=$1\&255
AB $f
let f=$1\>\>8
let f=$f\&255
AB $f
let f=$1\>\>16
let f=$f\&255
AB $f
let f=$1\>\>24
# signed. far out. so mask it.
let f=$f\&255
AB $f
}
LITLEAQ () { #> little endian quad AB as binary bytes
let f=$1\&255
LITAB $f
let f=$1\>\>8
let f=$f\&255
LITAB $f
let f=$1\>\>16
let f=$f\&255
LITAB $f
let f=$1\>\>24
# signed. far out. so mask it.
let f=$f\&255
LITAB $f
}
# and while we're HERE...
BEAQ () { #> big endian quad AB as binary bytes
let f=$1\>\>24 # signed. far out. so mask it.
let f=$f\&255
AB $f
f=$1\>\>16
let f=$f\&255
AB $f
let f=$1\>\>8
let f=$f\&255
AB $f
let f=$1\&255
AB $f
}
# LEAQ blows up if $1 is null.
# Ain't worth a if.
LEAD () { #> little endian quad AB as binary bytes
let f=$1\&255
AB $f
let f=$1\>\>8
let f=$f\&255
AB $f
}
LITLEAD () { #> little endian quad AB as binary bytes
let f=$1\&255
LITAB $f
let f=$1\>\>8
let f=$f\&255
LITAB $f
}
HO () { #> hexdump ./a.out. Single hex bytes. No endian swapping.
echo "\$HERE is " $HERE
od -t x1z -Ax a.out
}
homp () { # homp chomp is homp
echo ${1:1:100}
}
chom () { # chom "chomp" returns "chom"
echo ${1:0:${1}-1}
}
bigpic () {
echo "3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0"
echo "1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0"
}
bp () (
pic=""
qut=$1
for bla in 1 2 3 4 5 6 7 8 9 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 3 3 3
do
let bit=1\&$qut
pic=$bit" "$pic
let qut=$qut\>\>1
done
bigpic
echo $pic
)
# assembler for Hnsm specifically
# Feb 2021
V () { # append ASCII VVVVVVerbatim. Like a "text" directive?
set -f
a=$1
b=${#1}
let HERE+=$b
echo -n $a >> a.out
set +f
}
IF () { #> IF condition # then do a ;RESOLVE $label
V "\?"
##########################################
case $1 in
Z) V Z
;;
ZC|z) V z
;;
S|N) V S
;;
SC|NC|s) V s
;;
C) V C
;;
CC|cc|c) V c
;;
O|V) V V
;;
v|o|OC|VC) V v
;;
P) V P
;;
p|PZ|PT|PC) V p
;;
G|GT|gt) V G
;;
l|L|LE|LTE) V L
;;
m|SGE|SGTE) V m
;;
n|SLT|SL) V n
;;
q|SG|SGT) V q
;;
r|SLE|SLTE) V r
;;
A) V A
;;
esac
}
RESOLVE () { #> This assembles a PC-relative branch o/s dual
let foo=$1-$HERE
LITLEAD $foo
}
AMODE () { #> ASSEMBLE addressing mode
# ASCII 0<->7 = POST/PRE NAKED/WRITEBACK UP/DOWN
let f=0x30
for a in $*
do
case $a in
"100"|4|higher|cdr)
let f=0x34
;;
"101"|5|lower|c3r)
let f=0x35
;;
0|1| direct | post|up|UP|car)
;;
pre)
let f=f\|4
;;
"010"|2| WB|writeback|index|indexed |C++)
let f=f\|2
;;
down | DN | dn )
let f=f\|1
;;
"011"|3|"C--")
let f=0x33
;;
"111"|7|"--C")
let f=0x37
;;
"110"|6|"++C")
let f=0x36
esac
done
echo -en "A"${oct[$f]} >> a.out
}
FOR () { #> same opcode as UNTIL, assemble a loop init
At runtime ( pushes the following duals onto LS, ++LSC
echo -n "(" >> a.out
let HERE+=1
LEAD $1
AB 122 122 # will be converted to zeroes
let lOoP=HERE
}
UNTIL () { #> same opcode as FOR, assemble a loop init
At runtime ( pushes the following duals onto LS, ++LSC
echo -n "(" >> a.out
let HERE+=1
AB 122 122
LEAD $1
let lOoP=HERE
}
# assemble general transfer insn suffix byte
# TRANS src dest
TRANS ()
(
case $1 in
rsp|RSP) a=0 ;;
sp|FSP|SP|DSP) a=1 ;;
tors|TORS) a=2 ;;
tos|TOS|TOFS|TODS) a=3 ;;
toas|TOAS) a=4 ;;
asp) a=5 ;;
limit) a=6 ;;
lsp|LSP) a=7 ;;
count) a=8 ;;
csp|CSP) a=9 ;;
po|PO) a=10 ;;
wb|WB) a=11 ;;
dn|DN) a=12 ;;
pc|PC) a=15 ;;
esac
case $2 in
rsp|RSP) b=0 ;;
sp|FSP|SP|DSP) b=1 ;;
tors|TORS) b=2 ;;
tos|TOS|TOFS|TODS) b=3 ;;
toas|TOAS) b=4 ;;
asp) b=5 ;;
limit) b=6 ;;
lsp|LSP) b=7 ;;
count) b=8 ;;
csp|CSP) b=9 ;;
po|PO) b=10 ;;
wb|WB) b=11 ;;
dn|DN) b=12 ;;
pc|PC) b=15 ;;
esac
let c=b\<\<4\|a
AB $c
)
LIT () {
V "\""
LITLEAQ $1
}
GOTO () {
V G
LITLEAQ $1
}
TWICE () { # take 2 passes over sourcefile.
# Need that for forward branches.
rm a.out
HERE=0
. $1
rm a.out
HERE=0
. $1
echo >> a.out # IPL (read) needs this.
}
GOELPT () # greater or equal lowest power of two
# but this is getting kinda macro
# next thing you know people will do a Forth header...
{
let foo=1
while test $foo -lt $1; do
let foo*=2
done
echo $foo
}
--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)