|
Warning: this is an htmlized version!
The original is here, and the conversion rules are here. |
#!/usr/bin/tclsh
# «.dirs_and_libs» (to "dirs_and_libs")
# «.shell» (to "shell")
# «.immed_words» (to "immed_words")
# «.demos» (to "demos")
#%%%%
#
# «dirs_and_libs» (to ".dirs_and_libs")
#
#%%%%
proc getenv {vname default} {
global env
expr {[info exists env(TMPDIR)]?$env($vname):$default}
}
proc scriptdir {} { file dirname [info script]] }
proc tmpdir {} { getenv TMPDIR /tmp }
# (find-angg "CRIM1/crim1a-lib.tcl")
# (find-angg "CRIM1/crim1a-prims.tcl")
source [scriptdir]/crim1a-lib.tcl
source [scriptdir]/crim1a-prims.tcl
#%%%%
#
# «shell» (to ".shell")
#
#%%%%
proc shell {str} { writefile [tmpdir]/crim1.sh "set -v\n$str\nset +v" }
proc finalstuff {skelstem enginestem nasmstem binstem} {
set_final_prim_data
doCfilestuff [scriptdir]/${skelstem}.skel.c [tmpdir]/${enginestem}.c
doasmfilestuff [tmpdir]/${nasmstem}.asm
shell "
cd [tmpdir]
nasm -f elf -o ${nasmstem}.o -l ${nasmstem}.lst ${nasmstem}.asm
gcc -c -o ${enginestem}.o ${enginestem}.c
gcc -o ${binstem} ${enginestem}.o ${nasmstem}.o
./${binstem}
"
}
#%%%%
#
# «immed_words» (to ".immed_words")
#
#%%%%
proc asm {str} { global asm_code; append asm_code $str }
proc gtick {name} { asm "global ADR_$name\n"; tick $name }
proc to {label} { asm "\tdw LBL_${label}-_f0\n" }
proc lbl {label} { asm "LBL_${label}:\n" }
#%%%%
#
# «demos» (to ".demos")
#
#%%%%
# How to run
set whichdemo [lindex $argv 0]
switch $whichdemo 0 {
tick 2 ; run CON: ; asm "\tdd 2\n"
tick SQUARE ; run : DUP * \;
tick CUBE ; run : DUP SQUARE * \;
gtick DEMO ; run : 2 CUBE \;
finalstuff engine0 engine0 x0 demo0
} 1 {
tick &FOO ;run AT:
tick FOO! ;run TO:
tick FOO ;run CON: ;asm "\tdd 0x12345\n"
tick S\$@, ;run : S> COUNT 2DUP + >S \;
tick <.\"> ;run RSR:
tick S<.\"> ;run : S\$@, TYPE \;
tick 2<.\"> ;run RSR:
tick S2<.\"> ;run : S<.\"> CR S<.\"> \;
gtick DEMO ;run : 2<.\"> ;asm "\tdb 5, 'Hello'\n\tdb 5, 'There'\n"
;run CR FOO FOO + FOO! \;
finalstuff engine0 engine1 x1 demo1
} 2 {
tick strlen ;run C1: ;asm "\nextern strlen\n\tdd strlen\n"
tick 0<.\"> ;run RSR:
tick S0<.\"> ;run : S> DUP strlen 2DUP TYPE + 1 + >S \;
gtick DEMO ;run : 0<.\"> ;asm "\tdb 'Hello', 0\n"
;run CR 0<.\"> ;asm "\tdb 'There!', 0\n"
;run \;
finalstuff engine0 engine2 x2 demo2
} 3 {
tick strlen ;run C1: ;asm "\nextern strlen\n\tdd strlen\n"
tick 0<.\"> ;run RSR:
tick S0<.\"> ;run : S> DUP strlen 2DUP TYPE + 1 + >S \;
tick LITW ;run RSR: : SGOBBLE2 \;
proc 0.\" {dbstuff} { run 0<.\"> ;asm "\tdb $dbstuff\n" }
proc lit {w} { run LITW ;asm "\tdw $w\n" }
tick BRANCH ;run RSR: : SBRANCH \;
tick 0BRANCH ;run RSR: : S0BRANCH \;
tick YES/NO ;run : 0BRANCH ;to no ;0.\" {'yes',10,0}
;run BRANCH ;to end
;lbl no ;0.\" {'no',10,0}
;lbl end ;run \;
gtick DEMO ;run : ;0.\" {'Hello',10,0}
;lit 22 ;run YES/NO
;lit 0 ;run YES/NO
;run \;
finalstuff engine0 engine3 x3 demo3
} default {
puts "Usage: tclsh [info script] \[0|1|2|3\]
. [tmpdir]/crim1.sh"
}
# (find-fline "~/CRIM1/tclstuff" "arrset action \"''\"")
# (find-angg "CRIM1/crim1a-prims.tcl" "test:prims")
# (find-fline "~/CRIM1/")
# (find-fline "~/CRIM1/engine0.skel.c")
# (find-fline "/tmp/")
# (find-fline "/tmp/engine.c")
# (find-fline "/tmp/x.asm")
# (find-fline "/tmp/x.lst")
# (find-fline "/tmp/crim1.sh")
# print_vars
# doCfilestuff engine0.skel.c -
# doasmfilestuff -
# Local Variables:
# coding: no-conversion
# ee-anchor-format: "«%s»"
# ee-charset-indicator: "Ñ"
# End: