! 30/12/87 - Set lengths for MOVLF in oplr winstr8.i ! Release 1.0 10/11/87 Add bit operations winstr7 ! Field Trial 6 Correct complex*16 winstr6.i ! Correct Compress for neg bytes (ADJSP) ! Field trial 5 MOVif to reduce RHS if litval winstr5.i ! fix plant 16 bit imm. opd ! Field Trial 3 ! R6 not used. Ie left for optimiser Breg winstr4.i ! ! Field Trial 2 winstr3.i ! Setuse no longer fails registers owned by temp estack records. ! ! Field Trial 1 winstr2.i %constinteger imp = 1 %constinteger FORTRAN = 2 %constinteger CCOMP = 11 %constinteger PASCAL = 14 %include "itrimp_hostcodes" %constinteger host=IBMXA %constinteger target=vax %constinteger wordad=0 %externalstring(*) %fnspec ITOS %alias "S#ITOS"(%integer i) %externalstring(*) %fnspec htos %alias "S#HTOS"(%integer i,size) %externalroutinespec phex %alias "S#PHEX"(%integer n) %recordformat Stkfmt(%byte Form,Size,Reg,Modreg, Base,Modbase,Scale,Modform, (((%integer Offset %or %integer Intval %or %real rval), (%integer Modoffset %or %integer Modintval)) %orc %longreal lrval)) !*********************************************************************** !* Imports !*********************************************************************** %include "ercc07:vaxspecs" %include "ebits_ecodes28" %include "ercs04:mnems" %include "ercc07:vaxopcodes" %inc!lude "ercs04:forms" %extrinsicinteger decode,report,language %extrinsicinteger Elevel %extrinsicrecord(Stkfmt)%array Stk(0:15) %extrinsicintegerarray Ruse(0:7) %extrinsicintegerarray Rmem(0:7) %extrinsicintegerarray Fruse(0:7) %extrinsicintegerarray FRmem(0:7) %extrinsicintegerarray FRCorrupt(4:7) %extrinsicinteger CC, CCset ,CA, PREV %extrinsicinteger Addrstackca, Addrglaca %extrinsicrecord(Stkfmt) Zero,One,TOS,Fhalf,FLhalf !*********************************************************************** !* Common declarations !*********************************************************************** %constinteger LitVal = 0, { lit} ConstVal = 1, { const} RegVal = 2, { (reg)} FregVal = 3, { (freg)} TempVal = 4, { (temp)} DirVal = 5, { (dir)} IndRegVal = 6, { ((reg))} IndTempVal = 7, { ((temp))} IndDirVal = 8, { ((dir))} AddrConst = 9, { @const} AddrDir = 10, { @dir} RegAddr = 11, { (reg) is @} TempAddr = 12, { (temp) is @} DirAddr = 13, { (dir) is @} AddrDirMod = 14, { @dir+M} RegModAddr = 15, { (reg)+M} TempModAddr = 16, { (temp)+M} DirModAddr = 17, { (dir)+M} IndRegModVal = 18, { ((reg)+M)} IndTempModVal = 19, { ((temp)+M)} IndDirModVal = 20, { ((dir)+M)} AddrDirModVal = 21 { (@dir+M)} %constinteger Regflag= 32 {used to speedup search for reguse} !*********************************************************************** !* Nat Semi specific declerations !*********************************************************************** %constinteger TopofStack=31 { pseudo forms } %constinteger AbsAd = 30 %constinteger StackFront = 29 %constinteger FLitVal = 28 %constinteger Regvar = 27 %constinteger R0 = 0, { General registers } R1 = 1, R2 = 2, R3 = 3, R4 = 4, R5 = 5, R6 = 6, R7 = 7 %constinteger Resultreg = R0, FirstExprReg = R1, LastExprReg = R5 %constinteger FR0 = 0, { Floating point registers } FR1 = 1, FR2 = 2, FR3 = 3, FR4 = 4, FR5 = 5, FR6 = 6, FR7 = 7 %constbyteintegerarray InvCC(0:5)= {GT} 6, {LT} 12, {EQ} 0, {NE} 1, {GE} 13, {LE} 7 %constbyteintegerarray SetCC(0:5)= {LT} 12, {GT} 6, {EQ} 0, {NE} 1, {LE} 7, {GE} 13 %constbyteintegerarray UInvCC(0:5)= {HI} 4, {LO} 10, {EQ} 0, {NE} 1, {HS} 11, {LS} 5 %constbyteintegerarray USetCC(0:5)= {LO} 10, {HI} 4, {EQ} 0, {NE} 1, {LS} 5, {HS} 11 %constinteger Stack Offset=0 %constinteger Param Offset=4 %constinteger TWO31 = 8 %constinteger TWO32 = 16 %constinteger TWO31R= 24 %constinteger ShortRangeID=x'8FFFFFFF'{Hopefully unique - ensures 1 byte opd } !***** NAT SEMI ADDRESSING MODES ******* !* ( after page 4-16 of manual %constinteger REGISTER = B'00000', { 0 -> 7 registers } REGREL = B'01000', { 8 -> 15 disp(reg) } FrameRel = B'10000', { 16 = disp2(disp1(FP)) } StackRel = B'10001', { 17 = disp2(disp1(SP)) } StaticRel = B'10010', { 18 = disp2(disp1(SB)) } Immediate = B'10100', { 20 = value } Absolute = B'10101', { 21 = @disp } External = B'10110', { 22 = EXT(disp1) + disp2 } TOSmode = B'10111', { 23 = Top of stack } Frame = B'11000', { 24 = disp(FP) } StackMode = B'11001', { 25 = disp(SP) } StaticMode = B'11010', { 26 = disp(SB) } Program = B'11011', { 27 = PC + disp } ByteIndexed = B'11100', { 28 = Basemode[Rn:B] } WordIndexed = B'11101', { 29 = Basemode[Rn:W] } DoubleIndexed = B'11110', { 30 = Basemode[Rn:D] } QuadIndexed = B'11111' { 31 = Basemode[Rn:Q] } !*********************************************************************** %recordformat genfm(%integer mode,index,reg,disp2,base,((%integer disp1 %or %real rval,%integer disp3) %or %longreal lrval)) %owninteger Lastreg, Lastfreg %externalroutinespec Efix(%integer area,tgt,tgtare,tgtdisp) %externalroutinespec ED4(%integer area,disp,val) %externalroutinespec spcall(%integer i) %externalroutinespec Low Estack(%integer Opcode,Reqlevel) %externalintegerfnspec ETEMPWORKSPACE(%integer bytes) %externalroutinespec eop(%integer i) %externalroutinespec Estklit(%integer i) !*********************************************************************** !* Code generation procedure specs !*********************************************************************** %routinespec Refer(%record(Stkfmt)%name Stk,%integer Offset) %routinespec Address(%record(Stkfmt)%name Stk) %integerfnspec Load Int(%integer op,%record(Stkfmt)%name Stk, %integer Reg) %integerfnspec Load Real(%integer op,%record(Stkfmt)%name Stk,%integer Reg,l) %routinespec Stackr(%integer R) %routinespec Stackfr(%integer FR,Bytes) %routinespec Establish Logical %routinespec Int Binary Op(%integer Op) %routinespec Int Unary Op(%integer Op,%record(Stkfmt)%name RHS) %routinespec Real Binary Op(%integer Op) %routinespec Real Unary Op(%integer Op,%record(Stkfmt)%name RHS) %routinespec Convert RR(%integer mode,%record(Stkfmt)%name Stk,%integer Bytes) %routinespec Convert IR(%record(Stkfmt)%name Stk,%integer Bytes) %routinespec Convert II(%record(Stkfmt)%name Stk,%integer Bytes) %routinespec CoerceInt(%record(Stkfmt)%name Stk,%integer Bytes) %routinespec Convert RI(%record(Stkfmt)%name Stk,%integer Bytes,Mode) %routinespec Storeop(%record(Stkfmt)%name LHS,RHS) %routinespec Push Param(%integer Mode,%record(Stkfmt)%name Stk) %routinespec Note Index(%integer Scale,%record(Stkfmt)%name Base,Index) %routinespec Expcall(%integer Proc) %routinespec Compare Bytes(%record(Stkfmt)%name len,lhs,rhs) %routinespec Forget Regs %routinespec Dropall %routinespec Freeup Freg(%integer R) %routinespec Freeup Reg(%integer R) %routinespec Freeregs %routinespec Reset Reguse(%integer Old,New) %routinespec SetUSe(%integer reg, %record(stkfmt) %name stk) %routinespec SetFRuse(%integer reg, %record(stkfmt) %name stk) %integerfnspec Claimfr(%integer Curreg,size) %integerfnspec Claimr(%integer Curreg) %routinespec New Temporary(%integer Bytes,%record(stkfmt)%name tmp) %integerfnspec BaseReg(%integer area) %integerfnspec Indbase(%record(Stkfmt)%name Stk) %routinespec Do Charop(%integer Op,%record(Stkfmt)%name R,C1,L1,C2,L2) %routinespec Cx Operation(%integer Op,Flags,%record(Stkfmt)%name LHS,RHS1,RHS2) %routinespec COMPRESS (%record(Stkfmt)%name Stk) %routinespec OPRX(%integer Op,Reg,%record(Stkfmt)%name Stk) %routinespec OPXR(%integer Op,%record(Stkfmt)%name Stk,%integer Reg) %routinespec OPRR(%integer Op,Reg1,Reg2) %routinespec OPFX(%integer Op,size,Reg,%record(Stkfmt)%name Stk) %routinespec OPXF(%integer Op,%record(Stkfmt)%name Stk,%integer size,Reg) %routinespec OPFF(%integer Op,Reg1,size1,Reg2,size2) %routinespec OPXL(%integer op,%record(Stkfmt) %name LHS, %integer lit) %routinespec opXX(%integer op,%record(Stkfmt) %name lhs,rhs) %routinespec oplr(%integer op,%record(Stkfmt) %name lhs,rhs) %routinespec GENFIELD(%record(genfm) %name gen,%record(Stkfmt) %name S) %routinespec OP1lit(%integer op,opd) %routinespec OPX(%integer op,%record(Stkfmt) %name S) %routinespec CopyBytes(%record(stkfmt) %name len,from,to) %routinespec MoveMultiple(%integer l ,%record(stkfmt) %name from,to) %routinespec CompareMultiple(%integer l ,%record(stkfmt) %name from,to) %routinespec OPDD(%integer op,base1,disp1,base2,disp2) %routinespec OPDL(%integer op,base,disp,lit,size) %routinespec OPDX(%integer op,base,disp,%record(Stkfmt) %name S) %routinespec OPDR(%integer op,base,disp,reg) %routinespec OPRD(%integer op,reg,base,disp) %routinespec OPRL(%integer op,reg,lit) !********************************************************************** %ownstring(8)%array Areas(0:255)= %c "Stack ","Code ","Gla ","","Ust ","Gst ","Diags ","Scalars", "Ioarea ","","Consts ",""(245) !********************************************************************** !********************************************************************** !** Error reporting !********************************************************************** !********************************************************************** %routine puterror(%string(255) s) printstring(" Compiler Abort: ") printstring(s) %monitor %stop %end %routine Abort %monitor %stop %end;! Abort !*********************************************************************** !*********************************************************************** !** Code generation support procedures !*********************************************************************** !*********************************************************************** %externalroutine Refer(%record(Stkfmt)%name Stk,%integer Offset) %integer Reg %switch F(0:29) ->F(Stk_Form&31);! removing the reg marker bit F(AddrDirMod): { @dir+M } %if Offset=0 %then Stk_Form = AddrDirModVal %and %return F(IndTempVal): { ((temp)) } F(IndDirVal): { ((dir)) } F(IndRegModVal): { ((reg)+M) } F(IndTempModVal): { ((temp)+M)) } F(IndDirModVal): { ((dir)+M) } F(IndRegVal): { ((reg)) } F(StackFront): Loadr: Reg = LoadInt(MOVi,Stk,-1) F(RegVal): { (reg) } F(RegAddr): { (reg) is @ } %if Offset#0 %start Stk_Form=IndRegModVal!Regflag Ruse(Stk_Reg)=-Elevel Setoff: Stk_Modform=Litval Stk_Modintval=Offset Stk_Scale=0 %return %finish Set: Stk_Form=IndRegVal!Regflag Ruse(Stk_Reg)=-Elevel %return F(TempVal): { (temp) } %if Offset#0 %start Stk_Form=IndTempModVal ->Setoff %finish Stk_Form=IndTempVal %return F(DirVal): { (dir) } ! %if Stk_base # Stack %start ! Stk_reg = LoadInt(Movi,Stk,-1) ! ->Set ! %finishelsestart %if Offset#0 %start Stk_Form=IndDirModVal ->Setoff %finish Stk_Form=IndDirVal ! %finish %return F(AddrConst): { @const } Stk_Form=ConstVal Stk_Offset=Stk_Offset+Offset %return F(AddrDir): { @dir } Stk_Form=DirVal Stk_Offset=Stk_Offset+Offset %return F(TempAddr): { (temp) is @ } %if Offset#0 %start Stk_Form=IndTempModVal ->Setoff %finish Stk_Form=IndTempVal %return F(DirAddr): { (dir) is @ } %if Offset#0 %start Stk_Form=IndDirModVal ->Setoff %finish Stk_Form=IndDirVal %return F(RegModAddr): { (reg)+M } %if Offset=0 %start Stk_Form=IndRegModVal!Regflag %return %finish ->Loadr F(TempModAddr): { (temp)+M } %if Offset=0 %start Stk_Form=IndTempModVal %return %finish ->Loadr F(AddrDirModVal): F(DirModAddr): { (dir)+M } %if Offset=0 %start Stk_Form=InddirModVal %return %finish ->Loadr F(*): printstring(" Invalid attempt to Refer ") Abort %end;! Refer %externalroutine Address(%record(Stkfmt)%name Stk) %record(Stkfmt) Tmp %integer I,J,Op %switch F(0:28) ->F(Stk_Form&31);! removing the reg marker bit F(LitVal): { lit } F(FLitVal): { real lit } i=integer(AddrGLAca) Pdbytes(GLA,i,stk_size,addr(stk_intval)) integer(AddrGLAca)=i+stk_Size Stk_Base=GLA Stk_Offset=I F(ConstVal): { const } Stk_Form=AddrConst Size: Stk_Size=4 %return F(RegVal): { (reg) } FreeUpReg(Stk_Reg) Stk_Form=AddrDir ->Size F(FregVal): { (freg) } FreeUPFreg(Stk_reg) Stk_Form=AddrDir ->Size F(DirVal): { (dir) } F(TempVal): { (temp) } Stk_Form=AddrDir %return F(IndRegVal): { ((reg)) } Stk_Form=RegAddr!Regflag %return F(IndTempVal): { ((temp)) } Stk_Form=TempAddr %return F(IndDirVal): { ((dir)) } Stk_Form=DirAddr %return F(AddrDirModVal): { (dir+M) } Stk_Form=AddrDirMod %return F(IndRegModVal): { ((reg)+M) } Stk_Form=RegModAddr!Regflag %return F(IndTempModVal): { ((temp)+M) } Stk_Form=TempModAddr %return F(IndDirModVal): { ((dir)+M) } Stk_Form=DirModAddr %return F(AddrConst): { @const } F(RegAddr): { (reg) is @ } F(TempAddr): { (temp) is @ } F(DirAddr): { (dir) is @ } F(AddrDir): { @dir } F(AddrDirMod): { @dir+M } F(RegModAddr): { (reg)+M } F(TempModAddr): { (temp)+M } F(DirModAddr): { (dir)+M } %end;! Address %routine CheckLoaded(%record(Stkfmt)%name Stk) %integer form,i,j %if (stk_size=4 %and stk_form=Dirval) %orc Stk_form=IndDirVal %start j = (Stk_Base<<16 ) ! (Stk_Offset&x'ffff') %cycle i = FirstExprReg,1,LastExprReg %if Ruse(i)=0 %and Rmem(i)=j %start %if stk_form=dirval %then Stk_Form = Regval!Regflag %if stk_form=inddirval %then stk_form=Indregval!regflag Stk_reg = i %exit %finish %repeat %finish %end %routine CheckFLoaded(%record(Stkfmt)%name Stk) %integer form,i,j %if STk_form=Dirval %start j = (Stk_Base<<16 ) ! (Stk_Offset&x'ffff') %cycle i = 0,2,6 %if FRuse(i)=0 %and FRmem(i)=j %start %if Stk_size=8 %and FRmem(i+1)#j %then %continue %if Stk_size=4 %and FRmem(i+1)#0 %then %continue Stk_Form = FRegval!Regflag Stk_reg = i %exit %finish %repeat %finish %end %externalintegerfn Load Int(%integer op,%record(Stkfmt)%name Stk,%integer reg) !*********************************************************************** !* Stk describes an integer value (1,2 or 4 bytes) !* if Reg is >= 0 then this register must be loaded !* result is the general register to which the value has been loaded !*********************************************************************** %integer Bytes,i,j,Form Bytes = Stk_Size %unless 0End %finishelsestart { Not in a register } %if Form=Regvar %start reg=claimr(-1) OPRR(op,reg,stk_reg) ->set %finish %if Form=StackFront %then op = SPRi %and Stk_Form=Litval ! %if op=MOVi %and Form = AddrDir %then op = ADDRx %and STK_Form = Dirval %if op=MOVi %and Bytes<4 %then op=MOVXii %if op=MOVXii %and bytes = 1 %then op =MOVZii { bytes unsigned?? } %finish {---------------- IT'S NOT IN A REGISTER - GET ONE. ----------------} %if Reg<0 %then Reg= Claimr(-1) %elsec %if ruse(reg)#0 %start { Target Reg is in use } { Free it unless it is to be used to load itself } FreeUpReg(reg) %unless (Stk_Form&RegFlag#0 %and Stk_reg=reg) %orc (AddrDirMod<=Stk_Form&31<=AddrDirModVal %andc stk_ModForm&RegFlag#0 %and stk_Modreg=reg) %finish {---------------- MOVE FROM STK INTO TARGET REGISTER ----------------} OPRX(op,Reg,Stk) Set: Stk_Form = Regval!Regflag Stk_reg = reg End: SetUse(reg,Stk) %result=Reg %end;! Load Int %externalintegerfn Load Real(%integer op,%record(Stkfmt)%name Stk,%integer Freg,Newsize) !*********************************************************************** !* Stk describes a real value !* result is the floating register to which the value has been loaded * !*********************************************************************** %integer Oldsize,i,j Oldsize= Stk_Size %unless 0end %finish {---------------- IT'S NOT IN A REGISTER - GET ONE. ----------------} %if FReg<0 %then FReg = Claimfr(-1,newsize) %c %else %if ruse(Freg)#0 %then FreeUpFReg(Freg) {---------------- MOVE FROM STK INTO TARGET REGISTER ----------------} OPFX(op,Newsize,FReg,Stk) set: Stk_Form = FRegval Stk_reg = FReg Stk_size = Newsize end: SetFRuse(Freg,Stk) %result = FReg %end;! Load Real %externalroutine Stackr(%integer R) !*********************************************************************** !* create an Estack entry for a value held in a general register !*********************************************************************** Elevel=Elevel+1 Stk(Elevel)=0 Stk(Elevel)_Form=RegVal!Regflag Stk(Elevel)_Reg=R Stk(Elevel)_Size=4 Ruse(R)=-Elevel %end;! Stackr %externalroutine Stackfr(%integer FR,Bytes) !*********************************************************************** !* create an Estack entry for a value held in a floating register !*********************************************************************** Elevel=Elevel+1 Stk(Elevel)=0 Stk(Elevel)_Form=FregVal Stk(Elevel)_Reg=FR Stk(Elevel)_Size=Bytes Fruse(FR)=-Elevel %end;! Stackfr %externalroutine Establish Logical !*********************************************************************** !* called when a condition code has been set and required result is a * !* logical value (0 or 1) !*********************************************************************** %integer Reg, LabelID CCset = 0 Reg = Claimr(-1) { Grab a reg to set up with Logical value } OPRL(Scondi,Reg,CC) Stackr(Reg) { stack integer result in Reg %end;! Establish Logical %externalroutine Int Binary Op(%integer Op) !*********************************************************************** !* supports IADD,ISUB,IMULT,IDIV,IGT,ILT,IEQ,INE,IGE,ILE,IAND,IOR,IXOR !* descriptor to result on Estack !*********************************************************************** %constbyteintegerarray NSops(IADD:ILE) = ADDi,SUBi,MULi,QUOi,NEGi,ABSi,REMi,ANDi,ORi,COMi,XORi,LSHi,LSHi,ASHi, %c ASHi,CMPi,CMPi,CMPi,CMPi,CMPi,CMPi %integer Lform,Rform,Lreg,Rreg,reg,nsop %record(Stkfmt)%name Opd %switch Opcode(0:ILE) %record(Stkfmt)%name LHS,RHS %if Elevel<2 %then Low Estack(Op,2) %and %return Elevel=Elevel-2 LHS == Stk(Elevel+1) RHS == Stk(Elevel+2) Lform=LHS_Form&31 Rform=RHS_Form&31 Lreg=LHS_Reg Rreg=RHS_Reg %if op <= ILE %start { general integer op } L: nsop = nsops(op) ->Opcode(Op) %finishelsestart %if IADDST<=op<=IXORST %start { store to store op } %if lhs_size#rhs_size %and rhs_form#litval %thenc op = op - IADDST+1 %and ->L OPXX(nsops(op-IADDST+1),lhs,rhs) %return %finish %if op=EIMOD %then nsop = REMi %and ->Modulus %if op=EISHFTC %then nsop = ROTi %and ->Rotate %if op=EISHFT %then op=ISHLL %and ->L %if op = EIBTEST %start Compress(RHS) %if RForm=Litval LHS_Size = RHS_size opXX(TBITi,LHS,RHS) ccset = 1 cc = 8 { F bit set } %return %finish %if op=EIBSET %or op=EIBCLR %Start { op 1<Stackit %finish ->Opcode(Op) %finish Opcode(IMULT): Opcode(IADD): { Commutative operations } Opcode(IAND): Opcode(IOR): Opcode(IXOR): %if Rform#RegVal %and Lform#RegVal %start { Neither opd in a register } LOADLHS: reg = Loadint(MOVi,LHS,-1) Opd == RHS %finishelsestart %if Rform = RegVal %then reg = Rreg %and Opd == LHS %c %else reg = Lreg %and Opd == RHS %finish CoerceInt(OPD,4) %if OPD_size#4 { Match sizes } OPRX(NSop,reg,Opd) { reg = reg op opd } ->StackIt Opcode(ISHRL): Opcode(ISHRA): { Right shifts are indicated by negating the operand } %if Rform = LitVal %start %if RHS_intval=0 %then Elevel=Elevel+1 %and %return RHS_intval = - RHS_intval %finishelsec RHS_reg = LoadInt(NEGi,RHS,-1) -> LOADLHS Rotate: Opcode(ISHLA): { Left shifts: Ensure shift count is in a byte } Opcode(ISHLL): %if Rform=Litval %and RHS_intval=0 %then Elevel=Elevel+1 %and %return CoerceInt(RHS,1) %unless RHS_size=1 reg = Loadint(MOVi,LHS,-1) OPRX(NSop,reg,RHS) { reg = reg op opd } StackIt: Stackr(reg) { Leave result on top of Estack } Rmem(reg)=0 { Contents complicated by arithmetic } %return Opcode(ISUB): { NON- Commutative operations } %if Rform=LitVal %and -7<=RHS_IntVal<=8 %start nsop = IADD { Use AddQ if small lit. } RHS_IntVal = -RHS_IntVal %finish Opcode(IDIV): Opcode(IREM): Modulus: ->LOADLHS Opcode(IGT): Opcode(ILT): Opcode(IEQ): Opcode(INE): Opcode(IGE): Opcode(ILE): %if RHS_size#LHS_size %and LHS_form#Litval %and LHS_form&Regflag=0 %andc RHS_form#Litval %and RHS_form®flag=0 %start { This is here because IMP lets thru 1 to 2 byte comparisms} %if RHS_size>LHS_size %then CoerceInt(LHS,RHS_size) %c %else CoerceInt(RHS,LHS_size) %finish %if LHS_form=Litval %then LHS_size=RHS_size %if LHS_FORM=Litval %and -8<=LHS_IntVal<=7 %start { Can use CMPQi if condition is reversed } %if RHS_size=1 %then CC = UInvCC(op-IGT) %else CC = INVCC(op-IGT) opXX(CMPi,RHS,LHS) %Finishelsestart %if LHS_size=1 %then CC = USetCC(op-IGT) %else CC = SetCC(op-IGT) opXX(CMPi,LHS,RHS) %finish CCSet = 1 %return %end;! Int Binary Op %externalroutine Int Unary Op(%integer Op,%record(Stkfmt)%name RHS) !*********************************************************************** !* supports INEG,IABS,IABS !* descriptor to result on Estack !*********************************************************************** %integer Reg1,xop %if RHS_size#4 %then CoerceInt(RHS,4) { can't change size AND operate } %if Op = INEG %then xop=NEGi %elsec %if Op = INOT %then xop=COMi %elsec %if Op = BNOT %then xop=NOTi %elsec %if op = IABS %then xop=ABSi %else Abort reg1 = Load Int(xop,RHS,-1) Stackr(Reg1) %end;! Int Unary Op %externalroutine Real Binary Op(%integer Op) !*********************************************************************** !* supports RADD,RSUB,RMULT,RDIV,RGT,RLT,REQ,RNE,RGE,RLE !* descriptor to result on Estack !*********************************************************************** %integer Lform,Rform,Bytes,Freg,Lreg,Rreg %record(Stkfmt)%name Src,Opd %constbyteintegerarray NSop(Radd:RDIV) = ADDf,SUBf,MULf,DIVf %switch Opcode(RADD:RLE) %record(Stkfmt)%name LHS,RHS %if Elevel<2 %then Low Estack(Op,2) %and %return Elevel=Elevel-2 LHS == Stk(Elevel+1) RHS == Stk(Elevel+2) Lform = LHS_Form Rform = RHS_Form Lreg = LHS_Reg Rreg = RHS_Reg Bytes = LHS_Size ->Opcode(Op) Opcode(RADD): Opcode(RMULT): { Commutative operations } %if Rform#FregVal %and Lform#FregVal %start { Neither opd in a register } LOADLHS: Freg = Load real(MOVf,LHS,-1,bytes) Opd == RHS %finishelsestart %if Rform = FregVal %then Freg = Rreg %and Opd == LHS %c %else Freg = Lreg %and Opd == RHS %finish OPFX(NSop(Op),bytes,Freg,Opd) { reg = reg op opd } FRuse(Freg) = 0 { Don't try and remember } Stackfr(Freg,bytes) { Leave result on top of Estack } Frmem(Freg)=0 { Forget it } FRmem(Freg+1)=0 %return Opcode(RSUB): { NON- Commutative operations } Opcode(RDIV): -> LOADLHS Opcode(RGT): Opcode(RLT): Opcode(REQ): Opcode(RNE): Opcode(RGE): Opcode(RLE): CC = SetCC(op-RGT) opXX(CMPf,LHS,RHS) CCSet = 1 %end;! Real Binary Op %externalroutine Real Unary Op(%integer Op,%record(Stkfmt)%name RHS) !*********************************************************************** !* supports RNEG,RABS !* descriptor to result on Estack !*********************************************************************** %integer xop %if Op = RNEG %then xop = NEGf %elsec %if Op = RABS %then xop = ABSf %else Abort %if RHS_Form=Flitval %start { Cnst ops should really be done pre-ecode} %if rhs_size=4 %start %if xop=NEGf %then RHS_rval=-RHS_rval %c { but here for now } %else RHS_rval = mod(RHS_rval) xop=movf %finish %finish Stackfr( Load Real(xop,RHS,-1,RHS_size),RHS_size) %end %externalroutine Coerce Int(%record(Stkfmt)%name Stk,%integer Newsize) %integer reg %constintegerarray masks(1:3)=x'ff',x'ffff',x'ffffff' %if report#0 %start Printstring(" Coerce Int to ") write(Newsize,1) printstring(" from ") write(stk_size,1) newline %finish %if stk_form=litval %and stk_intval>>15=0 %then ->setsize %if newsize > Stk_size %start { expand integer with sign extended move} reg = Load Int(MOVi,Stk,-1) { expand it to 4 bytes in reg } %finishelsestart { contract integer by loading least significant part } !%if Stk_form = Dirval %or Stk_Form=AddrDir %start { can adjust disp } ! Stk_offset = Stk_offset+(Stk_size-Newsize) {BUT bytes swopped!!} !%finishelsestart %if Stk_form=litval %then Stk_Intval=Stk_Intval&masks(newsize) %c %else reg = LoadInt(MOVi,Stk,-1) !%finish %finish setsize: Stk_size = newsize %end %externalroutine Convert II(%record(Stkfmt)%name S,%integer Newsize) !*********************************************************************** !* converts between integer sizes !* descriptor to result on Estack !*********************************************************************** coerce int(s,newsize) Elevel=Elevel+1 %if s_form=Regval %then Ruse(s_reg) = -Elevel Stk(Elevel)=s %end;! Convert II %externalroutine Convert RR(%integer mode, %record(Stkfmt)%name Stk,%integer Newsize) !*********************************************************************** !* 0 converts between real sizes !* 1 TNCRR !* 2 RNDRR !* descriptor to result on Estack !*********************************************************************** %integer xop,oldsize,reg %if mode#0 %start reg=loadReal(MOVf,Stk,-1,newsize) stackfr(reg,newsize) estklit(4) %if mode=1 %then eop(TNCRI) %else eop(RNDRI) estklit(newsize) eop(cvtir) %return %finish Oldsize = Stk_size %if newsize = 8 %and oldsize = 4 %then xop = MOVFL %elsec %if newsize = 4 %and oldsize = 8 %then xop = MOVLF %elsec puterror(" Convert RR/ bad sizes ") reg = Load Real(MOVf,Stk,-1,OldSize) reg = Load Real(xop,Stk,-1,Newsize) %if frmem(reg)#0 %start { adjust reg memory to new size } %if newsize = 8 %then FRmem(reg+1)=FRmem(reg) %else FRmem(reg)=0 %finish Stackfr(reg,newsize) !Stackfr( Load Real(xop,Stk,-1,Newsize),newsize) %end;! Convert RR %externalroutine Convert RI(%record(Stkfmt)%name Stk,%integer Newsize,Mode) !*********************************************************************** !* converts between real and integer !* Mode = 0 TNC !* 1 RND !* descriptor to result on Estack !*********************************************************************** %integer xop,size %if mode = 0 %then xop = TRUNCfi{ %else xop = ROUNDfi } %if mode = 1 %start { Round to nearest takes .5 to even number. Weird. } { avoid ROUNDfi by adding 0.5 and using TRUNCfi } %if language=Fortran %start { NINT in fortran adds 0.5 if pos,but } { subtracts 0.5 if neg. goto subroutine } size=stk_size Address(Stk) %if size=4 %then spcall(10) %else stk_size=4 %and spcall(11) stackr(R0) stk_size=newsize %return %finishelsestart Stackfr(Load Real(Movf,stk,-1, stk_size),stk_size) %if stk_size=4 %then OPXX(ADDf,Stk,Fhalf) %elsec OPXX(addf,stk,FLhalf) xop = TRUNCfi %finish %finish %if mode > 1 %then xop=FLOORfi Stackr(Load Int(xop,Stk,-1)) stk_size=newsize %end;! Convert RI %externalroutine Convert IR(%record(Stkfmt)%name Stk,%integer Newsize) !*********************************************************************** !* converts integer to real !* descriptor to result on Estack !*********************************************************************** Stackfr(Load Real(MOVif,Stk,-1,newsize),Newsize) %end;! Convert IR %externalroutine Storeop(%record(Stkfmt)%name LHS,RHS) !*********************************************************************** !* value defined by RHS is assigned to LHS. !*********************************************************************** %constbyteintegerarray Ad(0:21)=0(9),1(9),0(4) %integer Op,RForm,Lform,i,j,l RForm = RHS_Form&31 LForm = LHS_Form&31 { remove Regflag bit if set } %if Lform<22 %and AD(LForm)#0 %then REFER(LHS,0) %andc LHS_size = RHS_size %if Rform=StackFront %start op = SPRi RHS_Form = LitVal RHS_INTVAL = 9 %finishelsestart %if Rform = FregVal %or RHS_size=8 %or LHS_size=8 %start %if LHS_size=8 %and RHS_size=4 %then op = MOVFL %elsec %if LHS_size=4 %and RHS_size=8 %then op = MOVLF %elsec op = MOVf %finishelsestart %if RHS_size=0 %then RHS_size=LHS_size { Dont cares } %if RHS_size < LHS_size %and RHS_form#LitVal %then op = MOVXii %else op = MOVi %if rhs_size=1 %and op=MOVXii %then op=MOVZii %finish %finish opXX(op,LHS,RHS) %if lform = Dirval %start { for simple Dirvals remember if in reg } { Lose register memories if they relate to location being written to } j = (LHS_base<<16)!(LHS_offset&x'ffff') %cycle i=0,1,6 %if Rmem(i)=j %then Rmem(i)=0 %if FRmem(i)=j %then FRmem(i)=0 %and FRmem(i+1)=0 %repeat l = LHS_size %if Rform=Regval%start { is it worth remembering what we put in the reg} %if l=4 %start %return %if op=MOVXii %or op=MOVZii Rmem(RHS_reg)=j %finish %finish %if Rform=FRegval %start l = LHS_size FRmem(RHS_reg)=j %if l=8 %then j=0 Frmem(i+1)=j %finish %finish %end;! Storeop %externalroutine Push Param(%integer Mode,%record(Stkfmt)%name Stk) !*********************************************************************** !* the value or address of Stk is added to the parameter list !* result is the reg used for retaining the value !* Mode = 0 push value !* 1 push address !*********************************************************************** %if mode=1 %then Address(Stk) %and Stk_size=4 %c %else %if Stk_Size>4 %then TOS_size=Stk_size %c %else TOS_size=4 Storeop(TOS,Stk) %end;! Push Param %externalroutine Note Index(%integer Scale,%record(Stkfmt)%name Base,Index) !*********************************************************************** !* incorporate Index info into Base record !*********************************************************************** %switch F(0:21) %integer form,reg %if Index_Form=LitVal %start Index_Intval=Index_Intval<F(Base_Form&31) F(IndTempVal): { ((temp)) } F(IndDirVal): { ((dir)) } Base_Form=Base_Form+12 Set: %if (Addrdirmod<=Index_Form&31 %and Index_Form&31<=Addrdirmodval) %or index_size#4 %start Base_Modreg=Loadint(MOVi,Index,-1) Base_Modform = Regval!Regflag Base_Modoffset=0 %finishelsestart Base_Modreg=Index_Reg Base_Modbase=Index_Base %if Index_form=Regvar %then Base_ModForm=Regval!Regflag %elsec Base_Modform=Index_Form Base_Modoffset=Index_Offset %finish Base_Scale=Scale %if Base_ModForm&Regflag#0 %then Ruse(Base_Modreg)=-Elevel %return F(AddrDir): { @dir } F(RegAddr): { (reg) is @ } F(TempAddr): { (temp) is @ } F(DirAddr): { (dir) is @ } Base_Form=Base_Form+4 ->Set F(AddrDirMod): { @dir+M } F(RegModAddr): { (reg)+M } F(TempModAddr): { (temp)+M } F(DirModAddr): { (dir)+M } F(IndDirModVal): { ((dir)+M) } F(RegVal): { (reg) } F(FregVal): { (freg) } F(TempVal): { (temp) } F(AddrConst): { @const } F(IndTempModVal): { ((temp)+M) } F(AddrDirModVal): { (@dir+M) } F(LitVal): { lit } F(ConstVal): { const } F(IndRegVal): { ((reg)) } { Only for IMP treat IndRegval as Regaddr } Reg = LoadInt(MOVi,Base,-1) Base_Form=RegModAddr!Regflag ->Set F(IndRegModVal): { ((reg)+M) } reg=LoadInt(MOVi,Base,Base_reg) ! OPRX(Movi,Base_reg,Base) {use loadint instead to reset use of base_reg} Base_Form = RegModAddr!Regflag ->Set F(DirVal): { (dir) } { Only for IMP treat DIRVAL as DirADDr } ->F(IndDirVal) %end;! Note Index %externalroutine Do Charop(%integer Op,%record(Stkfmt)%name Relop,C1,LenC1,C2,LenC2) { called by assign and compare character ops. C2 -> C1 } %integer Len1,Len2,Xop,excess %record(Stkfmt) Dest %if C1_Form=LitVal %then C1_Size=1 %if C2_Form=LitVal %then C2_Size=1 Len1 = LenC1_Intval Len2 = LenC2_Intval %if LenC1_Form=Litval %andc LenC2_Form=LitVal %andc Len1=Len2 %andc C2_Form=Litval %start {operate on one byte literals } %if Op=EASGNCHAR %then OPXX(MOVi,C1,C2) %c %else OPXX(CMPi,C2,C1) %return %finish %if LenC1_Form=Litval %and LenC2_form=Litval %start excess = Len1 - Len2 { ignore surplus chars } %if Len2 > Len1 %then LenC2_Intval = Len1 %and len2=len1 %if (len2=1 %or len2=2 %or len2=4) %and excess<=0 %start refer(C1,0); refer(C2,0) C1_size=Len1; C2_size=Len2 %if op=EASGNCHAR %then OPXX(MOVi,C1,C2) %c %else OPXX(CMPi,C2,C1) %and ccset=1 %return %finish %if Op=EASGNCHAR %start CopyBytes (LenC2,C2,C1) %if excess>0 %start { space fill } OPRL(MOVi,R0,-Excess) { length remaining } Plabel(ShortRangeid-1) Dest=0; Dest_Form=Indregval!Regflag;Dest_reg=R2;Dest_size=1 OPXL(MOVi,Dest,32) OpRL(ADDi,R2,1) Pjump(ACBi,ShortRangeid-1,1) %finish %finishelsestart { ECOMPCHAR } %if excess=0 %then Compare Bytes(LenC2,C1,C2) %c { Same length} %else ->cpstr { Not same length - call f_cpstr } %finish %finishelsestart { Lengths not known } %if op=EASGNCHAR %then spcall(9) %else %start cpstr: spcall(8) stackr(r0) ccset=0 %return %finish %finish %if op=Ecompchar %then ccset=1 %end;! Do Charop %externalroutine Cx Operation(%integer Op,Flags,%record(Stkfmt)%name LHS,RHS1,RHS2) !*********************************************************************** !* Op = 1 CXADD 5 CXNEG 9 CONJG !* 2 CXSUB 6 CXASGN !* 3 CXMULT 7 CXEQ !* 4 CXDIV 8 CXNE !* Flags = Variant<<8 ! Sizecode !* Variant: 0 complex op complex !* 1 complex op real !* 2 real op complex !* Sizecode: 0 8 (r*4) !* 1 16 (r*8) !* 2 32 !* For CXasgn sizecode = (rhsSize<<2)!lhsSize !*********************************************************************** %integer Adj,Variant,Reg1,Reg2,Reg3,Reg4,I,Op1,Adjl,Dl,D,size,opcode,xop %switch S(0:9) %record(stkfmt) LHSi,RHS1i,RHS2i %constinteger CopC=0,CopR=1,RopC=2 { load l and r and operate} %integerfn pair(%record(Stkfmt)%name l,r) %integer R1 R1=ClaimFR(-1,D) OPFX(MOVf,D,r1,L) OPFX(MULf,D,R1,R) Fruse(R1)=-255 %result=R1 %end %routine setup(%record(stkfmt) %name in,imag,%integer D) %integer reg,reg2 %if in_form&31 < Addrdirmod %start imag=in; refer(in,0); refer(imag,D) %finishelsestart { complex array } Address(in) reg=LoadInt(Movi,in,-1) { get address of complex element into a reg} imag=in imag_form=indregmodval!Regflag imag_modform=Litval imag_modintval=D in_form=indregval!regflag %finish in_size=D imag_size=D %end %if op=3 %or op=4 %start %cycle I=0,2,6 %if Fruse(I)<0 %then Freeup Freg(I) %repeat %finish Variant=Flags>>8 Size=Flags&3 %if Size=0 %then D=4 %else D=8 %if Op=4 %and Variant=CopC %start;! use support procedure for complex divide Spcall(3+Size) %return %finish %if op=6 { CXASGN} %start %if flags&4#0 %then DL=8 %else Dl=4 %finishelse Dl=D setup(LHS,LHSi,Dl) LHS_size=D; LHSi_size=D setup(RHS1,RHS1i,D) ->S(op) %if op>=5 setup(RHS2,RHS2i,D) ->S(Op) S(1): ! CXADD Reg1=ClaimFR(-1,D) OPFX(MOVf,D,reg1,RHS1) Fruse(reg1)=-255 Reg2=ClaimFR(-1,D) OPFX(MOVf,D,reg2,RHS1i) OPFX(ADDf,D,Reg1,RHS2) %if variant=CopC %then OPFX(ADDf,D,Reg2,RHS2i) Store: OPXF(MOVf,LHS,D,Reg1) OPXF(MOVf,LHSi,D,Reg2) %return S(2): ! CXSUB Reg1=ClaimFR(-1,D) OPFX(MOVf,D,reg1,RHS1) FRUSE(reg1)=-255 reg2=ClaimFR(-1,D) %if variant = RopC %then OPFX(MOVf,D,reg2,Zero) %c %else OPFX(MOVf,D,reg2,RHS1i) OPFX(SUBf,D,reg1,RHS2) %unless variant=CopR %then OPFX(SUBf,D,reg2,RHS2i) ->store S(3): ! CXMULT {(a,b)*(x,y) } { Real = ax-by } { Imag = bx+ay } Reg1=Pair(RHS1,RHS2) { reg1= ax } %if variant=CopC %start Reg2=pair(RHS1i,RHS2i) { reg2= by } OPFF(SUBf,Reg1,D,Reg2,D) { Realpt= reg1-reg2} Fruse(reg1)=-255 %finish %unless variant=RopC %then Reg2=pair(RHS1i,RHS2) { reg2= bx } %unless variant=CopR %then Reg3=pair(RHS1,RHS2i) { reg3= ay } %if variant=RopC %then reg2=Reg3 %if variant=CopC %then OPFF(ADDf,reg2,D,reg3,D) { Imagpt = reg2+reg3) ->Store S(4): ! CXDIV Reg1=claimfr(-1,D) OpFX(Movf,D,reg1,RHS2) OPFF(MULf,reg1,D,reg1,D) fruse(reg1)=-255 %unless variant=CopR %start Reg4=claimfr(-1,D) OpFX(MOVf,D,reg4,RHS2i) OPFF(MULf,reg4,D,reg4,D) OPFF(ADDf,reg4,D,reg1,D) { reg4 = ( x**2 + y**2 ) } %finish %else reg4 = reg1 fruse(reg4)=-255 Reg1=pair(RHS1,RHS2) { reg1= ax } ! %if variant=CopC %start !Reg2 = pair(RHS1i,RHS2i) !OPFF(ADDf,reg1,D,reg2,D) !%finish OPFF(DIVf,reg1,D,reg4,D) { realpt = re1 / reg4 } Fruse(reg1)=-255 Fruse(reg4)=-255 reg2 = pair(RHS1i,RHS2) %unless variant = RopC { reg2 = bx } %unless variant = CopR %start reg3 = pair(RHS1,RHS2i) { reg3 = ay } %if variant=RopC %then OPFF(NEGf,reg3,D,reg2,D) %c {CopC} %else OPFF(SUBf,reg2,D,reg3,D) %finish OPFF(DIVf,reg2,D,reg4,D) { imagpt = reg2 / reg4 } ->Store S(5): ! CXNEG OPXX(NEGf,LHS,RHS1) OPXX(NEGf,LHSi,RHS1i) %return S(6): ! CXASGN %if Flags&4=0 %then { assigning to single } Dl=4 %else Dl=8 { Take advantage of 16 byte move if possible } %if variant=CopC %and D=Dl %then MoveMultiple(D*2,RHS1,LHS) %c %and %return %if D#Dl %start;! unequal lengths being assigned %if Dl = 8 %then xop = MOVFL %else xop = MOVLF %finish %else xop = MOVf OPXX(xop,LHS,RHS1) { real part always copied } %if variant=CopC %then OPXX(xop,LHSi,RHS1i) %and %return %if variant=CopR %then opxx(MOVf,LHSi,Zero) %return S(7): ! CXEQ S(8): ! CXNE %if Op=7 %then CC=0 %else CC=1 %if Variant=0 %then CompareMultiple(D*2,RHS1,LHS) %c %else OPxx(CMPf,RHS1,LHS) CCset=1 ! CC=CC!!15;! inverse test was used in the above %return S(9): ! CONJG { Complex Conjugate => Negate Imaginary part } OPXX(MOVf,LHS,RHS1) OPXX(NEGf,LHSi,RHS1i) %end;! Cx Operation !*********************************************************************** !*********************************************************************** !** Nat Semi - specific procedures !*********************************************************************** !*********************************************************************** %externalroutine Forget Regs !*********************************************************************** !* forget all previous use of registers !*********************************************************************** %integer I Ruse(I)=0 %and Rmem(i)=0 %and Fruse(I)=0 %and FRmem(i)=0 %for I=0,1,7 Lastreg=0 Lastfreg=0 %end %externalroutine Dropall !*********************************************************************** !* no dynamic addressing registers can have assumed values !*********************************************************************** %integer I %cycle I=0,1,LastExprreg Ruse(I)=0; Rmem(i)=0 %repeat Frmem(i)=0 %for i=0,1,7 Ruse(0)=0 { in case its a function result } Lastreg=-1 Lastfreg=-1 %end %externalroutine Freeup Freg(%integer R) !*********************************************************************** !* store the content of floating register R in temp space, modifying !* Estack entries as necessary !*********************************************************************** %integer I,Size I=-Fruse(R);! was held as -Elevel %if I<=0 %then ->Wipe %if Stk(I)_Form&31=FregVal %and Stk(I)_Reg=R %start Size=Stk(I)_Size New Temporary(Size,Stk(i)) OPXR(MOVf,Stk(i),R) ->Wipe %finish printstring("Request to free FP register");write(R,2);newline Abort Wipe: Fruse(R)=0 FRmem(R)=0 FRmem(R+1)=0 %end;! Freeup Freg %externalroutine New Temporary(%integer Bytes,%record(stkfmt) %name tmp) !*********************************************************************** !* Obtain space on the Stack to save register contents in a 'Temporary' !* At this time no attempt is made to re-use Temporaries. !*********************************************************************** %integer I { Get current stack top and expand it by required size } %if language#IMP %start I=integer(AddrStackca)-((Bytes+3)&X'FFFFFFFC') integer(AddrStackca)=I %finish { Make up an Estack record by which the Temporary can be accessed } Tmp = 0 Tmp_form = TempVal !Tmp_offset = -I + (8 + PParamsize) %if language=IMP %start Tmp_offset = ETEMPWORKSPACE(bytes) %finishelsestart Tmp_offset = I %finish Tmp_size = Bytes Tmp_base = Stack %if report#0 %start printstring(" New Temp"); write(tmp_offset,1); write(bytes,1); newline %finish %end;! New Temp %owninteger FreeAll=0 %externalroutine Freeup Reg(%integer R) !*********************************************************************** !* store the content of general register R in temp space, modifying !* Estack entries as necessary !* no dynamic addressing registers can have assumed values !*********************************************************************** %integer I,Form,reg,j %record(stkfmt) Tmp %record(stkfmt) %name S %if report#0 %start printstring(" Free reg ") write(r,1) write(ruse(r),1) space phex(rmem(r)) newline %finish I=-Ruse(R) { was it held as -Elevel ?} ->Wipe %if I<=0 { Not needed by Estack so forget it } S == Stk(i) { S is the Estack entry which uses R } Form=S_Form&31 %if S_Reg=R %and (Form=RegVal %orc { Direct use of R ?} Form=IndRegVal %orc Form=RegAddr %orc Form=RegModAddr %orc Form=IndRegModVal) %start New Temporary(4,Tmp) { Get space for safe storage of reg } %if Form=RegVal %then S=tmp %and ->store S_Form=Form+1 S_Offset=Tmp_offset S_Base=0 ->Store %finishelsestart { Modified use of R ?} %if S_Modreg=R %and S_Modform&Regflag # 0 %start %if FreeAll = 0 %start { Unless all regs are ato be emptied } { Its worth keeping this in another reg. if one is free } %cycle j = FirstExprreg,1,LastExprReg %if ruse(j)>=0 %start reg=Claimr(-1) { Move modifier to another register } OPRR(MOVi,Reg,R) S_Modreg=reg Ruse(reg) = -I ->Wipe %finish %repeat %finish { No reg free, so dump it into a temporary } New Temporary(4,Tmp) { Get space for safe storage of reg } %if S_ModForm&31=Regval %then S_Modform=Tempval %andc ->ModStore %if S_ModForm&31=IndRegval %then S_Modform=IndTempval %andc ->ModStore %finish %finish printstring("Request to free register");write(R,2);newline Abort ModStore: S_ModOffset = Tmp_Offset S_ModBAse = Stack Store: OPXR(MOVi,Tmp,R) S_size = 4 Wipe: Ruse(R)=0 Rmem(R)=0 %end;! Freeup Reg %externalroutine Reset Reguse(%integer Old,New) !*********************************************************************** !* When an Estack Entry has moved (eg. swopped or promoted ), !* if it describes a register then the Ruse must be altered to !* point at the new position of the Estack entry. !*********************************************************************** %integer I %cycle I=0,1,LastExprreg %if Ruse(I)=-Old %then Ruse(I)=-New %and %return %repeat %cycle I=0,2,6 %if Fruse(I)=-Old %then Fruse(I)=-New %and %return %repeat %end;! Reset Reguse %externalroutine Freeregs !*********************************************************************** !* save any general or floating registers !*********************************************************************** %integer I FreeAll=1 %cycle I=ResultReg,1,LastExprReg %if Ruse(I)<0 %then Freeup Reg(I) Ruse(I)=0 %repeat %cycle I=0,2,6 %if Fruse(I)<0 %then Freeup Freg(I) %repeat Rmem(i)=0 %for i=ResultReg,1,LastExprReg FRmem(i)=0 %for i=0,1,7 Lastreg=-1 Lastfreg=-1 FreeAll=0 %end;! Freeregs %externalintegerfn Claimfr(%integer Curreg,size) !*********************************************************************** !* result is a free floating register, other than Curreg !*********************************************************************** %integer I %if report#0 %then printstring(" ClaimFR ") %and write(curreg,1) %andc write(size,1) %cycle i = 0,2,6 %if report#0 %then write(i,1) %and write(fruse(i),1) %if Fruse(i)=0 %and Frmem(i)=0 %then ->TakeIt %repeat %cycle i = 0,2,6 %if Fruse(i)=0 %then ->TakeIt %repeat %cycle i = 0,2,6 %unless I=Curreg %or I=Lastfreg %start Freeup Freg(i) ->TakeIt %finish %repeat Abort TakeIt: FRuse(i) = -255 { Lock it until owner fills in Estack index } FRmem(i)=0 FRmem(i+1)=0 %if i>3 %then FRCorrupt(i)=1 %result=i %end;! Claimfr %externalintegerfn Claimr(%integer Curreg) !*********************************************************************** !* result is a free general register, other than Curreg !*********************************************************************** %integer I %if report#0 %then printstring(" Claim ") %and write(curreg,1) { First look for a reg which is unclaimed, not Curreg and not Lastreg } { and whose contents are unknown } %cycle I=FirstExprReg,1,LastExprReg %if report#0 %then write(i,1) %and write(ruse(i),1) %if Ruse(I)=0 %and Rmem(I)=0 %and I#Curreg %and I#Lastreg %then ->TakeI %repeat { Next look for a reg which is unclaimed, not Curreg and not Lastreg} %cycle I=FirstExprReg,1,LastExprReg %if report#0 %then write(i,1) %and write(ruse(i),1) %if Ruse(I)=0 %and I#Curreg %and I#Lastreg %then ->TakeI %repeat { Next try for a reg which is not Locked and not curreg or lastreg } %cycle I=FirstExprReg,1,LastExprReg %unless I=Curreg %or I=Lastreg %or Ruse(I)=-255 %start Freeup Reg(I) ->TakeI %finish %repeat { Use R0 if its free } %if Ruse(0)=0 %then I=R0 %and ->TakeI { Finally use Lastreg if if its not the same as Curreg } %if Lastreg>0 %and Lastreg#Curreg %start Freeup Reg(Lastreg) I = LAstreg %finish %else Abort TakeI: Lastreg=I %if report#0 %then newline ruse(i)=-255 { Lock it until Owner acknowledges it } Rmem(i)=0 %result=I %end;! Claimr %routine SetUSe(%integer reg, %record(stkfmt) %name s) !*********************************************************************** !* Set Ruse of 'reg' to be owned by 'S' , found on the Estack. !*********************************************************************** %integer i i = (addr(S) - addr(STK(0)))//(16>>wordad) { get index to Estack array } %if 0 <= i <= 15 %then Ruse(reg) = -i %and %return ruse(reg)=-255 { Lock it anyway. Belongs to temp estack entry } %if report #0 %then Printstring(" Setuse cannot locate owner of ".itos(reg))%c %and newline %end %routine SetFRuse(%integer reg, %record(stkfmt) %name s) %integer i i = (addr(s) - addr(stk(0)))//(16>>wordad) %if 0<=i<=15 %then FRuse(reg) = -i %and %return puterror(" SetFRuse cannot locate owner of FR".itos(reg)) %end %externalintegerfn BaseReg(%integer area) !*********************************************************************** !* result is the register addressing the nominated area !*********************************************************************** !%integer i !%record(stkfmt) S %if area = GLa %and Ruse(R7) = Gla %then %result = R7 %result = -1 !%cycle i = LastBaseReg,-1,FirstBaseReg ! %if ruse(i)=Area %then lastbreg = i %and %result = i !%repeat !%cycle i = LastBaseReg,-1,FirstBaseReg ! %unless i = lastbreg %start ! S=0; S_form = Dirval; S_base = Area ! OpXR(ADDRi,S,i) ! Ruse(i) = Area ! lastbreg = i ! %result = i ! %finish !%repeat %end ! %externalintegerfn Indbase(%record(Stkfmt) %name Stk) !*********************************************************************** !* result is a register containing the address held in the nominated !* location !*********************************************************************** %integer I,J,K %record(Stkfmt) S %integer Area,Disp Area = STk_base Disp = Stk_Offset J=(Area<<16)!Disp %cycle K=FirstExprReg,1,LastExprReg %if Rmem(K)=J %then ->set %repeat S = 0 S_Form = Dirval S_size = 4 S_BASE = Area S_Offset = Disp K=Claimr(-1) OPRX(MOVi,K,S) Rmem(K)=(Area<<16)!Disp set: SetUSe(K,Stk) %if report#0 %start; printstring(" IndBase "); write(k,1); newline; %finish %result=K %end;! Indbase %externalintegerfn Load Modifier(%record(Stkfmt)%name Stk) !*********************************************************************** !* result is a register loaded with the modifier. !*********************************************************************** %record(STKFMT) S %integer j,i %if report#0 %then printstring(" Load Modifier ".itos(stk_modform)) %andc newline ->reg %if STK_Modform&31 = Regval %if Stk_Modform=Dirval %start { assume modifier always 4 bytes } j = (Stk_MODBase<<16 ) ! (Stk_MODOffset&x'ffff') %cycle i = FirstExprReg,1,LastExprReg %if Ruse(i)=0 %and Rmem(i)=j %then Stk_Modreg=i %and ->set %repeat %finish S = 0 S_form = Stk_ModForm S_offset = Stk_Modoffset S_size = 4 S_base = Stk_MODbase S_reg = Stk_ModReg Stk_ModReg = Claimr(-1) OPRX(MOVi,Stk_ModReg,S) %if S_form=Dirval %then Rmem(Stk_Modreg)=j set: SetUse(Stk_Modreg,Stk) Stk_Modform = RegVal!Regflag reg: Stk_Modoffset = 0 %result=Stk_ModReg %end;! Load Modifier !*************************************************** ! ! CODE PLANTING ! !*************************************************** %ownstring(255) text %externalroutine GENFIELD(%record(genfm) %name gen,%record(Stkfmt) %name S) %switch form(LitVal:TopOfStack) %integer f %constbytearray getindexmode(0:3)=B'11100',B'11101',B'11110',B'11111' %conststring(1)%array indexmode(0:3)= "B","W","D","Q" gen = 0 f = S_form&31 -> FORM( f ) form(LitVal): { extension = S_intval } gen_mode = IMMEDIATE gen_disp1 = S_intval %if decode#0 %then text=text." ".itos(S_intval) %return form(FLitVal): gen_mode = IMMEDIATE %if S_size=8 %then gen_lrval=S_lrval %elsec gen_rval = S_rval { need rtos routine } %if decode#0 %then text=text." X".htos(S_intval,8) %if decode#0 %and s_size=8 %then text=text."X".htos(gen_disp3,8) %return form(FregVal): gen_reg = S_reg FRuse(S_reg) = 0 gen_mode = S_reg { register modes are 0 + regID } %if decode#0 %then text=text." FR".itos(gen_reg) %return form(RegVal): form(REgvar): gen_reg = S_reg Ruse(S_reg) = 0 %if Ruse(S_reg)<0 gen_mode = S_reg { register modes are 0 + regID } %if decode#0 %then text=text." R".itos(gen_reg) %return form(IndRegVal): Ruse(S_reg) = 0 %if Ruse(S_reg)<0 gen_reg = S_reg gen_mode = REGREL + gen_reg %if decode#0 %then text = text." 0(R".itos(gen_reg).")" %return form(TempVal): gen_mode = Frame gen_disp1 = S_offset %if decode#0 %then text=text." ".itos(gen_disp1)."(FP)" %return form(ConstVal): form(DirVal): form(AddrDirModVal): %if S_base = Stack %thenc gen_mode = Frame %elsec %if S_base = Gla %and ruse(R7)=Gla %start gen_reg = R7 gen_mode = RegRel + R7 gen_disp1 = S_offset %if decode#0 %then text = text." ".itos(S_offset)."(R7)" ->enddirval %finishelsestart %if SST<=S_BASEenddirval %finish gen_mode = Program gen_base = S_base %finish gen_disp1 = S_offset %if decode#0 %start text=text." " %if gen_mode = Program %then text=text."*".areas(S_base)." + " text=text.itos(gen_disp1) %if gen_mode = Frame %then text=text."(FP)" %finish enddirval: ->scale %if f=addrdirmodval %return form(IndDirVal): form(IndTempVal): %if S_base = Stack{param or local}%then gen_mode = FrameRel %c %else puterror(" Inddirval not to stack ") gen_disp1 = S_offset %if decode#0 %then text=text." 0(".itos(gen_disp1)."(FP))" %return form(IndDirModVal): form(IndTempModVal): %if S_base = Stack{ param or local} %then gen_mode = FrameRel %c %else puterror(" InddirModval not to stack ") gen_disp1 = S_offset gen_disp2 = S_Modoffset %if decode#0 %thenc text=text." ".itos(gen_disp2)."(".itos(gen_disp1)."(FP))" ->scale form(IndRegModVal): gen_reg = S_reg Ruse(S_reg)=0 %if Ruse(S_reg)<0 gen_mode = REGREL + S_reg gen_disp1 = S_Modoffset %if decode#0 %thenc text = text." ".itos(gen_disp1)."(R".itos(gen_reg).")" ->Scale form(RegModAddr): gen_reg = S_reg Ruse(S_reg) = 0 %if Ruse(S_reg)<0 gen_mode = S_reg %if decode#0 %then text = text." R".itos(gen_reg) ->scale form(TopofStack): gen_mode = TOSmode %if decode#0 %then text=text." TOS " %return form(AbsAd): gen_mode = Absolute gen_disp1 = S_intval %if decode#0 %then text=text." @".itos(gen_disp1) %return scale: %return %unless S_ModForm&31 = Regval gen_index = (gen_mode<<3) ! S_Modreg Ruse(S_Modreg)=0 %if Ruse(S_Modreg)<0 gen_mode = getindexmode(S_scale) %if decode#0 %then text = text."[R".itos(S_Modreg).":". %c indexmode(S_scale)."]" %return form(*): puterror(" Genfield does not understand ".itos(S_form)) %end !*********************************************************************** %externalroutine OP1lit(%integer op,opd) { Plant a one integer operand instruction } { where the operand is a simple literal } %record(stkfmt) lit %if decode#0 %then text=NSmnemonic(op)." ".itos(opd) PREV = CA { Special cases of instructions which ONLY have one literal operand } %if op =BSR %then PB(B'00000010') %and -> disp %elsec %if op =BR %then PB(B'11101010') %and -> disp %elsec %if op =EXIT %then PB(B'10010010') %and -> immediate %elsec %if op =SAVE %then PB(B'01100010') %and -> immediate %elsec %if op =RESTORE %then PB(B'01110010') %and -> immediate %elsec %if op =RET %then PB(B'00010010') %and -> disp %elsec %if op =RXP %then PB(B'00110010') %and -> const %elsec %if op =CXP %then PB(B'00100010') %and -> index %elsec %start { Instr takes general operand } lit = Zero lit_IntVal = opd lit_size = 4 Compress(lit) OPx(op,lit) %return %finish disp: const: index: Pdisp(opd) ->end immediate: PB(opd) { What if it is not a byte ? } end: %if decode#0 %then PdumpInstr(text) %end %constBYTEarray SizePos(0:97) = %c { 0} 0 , {ADDi } x'04', {ADDQi } x'05', {ADDCi } x'05', {SUBi } x'04', {SUBCi } x'05', {NEGi } x'04', {ABSi } x'04', { 8} {MULi } x'04', {MEIi } x'04', {DIVi } x'04', {MODi } x'04', {QUOi } x'04', {REMi } x'04', {DEIi } x'04', {MOVi } x'04', {16} {MOVQi } x'05', {MOVXBi } x'06', {MOVZBi } x'06', {CMPi } x'04', {CMPQi } x'05', 0 , 0 , {ADDf } x'40', {24} {SUBf } x'40', {MULf } x'40', {DIVf } x'40', {NEGf } x'40', {ABSf } x'40', {CMPf } x'40', {MOVf } x'40', {MOVLF } 0 , {32} {MOVFL } 0 , {MOVif } x'54', {ROUNDfi} x'67', {TRUNCfi} x'67', {FLOORfi} x'78', {LFSR } 0 , {SFSR } 0 , {ANDi } x'04', {40} {ORi } x'03', {BICi } x'04', {XORi } x'04', {COMi } x'04', 0 , {ASHi } x'04', {LSHi } x'04', {ROTi } x'04', {48} {NOTi } x'04', {Scondi } 0 , {TBITi } x'05', {SBITi } x'05', {SBITIi } x'06', {CBITi } x'05', {CBITIi } x'06', {IBITi } x'05', {56} {FFSi } x'04', {CVTP } 0 , 0 , 0 , 0 , 0 , {MOVSi } x'05', {MOVST } 0 , {64} {CMPSi } x'05', {CMPST } 0 , {SKPST } 0 , {MOVMi } x'05', {CMPMi } x'05', {CHECKi } x'06', {INDEXi } x'06', {JUMP } 0 , {72} {Bcond } 0 , {BR } 0 , {CASEi } x'05', {ACBi } x'04', {JSR } 0 , {BSR } 0 , {RET } 0 , {CXP } 0 , {80} {CXPD } 0 , {RXP } 0 , 0 , 0 , 0 , 0 , 0 , {ADDRi } x'05', {88} 0 , {SAVE } 0 , {RESTORE} 0 , {ENTER } 0 , {EXIT } 0 , {ADJSPi } x'06', {BICPSRi} x'07', {BISPSRi} x'07', {90} {LPRi } x'04', {SPRi } x'04' %constbytearray ISizeDigit(0:3)='B','W',0,'D' %constbytearray FSizeDigit(0:1)='L','F' %owninteger MOVMlen=0,CHKDestreg { extra info for oplr } %owninteger IndexReg=0 %constbyteintegerarray numdisps(0:32) = %C 0(8), 1(8), 2(3), 0,0,1,{22} 2, 0, 1(4), 0(*) %conststring(2) %array conds(0:13) = "EQ","NE","CS","CC","HI","LS", "GT","LE","FS","FC","LO","HS", "LT","GE" %conststring(2) %array sregs(0:15) = ""(8),"FP","SP","SB",""(5) { TWO operand instructions come here } %externalroutine oplr(%integer op,%record(Stkfmt) %name lhs,rhs) %integer form,subform,Ifield,Ffield,z,yy,zzzz,y,zzz,len,nd,i,j %record(genfm) src,dest %byteintegerarrayformat bfm(0:255) %byteintegerarrayname b %switch F(0:15) PREV = CA len = LHS_size { Usually dest(LHS) sets length} %if len=0 %then len = RHS_size { But, take length from RHS } %if rhs_form=Litval {%or rhs_form=FLitval} %then rhs_size=len { if literal or don't care} %if len = 1 %then Ifield = 0 %elsec %if len = 2 %then Ifield = 1 %elsec %if len = 4 %then Ifield = 3 %and Ffield = 1 %elsec %if len = 8 %then Ffield = 0 %else Abort %if op = ADDi %or op = MOVi %or op = CMPi %start { Possible SHORT forms } %if RHS_form = LitVal %and -8<=RHS_offset<=7 %start %if op = MOVi %then op = MOVQi %and z = 1 { Possible Quick forms } %if op = CMPi %then op = CMPQi %and z = 0 %if op = ADDi %then op = ADDQi %and z = 0 %finishelsestart %if op = MOVi %and RHS_form = LitVal %start %if len>1 %and RHS_offset&x'FFFF0000'=0 %and LHS_Form=Regval %Start op = ADDRx { Faster to use ADDR @absaddr,X for small consts } RHS_form = AbsAd %finishelseif -8192<=RHS_IntVal=-9 %start op = MOVXii %if RHS_INTVAL<-255 %then RHS_size=2 %else RHS_size=1 %finishelseif 8<=RHS_INTVAL<=32767 %and len=4 %start op = MOVZii %if RHS_INTVAL>255 %then RHS_size=2 %else RHS_size=1 %finish %finish %finish %finish { Possible SHORT forms } %if ADDf<=op<=FLOORfi %and op#MOVif %then checkFloaded(RHS) %elsec %if op # MOVMi %and op#CMPMi %and op#ADDRx %then CheckLoaded(RHS) %if op=CMPi %then CheckLoaded(LHS) %if op=MOVif %start %if RHS_Form=Litval %then Compress(RHS) { Litval to minimum size } %if RHS_size = 1 %then Ifield = 0 %elsec {Take Ifield from RHS} %if RHS_size = 2 %then Ifield = 1 %elsec Ifield = 3 %finish form = NSforms(op) %if decode#0 %start text=NSmnemonic(op) %if SizePos(op)#0 %start b == array(addr(text),bfm) i = SizePos(op)&15 %if i # 0 %then b(i) = ISizeDigit(Ifield) i = SizePos(op)>>4 %if i # 0 %then b(i) = FSizeDigit(Ffield) %if op = MOVXii %or op = MOVZii %start %if rhs_size=1 %then i = 0 %else i=1 b(5)=IsizeDigit(i) %finish %finish %finish -> F(form) F(1): { CMPi } { Only one possibility in these forms } F(2): { BICi } F(5): { MOVi } F(6): { ORi } F(13): { TBITi } F(14): { XORi } F(10): { ANDi } F(0): { ADDi } { Only one 2 operand possibility in these forms } F(4): { ADDCi } F(8): { SUBi } F(12): { SUBCi } ->gengen F(7): ->genquick F(9): Ifield = 3 %if op = ADDRX %then ->gengen { %if op = LXPD %then Firstop = B'10110' %and -> ?} ->Missing F(11): %if op = LPRi %then z = 1 %and -> genshort %if op = SPRi %then z = 0 %and -> genshort %if {op = EXT %or} op = INDEX %start PB(B'00101110') {%if op = EXT %then y = 0 %else} y = 1 ->GEnGEnreg %finish ! %if op = CVTP %or op = FFSi %start { not implemented } ! %if op = FFSi %then RHS_size = 1 ! %finish ! %if op = INS ! %if op = MOVSU ! %if op = MOVUS %if op = CHECKi %start PB(B'11101110') form = CHKDestreg<<1 %if decode#0 %then text=text." R".itos(chkdestreg)." , " -> gengen %finish ->Missing F(15): %if op = SCondi %then z = 0 %and ->genshort yy = subforms(op)>>4 zzz = subforms(op)&15 %if yy = 0 %start { gen , gen , zzz , f , i , 00 1111 10 } {%if op = LFSR} { special case } PB(B'00111110') %if op=MOVFL %then Ffield=0 %and Ifield=3 %if op=MOVLF %then Ffield=1 %and Ifield=2 %if op=ROUNDfi %or op=TRUNCfi %or op=FLOORfi %start %if rhs_size=8 %then Ffield=0 %else Ffield=1 %finish Form = (zzz<<1) ! Ffield -> GENGEN %finish %if yy = 1 %start { gen , zzz , 01 1111 xx } ! %if op = BICPSRB %or op = BISPSRB %start ! Ifield = 0 ! RHS_size=1 ! %finish %if zzz&1 = 0 %then Ifield = 3 PB(B'01111100' ! Ifield) -> genzzz %finish %if yy = 2 %start { gen , gen zzzz 0 f 10 1111 10 } PB(B'10111110') Form = zzz Ifield=Ffield -> GENGEN %finish ->Missing F(3): %if op = ACBi %then z = 1 %and -> genQuick %if op = ADDQi %then ->genQuick yy = subforms(op)>>4 zzzz = subforms(op)&15 %if yy = 1 %start PB(B'01001110') %if op = ROTi %or op = ASHi %or op = LSHi %then RHS_size = 1 -> gengenzzzzi %finish %if yy = 3 %start PB(B'11001110') %if op = MOVXii %or op = MOVZii %start %if RHS_size = 1 %and len = 4 %thenc { MOV?BD } Ifield = 0 %elsec %if RHS_size = 2 %and len = 4 %thenc { MOV?WD } Ifield = 1 %elsec %if RHS_size = 1 %and len = 2 %thenc { MOV?BW } zzzz = zzzz-1 %and Ifield = 0 %elsec puterror(" MOV?ii - illegal combination of sizes ".itos(rhs_size)." -> ".itos(len)) %finish -> gengenzzzzi %finish %if yy = 0 %start %finish ->Missing GENGENzzzzI: form = zzzz {real form byte already out, this is just a convenience } GENGEN: genfield(SRC ,RHS) %if decode#0 %then text=text." , " genfield(DEST,LHS) PH( (src_mode<<11) ! (dest_mode<<6) ! (form<<2) ! Ifield ) TWOGENS: %if src_index#0 %then PB(src_index) %if dest_index#0 %then PB(dest_index) %if src_mode>=ByteIndexed %then nd = numdisps(src_Index>>3) %elsec nd = numdisps(src_mode) %if nd > 0 %start %if src_base#0 %then Pfixdisp(0,src_base,src_disp1) %elsec Pdisp(src_disp1) %finish %if nd = 2 %then Pdisp(src_disp2) %if src_mode = Immediate %start %if Rhs_size = 4 %then PW(src_disp1) %elsec %if Rhs_size = 2 %then PH(((src_disp1>>8)&255)!((src_disp1&255)<<8)) %elsec %if Rhs_size = 1 %then PB(src_disp1) %elsec PW(src_disp3) %and PW(src_disp1) %finish DEST: %if dest_mode>=ByteIndexed %then nd = numdisps(dest_Index>>3) %elsec nd = numdisps(dest_mode) %if nd > 0 %start %if dest_base#0 %then Pfixdisp(0,dest_base,dest_disp1) %elsec Pdisp(dest_disp1) %finish %if nd = 2 %then Pdisp(dest_disp2) %if dest_mode = Immediate %start %if lhs_size = 4 %then PW(dest_disp1) %elsec %if lhs_size = 2 %then PH(((dest_disp1>>8)&255)!((dest_disp1&255)<<8)) %elsec %if lhs_size=1 %then PB(dest_disp1) %elsec { 8 byte real } PW(dest_disp3) %and PW(dest_disp1) %finish %if op=MOVMi %or op=CMPMi %start PB(MOVMlen) %if decode#0 %then text=text." , ".itos(movmlen) %finish %if decode#0 %then PDumpInstr(text) %return GENQUICK: %if decode#0 %then text= text." ".itos(RHS_offset)." , " genfield(dest,lhs) PH( (dest_mode<<11) ! ((RHS_offset&15)<<7) ! (z<<6) ! (form<<2) ! Ifield ) ->ONEGEN genzzz: genfield(dest,lhs) PB((dest_mode<<3)!zzz) ->ONEGEN genshort: %if op=LPRi %start genfield(dest,rhs) PH( dest_mode<<11 ! LHS_intval<<7 ! z<<6 ! Form<<2 ! Ifield ) %if decode#0 %then text=text." ".sregs(lhs_intval) %finishelsestart genfield(dest,lhs) PH( dest_mode<<11 ! RHS_intval<<7 ! z<<6 ! Form<<2 ! Ifield ) %if decode#0 %start text=text." " %if op=Scondi %then text = text.conds(rhs_intval) %elsec text = text.sregs(rhs_intval) %finish %finish ONEGEN: %if dest_index#0 %then PB(dest_index) ->DEST gengenreg: form=(IndexReg<<1)!1 Ifield=3 ->gengen newline MISSING: puterror(" oplr - Opcode not catered for yet ".NSmnemonic(op)) %end; ! of oplr %constbyteintegerarray RAD(0:21)=0(9),ConstVal,DirVal,0,0,0,AddrDirmodval,0,%c Indtempmodval,IndDirModVal,0(4 ) %externalroutine SIMPLIFY(%record(Stkfmt)%name Stk, %integer op) %integer B2,Modform,Modreg,bytes,reg,Form %switch F(0:TopOfStack) Form = Stk_form&31 { get rid of Regflag } { printstring(" Simplify "); write(stk_form,1); newline} ->F(Form) F(Regvar): F(Litval): { These forms can be accessed by normal instr. opd. modes } F(FlitVAl): F(ConstVal): F(TempVal): F(TempAddr): { (temp) is @ } F(TopofStack): F(DirVal): { (dir) } F(IndTempVal): { ((temp)) } F(RegAddr): { (reg) is @ } F(RegVal): { (reg) } F(IndRegVal): { ((reg)) } %return F(StackFront): reg = Claimr(-1) OPRL(SPRi,reg,9) Stk_form = Regval!Regflag Stk_reg = reg %return F(IndDirVal): { ((dir)) } %unless STK_base=Stack %start Stk_reg = Indbase(Stk) Stk_form = IndRegVal %finish %return F(FregVal): { (freg) } Fruse(Stk_Reg)=0 %return F(RegModAddr): { (reg)+M } %if Stk_Modform=Litval %then Stk_Form=IndRegModVal %and %return %return %if op=CASEi Modreg=Load Modifier(Stk) OPRL(LSHi,Modreg,Stk_Scale) %unless Stk_Scale=0 OPRR(ADDi,STK_reg,ModReg) Stk_Form = Regval!Regflag RMem(Modreg)=0 RMem(STK_reg)=0 %return F(IndDirModVal): { ((dir)+M) } %unless STK_base=Stack %start {Can only go dbl indirect STACK - n(m(FP))} Stk_reg=Indbase(Stk) { Otherwise - have to load address } Stk_form = IndRegModVal { and go - 0(Reg) } Stk_offset=0 %finish F(AddrDirModVal): { (dir+M) } F(IndTempModVal): { ((temp)+M) } F(IndRegModVal): { ((reg)+M) } Modify: %return %if Stk_Modform=LitVal Modreg=Load Modifier(Stk) { Scaled indexing implies 'addr' mode for registers so 0(r) => r } %if stk_form=Indregmodval %and stk_modoffset=0 %then stk_form=Regmodaddr %return F(addrconst): {@const} F(AddrDir): { @dir } reg=LoadInt(MOVi,Stk,-1) %return F(TempModaddr): F(DirModAddr): %unless STK_base=Stack %start Stk_reg=Indbase(Stk) Stk_form=Indregmodval %finish %else Stk_form = IndDirModVal reg=LoadInt(ADDRx,Stk,-1) %return F(DirAddr): { (dir) is @ } Stk_Form=Dirval %return F(*): puterror(" simplify does not understand ".itos(Stk_Form)) %end;! Simplify %externalroutine opXX(%integer op,%record(Stkfmt) %name lhs,rhs) %integer RForm { All two operand instruction requests come through here } { The form of the operands is checked by Simplify } { Any required prior instructions are planted } RForm= RHS_Form { Watch out for L -> LA } %if op=MOVi %and (RForm<22 %and RAD(RForm)#0) %start { RHS addressed ? } RHS_Form = RAD(RForm) op = ADDRX %finish Simplify(rhs,op) Simplify(lhs,op) %if op = MOVi %and lhs_form=Regval %andc { side effect of load mod. } rhs_form=Regval!Regflag %andc lhs_reg=rhs_reg %then %return oplr( op,lhs,rhs) %end;! OpXX %externalroutine OPX(%integer op,%record(Stkfmt) %name S) Simplify(S,op) oplr(op,S,S{dummy}) %end %externalroutine OPFX(%integer Op,size,Reg,%record(Stkfmt)%name Stk) { An instruction of the form Floating Point register = Reg op Opd } %record(Stkfmt) R R = 0 { set up a pseudo Estack record } R_form = FregVal { so we can use the general code planting routine } R_reg = Reg R_size = size opXX(op,R,Stk) %end %externalroutine OPXF(%integer Op,%record(Stkfmt)%name Stk,%integer size,Reg) { An instruction of the form opd = Opd op FPreg } %record(Stkfmt) R R = 0 { set up a pseudo Estack record } R_form = FregVal { so we can use the general code planting routine } R_reg = Reg R_size = size opXX(op,Stk,R) %end %externalroutine OPRX(%integer Op,Reg,%record(Stkfmt)%name Stk) { An instruction of the form General register = Reg op Opd } %record(Stkfmt) R R = 0 { set up a pseudo Estack record } R_form = RegVal { so we can use the general code planting routine } R_reg = Reg R_size = 4 opXX(op,R,Stk) %end %externalroutine OPXR(%integer Op,%record(Stkfmt)%name Stk,%integer Reg) { An instruction of the form Opd = Reg } %record(Stkfmt)% R R = 0 { set up a pseudo Estack record } R_form = RegVal { so we can use the general code planting routine } R_reg = Reg R_size = 4 opXX(op,Stk,R) %end %externalroutine OPRR(%integer Op,Reg1,Reg2) { An instruction of the form Reg1 = Reg1 op Reg2 } %record(Stkfmt) R1,R2 R1 = 0 { set up a pseudo Estack record } R1_form = RegVal{ so we can use the general code planting routine } R1_reg = Reg1 R1_size = 4 R2 = R1 R2_reg = Reg2 oplr(op,R1,R2) %end %externalroutine IndexInstr(%record(stkfmt) %name accum,length,index) Indexreg=LoadInt(MOVi,accum,-1) OPXX(INDEXi,length,index) %end %externalroutine COMPRESS (%record(Stkfmt)%name R) { get opd to smallest byte form} %integer i %return %unless R_form = LitVal %return %if r_size =1 i = R_intval %if i >= 0 %start %if i &x'FFFFFF80' = 0 %then R_size = 1 %elsec %if i &x'FFFF8000' = 0 %then R_size = 2 %finishelsestart %if i &x'FFFFFF80' = x'FFFFFF80' %then R_size = 1 %elsec %if i &x'FFFF8000' = x'FFFF8000' %then R_size = 2 %finish %end;! of Compress %externalroutine MoveMultiple(%integer l ,%record(stkfmt) %name from,to) %integer intsize,op { MOVM is unusual in having 'addr' type operands } %if l <0 %then l = -l %and op = CMPMi %else op=MOVMi %if l&3=0 %then intsize=4 %elsec %if l&1=0 %then intsize=2 %else intsize=1 MOVMlen = ((l//intsize)-1)*intsize { remember for use in oplr } to_size = intsize OPXX(op,to,from) { No overlaps } %end %externalroutine CompareMultiple(%integer l ,%record(stkfmt) %name from,to) MoveMultiple(-l,from,to) %end %externalroutine CopyBytes(%record(stkfmt) %name len,from,to) %ownstring(7) mnem = "MOVSi" %integer reg,l,intsize { If there is NO risk of this being an overlapping move then short lengths} { can use MOVMi. MOVSi is safe for overlaps. } %if len_form = Litval %start l = Len_Intval %return %if l<=0 %if l<17 %start %finish len_size = 4 %finish Reg = LoadInt(MOVi,len,0) { Length to move must be in Reg 0} ruse(0)= -255; rmem(0)=0 from_size = 4 Reg = LoadInt(MOVi,from,1) { Source Ad must be in Reg 1 } ruse(1)= -255; rmem(1)=0 to_size = 4 Reg = LoadInt(MOVi,to,2) { Target Ad must be in Reg 2 } ruse(2)= -255 PREV = CA PB(B'00001110') { Plant actual MOVSi opcode } PB(B'00000000') PB(B'00000000') %if decode#0 %then PDumpInstr(mnem) ruse(0) = 0 { Free all registers involved } ruse(1) = 0 ruse(2) = 0 rmem(0) = 0 { MOVSi changes the registers } rmem(1) = 0 { so forget what was in them. } rmem(2) = 0 %end %externalroutine Compare Bytes(%record(Stkfmt)%name len,from,to) !*********************************************************************** %ownstring(7) mnem = "CMPSi" %integer reg,l,intsize %if len_form = Litval %start l = Len_Intval %return %if l<=0 %if l<17 %start %finish len_size = 4 %finish Reg = LoadInt(MOVi,len,0) { Length to move must be in Reg 0} ruse(0)= -255; rmem(0)=0 from_size = 4 Reg = LoadInt(MOVi,from,1) { Source Ad must be in Reg 1 } ruse(1)= -255; rmem(1)=0 to_size = 4 Reg = LoadInt(MOVi,to,2) { Target Ad must be in Reg 2 } ruse(2)= -255 PREV = CA PB(B'00001110') { Plant actual CMPSi opcode } PB(B'00000100') PB(B'00000000') %if decode#0 %then PDumpInstr(mnem) ruse(0) = 0 { Free all registers involved } ruse(1) = 0 ruse(2) = 0 rmem(0) = 0 rmem(1) = 0 rmem(2) = 0 CCset = 1 %end;! Compare Bytes %externalroutine OPDD(%integer op,base1,disp1,base2,disp2) %record(Stkfmt) LHS,RHS LHS=0; RHS=0 LHS_form = Dirval RHS_form = Dirval LHS_base = base1 RHS_base = base2 LHS_Offset = disp1 LHS_size = 4 RHS_offset = disp2 oplr(op,LHS,RHS) %end %externalroutine OPRD(%integer op, reg,base,disp) %record(stkfmt) RHS RHS = 0 RHS_form = Dirval RHS_base=base RHS_Offset=disp OPRX(op,reg,RHS) %end %externalroutine OPCHECK(%record(stkfmt) %name Stk,%integer area,disp,size, %integername reg) %record(stkfmt) LHS CoerceInt(stk,size) %unless Stk_size=size %if reg=-1 %start CHKDestreg = claimr(-1) reg = CHKDestreg %finishelse CHKDestreg = reg LHS=0 %if area<0 %start { disp(reg) } LHS_form=IndRegModVAl LHS_reg = - area LHS_modoffset = disp LHS_MODform=Litval %finishelsestart { disp(area) } LHS_form=Dirval LHS_base=area LHS_offset=disp %finish LHS_size=4 OPXX(CHECKi,STK,LHS) %end %externalroutine OPDR(%integer op, base,disp,reg) %record(stkfmt) LHS LHS = 0 LHS_form = Dirval LHS_base=base LHS_Offset=disp OPXR(op,LHS,reg) %end %externalroutine OPDL(%integer op,base,disp,lit,size) %record(Stkfmt) LHS,RHS LHS=0; RHS=0 LHS_form = Dirval RHS_form = LitVal LHS_base = base LHS_Offset = disp LHS_size = size RHS_Intval = lit oplr(op,LHS,RHS) %end %externalroutine OPLD(%integer op,lit,base,disp) %record(Stkfmt) LHS,RHS LHS=0; RHS=0 RHS_form = Dirval LHS_form = LitVal RHS_base = base RHS_Offset = disp RHS_size = 4 LHS_Intval = lit oplr(op,LHS,RHS) %end %externalroutine OPFD(%integer op,reg,size1,base,disp,size2) %record(stkfmt) lhs,rhs LHS=0 LHS_Form=Fregval LHS_reg=reg LHS_size=size1 RHS=0 RHS_Form=Dirval RHS_base=base RHS_offset=disp RHS_size=size2 OPXX(op,LHS,RHS) %end %externalroutine OPDF(%integer op,base,disp,size1,reg,size2) %record(stkfmt) lhs,rhs LHS=0 LHS_Form=Dirval LHS_base=base LHS_offset=disp LHS_size=size1 RHS=0 RHS_Form=Fregval RHS_reg=reg RHS_size=size2 OPXX(op,LHS,RHS) %end %externalroutine OPRL(%integer op,reg,lit) %record(Stkfmt) RHS RHS=0 RHS_form = LitVal RHS_Intval = lit OPRX(op,reg,RHS) %end %externalroutine OPDX(%integer op,base1,disp1,%record(Stkfmt) %name RHS) %record(Stkfmt) LHS LHS=0 LHS_form=Dirval LHS_base = base1 LHS_Offset = disp1 LHS_size = 4 oplr(op,LHS,RHS) %end %externalroutine OPXL(%integer op,%record(Stkfmt) %name LHS, %integer lit) %record(Stkfmt) RHS RHS=0 RHS_form = LitVal RHS_Intval = lit oplr(op,LHS,RHS) %end %externalroutine OPFF(%integer op, Freg1,size1,Freg2,size2) %record(stkfmt) LHS,RHS LHS = 0 LHS_form = FREGval RHS = LHS LHS_reg = Freg1 RHS_reg = Freg2 LHS_size = size1 RHS_size = size2 %if op=TRUNCfi %then LHS_form=Regval %if op=MOVif %then RHS_form=Regval { not worth having opRF and opFR just for these } OPXX(op,LHS,RHS) %end %externalroutine EgenerateObject(%string(255) %name objfilename) %end %endoffile