b16.fs 10.6 KB
Newer Older
bp's avatar
bp committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29
\ b16 simulator

\ Instruction set:
\ 1, 5, 5, 5 bits
\     0    1    2    3    4    5    6    7
\  0: nop  call jmp  ;    jz   jnz  jc   jnc
\          exec goto ;    gz   gnz  gc   gnc   for slot 3
\  8: xor  com  and  or   +    +c   *+   /-
\ 10: A!+  A@+  R@+  lit  Ac!+ Ac@+ Rc@+ litc
\     A!   A@   R@   lit  Ac!  Ac@  Rc@  litc  for slot 1
\ 18: nip  drop over dup  >r   >a   r>   a

\ $Log: b16.fs,v $
\ Revision 1.4  2004/05/02 21:40:21  bernd
\ Changes for USB and Cyclone
\
\ Revision 1.3  2003/01/06 20:35:21  bernd
\ Changes to run with Icarus Verilog
\ USB interrupts
\ Added interrupts to the b16 core
\

: 0.r ( n r -- )  0 swap <# 0 ?DO # LOOP #> type ;

\ Variables

Variable Inst
Variable P
Variable A
bp's avatar
bp committed
30 31
0 Value T
0 Value N
bp's avatar
bp committed
32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
Variable c
Variable sp  here &10 cells dup allot erase  2 sp !
Variable rp  here   8 cells dup allot erase
Variable slot  4 slot !
Variable cycles

\ RAM access

$10000 allocate throw Value RAM  RAM $10000 erase
: ramc@ ( addr -- n )  RAM + c@ ;
: ramc! ( n addr -- )  RAM + c! ;
: ram@  ( addr -- n )  dup ramc@ 8 lshift swap 1+ ramc@ or ;
: ram!  ( n addr -- )  over 8 rshift over ramc!  1+ ramc! ;

\ Stack access

bp's avatar
bp committed
48
: 3rd ( -- n )  sp @ 1+ cells sp + @ ;
bp's avatar
bp committed
49
: R ( -- n )  rp @ 1+ cells rp + @ ;
bp's avatar
bp committed
50
: ?sp ( -- )  sp @ 7 and sp ! ;
bp's avatar
bp committed
51
: ?rp ( -- )  rp @ 8 u> abort" Rstack wrap" ;
bp's avatar
bp committed
52 53
: pop ( -- n )  T  N to T  3rd to N  -1 sp +! ?sp ;
: push ( n -- ) 1 sp +! ?sp  N sp @ 1+ cells sp + !  T to N  to T ;
bp's avatar
bp committed
54 55 56 57 58 59 60 61 62
: rpop ( -- n )  R  -1 rp +! ?rp ;
: rpush ( n -- ) 1 rp +! ?rp rp @ 1+ cells rp + ! ;

\ Jumps

Vocabulary b16-sim  also b16-sim definitions also Forth

: nop   ;
: jmp   slot @ 3 = IF  pop P ! EXIT  THEN
bp's avatar
bp committed
63 64 65 66
        1 4 slot @ - 5 * lshift 1- dup Inst @ and
        swap invert P @ 2/ and or 2* P ! 4 slot ! ;
: call  P @ c @ 1 and or rpush jmp ;
: ret   rpop dup 1 and c ! -2 and P ! 4 slot ! ;
bp's avatar
bp committed
67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84
: jz    T 0= IF  jmp  THEN  4 slot ! ;
: jnz   T 0<> IF  jmp  THEN  4 slot ! ;
: jc    c @ IF  jmp  THEN  4 slot ! ;
: jnc   c @ 0= IF  jmp  THEN  4 slot ! ;

\ ALU

: xor  pop pop xor push ;
: com  pop $FFFF xor push ;
: and  pop pop and push ;
: or   pop pop or  push ;
: +rest dup $FFFF and push $10 rshift c ! ;
: add  pop pop +   +rest ;
: addc pop pop + c @ + +rest ;
: *+   pop c @ IF  T +  THEN  dup 2/ push 
  1 and $10 lshift A @ or  dup 1 and c ! 2/ A ! ;
: /-   pop dup T + 1+  dup $10 rshift c @ or dup >r
  IF  nip  ELSE  drop  THEN  $10 lshift A @ or
bp's avatar
bp committed
85
  dup $1F rshift c !  2* r> or  dup $FFFF and A ! $10 rshift push ;
bp's avatar
bp committed
86 87 88 89 90 91 92 93 94 95 96

\ Memory

: A@  A @ ram@ push ;
: A!  pop A @ ram! ;
: R@  R ram@ push ;
: lit P @ ram@ push  2 P +! ;
: Ac@ A @ ramc@ push ;
: Ac! pop A @ ramc! ;
: Rc@ R ramc@ push ;
: litc P @ ramc@ push 1 P +! ;
bp's avatar
bp committed
97 98 99
: A@+ A @ ram@ push 2 A +! ;
: A!+ pop A @ ram! 2 A +! ;
: R@+ R ram@ push rpop 2 + rpush ;
bp's avatar
bp committed
100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124
: Ac@+ Ac@ 1 A +! ;
: Ac!+ Ac! 1 A +! ;
: Rc@+ Rc@ rpop 1 + rpush ;

\ stack

: nip  pop pop drop push ;
: drop pop drop ;
: over pop T swap push push ;
: dup  T push ;
: >r   pop rpush ;
: >a   pop A ! ;
: r>   rpop push ;
: a    A @ push ;

\ toplevel

Forth definitions
: (jmps) ( n1 n2 -- )  and cells r> + @ execute ;
: jmps ( n -- )  dup 1- postpone literal postpone (jmps)
  also b16-sim  0 ?DO  ' ,  LOOP  previous  postpone ; ;
  immediate

: <jmps>  [ 8 ] jmps  nop call jmp ret jz jnz jc jnc
: <ALUs>  [ 8 ] jmps  xor com and or add addc *+ /-
bp's avatar
bp committed
125 126
: <mem+>  1 cycles +! [ 8 ] jmps  A!+ A@+ R@+ lit  Ac!+ Ac@+ Rc@+ litc
: <mem>   1 cycles +! [ 8 ] jmps  A!  A@  R@  lit  Ac!  Ac@  Rc@  litc
bp's avatar
bp committed
127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146
: <stack> [ 8 ] jmps  nip drop over dup >r >a r> a
: <op23> dup 3 rshift [ 4 ] jmps <jmps> <ALUs> <mem+> <stack>
: <op1> dup 3 rshift [ 4 ] jmps <jmps> <ALUs> <mem> <stack>
: <op>  dup slot @ 0> or 0<> negate cycles +!
  1 slot +!  slot @ 2 = IF  <op1>  ELSE  <op23>  THEN ;
Defer <inst>  ' noop IS <inst>
: run  BEGIN  slot @ 4 = IF 
       P @ ram@ Inst ! 2 P +! slot off  THEN  <inst>
       Inst @ 3 slot @ - 5 * rshift <op>  AGAIN ;

\ trace

: .v base @ >r hex 4 0.r space r> base ! ;
Create i0
," nop call"
," nop calljmp ret jz  jnz jc  jnc xor com and or  +   +c  *+  /-  A!  A@  R@  lit Ac@ Ac! Rc@ litcnip dropoverdup >r  >a  r>  a   "
," nop calljmp ret jz  jnz jc  jnc xor com and or  +   +c  *+  /-  A!+ A@+ R@+ lit Ac@+Ac!+Rc@+litcnip dropoverdup >r  >a  r>  a   "
," nop execgotoret gz  gnz gc  gnc xor com and or  +   +c  *+  /-  A!+ A@+ R@+ lit Ac@+Ac!+Rc@+litcnip dropoverdup >r  >a  r>  a   "

: .inst cr P @ .v Inst @ 3 slot @ - 5 * rshift $1F and
bp's avatar
bp committed
147
    i0 slot @ 0 ?DO count + LOOP 1+ swap 2* 2* + 4 type space
bp's avatar
bp committed
148
    T .v N .v A @ .v ;
bp's avatar
bp committed
149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276
' .inst IS <inst>

previous previous

\ Assembler

Vocabulary b16-asm

Variable slot#  slot# off
Variable IP     IP off
Variable bundle bundle off
Variable extra-inc  extra-inc off 0 c, 0 c, 0 c, 0 c, 0 c, 0 c,

: slot, ( -- )  bundle @ IP @ ram!  2 IP +!
    extra-inc @ 0 ?DO
        I cell+ extra-inc + c@ IP @ ramc!  1 IP +!
    LOOP
    slot# off bundle off extra-inc off
    IP @ 1 and abort" odd IP" ;
: slot ( inst -- ) slot# @ 4 = IF slot, THEN 
    dup 1 > slot# @ 0= and IF  1 slot# +!  THEN
    3 slot# @ - 5 * lshift bundle +! 1 slot# +! ;
: slot1 ( inst -- )
    BEGIN  slot# @ 1 <> WHILE  0 slot  REPEAT  slot ;
: slot23 ( inst -- )
    BEGIN  slot# @ 2 and 2 <> WHILE  0 slot  REPEAT  slot ;
: slot3 ( inst -- )
    BEGIN  slot# @ 3 <> WHILE  0 slot  REPEAT  slot ;
: inst ( n -- )  Create ,  DOES> @ slot ;
: inst1 ( n -- )  Create ,  DOES> @ slot1 ;
: inst23 ( n -- )  Create ,  DOES> @ slot23 ;
: inst3 ( n -- )  Create ,  DOES> @ slot3 ;
: insts ( n1 n -- )  bounds ?DO  I inst  LOOP ;
: insts1 ( n1 n -- )  bounds ?DO  I inst1  LOOP ;
: insts23 ( n1 n -- )  bounds ?DO  I inst23  LOOP ;
: insts3 ( n1 n -- )  bounds ?DO  I inst3  LOOP ;

: addrmask ( -- mask ) $7FFF slot# @ 5 * rshift ;
: fit? ( addr -- flag )  2/ addrmask
    IP @ 2/ 1+ over invert and >r over and r> or = ;
: inst, ( -- )  slot# @ 0= ?EXIT
    BEGIN  slot# @ 4 < WHILE  0 slot  REPEAT  slot, ;
: jmp, ( addr inst -- ) over fit? 0= IF inst, THEN
    swap addrmask swap 2/ and bundle +! slot 4 slot# ! ( inst, ) ;
: jmp ( inst -- )  Create , DOES> @ jmp, ;
: jmps ( start n -- ) bounds ?DO  I jmp  LOOP ;

: clit, ( n -- ) extra-inc dup @ cell+ + c! 1 extra-inc +! ;

also B16-asm definitions

$02 1 jmps    jmp
$04 4 jmps    jz   jnz  jc   jnc
$10 8 insts   A!*  A@*  R@*  lit  Ac!* Ac@* Rc@* litc
$10 3 insts1  A!   A@   R@
$14 3 insts1  Ac!  Ac@  Rc@
$10 3 insts23 A!+  A@+  R@+
$14 3 insts23 Ac!+ Ac@+ Rc@+

: F Forth ' execute B16-asm ;
: # ( n -- ) lit \ bl sword s>number drop
    $100 /mod clit, clit, ;
: #c ( n -- ) litc \ bl sword s>number drop
    clit, ;
: c, ( n -- )   IP @ ramc!  1 IP +! ;
: ,  ( c -- )   IP @ ram!   2 IP +! ;
: align ( -- )  inst, IP @ 1 and IP +! ;
: org ( n -- )  inst, IP ! ;
: $, ( addr u -- )
    bounds ?DO
        I c@ c,  LOOP ;
also Forth
: BEGIN  inst, IP @ ;
: fws  slot# @ 1 > IF  inst,  THEN  IP @ $FFC0 2dup and ;
: fw   inst, IP @ $FC00 2dup and ;
b16-asm
: AHEAD  fw jmp ;
: sAHEAD  fws jmp ;
: AGAIN ( addr -- )  jmp ;
: UNTIL ( addr -- )  jz ;
: -UNTIL ( addr -- )  jnz ;
: cUNTIL ( addr -- )  jnc ;
: -cUNTIL ( addr -- )  jc ;
: IF   fw jz ;
: -IF  fw jnz ;
: -cIF fw jc ;
: cIF  fw jnc ;
: WHILE   >r fw jz r> ;
: -WHILE  >r fw jnz r> ;
: -cWHILE >r fw jc r> ;
: cWHILE  >r fw jnc r> ;
: sIF   fws jz ;
: -sIF  fws jnz ;
: -csIF fws jc ;
: csIF  fws jnc ;
Forth
: THEN ( addr mask -- ) inst,
    swap >r r@ ram@ over and swap invert IP @ 2/ and or r> ram! ;
b16-asm
: ELSE  AHEAD  2swap  THEN ;
: sELSE  sAHEAD  2swap  THEN ;
Forth
0 Value fd
: new-fd ( addr u -- ) r/w create-file throw to fd ;
: .mif-head ( addr u -- ) new-fd
    s" WIDTH = 8;" fd write-line throw
    s" DEPTH = 1024;" fd write-line throw
    s" ADDRESS_RADIX = HEX;" fd write-line throw
    s" DATA_RADIX = HEX;" fd write-line throw
    s" CONTENT BEGIN" fd write-line throw ;
: .mif-tail ( -- )  s" END;" fd write-line throw
    fd close-file throw ;
: .mif-dump ( val addr -- ) s"         " fd write-file throw
    0 <# #S #> fd write-file throw s"  : " fd write-file throw
    0 <# # # #> fd write-file throw s" ;" fd write-line throw ;
: .mif ( -- )  hex inst,
    s" bootramh.mif" .mif-head
    $800 0 ?DO I ramc@ I 2/ .mif-dump 2 +LOOP .mif-tail
    s" bootraml.mif" .mif-head
    $800 0 ?DO I 1+ ramc@ I 2/ .mif-dump 2 +LOOP .mif-tail ;
: .hex ( -- ) hex
    s" b16.hex" new-fd
    IP @ 0 ?DO
	I 2/ 0 <# I ram@ 0 # # # # 2drop bl hold # # # # '@ hold #>
	fd write-line throw 2 +LOOP fd close-file throw ;
: .end inst, ;
: macro: : ;
: end-macro postpone ; ; immediate
bp's avatar
bp committed
277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305

\ label handling
: :-does DOES> @ inst, 1 jmp, ;
: |-does DOES> @ ;
: label-resolve ( addr -- )
    cell+ @  BEGIN
	dup -1 <> WHILE
	    dup >r @ $FC00 [ b16-asm ] THEN [ Forth ] r> cell+ @
    REPEAT  drop ;

: ?Create >in @ >r name find  IF
	rdrop  lastcfa !  inst,
	IP @ lastcfa @ >body !
	lastcfa @ >body label-resolve
	lastcfa @ >body cell+ off
    ELSE  drop r> >in ! Create inst, IP @ , 0 ,  THEN ;

: : ?Create  :-does ;
: | ?Create  |-does ;
: ' ( "name" -- addr )
    >in @ >r name find
    IF  >body dup @ swap cell+
	dup @ IF  here IP @ , over @ , swap !
	    IP @ $FC00 and
	ELSE  drop  THEN  rdrop
    ELSE
	drop r> >in !
	Create 0 , here cell+ , IP @ $FC00 and dup , -1 , |-does
    THEN ;
bp's avatar
bp committed
306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333

$00 inst nop
$01 2 insts3 exec goto
$03 inst ret
$08 8 insts xor  com   and  or   +    +c   *+   /-
$18 8 insts nip  drop  over dup  >r   >a   r>   a

macro: ;
  slot# @ 4 = bundle @ $8000 and and
  IF  slot# off  bundle @ $7FFF and 2* bundle off 2 jmp,
  ELSE  ret  THEN end-macro

macro: !  >a a!* end-macro
macro: @  >a a@* end-macro
macro: c! >a ac!* end-macro
macro: c@ >a ac@* end-macro

macro: org inst, IP ! end-macro
  
previous previous definitions

\ communication program

include serial.fs

dos also

0 value b16
bp's avatar
bp committed
334
: init ( -- )  s" /dev/ttyS0" r/w bin open-file throw to b16
bp's avatar
bp committed
335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361
    B115200 b16 filehandle @ set-baud ;

: ?in ( -- )  pad b16 check-read b16 read-file throw pad swap type ;
: ?flush ( -- )  pad $100 + b16 check-read b16 read-file throw drop ;

: program ( addr u addr -- ) ?flush
    <# over hold $100 /mod swap hold hold '0 hold 0. #>
    b16 write-file throw b16 write-file throw ?flush ;

: check ( addr u -- ) ?flush swap
    <# over hold $100 /mod swap hold hold '1 hold 0. #>
    b16 write-file throw
    pad $F + -$10 and swap 2dup bounds ?DO
	I I' over - b16 read-file throw
    +LOOP  dump  ?flush ;

: exec ( addr -- ) ?flush
    <# $100 /mod swap hold hold '2 hold 0. #>
    b16 write-file throw ?in ;

b16-asm also Forth

: prog ( >defs -- )  also b16-asm interpret previous inst, ;
: comp ( >defs -- )
    IP @ >r prog r@ RAM + IP @ r@ - r> program ;
: eval ( >defs -- )
    IP @ >r comp r@ exec r> org &20 wait ?in ;
bp's avatar
bp committed
362 363
: sim  ( >defs -- )  rp off
    IP @ >r prog r@ P ! ['] run catch r> org throw ;
bp's avatar
bp committed
364 365 366 367 368 369 370

: asm-load ( -- )  b16-asm definitions include forth definitions ;

previous Forth

previous

bp's avatar
bp committed
371
\ init
bp's avatar
bp committed
372 373
\ asm-load boot.asm