目次
前
次
シミュレータ作成
i8048は、古い化石のようなワンチップマイコンなので
2018年のはじめに、シミュレータ、デバッガを探しても
発見できずで、シミュレータを自作しました。
シミュレータを自作し、活用するのは、ROMにプログラム
を焼きこんで、動作確認する時間を節約するためでした。
マルチプラットホームを想定し、Tcl/Tkによるアプリ
ケーション開発で、10日くらいで完成。
ソースコードを利用したシミュレータとしてあります。
全命令をシミュレートするのではなく、2048バイトの
プログラム容量という制約を与えておきます。
他には、次の制限を入れてます。
- メインコードは、100Hより開始
- サブルーチンは、10HからFFHに配置
- PSW(Program Status Word)は、フラグとして扱う
- 外部割込みは、対象外
- タイマー割込みは、対象外
- ハーフキャリーのフラグ変化は扱わない
- フラグF1は扱わない
- アセンブリ言語は、PROASM-IIとしておく
ソースコードシミュレータなので、バイトではなく
ラインごとの管理とする。
ソースコードは、リストボックスに読込む他に
配列に読込み、配列に保存されているコードを
１ラインごとに取得して、１命令ごとに動作を
シミュレート。
Tcl/Tkでは、連想配列を使えるので、擬似
命令のEQUとラベルは各々の連想配列を用意
して対応します。
自作なので、極力機能は少なくします。
ファイルからのソースコード入力とステップ
動作でレジスタ、フラグ等の変化を可視化と
して対応。
基本機能を記述していきます。
ソースコード入力
専用ボタンを用意して、イベント処理で動かします。
ボタンクリックで、ソースコード一覧を表示して
ファイルを選択できるようにしておきます。
ファイル一覧は、Tkメソッドに用意されている
tk_getOpenFile
を使うことに。
GUIの部品には、ラベルとボタンが必要なので、用意。
label .lblFileName -text "File Name"
button .btnLoad -text "Load" -command "fload" -width 12 -bg #0000ff
実際の操作は、プロシージャ「fload」で対応します。
その内容は、以下。
proc fload {} {
global fName fd_in ss bline currentLine currentResult curCode
global equtbl lbltbl
# get file name
set FName [tk_getOpenFile -filetypes {{"assembly" {.src .SRC}}}]
# copy
set fName [lindex [split $FName /] end]
set fName [lindex [split $fName .] 0]
# clear
set i 0
.lsbCode delete 0 end
# flag
set oflag 0
# open file
set fd_in [open $FName "r"]
# loop
while { [gets $fd_in sbuf] >= 0 } {
# toupper
set sbuf [string toupper $sbuf 0 end]
# replace
set sbuf [regsub -all {[\t]} $sbuf " "]
# skip
if { [string index $sbuf 0] == ";" && $oflag == 0 } {
#tk_messageBox -message "$sbuf" -type ok
} else {
# default
set car [lindex $sbuf 0]
# judge
if { $car == "INCLUDE" } {
set oflag 1
}
}
# store
if { $oflag > 0 } {
# store list box
.lsbCode insert end $sbuf
# get size
set xlen [llength $sbuf]
# EQU table
if { [lindex $sbuf 1] == "EQU" } {
# get strings
set car [lindex $sbuf 0]
set cdr [lindex $sbuf end]
# store hash table
set equtbl($car) $cdr
}
# LABEL table
if { $xlen == 1 } {
# get first
set car $sbuf
# calculate length
set xlen [string length $car]
# calcuate end location
set xloc [expr $xlen - 1]
# get last code
set cdr [string index $car $xloc]
# judge
if { $xlen > 0 && $cdr == ":" } {
# get code
set xcar [string range $car 0 [expr $xloc - 1]]
# store line number to hash table
set lbltbl($xcar) $i
}
}
# entry line
if { [lindex $sbuf 0] == "ORG" && [lindex $sbuf 1] == "100H" } {
set currentLine [expr $i + 1]
}
}
# store statement
set ss($i) $sbuf
# increment
incr i
}
# close
close $fd_in
# show current statement
set xcode $ss($currentLine)
# LABEL ?
# calculate length
set xlen [string length $xcode]
# calcuate end location
set xloc [expr $xlen - 1]
# get last code
set cdr [string index $xcode $xloc]
# judge
if { $cdr == ":" } {
# update
set currentLine [expr $currentLine + 1]
# get
set xcode $ss($currentLine)
}
set curCode $xcode
# clear memory
.lsbMemory delete 0 end
for {set i 0} {$i < 64} {incr i} {
.lsbMemory insert end 0
}
}
プロシージャは、以下の内容を考え記述しています。
- ファイル拡張子に「.src」を採用
- ファイルから入力した１行１行は、配列に格納
- １行のホワイトスペースは、スペース１行に変換
- 先頭のコメントはスキップ
- ソースコードは、リストボックスにも格納
- 擬似命令EQUで指定されるラベルは、テーブルequtblに格納
- テーブルequtblは、連想配列として使いやすくする
- 分岐先に使うラベルは、テーブルlbltblに格納
- テーブルlbltblは、連想配列として使いやすくする
- 文字列「ORG 100H」を発見したら、行番号を記憶
- 文字列「ORG 100H」の次の行を、プログラム開始行とする
- ソースコードを読み込んだなら、プログラム開始行を表示
- メモリ内容をゼロクリア
ステップ動作
専用ボタンを用意して、イベント処理で動かします。
動作は、単純にしました。
１行のステートメントを読込み、解釈後に
プログラムカウンタ、レジスタ、フラグ値
を変更。
動作は、次の３種に限定しておきます。
転送は、MOVですが、加算減算、論理演算は
転送命令の一種と解釈して扱います。
分岐は、CALL、JMP、Jcc、JBcのいずれかなので
分岐先を行番号で管理して対応。
その他は、転送、分岐に該当しない命令の扱いと
して、スクリプトを書きやすくします。
転送命令MOVの扱いは、次のように定義しました。
if { $car == "MOV" } {
# separate
set plist [split $cdr ","]
# get parameters
set pcar [lindex $plist 0]
set pcdr [lindex $plist 1]
# timer
if { $pcar == "T" && $pcdr == "A" } {
set varT $varAcc
}
# psw
if { $pcar == "PSW" && $pcdr == "A" } {
set varFlag $varAcc
}
# accumlator
if { $pcar == "A" } {
# psw
if { $pcdr == "PSW" } {
set xval $varFlag
}
# register
if { $pcdr == "R0" } {
set xval $varR0
}
if { $pcdr == "R1" } {
set xval $varR1
}
if { $pcdr == "R2" } {
set xval $varR2
}
if { $pcdr == "R3" } {
set xval $varR3
}
if { $pcdr == "R4" } {
set xval $varR4
}
if { $pcdr == "R5" } {
set xval $varR5
}
if { $pcdr == "R6" } {
set xval $varR6
}
if { $pcdr == "R7" } {
set xval $varR7
}
# pointer
if { $pcdr == "@R0" } {
set xval $varmem($varR0)
}
if { $pcdr == "@R1" } {
set xval $varmem($varR1)
}
#immidiate
if { [string index $pcdr 0] == "#" } {
# length
set xlen [string length $pcdr]
# get
set xval [string range $pcdr 1 end]
# convert
set xval [get_value $xval]
}
# timer
if { $pcdr == "T" } {
set varAcc $varT
}
# store
set varAcc $xval
}
# register
if { $pcar == "R0" || $pcar == "R1" || $pcar == "R2" || $pcar == "R3" ||
$pcar == "R4" || $pcar == "R5" || $pcar == "R6" || $pcar == "R7" } {
# immidieate
if { [string index $pcdr 0] == "#" } {
# get
set xval [string range $pcdr 1 end]
# calculate
set xval [get_value $xval]
}
# accumulator
if { $pcdr == "A" } {
set xval $varAcc
}
# pointer
if { $pcdr == "@R0" } {
set xval $varmem($varR0)
}
if { $pcdr == "@R1" } {
set xval $varmem($varR1)
}
# store
if { $pcar == "R0" } {
set varR0 $xval
}
if { $pcar == "R1" } {
set varR1 $xval
}
if { $pcar == "R2" } {
set varR2 $xval
}
if { $pcar == "R3" } {
set varR3 $xval
}
if { $pcar == "R4" } {
set varR4 $xval
}
if { $pcar == "R5" } {
set varR5 $xval
}
if { $pcar == "R6" } {
set varR6 $xval
}
if { $pcar == "R7" } {
set varR7 $xval
}
}
# pointer
if { $pcar == "@R0" || $pcar == "@R1" } {
# calculate address
set xadr $varR0
if { $pcar == "@R1" } {
set xadr $varR1
}
# immediate
if { [string index $pcdr 0] == "#" } {
# get
set xval [string range $pcdr 1 end]
# calculate
set xval [get_value $xval]
}
# accumulator
if { $pcdr == "A" } {
set xval $varAcc
}
# register
if { $pcdr == "R0" } {
set xval $varR0
}
if { $pcdr == "R1" } {
set xval $varR1
}
if { $pcdr == "R2" } {
set xval $varR2
}
if { $pcdr == "R3" } {
set xval $varR3
}
if { $pcdr == "R4" } {
set xval $varR4
}
if { $pcdr == "R5" } {
set xval $varR5
}
if { $pcdr == "R6" } {
set xval $varR6
}
if { $pcdr == "R7" } {
set xval $varR7
}
# store
set varmem($xadr) $xval
}
}
１行を読込んで、OPCODEとOPRANDに分けておきます。
OPRANDは、「,」の左と右が何かを場合分けしたなら
ソースからディスティネーションに値を複写すると
しています。
ある程度は最適化していますが、目的はプログラム
コードの動作を確認すること。コピーとペーストで
できることは、その要領でスクリプトとします。
転送元、転送先は、レジスタかメモリになるので
変数として定義しておきます。
# initialize memory
for {set i 0} {$i < 64} {incr i} {
set varmem($i) 0
}
# Accumulator
set varAcc 0
# Flag
set varFlag 0
# General Purpose registers
set R0 0
set R1 0
set R2 0
set R3 0
set R4 0
set R5 0
set R6 0
set R7 0
# General Purpose registers
set varR0 0
set varR1 0
set varR2 0
set varR3 0
set varR4 0
set varR5 0
set varR6 0
set varR7 0
# General Purpose registers
set varRB0 0
set varRB1 0
set varRB2 0
set varRB3 0
set varRB4 0
set varRB5 0
set varRB6 0
set varRB7 0
# Port and Bus
set varP1 0
set varP2 0
set varBUS 0
#
set varTCNT 0
# external flag --T1 T0 F1 TFLAG IFLAG--
set varEflag 0
8048では、汎用レジスタはメモリの中に配置されています。
メモリとの間でデータを交換する処理を定義しておきます。
proc load_memory {x} {
#
global varR0 varR1 varR2 varR3
global varR4 varR5 varR6 varR7
global varRB0 varRB1 varRB2 varRB3
global varRB4 varRB5 varRB6 varRB7
global varmem varFlag
# handling bank #0
if { $x == 0 } {
set varR0 $varmem(0)
set varR1 $varmem(1)
set varR2 $varmem(2)
set varR3 $varmem(3)
set varR4 $varmem(4)
set varR5 $varmem(5)
set varR6 $varmem(6)
set varR7 $varmem(7)
}
# handling bank #1
if { $x == 1 } {
set varRB0 $varmem(24)
set varRB1 $varmem(25)
set varRB2 $varmem(26)
set varRB3 $varmem(27)
set varRB4 $varmem(28)
set varRB5 $varmem(29)
set varRB6 $varmem(30)
set varRB7 $varmem(31)
}
}
proc store_memory {x} {
#
global R0 R1 R2 R3
global R4 R5 R6 R7
global varR0 varR1 varR2 varR3
global varR4 varR5 varR6 varR7
global varRB0 varRB1 varRB2 varRB3
global varRB4 varRB5 varRB6 varRB7
global varmem
# handling bank #0
if { $x == 0 } {
set varmem(0) $R0
set varmem(1) $R1
set varmem(2) $R2
set varmem(3) $R3
set varmem(4) $R4
set varmem(5) $R5
set varmem(6) $R6
set varmem(7) $R7
}
# handling bank #1
if { $x == 1 } {
set varmem(24) $R0
set varmem(25) $R1
set varmem(26) $R2
set varmem(27) $R3
set varmem(28) $R4
set varmem(29) $R5
set varmem(30) $R6
set varmem(31) $R7
}
# update register area
set varR0 $varmem(0)
set varR1 $varmem(1)
set varR2 $varmem(2)
set varR3 $varmem(3)
set varR4 $varmem(4)
set varR5 $varmem(5)
set varR6 $varmem(6)
set varR7 $varmem(7)
set varRB0 $varmem(24)
set varRB1 $varmem(25)
set varRB2 $varmem(26)
set varRB3 $varmem(27)
set varRB4 $varmem(28)
set varRB5 $varmem(29)
set varRB6 $varmem(30)
set varRB7 $varmem(31)
# update user area
.lsbMemory delete 0 end
for {set i 0} {$i < 64} {incr i } {
.lsbMemory insert end $varmem($i)
}
}
２つのプロシージャを、MOV命令の実行時に
最初と最後に入れておけば充分。
MOV命令の変形は、XCH命令。その内容は以下。
if { $car == "XCH" } {
# separate
set plist [split $cdr ","]
# get parameters
set pcar [lindex $plist 0]
set pcdr [lindex $plist 1]
# check
if { $pcar == "A" } {
set xacc $varAcc
# R0
if { $pcdr == "R0" } {
set varAcc $varR0
set varR0 $xacc
}
# R1
if { $pcdr == "R1" } {
set varAcc $varR1
set varR1 $xacc
}
# R2
if { $pcdr == "R2" } {
set varAcc $varR2
set varR2 $xacc
}
# R3
if { $pcdr == "R3" } {
set varAcc $varR3
set varR3 $xacc
}
# R4
if { $pcdr == "R4" } {
set varAcc $varR4
set varR4 $xacc
}
# R5
if { $pcdr == "R5" } {
set varAcc $varR5
set varR5 $xacc
}
# R6
if { $pcdr == "R6" } {
set varAcc $varR6
set varR6 $xacc
}
# R7
if { $pcdr == "R7" } {
set varAcc $varR7
set varR7 $xacc
}
# pointer
if { $pcdr == "@R0" } {
set xval $varmem($varR0)
set varmem($varR0) $varAcc
set varAcc $xval
}
if { $pcdr == "@R1" } {
set xval $varmem($varR1)
set varmem($varR1) $varAcc
set varAcc $xval
}
}
}
論理演算は、一つのプロシージャにまとめておき
演算種別とパラメータを渡すことで対応。
proc logic_computing {x y} {
#
global varAcc varmem
global R0 R1 R2 R3 R4 R5 R6 R7
# separate
set plist [split $x ","]
# get parameters
set pcar [lindex $plist 0]
set pcdr [lindex $plist 1]
# target car
if { $pcar == "A" } {
set xx $varAcc
}
# target cdr
if { $pcdr == "R0" } {
set yy $R0
}
if { $pcdr == "R1" } {
set yy $R1
}
if { $pcdr == "R2" } {
set yy $R2
}
if { $pcdr == "R3" } {
set yy $R3
}
if { $pcdr == "R4" } {
set yy $R4
}
if { $pcdr == "R5" } {
set yy $R5
}
if { $pcdr == "R6" } {
set yy $R6
}
if { $pcdr == "R7" } {
set yy $R7
}
# pointer
if { $pcdr == "@R0" } {
set yy $varmem($R0)
}
if { $pcdr == "@R1" } {
set yy $varmem($R1)
}
# immediate
if { [string index $pcdr 0] == "#" } {
# get code
set x [string range $pcdr 1 end]
# judge
if { [is_label $x] > 0 } {
set yy $lbltbl($x)
} else {
set yy [get_value $x]
}
}
# handling
if { $y == "AND" } {
set result [expr $xx & $yy]
}
if { $y == "OR" } {
set result [expr $xx | $yy]
}
if { $y == "XOR" } {
set result [expr $xx ^ $yy]
}
# adjust
set result [expr $result & 255]
return $result
}
OPCODEは異なっても、OPRANDは論理演算すべてで
共通なので、２パラメータの取得後、計算種別を
利用して結果を求めておきます。
8048では、算術計算は加算と＋１、−１だけが
用意されているので加算については以下の定義
で、キャリーのあるなしに対応。
if { $car == "ADDC" || $car == "ADD" } {
# separate
set plist [split $cdr ","]
# get parameters
set pcar [lindex $plist 0]
set pcdr [lindex $plist 1]
# register
if { $pcdr == "R0" } {
set xval $R0
}
if { $pcdr == "R1" } {
set xval $R1
}
if { $pcdr == "R2" } {
set xval $R2
}
if { $pcdr == "R3" } {
set xval $R3
}
if { $pcdr == "R4" } {
set xval $R4
}
if { $pcdr == "R5" } {
set xval $R5
}
if { $pcdr == "R6" } {
set xval $R6
}
if { $pcdr == "R7" } {
set xval $R7
}
# pointer
if { $pcdr == "@R0" } {
set xval $varmem($R0)
}
if { $pcdr == "@R1" } {
set xval $varmem($R1)
}
# immediate
if { [string index $pcdr 0] == "#" } {
# get code
set x [string range $pcdr 1 end]
# judge
if { [is_label $x] > 0 } {
set xval $lbltbl($x)
} else {
set xval [get_value $x]
}
}
# add
set xadd [expr $varAcc + $xval]
#
if { $car == "ADDC" } {
# add carry
if { [expr $varFlag & 128] == 128 } {
set xadd [expr $xadd + 1]
}
}
# flag
if { $xadd > 255 } {
set varFlag [expr $varFlag | 128]
} else {
set varFlag [expr $varFlag & 127]
}
# adjust
set varAcc [expr $xadd % 256]
}
＋１加算の場合、アキュムレータ、汎用レジスタ
メモリの３種だけにOPRANDは限定されてるので
場合分けして、その時点の値を取り出し、＋１した
後に書き戻す操作で対応。
if { $car == "INC" } {
# accumulator
if { $cdr == "A" } {
set xval $varAcc
}
# register
if { $cdr == "R0" } {
set xval $R0
}
if { $cdr == "R1" } {
set xval $R1
}
if { $cdr == "R2" } {
set xval $R2
}
if { $cdr == "R3" } {
set xval $R3
}
if { $cdr == "R4" } {
set xval $R4
}
if { $cdr == "R5" } {
set xval $R5
}
if { $cdr == "R6" } {
set xval $R6
}
if { $cdr == "R7" } {
set xval $R7
}
# pointer
if { $cdr == "@R0" } {
set xval $varmem($R0)
}
if { $cdr == "@R1" } {
set xval $varmem($R1)
}
# increment
set xval [expr ($xval + 1) % 256]
# accumulator
if { $cdr == "A" } {
set varAcc $xval
}
# register
if { $cdr == "R0" } {
set R0 $xval
}
if { $cdr == "R1" } {
set R1 $xval
}
if { $cdr == "R2" } {
set R2 $xval
}
if { $cdr == "R3" } {
set R3 $xval
}
if { $cdr == "R4" } {
set R4 $xval
}
if { $cdr == "R5" } {
set R5 $xval
}
if { $cdr == "R6" } {
set R6 $xval
}
if { $cdr == "R7" } {
set R7 $xval
}
# pointer
if { $cdr == "@R0" } {
set varmem($R0) $xval
}
if { $cdr == "@R1" } {
set varmem($R1) $xval
}
}
−１加算の場合、＋１加算とOPRANDが少し異なる
ので、異なる部分だけを変更。
if { $car == "DEC" } {
# accumulator
if { $cdr == "A" } {
set xval $varAcc
}
# register
if { $cdr == "R0" } {
set xval $R0
}
if { $cdr == "R1" } {
set xval $R1
}
if { $cdr == "R2" } {
set xval $R2
}
if { $cdr == "R3" } {
set xval $R3
}
if { $cdr == "R4" } {
set xval $R4
}
if { $cdr == "R5" } {
set xval $R5
}
if { $cdr == "R6" } {
set xval $R6
}
if { $cdr == "R7" } {
set xval $R7
}
# decrement
set xval [expr ($xval + 255) % 256]
# accumulator
if { $cdr == "A" } {
set varAcc $xval
}
# register
if { $cdr == "R0" } {
set R0 $xval
}
if { $cdr == "R1" } {
set R1 $xval
}
if { $cdr == "R2" } {
set R2 $xval
}
if { $cdr == "R3" } {
set R3 $xval
}
if { $cdr == "R4" } {
set R4 $xval
}
if { $cdr == "R5" } {
set R5 $xval
}
if { $cdr == "R6" } {
set R6 $xval
}
if { $cdr == "R7" } {
set R7 $xval
}
}
分岐処理では、次の行に移るのか、ラベルで指定した行に
移るのかを計算で求めて、フラグに反映させます。
# clear myflag (control program counter)
set myflag 0
:
# line number increment
if { $myflag == 0 } {
# increment
set currentLine [expr $currentLine + 1]
# update
set curCode $ss($currentLine)
}
分岐に無関係であっても、プログラムカウンタPCの値を
変更する必要があります。PCの値を、＋１するのか指定
した値にするのかをステップ処理の最後で決定。
全体のスクリプトは、以下。
#!/usr/bin/wish
. configure -width 320 -height 240
wm title . "simulate i8048"
wm resizable . 0 0
#######################################
# initialize variables
#######################################
set fd_in ""
set fd_out ""
set fName "unknown"
# initialize EQU table
set equtbl("EQU") -1
# initialize LABLE table
set lbltbl("LABLE") -1
# initialize statement
for {set i 0} {$i < 2048} {incr i} {
set ss($i) ""
}
# initialize memory
for {set i 0} {$i < 64} {incr i} {
set varmem($i) 0
}
set bline 0
set curCode ""
set currentLine 0
set currentResult ""
set rline -1
set rstack ""
# Accumulator
set varAcc 0
# Flag
set varFlag 0
# General Purpose registers
set R0 0
set R1 0
set R2 0
set R3 0
set R4 0
set R5 0
set R6 0
set R7 0
# General Purpose registers
set varR0 0
set varR1 0
set varR2 0
set varR3 0
set varR4 0
set varR5 0
set varR6 0
set varR7 0
# General Purpose registers
set varRB0 0
set varRB1 0
set varRB2 0
set varRB3 0
set varRB4 0
set varRB5 0
set varRB6 0
set varRB7 0
# Port and Bus
set varP1 0
set varP2 0
set varBUS 0
# external flag --T1 T0 F1 TFLAG IFLAG--
set varEflag 0
set varTCNT 0
#######################################
# define labels objects
#######################################
label .lblCode -text "Code"
label .lblFileName -text "File Name"
label .lblBeginLine -text "Begin Line"
label .lblCurrentLine -textvariable currentLine
label .lblCurrentResult -textvariable currentResult
label .lblMemory -text "Memory"
label .lblAcc -text "Acc"
label .lblFlg -text "Flg"
label .lblR0 -text "R0"
label .lblR1 -text "R1"
label .lblR2 -text "R2"
label .lblR3 -text "R3"
label .lblR4 -text "R4"
label .lblR5 -text "R5"
label .lblR6 -text "R6"
label .lblR7 -text "R7"
label .lblRB0 -text "RB0"
label .lblRB1 -text "RB1"
label .lblRB2 -text "RB2"
label .lblRB3 -text "RB3"
label .lblRB4 -text "RB4"
label .lblRB5 -text "RB5"
label .lblRB6 -text "RB6"
label .lblRB7 -text "RB7"
label .lblP1 -text "P1"
label .lblP2 -text "P2"
label .lblBUS -text "BUS"
label .lblTCNT -text "TCNT"
label .lblPSW -text "PSW"
label .lblEXT -text "EXT"
#######################################
# define listbox
#######################################
listbox .lsbCode -xscrollcommand ".sh set" -yscrollcommand ".sv set" -width 32
listbox .lsbMemory -yscrollcommand ".xsv set"
#######################################
# define scroll bar
#######################################
scrollbar .sv -orient vertical -command ".lsbCode yview"
scrollbar .sh -orient horizontal -command ".lsbCode xview"
scrollbar .xsv -orient vertical -command ".lsbMemory yview"
#######################################
# define entry
#######################################
entry .entFileName -textvariable fName -bg green
entry .entCurLine -textvariable curCode
entry .entAcc -textvariable varAcc
entry .entFlg -textvariable varFlag
entry .entR0 -textvariable varR0
entry .entR1 -textvariable varR1
entry .entR2 -textvariable varR2
entry .entR3 -textvariable varR3
entry .entR4 -textvariable varR4
entry .entR5 -textvariable varR5
entry .entR6 -textvariable varR6
entry .entR7 -textvariable varR7
entry .entRB0 -textvariable varRB0
entry .entRB1 -textvariable varRB1
entry .entRB2 -textvariable varRB2
entry .entRB3 -textvariable varRB3
entry .entRB4 -textvariable varRB4
entry .entRB5 -textvariable varRB5
entry .entRB6 -textvariable varRB6
entry .entRB7 -textvariable varRB7
entry .entP1 -textvariable varP1
entry .entP2 -textvariable varP2
entry .entBUS -textvariable varBUS
entry .entTCNT -textvariable varTCNT
entry .entPSW -textvariable varFlag
entry .entEXT -textvariable varEflag
#######################################
# define button objects
#######################################
button .btnLoad -text "Load" -command "fload" -width 12 -bg #0000ff
button .btnRun -text "Run" -command "xrun" -width 10 -bg green
button .btnStep -text "Step" -command "xstep" -width 10
button .btnCancel -text "Cancel" -command "xcancel" -width 10 -bg yellow
button .btnExit -text "Exit" -command "exit" -width 12 -bg #007f7f
button .btnSetF0 -text "set F0" -command "xsetf0" -width 10 -bg red
button .btnClrF0 -text "clr F0" -command "xclrf0" -width 10 -bg red
button .btnIncT -text "inc T" -command "xinct" -width 10
button .btnSetT0 -text "set T0" -command "xsett0" -width 10
button .btnClrT0 -text "clr T0" -command "xclrt0" -width 10
button .btnSetT1 -text "set T1" -command "xsett1" -width 10
button .btnClrT1 -text "clr T1" -command "xclrt1" -width 10
############################
# define procedures
############################
proc fload {} {
global fName fd_in ss bline currentLine currentResult curCode
global equtbl lbltbl
# get file name
set FName [tk_getOpenFile -filetypes {{"assembly" {.src .SRC}}}]
# copy
set fName [lindex [split $FName /] end]
set fName [lindex [split $fName .] 0]
# clear
set i 0
.lsbCode delete 0 end
# flag
set oflag 0
# open file
set fd_in [open $FName "r"]
# loop
while { [gets $fd_in sbuf] >= 0 } {
# toupper
set sbuf [string toupper $sbuf 0 end]
# replace
set sbuf [regsub -all {[\t]} $sbuf " "]
# skip
if { [string index $sbuf 0] == ";" && $oflag == 0 } {
#tk_messageBox -message "$sbuf" -type ok
} else {
# default
set car [lindex $sbuf 0]
# judge
if { $car == "INCLUDE" } {
set oflag 1
}
}
# store
if { $oflag > 0 } {
# store list box
.lsbCode insert end $sbuf
# get size
set xlen [llength $sbuf]
# EQU table
if { [lindex $sbuf 1] == "EQU" } {
# get strings
set car [lindex $sbuf 0]
set cdr [lindex $sbuf end]
# store hash table
set equtbl($car) $cdr
}
# LABEL table
if { $xlen == 1 } {
# get first
set car $sbuf
# calculate length
set xlen [string length $car]
# calcuate end location
set xloc [expr $xlen - 1]
# get last code
set cdr [string index $car $xloc]
# judge
if { $xlen > 0 && $cdr == ":" } {
# get code
set xcar [string range $car 0 [expr $xloc - 1]]
# store line number to hash table
set lbltbl($xcar) $i
}
}
# entry line
if { [lindex $sbuf 0] == "ORG" && [lindex $sbuf 1] == "100H" } {
set currentLine [expr $i + 1]
}
}
# store statement
set ss($i) $sbuf
# increment
incr i
}
# close
close $fd_in
# show current statement
set xcode $ss($currentLine)
# LABEL ?
# calculate length
set xlen [string length $xcode]
# calcuate end location
set xloc [expr $xlen - 1]
# get last code
set cdr [string index $xcode $xloc]
# judge
if { $cdr == ":" } {
# update
set currentLine [expr $currentLine + 1]
# get
set xcode $ss($currentLine)
}
set curCode $xcode
# clear memory
.lsbMemory delete 0 end
for {set i 0} {$i < 64} {incr i} {
if { $i < 8 || $i > 23 } {
.lsbMemory insert end 0
}
}
}
proc xrun {} {
#
global bline currentLine currentResult
# initialize
set currentResult ""
# loop
do_event
}
proc xstep {} {
#
global bline currentLine currentResult curCode
global equtbl lbltbl ss rline varAcc varP1 varP2 varBUS
global R0 R1 R2 R3 R4 R5 R6 R7
global rline varmem varFlag varEflag varTCNT
# get current bank number
set bnum [expr $varFlag & 16]
set bnum [expr $bnum / 16]
# load memory
load_memory $bnum
# clear myflag (control program counter)
set myflag 0
# get code
set xcode $curCode
# get opcode
set car [lindex $xcode 0]
set cdr [lindex $xcode 1]
# DIS
if { $car == "DIS" } {
if { $cdr == "I" } {
set xval [expr $varEflag & 254]
}
if { $cdr == "TCNTI" } {
set xval [expr $varEflag & 253]
}
set varEflag $xval
}
# EN
if { $car == "EN" } {
if { $cdr == "I" } {
set xval [expr $varEflag | 1]
}
if { $cdr == "TCNTI" } {
set xval [expr $varEflag | 2]
}
set varEflag $xval
}
# RET
if { $car == "RET" } {
# resume line number
set currentLine $rline
# update statement
set curCode $ss($currentLine)
# set flag
set myflag 1
}
# IN
if { $car == "IN" } {
# separate
set plist [split $cdr ","]
# get parameters
set pcar [lindex $plist 0]
set pcdr [lindex $plist 1]
# PORT 1
if { $pcar == "A" && $pcdr == "P1" } {
set varAcc $varP1
}
# PORT 2
if { $pcar == "A" && $pcdr == "P2" } {
set varAcc $varP2
}
}
# OUTL
if { $car == "OUTL" } {
# separate
set plist [split $cdr ","]
# get parameters
set pcar [lindex $plist 0]
set pcdr [lindex $plist 1]
# port 1
if { $pcar == "P1" && $pcdr == "A" } {
set varP1 $varAcc
}
# port 2
if { $pcar == "P2" && $pcdr == "A" } {
set varP2 $varAcc
}
# bus
if { $pcar == "BUS" && $pcdr == "A" } {
set varBUS $varAcc
}
}
# branch
if { $car == "CALL" } {
# store return line
set rline [expr $currentLine + 1]
# calculate line number
set xline [expr $lbltbl($cdr) + 1]
# update current line number
set currentLine $xline
# update statement
set curCode $ss($currentLine)
}
if { $car == "JMP" } {
# calculate line number
set xline [expr $lbltbl($cdr) + 1]
# update current line number
set currentLine $xline
# update statement
set curCode $ss($currentLine)
#
set myflag 1
}
if { $car == "JMPP" } {
if { $cdr == "@A" } {
#
}
}
if { $car == "JC" } {
# get carry flag
set cflag [expr $varFlag & 128]
# judge
if { $cflag == 128 } {
# calculate line number
set xline [expr $lbltbl($cdr) + 1]
# update current line number
set currentLine $xline
# update statement
set curCode $ss($currentLine)
# surpress
set myflag 1
}
}
if { $car == "JNC" } {
# get carry flag
set cflag [expr $varFlag & 128]
# judge
if { $cflag == 0 } {
# calculate line number
set xline [expr $lbltbl($cdr) + 1]
# update current line number
set currentLine $xline
# update statement
set curCode $ss($currentLine)
# surpress
set myflag 1
}
}
if { $car == "JZ" } {
# judge
if { $varAcc == 0 } {
# calculate line number
set xline [expr $lbltbl($cdr) + 1]
# update current line number
set currentLine $xline
# update statement
set curCode $ss($currentLine)
# surpress
set myflag 1
}
}
if { $car == "JNZ" } {
# judge
if { $varAcc > 0 } {
# calculate line number
set xline [expr $lbltbl($cdr) + 1]
# update current line number
set currentLine $xline
# update statement
set curCode $ss($currentLine)
# surpress
set myflag 1
}
}
if { $car == "JT0" } {
# get flag
set eflag [expr $varEflag & 8]
# judge
if { $eflag == 8 } {
# calculate line number
set xline [expr $lbltbl($cdr) + 1]
# update current line number
set currentLine $xline
# update statement
set curCode $ss($currentLine)
# surpress
set myflag 1
}
}
if { $car == "JNT0" } {
# get flag
set eflag [expr $varEflag & 8]
# judge
if { $eflag == 0 } {
# calculate line number
set xline [expr $lbltbl($cdr) + 1]
# update current line number
set currentLine $xline
# update statement
set curCode $ss($currentLine)
# surpress
set myflag 1
}
}
if { $car == "JT1" } {
# get flag
set eflag [expr $varEflag & 16]
# judge
if { $eflag == 16 } {
# calculate line number
set xline [expr $lbltbl($cdr) + 1]
# update current line number
set currentLine $xline
# update statement
set curCode $ss($currentLine)
# surpress
set myflag 1
}
}
if { $car == "JNT1" } {
# get flag
set eflag [expr $varEflag & 16]
# judge
if { $eflag == 0 } {
# calculate line number
set xline [expr $lbltbl($cdr) + 1]
# update current line number
set currentLine $xline
# update statement
set curCode $ss($currentLine)
# surpress
set myflag 1
}
}
if { $car == "JF0" } {
# get flag
set cflag [expr $varFlag & 32]
# judge
if { $cflag == 32 } {
# calculate line number
set xline [expr $lbltbl($cdr) + 1]
# update current line number
set currentLine $xline
# update statement
set curCode $ss($currentLine)
# surpress
set myflag 1
}
}
if { $car == "JNF0" } {
# get flag
set cflag [expr $varFlag & 32]
# judge
if { $cflag == 0 } {
# calculate line number
set xline [expr $lbltbl($cdr) + 1]
# update current line number
set currentLine $xline
# update statement
set curCode $ss($currentLine)
# surpress
set myflag 1
}
}
if { $car == "JTF" } {
# get flag
set cflag [expr $varEflag & 2]
# judge
if { $cflag == 2 } {
# calculate line number
set xline [expr $lbltbl($cdr) + 1]
# update current line number
set currentLine $xline
# update statement
set curCode $ss($currentLine)
# surpress
set myflag 1
}
}
if { $car == "JNI" } {
# get flag
set cflag [expr $varEflag & 1]
# judge
if { $cflag == 1 } {
# calculate line number
set xline [expr $lbltbl($cdr) + 1]
# update current line number
set currentLine $xline
# update statement
set curCode $ss($currentLine)
# surpress
set myflag 1
}
}
if { $car == "JB0" } {
# check 2^0
set cflag [expr $varAcc & 1]
# judge
if { $cflag == 1 } {
# calculate line number
set xline [expr $lbltbl($cdr) + 1]
# update current line number
set currentLine $xline
# update statement
set curCode $ss($currentLine)
# surpress
set myflag 1
}
}
if { $car == "JB1" } {
# check 2^1
set cflag [expr $varAcc & 2]
# judge
if { $cflag == 2 } {
# calculate line number
set xline [expr $lbltbl($cdr) + 1]
# update current line number
set currentLine $xline
# update statement
set curCode $ss($currentLine)
# surpress
set myflag 1
}
}
if { $car == "JB2" } {
# check 2^2
set cflag [expr $varAcc & 4]
# judge
if { $cflag == 4 } {
# calculate line number
set xline [expr $lbltbl($cdr) + 1]
# update current line number
set currentLine $xline
# update statement
set curCode $ss($currentLine)
# surpress
set myflag 1
}
}
if { $car == "JB3" } {
# check 2^3
set cflag [expr $varAcc & 8]
# judge
if { $cflag == 8 } {
# calculate line number
set xline [expr $lbltbl($cdr) + 1]
# update current line number
set currentLine $xline
# update statement
set curCode $ss($currentLine)
# surpress
set myflag 1
}
}
if { $car == "JB4" } {
# check 2^4
set cflag [expr $varAcc & 16]
# judge
if { $cflag == 16 } {
# calculate line number
set xline [expr $lbltbl($cdr) + 1]
# update current line number
set currentLine $xline
# update statement
set curCode $ss($currentLine)
# surpress
set myflag 1
}
}
if { $car == "JB5" } {
# check 2^5
set cflag [expr $varAcc & 32]
# judge
if { $cflag == 32 } {
# calculate line number
set xline [expr $lbltbl($cdr) + 1]
# update current line number
set currentLine $xline
# update statement
set curCode $ss($currentLine)
# surpress
set myflag 1
}
}
if { $car == "JB6" } {
# check 2^6
set cflag [expr $varAcc & 64]
# judge
if { $cflag == 64 } {
# calculate line number
set xline [expr $lbltbl($cdr) + 1]
# update current line number
set currentLine $xline
# update statement
set curCode $ss($currentLine)
# surpress
set myflag 1
}
}
if { $car == "JB7" } {
# check 2^7
set cflag [expr $varAcc & 128]
# judge
if { $cflag == 128 } {
# calculate line number
set xline [expr $lbltbl($cdr) + 1]
# update current line number
set currentLine $xline
# update statement
set curCode $ss($currentLine)
# surpress
set myflag 1
}
}
# sel
if { $car == "SEL" } {
# RB0
if { $cdr == "RB0" } {
set varFlag [expr $varFlag & 239]
}
# RB1
if { $cdr == "RB1" } {
set varFlag [expr $varFlag | 16]
}
}
# mov
if { $car == "MOV" } {
# separate
set plist [split $cdr ","]
# get parameters
set pcar [lindex $plist 0]
set pcdr [lindex $plist 1]
# timer
if { $pcar == "T" && $pcdr == "A" } {
set varTCNT $varAcc
}
# psw
if { $pcar == "PSW" && $pcdr == "A" } {
set varFlag $varAcc
}
# accumlator
if { $pcar == "A" } {
# psw
if { $pcdr == "PSW" } {
set xval $varFlag
}
# register
if { $pcdr == "R0" } {
set xval $R0
}
if { $pcdr == "R1" } {
set xval $R1
}
if { $pcdr == "R2" } {
set xval $R2
}
if { $pcdr == "R3" } {
set xval $R3
}
if { $pcdr == "R4" } {
set xval $R4
}
if { $pcdr == "R5" } {
set xval $R5
}
if { $pcdr == "R6" } {
set xval $R6
}
if { $pcdr == "R7" } {
set xval $R7
}
# pointer
if { $pcdr == "@R0" } {
set xval $varmem($R0)
}
if { $pcdr == "@R1" } {
set xval $varmem($R1)
}
#immidiate
if { [string index $pcdr 0] == "#" } {
# length
set xlen [string length $pcdr]
# get
set xval [string range $pcdr 1 end]
# convert
set xval [get_value $xval]
}
# timer
if { $pcdr == "T" } {
set varAcc $varT
}
# store
set varAcc $xval
}
# register
if { $pcar == "R0" || $pcar == "R1" || $pcar == "R2" || $pcar == "R3" } {
# immidieate
if { [string index $pcdr 0] == "#" } {
# get
set xval [string range $pcdr 1 end]
# calculate
set xval [get_value $xval]
}
# accumulator
if { $pcdr == "A" } {
set xval $varAcc
}
# pointer
if { $pcdr == "@R0" } {
set xval $varmem($R0)
}
if { $pcdr == "@R1" } {
set xval $varmem($R1)
}
# store
if { $pcar == "R0" } {
set R0 $xval
}
if { $pcar == "R1" } {
set R1 $xval
}
if { $pcar == "R2" } {
set R2 $xval
}
if { $pcar == "R3" } {
set R3 $xval
}
}
if { $pcar == "R4" || $pcar == "R5" || $pcar == "R6" || $pcar == "R7" } {
# immidieate
if { [string index $pcdr 0] == "#" } {
# get
set xval [string range $pcdr 1 end]
# calculate
set xval [get_value $xval]
}
# accumulator
if { $pcdr == "A" } {
set xval $varAcc
}
# pointer
if { $pcdr == "@R0" } {
set xval $varmem($R0)
}
if { $pcdr == "@R1" } {
set xval $varmem($R1)
}
# store
if { $pcar == "R4" } {
set R4 $xval
}
if { $pcar == "R5" } {
set R5 $xval
}
if { $pcar == "R6" } {
set R6 $xval
}
if { $pcar == "R7" } {
set R7 $xval
}
}
# pointer
if { $pcar == "@R0" || $pcar == "@R1" } {
# calculate address
set xadr $R0
if { $pcar == "@R1" } {
set xadr $R1
}
# immediate
if { [string index $pcdr 0] == "#" } {
# get
set xval [string range $pcdr 1 end]
# calculate
set xval [get_value $xval]
}
# accumulator
if { $pcdr == "A" } {
set xval $varAcc
}
# register
if { $pcdr == "R0" } {
set xval $R0
}
if { $pcdr == "R1" } {
set xval $R1
}
if { $pcdr == "R2" } {
set xval $R2
}
if { $pcdr == "R3" } {
set xval $R3
}
if { $pcdr == "R4" } {
set xval $R4
}
if { $pcdr == "R5" } {
set xval $varR5
}
if { $pcdr == "R6" } {
set xval $R6
}
if { $pcdr == "R7" } {
set xval $R7
}
# store
set varmem($xadr) $xval
}
}
# exchange
if { $car == "XCH" } {
# separate
set plist [split $cdr ","]
# get parameters
set pcar [lindex $plist 0]
set pcdr [lindex $plist 1]
# check
if { $pcar == "A" } {
set xacc $varAcc
# R0
if { $pcdr == "R0" } {
set varAcc $R0
set R0 $xacc
}
# R1
if { $pcdr == "R1" } {
set varAcc $R1
set R1 $xacc
}
# R2
if { $pcdr == "R2" } {
set varAcc $R2
set R2 $xacc
}
# R3
if { $pcdr == "R3" } {
set varAcc $R3
set R3 $xacc
}
# R4
if { $pcdr == "R4" } {
set varAcc $R4
set R4 $xacc
}
# R5
if { $pcdr == "R5" } {
set varAcc $R5
set R5 $xacc
}
# R6
if { $pcdr == "R6" } {
set varAcc $R6
set R6 $xacc
}
# R7
if { $pcdr == "R7" } {
set varAcc $R7
set R7 $xacc
}
# pointer
if { $pcdr == "@R0" } {
set xval $varmem($R0)
set varmem($R0) $varAcc
set varAcc $xval
}
if { $pcdr == "@R1" } {
set xval $varmem($R1)
set varmem($R1) $varAcc
set varAcc $xval
}
}
}
# decrement jmp
if { $car == "DJNZ" } {
# separate
set plist [split $cdr ","]
# set next line number
set nadr [expr $currentLine + 1]
# get parameters
set pcar [lindex $plist 0]
set pcdr [lindex $plist 1]
# get line number
set xadr $lbltbl($pcdr)
# decrement
if { $pcar == "R0" } {
set xval $R0
}
if { $pcar == "R1" } {
set xval $R1
}
if { $pcar == "R2" } {
set xval $R2
}
if { $pcar == "R3" } {
set xval $R3
}
if { $pcar == "R4" } {
set xval $R4
}
if { $pcar == "R5" } {
set xval $R5
}
if { $pcar == "R6" } {
set xval $R6
}
if { $pcar == "R7" } {
set xval $R7
}
# decrement
set xval [expr ($xval + 255) % 256]
# resume
if { $pcar == "R0" } {
set R0 $xval
}
if { $pcar == "R1" } {
set R1 $xval
}
if { $pcar == "R2" } {
set R2 $xval
}
if { $pcar == "R3" } {
set R3 $xval
}
if { $pcar == "R4" } {
set R4 $xval
}
if { $pcar == "R5" } {
set R5 $xval
}
if { $pcar == "R6" } {
set R6 $xval
}
if { $pcar == "R7" } {
set R7 $xval
}
# judge
if { $xval > 0 } {
# skip PC increment
set myflag 1
set currentLine $xadr
} else {
# PC increment
set myflag 0
set currentLine [expr $currentLine + 1]
set curCode $ss($currentLine)
}
}
# clear
if { $car == "CLR" } {
# accumulator
if { $cdr == "A" } {
# put value
set varAcc 0
}
# carry flag
if { $cdr == "C" } {
# get current value
set xval $varFlag
# clear
set xval [expr $xval & 127]
# put
set varFlag $xval
}
# flag F0
if { $cdr == "F0" } {
# get current value
set xval $varFlag
# clear
set xval [expr $xval & 223]
# put
set varFlag $xval
}
# flag F1
if { $cdr == "F1" } {
# get current value
set xval $varEflag
# clear
set xval [expr $xval & 251]
# put
set varEflag $xval
}
}
# complement
if { $car == "CPL" } {
# accumulator
if { $cdr == "A" } {
# get current value
set xval $varAcc
# invrese
set xval [expr $xval ^ 255]
# put value
set varAcc $xval
}
# carry flag
if { $cdr == "C" } {
# get current value
set xval $varFlag
# clear
set xval [expr $xval ^ 128]
# put
set varFlag $xval
}
# flag F0
if { $cdr == "F0" } {
# get current value
set xval $varFlag
# clear
set xval [expr $xval ^ 32]
# put
set varFlag $xval
}
# flag F1
if { $cdr == "F1" } {
# get current value
set xval $varEflag
# clear
set xval [expr $xval ^ 4]
# put
set varEflag $xval
}
}
# increment
if { $car == "INC" } {
# accumulator
if { $cdr == "A" } {
set xval $varAcc
}
# register
if { $cdr == "R0" } {
set xval $R0
}
if { $cdr == "R1" } {
set xval $R1
}
if { $cdr == "R2" } {
set xval $R2
}
if { $cdr == "R3" } {
set xval $R3
}
if { $cdr == "R4" } {
set xval $R4
}
if { $cdr == "R5" } {
set xval $R5
}
if { $cdr == "R6" } {
set xval $R6
}
if { $cdr == "R7" } {
set xval $R7
}
# pointer
if { $cdr == "@R0" } {
set xval $varmem($R0)
}
if { $cdr == "@R1" } {
set xval $varmem($R1)
}
# increment
set xval [expr ($xval + 1) % 256]
# accumulator
if { $cdr == "A" } {
set varAcc $xval
}
# register
if { $cdr == "R0" } {
set R0 $xval
}
if { $cdr == "R1" } {
set R1 $xval
}
if { $cdr == "R2" } {
set R2 $xval
}
if { $cdr == "R3" } {
set R3 $xval
}
if { $cdr == "R4" } {
set R4 $xval
}
if { $cdr == "R5" } {
set R5 $xval
}
if { $cdr == "R6" } {
set R6 $xval
}
if { $cdr == "R7" } {
set R7 $xval
}
# pointer
if { $cdr == "@R0" } {
set varmem($R0) $xval
}
if { $cdr == "@R1" } {
set varmem($R1) $xval
}
}
# decremnt
if { $car == "DEC" } {
# accumulator
if { $cdr == "A" } {
set xval $varAcc
}
# register
if { $cdr == "R0" } {
set xval $R0
}
if { $cdr == "R1" } {
set xval $R1
}
if { $cdr == "R2" } {
set xval $R2
}
if { $cdr == "R3" } {
set xval $R3
}
if { $cdr == "R4" } {
set xval $R4
}
if { $cdr == "R5" } {
set xval $R5
}
if { $cdr == "R6" } {
set xval $R6
}
if { $cdr == "R7" } {
set xval $R7
}
# decrement
set xval [expr ($xval + 255) % 256]
# accumulator
if { $cdr == "A" } {
set varAcc $xval
}
# register
if { $cdr == "R0" } {
set R0 $xval
}
if { $cdr == "R1" } {
set R1 $xval
}
if { $cdr == "R2" } {
set R2 $xval
}
if { $cdr == "R3" } {
set R3 $xval
}
if { $cdr == "R4" } {
set R4 $xval
}
if { $cdr == "R5" } {
set R5 $xval
}
if { $cdr == "R6" } {
set R6 $xval
}
if { $cdr == "R7" } {
set R7 $xval
}
}
# rotate without carry
if { $car == "RL" && $cdr == "A" } {
# get value
set xval $varAcc
# x2
set xval [expr $xval * 2]
# judge 256bit
if { $xval > 255 } {
set xval [expr ($xval + 1) % 256]
}
# put value
set varAcc $xval
}
if { $car == "RR" && $cdr == "A" } {
# get value
set xval $varAcc
# / 2
set xval [expr $xval / 2]
# clear MSB
set xval [expr $xval & 127]
# judge 256bit
if { [expr $varAcc & 1] == 1 } {
set xval [expr $xval | 128]
}
# put value
set varAcc $xval
}
# rotate with carry
if { $car == "RLC" && $cdr == "A" } {
# get value
set xval $varAcc
if { [expr $varFlag & 128] > 0 } {
set yval 1
set varFlag [expr $varFlag & 127]
}
# x2
set xval [expr $xval * 2]
# adjust
if { $xval > 255 } {
set varFlag [expr $varFlag | 128]
set xval [expr ($xval + 1) % 256 + $yval]
}
# put value
set varAcc $xval
}
if { $car == "RRC" && $cdr == "A" } {
# get value
set xval $varAcc
if { [expr $varFlag & 128] > 0 } {
set yval 128
set varFlag [expr $varFlag & 127]
}
# / 2
set xval [expr $xval / 2]
# add MSB
set xval [expr $xval + $yval]
# adjust carry flag
if { [expr $varAcc & 1] == 1 } {
set varFlag [expr $varFlag | 128]
}
# put value
set varAcc $xval
}
# swap
if { $car == "SWAP" && $cdr == "A" } {
# get value
set xval [expr ($varAcc % 16) & 255]
set yval [expr ($varAcc / 16) & 255]
# calculate
set xval [expr $xval * 16]
set yval [expr $yval / 16]
# concatenate
set varAcc [expr ($xval + $yval) & 255]
}
# add
if { $car == "ADDC" || $car == "ADD" } {
# separate
set plist [split $cdr ","]
# get parameters
set pcar [lindex $plist 0]
set pcdr [lindex $plist 1]
# register
if { $pcdr == "R0" } {
set xval $R0
}
if { $pcdr == "R1" } {
set xval $R1
}
if { $pcdr == "R2" } {
set xval $R2
}
if { $pcdr == "R3" } {
set xval $R3
}
if { $pcdr == "R4" } {
set xval $R4
}
if { $pcdr == "R5" } {
set xval $R5
}
if { $pcdr == "R6" } {
set xval $R6
}
if { $pcdr == "R7" } {
set xval $R7
}
# pointer
if { $pcdr == "@R0" } {
set xval $varmem($R0)
}
if { $pcdr == "@R1" } {
set xval $varmem($R1)
}
# immediate
if { [string index $pcdr 0] == "#" } {
# get code
set x [string range $pcdr 1 end]
# judge
if { [is_label $x] > 0 } {
set xval $lbltbl($x)
} else {
set xval [get_value $x]
}
}
# add
set xadd [expr $varAcc + $xval]
#
if { $car == "ADDC" } {
# add carry
if { [expr $varFlag & 128] == 128 } {
set xadd [expr $xadd + 1]
}
}
# flag
if { $xadd > 255 } {
set varFlag [expr $varFlag | 128]
} else {
set varFlag [expr $varFlag & 127]
}
# adjust
set varAcc [expr $xadd % 256]
}
# and
if { $car == "ANL" } {
set varAcc [logic_computing $cdr "AND"]
}
# or
if { $car == "ORL" } {
set varAcc [logic_computing $cdr "OR"]
}
# xor
if { $car == "XRL" } {
set varAcc [logic_computing $cdr "XOR"]
}
# store memory
store_memory $bnum
# line number increment
if { $myflag == 0 } {
# increment
set currentLine [expr $currentLine + 1]
# update
set curCode $ss($currentLine)
}
}
proc logic_computing {x y} {
#
global varAcc varmem
global R0 R1 R2 R3 R4 R5 R6 R7
# separate
set plist [split $x ","]
# get parameters
set pcar [lindex $plist 0]
set pcdr [lindex $plist 1]
# target car
if { $pcar == "A" } {
set xx $varAcc
}
# target cdr
if { $pcdr == "R0" } {
set yy $R0
}
if { $pcdr == "R1" } {
set yy $R1
}
if { $pcdr == "R2" } {
set yy $R2
}
if { $pcdr == "R3" } {
set yy $R3
}
if { $pcdr == "R4" } {
set yy $R4
}
if { $pcdr == "R5" } {
set yy $R5
}
if { $pcdr == "R6" } {
set yy $R6
}
if { $pcdr == "R7" } {
set yy $R7
}
# pointer
if { $pcdr == "@R0" } {
set yy $varmem($R0)
}
if { $pcdr == "@R1" } {
set yy $varmem($R1)
}
# immediate
if { [string index $pcdr 0] == "#" } {
# get code
set x [string range $pcdr 1 end]
# judge
if { [is_label $x] > 0 } {
set yy $lbltbl($x)
} else {
set yy [get_value $x]
}
}
# handling
if { $y == "AND" } {
set result [expr $xx & $yy]
}
if { $y == "OR" } {
set result [expr $xx | $yy]
}
if { $y == "XOR" } {
set result [expr $xx ^ $yy]
}
# adjust
set result [expr $result & 255]
return $result
}
proc xcancel {} {
#
global bline currentLine currentResult
# initialize
set currentResult ""
}
proc get_hex {x} {
set result 0
if { $x <= 9 } {
set result $x
} else {
if { $x == "A" } {
set result 10
}
if { $x == "B" } {
set result 11
}
if { $x == "C" } {
set result 12
}
if { $x == "D" } {
set result 13
}
if { $x == "E" } {
set result 14
}
if { $x == "F" } {
set result 15
}
}
return $result
}
proc get_value {x} {
global equtbl
# copy
set xx $x
# default
set xsum 0
# judge label
if { [is_label $xx] > 0 } {
set xx $equtbl($xx)
}
# size
set xlen [string length $xx]
# hexadecimal
if { [string index $xx end] == "H" } {
# calculate length
set xlast [expr $xlen - 1 ]
# add
for {set i 0} {$i < $xlast} {incr i} {
set xtmp [string index $xx $i]
set xtmp [get_hex $xtmp]
set xsum [expr 16 * $xsum + $xtmp]
}
} else {
# get length
set xlast $xlen
# add
for {set i 0} {$i < $xlast} {incr i} {
set xtmp [string index $xx $i]
set xtmp [get_hex $xtmp]
set xsum [expr 10 * $xsum + $xtmp]
}
}
#set result $xsum
return $xsum
}
proc is_label {x} {
# default
set result 1
# get first code
set xx [string index $x 0]
# judge number
if { $xx <= 9 } {
set result 0
}
return $result
}
proc load_memory {x} {
#
global R0 R1 R2 R3
global R4 R5 R6 R7
global varmem
# handling bank #0
if { $x == 0 } {
set R0 $varmem(0)
set R1 $varmem(1)
set R2 $varmem(2)
set R3 $varmem(3)
set R4 $varmem(4)
set R5 $varmem(5)
set R6 $varmem(6)
set R7 $varmem(7)
}
# handling bank #1
if { $x == 1 } {
set R0 $varmem(24)
set R1 $varmem(25)
set R2 $varmem(26)
set R3 $varmem(27)
set R4 $varmem(28)
set R5 $varmem(29)
set R6 $varmem(30)
set R7 $varmem(31)
}
}
proc store_memory {x} {
#
global R0 R1 R2 R3
global R4 R5 R6 R7
global varR0 varR1 varR2 varR3
global varR4 varR5 varR6 varR7
global varRB0 varRB1 varRB2 varRB3
global varRB4 varRB5 varRB6 varRB7
global varmem
# handling bank #0
if { $x == 0 } {
set varmem(0) $R0
set varmem(1) $R1
set varmem(2) $R2
set varmem(3) $R3
set varmem(4) $R4
set varmem(5) $R5
set varmem(6) $R6
set varmem(7) $R7
}
# handling bank #1
if { $x == 1 } {
set varmem(24) $R0
set varmem(25) $R1
set varmem(26) $R2
set varmem(27) $R3
set varmem(28) $R4
set varmem(29) $R5
set varmem(30) $R6
set varmem(31) $R7
}
# update register area
set varR0 $varmem(0)
set varR1 $varmem(1)
set varR2 $varmem(2)
set varR3 $varmem(3)
set varR4 $varmem(4)
set varR5 $varmem(5)
set varR6 $varmem(6)
set varR7 $varmem(7)
set varRB0 $varmem(24)
set varRB1 $varmem(25)
set varRB2 $varmem(26)
set varRB3 $varmem(27)
set varRB4 $varmem(28)
set varRB5 $varmem(29)
set varRB6 $varmem(30)
set varRB7 $varmem(31)
# update user area
.lsbMemory delete 0 end
for {set i 0} {$i < 64} {incr i } {
if { $i < 8 || $i > 23 } {
.lsbMemory insert end $varmem($i)
}
}
}
proc xsetf0 {} {
global varFlag
# get
set val $varFlag
# set
set val [expr $val | 32]
# resume
set varFlag $val
}
proc xclrf0 {} {
global varFlag
# get
set val $varFlag
# clear
set val [expr $val & 223]
# resume
set varFlag $val
}
proc xinct {} {
global varTCNT varEflag
# get
set val $varTCNT
# increment
set val [expr $val + 1]
# judge
if { $val == 256 } {
# get flag
set xtmp $varEflag
# set
set xtmp [expr $xtmp | 2]
# resume
set varEflag $xtmp
}
# adjust
set val [expr $val % 256]
# resume
set varTCNT $val
}
proc xsett0 {} {
global varEflag
# get
set val $varEflag
# set
set val [expr $val | 8]
# resume
set varEflag $val
}
proc xclrt0 {} {
global varEflag
# get
set val $varEflag
# set
set val [expr $val & 247]
# resume
set varEflag $val
}
proc xsett1 {} {
global varEflag
# get
set val $varEflag
# set
set val [expr $val | 16]
# resume
set varEflag $val
}
proc xclrt1 {} {
global varEflag
# get
set val $varEflag
# set
set val [expr $val & 239]
# resume
set varEflag $val
}
proc do_event {} {
after 1000 do_event
}
############################
# place objects
############################
grid .lblFileName -column 1 -row 0
grid .lblMemory -column 3 -row 1
grid .lblCode -column 0 -row 2
grid .lsbCode -column 1 -row 2
grid .sv -column 2 -row 2 -sticky ns
grid .sh -column 1 -row 3 -sticky ew
grid .lsbMemory -column 3 -row 2
grid .xsv -column 4 -row 2 -sticky ns
grid .lblBeginLine -column 1 -row 4
grid .entCurLine -column 1 -row 5
grid .lblCurrentLine -column 1 -row 6
grid .lblCurrentResult -column 1 -row 7
grid .entFileName -column 1 -row 1
grid .btnLoad -column 5 -row 0
grid .btnRun -column 0 -row 4
grid .btnStep -column 0 -row 5
grid .btnCancel -column 0 -row 6
grid .btnExit -column 5 -row 9
grid .btnSetF0 -column 5 -row 10
grid .btnClrF0 -column 5 -row 11
grid .btnIncT -column 5 -row 12
grid .btnSetT0 -column 5 -row 13
grid .btnClrT0 -column 5 -row 14
grid .btnSetT1 -column 5 -row 15
grid .btnClrT1 -column 5 -row 16
grid .lblAcc -column 0 -row 10
grid .lblFlg -column 0 -row 12
grid .lblP1 -column 0 -row 14
grid .lblP2 -column 0 -row 16
grid .lblBUS -column 0 -row 18
grid .lblTCNT -column 2 -row 5
grid .lblPSW -column 2 -row 6
grid .lblEXT -column 2 -row 7
grid .lblR0 -column 1 -row 10
grid .lblR1 -column 1 -row 11
grid .lblR2 -column 1 -row 12
grid .lblR3 -column 1 -row 13
grid .lblR4 -column 1 -row 14
grid .lblR5 -column 1 -row 15
grid .lblR6 -column 1 -row 16
grid .lblR7 -column 1 -row 17
grid .lblRB0 -column 3 -row 10
grid .lblRB1 -column 3 -row 11
grid .lblRB2 -column 3 -row 12
grid .lblRB3 -column 3 -row 13
grid .lblRB4 -column 3 -row 14
grid .lblRB5 -column 3 -row 15
grid .lblRB6 -column 3 -row 16
grid .lblRB7 -column 3 -row 17
grid .entTCNT -column 3 -row 5
grid .entPSW -column 3 -row 6
grid .entEXT -column 3 -row 7
grid .entAcc -column 0 -row 11
grid .entFlg -column 0 -row 13
grid .entP1 -column 0 -row 15
grid .entP2 -column 0 -row 17
grid .entBUS -column 0 -row 19
grid .entR0 -column 2 -row 10
grid .entR1 -column 2 -row 11
grid .entR2 -column 2 -row 12
grid .entR3 -column 2 -row 13
grid .entR4 -column 2 -row 14
grid .entR5 -column 2 -row 15
grid .entR6 -column 2 -row 16
grid .entR7 -column 2 -row 17
grid .entRB0 -column 4 -row 10
grid .entRB1 -column 4 -row 11
grid .entRB2 -column 4 -row 12
grid .entRB3 -column 4 -row 13
grid .entRB4 -column 4 -row 14
grid .entRB5 -column 4 -row 15
grid .entRB6 -column 4 -row 16
grid .entRB7 -column 4 -row 17
目次
前
次
