\ bernd thallner 9725890 881 \ assembler in forth for alpha \ require ../../code.fs get-current also assembler definitions \ register \$0 constant v0 \$1 constant t0 \$2 constant t1 \$3 constant t2 \$4 constant t3 \$5 constant t4 \$6 constant t5 \$7 constant t6 \$8 constant t7 \$9 constant s0 \$a constant s1 \$b constant s2 \$c constant s3 \$d constant s4 \$e constant s5 \$f constant fp \ commented out to avoid shadowing hex numbers \ \$10 constant a0 \ \$11 constant a1 \ \$12 constant a2 \ \$13 constant a3 \ \$14 constant a4 \ \$15 constant a5 \$16 constant t8 \$17 constant t9 \$18 constant t10 \$19 constant t11 \$1a constant ra \$1b constant t12 \$1c constant at \$1d constant gp \$1e constant sp \$1f constant zero \ util : h@ ( addr -- n ) \ 32 bit fetch dup dup aligned = if @ \$00000000ffffffff and else 4 - @ \$20 rshift endif ; : h! ( n addr -- ) \ 32 bit store dup dup aligned = if dup @ \$ffffffff00000000 and rot or swap ! else 4 - dup @ \$00000000ffffffff and rot \$20 lshift or swap ! endif ; : h, ( h -- ) \ 32 bit store + allot here here aligned = if here ! else 32 lshift here 4 - dup @ rot or swap ! endif 4 allot ; \ operands : check-range ( u1 u2 u3 -- ) within 0= -24 and throw ; : rega ( rega code -- code ) \ ra field, named rega to avoid conflict with register ra swap dup 0 \$20 check-range 21 lshift or ; : rb ( rb code -- code ) swap dup 0 \$20 check-range 16 lshift or ; : rc ( rc code -- code ) swap dup 0 \$20 check-range or ; : hint ( addr code -- code ) swap 2 rshift \$3fff and or ; : disp ( n code -- code ) swap dup -\$8000 \$8000 check-range \$ffff and or ; : branch-disp ( addr code -- code ) swap here 4 + - dup 3 and 0<> -24 and throw dup -\$100000 \$100000 check-range \$1fffff and or ; : imm ( u code -- code ) swap dup 0 \$100 check-range 13 lshift or ; : palcode ( u code -- code ) swap dup 0 \$4000000 check-range or ; \ formats : Bra ( opcode -- ) \ branch instruction format create 26 lshift , does> ( rega target-addr -- ) @ branch-disp rega h, ; : Mbr ( opcode hint -- ) \ memory branch instruction format create 14 lshift swap 26 lshift or , does> ( rega rb hint -- ) @ hint rb rega h, ; : F-P ( opcode func -- ) \ floating-point operate instruction format create 5 lshift swap 26 lshift or , does> ( fa fb fc -- ) @ rc rb rega h, ; : Mem ( opcode -- ) \ memory instruction format create 26 lshift , does> ( rega memory_disp rb -- ) @ rb disp rega h, ; : Mfc ( opcode func -- ) \ memory instruction with function code format create swap 26 lshift or , does> ( rega rb -- ) @ rb rega h, ; : Opr ( opcode.ff ) \ operate instruction format create 5 lshift swap 26 lshift or , does> ( rega rb rc -- ) @ rc rb rega h, ; : Opr# ( opcode func -- ) \ operate instruction format create 5 lshift swap 26 lshift or 1 12 lshift or , does> ( rega imm rc -- ) @ rc imm rega h, ; : Pcd ( opcode -- ) \ palcode instruction format create 26 lshift , does> ( palcode addr -- ) @ palcode h, ; \ instructions \$15 \$80 F-P addf, \$15 \$a0 F-P addg, \$10 \$00 Opr addl, \$10 \$00 Opr# addl#, \$10 \$40 Opr addlv, \$10 \$40 Opr# addlv#, \$10 \$20 Opr addq, \$10 \$20 Opr# addq#, \$10 \$60 Opr addqv, \$10 \$60 Opr# addqv#, \$16 \$80 F-P adds, \$16 \$a0 F-P addt, \$11 \$00 Opr and, \$11 \$00 Opr# and#, \$39 Bra beq, \$3e Bra bge, \$3f Bra bgt, \$11 \$08 Opr bic, \$11 \$08 Opr# bic#, \$11 \$20 Opr bis, \$11 \$20 Opr# bis#, \$38 Bra blbc, \$3c Bra blbs, \$3b Bra ble, \$3a Bra blt, \$3d Bra bne, \$30 Bra br, \$34 Bra bsr, \$00 Pcd call_pal, \$11 \$24 Opr cmoveq, \$11 \$24 Opr# cmoveq#, \$11 \$46 Opr cmovge, \$11 \$46 Opr# cmovge#, \$11 \$66 Opr cmovgt, \$11 \$66 Opr# cmovgt#, \$11 \$16 Opr cmovlbc, \$11 \$16 Opr# cmovlbc#, \$11 \$14 Opr cmovlbs, \$11 \$14 Opr# cmovlbs#, \$11 \$64 Opr cmovle, \$11 \$64 Opr# cmovle#, \$11 \$44 Opr cmovlt, \$11 \$44 Opr# cmovlt#, \$11 \$26 Opr cmovne, \$11 \$26 Opr# cmovne#, \$10 \$0f Opr cmpbge, \$10 \$0f Opr# cmpbge#, \$10 \$2d Opr cmpeq, \$10 \$2d Opr# cmpeq#, \$15 \$a5 F-P cmpgeq, \$15 \$a7 F-P cmpgle, \$15 \$a6 F-P cmpglt, \$10 \$6d Opr cmple, \$10 \$6d Opr# cmple#, \$10 \$4d Opr cmplt, \$10 \$4d Opr# cmplt#, \$16 \$a5 F-P cmpteq, \$16 \$a7 F-P cmptle, \$16 \$a6 F-P cmptlt, \$16 \$a4 F-P cmptun, \$10 \$3d Opr cmpule, \$10 \$3d Opr# cmpule#, \$10 \$1d Opr cmpult, \$10 \$1d Opr# cmpult#, \$17 \$20 F-P cpys, \$17 \$22 F-P cpyse, \$17 \$21 F-P cpysn, \$15 \$9e F-P cvtdg, \$15 \$ad F-P cvtgd, \$15 \$ac F-P cvtgf, \$15 \$af F-P cvtgq, \$17 \$10 F-P cvtlq, \$15 \$bc F-P cvtqf, \$15 \$be F-P cvtqg, \$17 \$30 F-P cvtql, \$17 \$530 F-P cvtqlsv, \$17 \$130 F-P cvtqlv, \$16 \$bc F-P cvtqs, \$16 \$be F-P cvtqt, \$16 \$2ac F-P cvtst, \$16 \$af F-P cvttq, \$16 \$ac F-P cvtts, \$15 \$83 F-P divf, \$15 \$a3 F-P divg, \$16 \$83 F-P divs, \$16 \$a3 F-P divt, \$11 \$48 Opr eqv, \$11 \$48 Opr# eqv#, \$18 \$400 Mfc excb, \$12 \$06 Opr extbl, \$12 \$06 Opr# extbl#, \$12 \$6a Opr extlh, \$12 \$6a Opr# extlh#, \$12 \$26 Opr extll, \$12 \$26 Opr# extll#, \$12 \$7a Opr extqh, \$12 \$7a Opr# extqh#, \$12 \$36 Opr extql, \$12 \$36 Opr# extql#, \$12 \$5a Opr extwh, \$12 \$5a Opr# extwh#, \$12 \$16 Opr extwl, \$12 \$16 Opr# extwl#, \$31 Bra fbeq, \$36 Bra fbge, \$37 Bra fbgt, \$33 Bra fble, \$32 Bra fblt, \$35 Bra fbne, \$17 \$2a F-P fcmoveq, \$17 \$2d F-P fcmovge, \$17 \$2f F-P fcmovgt, \$17 \$2e F-P fcmovle, \$17 \$2c F-P fcmovlt, \$17 \$2b F-P fcmovne, \$18 \$8000 Mfc fetch, \$18 \$a000 Mfc fetch_m, \$12 \$0b Opr insbl, \$12 \$0b Opr# insbl#, \$12 \$67 Opr inslh, \$12 \$67 Opr# inslh#, \$12 \$2b Opr insll, \$12 \$2b Opr# insll#, \$12 \$77 Opr insqh, \$12 \$77 Opr# insqh#, \$12 \$3b Opr insql, \$12 \$3b Opr# insql#, \$12 \$57 Opr inswh, \$12 \$57 Opr# inswh#, \$12 \$1b Opr inswl, \$12 \$1b Opr# inswl#, \$1a \$00 Mbr jmp, \$1a \$01 Mbr jsr, \$1a \$03 Mbr jsr_coroutine, \$08 Mem lda, \$09 Mem ldah, \$20 Mem ldf, \$21 Mem ldg, \$28 Mem ldl, \$2a Mem ldl_l, \$29 Mem ldq, \$2b Mem ldq_l, \$0b Mem ldq_u, \$22 Mem lds, \$23 Mem ldt, \$18 \$4000 Mfc mb, \$17 \$25 F-P mf_fpcr, \$12 \$02 Opr mskbl, \$12 \$02 Opr# mskbl#, \$12 \$62 Opr msklh, \$12 \$62 Opr# msklh#, \$12 \$22 Opr mskll, \$12 \$22 Opr# mskll#, \$12 \$72 Opr mskqh, \$12 \$72 Opr# mskqh#, \$12 \$32 Opr mskql, \$12 \$32 Opr# mskql#, \$12 \$52 Opr mskwh, \$12 \$52 Opr# mskwh#, \$12 \$12 Opr mskwl, \$12 \$12 Opr# mskwl#, \$17 \$24 F-P mt_fpcr, \$15 \$82 F-P mulf, \$15 \$a2 F-P mulg, \$13 \$00 Opr mull, \$13 \$00 Opr# mull#, \$13 \$40 Opr mullv, \$13 \$40 Opr# mullv#, \$13 \$20 Opr mullq, \$13 \$20 Opr# mullq#, \$13 \$60 Opr mullqv, \$13 \$60 Opr# mullqv#, \$16 \$82 F-P mulls, \$16 \$a2 F-P mullt, \$11 \$28 Opr ornot, \$11 \$28 Opr# ornot#, \$18 \$e000 Mfc rc, \$1a \$02 Mbr ret, \$18 \$c000 Mfc rpcc, \$18 \$f000 Mfc rs, \$10 \$02 Opr s4addl, \$10 \$02 Opr# s4addl#, \$10 \$22 Opr s4addq, \$10 \$22 Opr# s4addq#, \$10 \$0b Opr s4subl, \$10 \$0b Opr# s4subl#, \$10 \$2b Opr s4subq, \$10 \$2b Opr# s4subq#, \$10 \$12 Opr s8addl, \$10 \$12 Opr# s8addl#, \$10 \$32 Opr s8addq, \$10 \$32 Opr# s8addq#, \$10 \$1b Opr s8ubl, \$10 \$1b Opr# s8ubl#, \$10 \$3b Opr s8ubq, \$10 \$3b Opr# s8ubq#, \$12 \$39 Opr sll, \$12 \$39 Opr# sll#, \$12 \$3c Opr sra, \$12 \$3c Opr# sra#, \$12 \$34 Opr srl, \$12 \$34 Opr# srl#, \$24 Mem stf, \$25 Mem stg, \$26 Mem sts, \$2c Mem stl, \$2e Mem stl_c, \$2d Mem stq, \$2f Mem stq_c, \$0f Mem stq_u, \$27 Mem stt, \$15 \$81 F-P subf, \$15 \$a1 F-P subg, \$10 \$09 Opr subl, \$10 \$09 Opr# subl#, \$10 \$49 Opr sublv, \$10 \$49 Opr# sublv#, \$10 \$29 Opr subq, \$10 \$29 Opr# subq#, \$10 \$69 Opr subqv, \$10 \$69 Opr# subqv#, \$16 \$81 F-P subs, \$16 \$a1 F-P subt, \$18 \$00 Mfc trapb, \$13 \$30 Opr umulh, \$13 \$30 Opr# umulh#, \$18 \$4400 Mfc wmb, \$11 \$40 Opr xor, \$11 \$40 Opr# xor#, \$12 \$30 Opr zap, \$12 \$30 Opr# zap#, \$12 \$31 Opr zapnot, \$12 \$31 Opr# zapnot#, \ conditions ' beq, constant ne ' bge, constant lt ' bgt, constant le ' blbc, constant lbs ' blbs, constant lbc ' ble, constant gt ' blt, constant ge ' bne, constant eq ' fbeq, constant fne ' fbge, constant flt ' fbgt, constant fle ' fble, constant fgt ' fblt, constant fge ' fbne, constant feq \ control structures \ if, [ else, ] endif, \ : magic-asm ( u1 u2 -- u3 u4 ) \ \ turns a magic number into an asm-magic number or back \ \$fedcba0987654321 xor ; \ : patch-branch ( branch-delay-addr target-addr -- ) \ \ there is a branch just before branch-delay-addr; PATCH-BRANCH \ \ patches this branch to branch to target-addr \ over - ( branch-delay-addr rel ) \ swap cell - dup >r ( rel branch-addr R:branch-addr ) \ @ asm-rel r> ! ; \ !! relies on the imm field being 0 before : ahead, ( -- asmorig ) 31 0 br, here 4 - ; : if, ( -- asmorig ) 0 beq, here 4 - ; : endif, ( asmorig -- ) dup here swap - 4 - 4 / \$1fffff and over h@ or swap h! ; : else, ( asmorig1 -- asmorig2 ) ahead, swap endif, ; \ begin, ``` again, : begin, ( -- asmdest ) here ; : again, ( asmdest -- ) here - 4 - 4 / \$1fffff and 31 swap br, ; \ begin, until, : until, ( asmdest -- ) here rot swap - 4 - 4 / \$1fffff and bne, ; \ begin, while, repeat, : while, ( asmdest -- asmorig asmdest ) if, swap ; : repeat, ( asmorig asmdest -- ) again, endif, ; \ \ jump marks \ \ example: \ \ init_marktbl \ initializes mark table \ \ 31 0 br, \ \ 0 store_branch \ store jump address for mark 0 \ \ 1 2 3 addf, \ \ 0 set_mark \ store mark 0 \ \ 2 3 4 addf, \ \ 2 0 beq, \ \ 0 store_branch \ store jump address for mark 0 \ \ calculate_marks \ calculate all jumps \ \ with calculate_branch you can calculate the \ \ displacement field without the mark_table for one branch \ \ example: \ \ here 31 0 br, \ \ here 1 2 3 addf, \ \ calculate_branch \ 5 constant mark_numbers \ 5 constant mark_uses \ create mark_table \ mark_numbers mark_uses 1+ * cells allot \ : init_marktbl ( -- ) \ initializes mark table \ mark_table mark_numbers mark_uses 1+ * cells + \ mark_table \ begin \ over over > \ while \ dup 0 swap ! \ 1 cells + \ repeat \ drop drop \ ; \ : set_mark ( mark_number -- ) \ sets mark, store address in mark table \ dup mark_numbers >= abort" error, illegal mark number" \ mark_uses 1+ * cells \ mark_table + here 8 - swap ! \ ; \ : store_branch ( mark_number -- ) \ stores address of branch in mark table \ dup mark_numbers >= abort" error, illegal mark number" \ mark_uses 1+ * cells \ mark_table + 1 cells + \ dup mark_uses cells + swap \ begin \ over over > over @ and \ while \ 1 cells + \ repeat \ swap over = abort" error, not enough space in mark_table, increase mark_uses" \ here 4 - swap ! \ ; \ : calculate_branch ( mark_addr branch_addr -- ) \ calculate branch displacement field for one branch \ swap over - 4 + 4 / \ \$1fffff and \ over h@ or swap h! \ ; \ : calculate_mark ( tb mark_address -- tb ) \ calculates branch displacement field for one mark \ over 1 cells + \ dup mark_uses cells + swap \ begin \ over over > \ while \ 2over swap drop ( ei i markaddr ej j markaddr ) \ over @ \ dup if \ calculate_branch \ else \ drop drop \ endif \ 1 cells + \ repeat drop drop drop \ ; \ : calculate_marks ( -- ) \ calculates branch displacement field for all marks \ mark_table mark_numbers 1- mark_uses 1+ * cells + \ mark_table \ begin \ over over >= \ while \ dup @ \ dup if \ used mark \ calculate_mark \ else \ drop \ endif \ mark_uses 1+ cells + \ repeat \ drop drop \ ; previous set-current ```