149 lines
4.4 KiB
Mathematica
149 lines
4.4 KiB
Mathematica
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; ;
|
|
; Copyright 2001, 2007 Fidelity Information Services, Inc ;
|
|
; ;
|
|
; This source code contains the intellectual property ;
|
|
; of its copyright holder(s), and is made available ;
|
|
; under a license. If you do not know the terms of ;
|
|
; the license, please stop and do not read further. ;
|
|
; ;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
tttscan ;parse ttt.txt
|
|
n (work,infile,opc,opx,vxi,vxx,ttt,opcdcnt)
|
|
k work,ttt
|
|
s ttt=opcdcnt
|
|
s eof=0,eofcd=$c(26),eol=$c(13)
|
|
s linnum=0,instr="",ptr=1,dir="" d scan,scan
|
|
d proc
|
|
c infile
|
|
q
|
|
proc d block q:tok=eofcd
|
|
g proc:'z
|
|
proc1 i tok'?1"OC_"1.AN q:tok=eofcd d scan g proc1
|
|
g proc
|
|
block i tok=eol d scan g block
|
|
d head q:z
|
|
s work(indx)=ttt
|
|
d body i z s em="invalid template body" d err
|
|
s ttt(ttt)="VXT_END",ttt=ttt+1
|
|
q
|
|
head i tok'?1"OC_"1.AN.1"_".AN s z=1,em="invalid opcode name" d err,scan q
|
|
i '$d(opc(tok)) s em="triple op code not defined in opcode.h",z=1 d err,scan q
|
|
s indx=opc(tok)
|
|
s opcode=tok,case=""
|
|
d scan
|
|
i tok=":" d scan s z=0 q
|
|
i tok'="-" s em="dash or colon expected here" d err s z=1 q
|
|
d scan
|
|
i tok="BYTE" s indx=indx+.1
|
|
e i tok="WORD" s indx=indx+.2
|
|
e i tok="LONG" s indx=indx+.3
|
|
e i tok="MVAL" s indx=indx+.1
|
|
e i tok="MSTR" s indx=indx+.2
|
|
e i tok="MFLT" s indx=indx+.3
|
|
e i tok="MINT" s indx=indx+.4
|
|
e i tok="BOOL" s indx=indx+.5
|
|
e i tok="MVADDR" s indx=indx+.6
|
|
e s em="byte, word or long expected here" s z=1 d err q
|
|
d scan
|
|
i tok'=":" s em="colon expected here" d err s z=1 q
|
|
d scan
|
|
s z=0
|
|
q
|
|
body i dir=":"!((dir="-")&(tok?1"OC_"1.AN)) s z=0 q
|
|
i $d(vxi(tok)) s ttt(ttt)=vxi(tok,1),ttt=ttt+1
|
|
e i tok="irepab" s ttt(ttt)="VXT_IREPAB",ttt=ttt+1
|
|
e i tok="irepl" s ttt(ttt)="VXT_IREPL",ttt=ttt+1
|
|
e i $c(26)=tok&(tok=dir) s z=0 q
|
|
e s em="vax opcode not defined" d err s z=1 q
|
|
d scan
|
|
bod1 d arg i tok="," d scan g bod1
|
|
i tok=eol!(tok=eofcd) d scan g body
|
|
s em="comma or end of line expected" d err s z=1
|
|
q
|
|
arg i tok="val" s x="VAL" g argval
|
|
i tok="addr" s x="ADDR" g argval
|
|
i tok="vnum" s x="VNUM" g argval
|
|
i tok="jmp" s x="JMP" g argval
|
|
i tok="#" g arglit
|
|
i tok="xfer" g argxfer
|
|
i tok="G",dir="^" d scan,scan s x="GREF" g argval
|
|
i tok'="@" s gotat=0
|
|
e s gotat=1 d scan
|
|
s displ=""
|
|
i tok="(" g argpara
|
|
i tok="-" g argpush
|
|
i dir="(" s displ=tok d scan g argpara
|
|
d argreg i z q
|
|
i gotat s mode=6
|
|
e s mode=5
|
|
d argstsh
|
|
s z=0
|
|
q
|
|
argval d scan i tok'="." s em="period (.) expected" d err s z=1 q
|
|
s ttt(ttt)="VXT_"_x,ttt=ttt+1 d scan s ttt(ttt)=tok,ttt=ttt+1
|
|
d scan
|
|
s z=0
|
|
q
|
|
arglit s ttt(ttt)="VXT_LIT",ttt=ttt+1 d scan s ttt(ttt)=tok,ttt=ttt+1
|
|
d scan
|
|
s z=0
|
|
q
|
|
argxfer d scan i tok'="." s em="period (.) expected" d err s z=1 q
|
|
s ttt(ttt)="VXT_XFER",ttt=ttt+1 d scan s ttt(ttt)="SIZEOF(char *) * (short int)"_tok,ttt=ttt+1
|
|
d scan
|
|
s z=0
|
|
q
|
|
argpara d scan,argreg i z s em="register expected" d err q
|
|
i tok'=")" s em="right paranthesis expected" d err s z=1 q
|
|
d scan
|
|
i tok'="+" s mode=$s(gotat:11,1:6)
|
|
e d scan s mode=$s(gotat:9,1:8)
|
|
i displ'="" s mode=$s(mode=6:10,1:11)
|
|
i mode=11,displ="" s displ=0
|
|
d argstsh
|
|
i displ'="" s ttt(ttt)="VXT_DISP",ttt=ttt+1,ttt(ttt)=displ,ttt=ttt+1
|
|
s z=0
|
|
q
|
|
argpush d scan i tok'="(" s em="left paranthesis expected" d err s z=1 q
|
|
i gotat s em="illegal addressing mode" d err s z=1 q
|
|
d scan,argreg i z s em="register expected" d err s z=1 q
|
|
i tok'=")" s em="right paranthesis expected" d err s z=1 q
|
|
d scan
|
|
s mode=7
|
|
d argstsh
|
|
s z=0
|
|
q
|
|
argreg n x
|
|
i tok?1"r"1.2n s x=+$e(tok,2,3) g argreg1:x<16 s z=1 q
|
|
i tok="pc" s x=15
|
|
e i tok="sp" s x=14
|
|
e i tok="fp" s x=13
|
|
e i tok="ap" s x=12
|
|
e s z=1 q
|
|
argreg1 d scan s z=0,regnum=x
|
|
q
|
|
argstsh s ttt(ttt)="VXT_REG",ttt=ttt+1
|
|
s ttt(ttt)="0x"_$s(mode>9:$c(mode+55),1:mode)_$s(regnum>9:$c(regnum+55),1:regnum)
|
|
s ttt=ttt+1
|
|
q
|
|
err i erflag q
|
|
u "" w "%TTTGEN-F ",em," at line ",oldlin," character ",oldptr,!
|
|
s erflag=1
|
|
q
|
|
scan i eof g sceof
|
|
s oldlin=linnum,oldptr=ptr
|
|
i $e(instr,ptr)'="" g sc1
|
|
u infile r instr g sceof:$zeof s erflag=0,linnum=linnum+1,ptr=1,t=eol u "" w $j(linnum,6)," ",instr,! g scfin
|
|
sc1 i $c(9)_" "[$e(instr,ptr) s ptr=ptr+1 g scan
|
|
i $e(instr,ptr)?1P s t=$e(instr,ptr),ptr=ptr+1 g scfin:t'=";" s ptr=9999 g scan
|
|
i $e(instr,ptr)'?1AN&($e(instr,ptr)'="_")&($e(instr,ptr)'="$") g scerr
|
|
n x s x=ptr f ptr=ptr+1:1 q:$e(instr,ptr)'?1AN&($e(instr,ptr)'="_")&($e(instr,ptr)'="$")
|
|
s t=$e(instr,x,ptr-1)
|
|
scfin s tok=dir,dir=t
|
|
q
|
|
scerr b
|
|
q
|
|
sceof s eof=1,t=eofcd
|
|
g scfin
|