MODULE FoxAMD64Assembler; (** AUTHOR "fn & fof"; PURPOSE "Oberon Compiler:AMD 64 Assembler"; **) (* (c) fof ETH Zürich, 2008-2017 *) (* this module has in great portions been taken over from Florian Negele's PCAAMD64.Mod *) IMPORT Basic := FoxBasic, Scanner := FoxScanner, SyntaxTree := FoxSyntaxTree, Global := FoxGlobal, InstructionSet := FoxAMD64InstructionSet, Sections := FoxSections, BinaryCode := FoxBinaryCode, SYSTEM, Streams, Strings, Commands, KernelLog, Diagnostics, IntermediateCode := FoxIntermediateCode, ObjectFile ; CONST Trace= FALSE; none* = InstructionSet.none; (* rex prefix bit positions *) rexB = 0; rexX = 1; rexR = 2; rexW= 3; rex = 4; (* register indices, the numbers have a meaning in instruction encoding, do not modify *) RAX* = 0; EAX*=0; AX*=0; AL*=0; RCX* = 1; ECX*=1; CX*=1; CL*=1; RDX* = 2;EDX*=2; DX*=2; DL*=2; RBX* = 3;EBX*=3; BX*=3; BL*=3; RSP* = 4; ESP*=4; SP*=5; SPL*=4; AH*=4; RBP* = 5; EBP*=5; BP*=5; BPL*=5; CH*=5; RSI* = 6; ESI*=6; SI*=6; SIL*=6; DH*=6; RDI* = 7;EDI*=7; DI*=7; DIL*=7; BH*=7; R8*= 8; R8D*=8; R8W*=8; R8B*=8; R9* = 9;R9D*=9; R9W*=9; R9B*=9; R10* = 10;R10D*=10; R10W*=10; R10B*=10; R11* = 11;R11D*=11; R11W*=11; R11B*=11; R12* = 12;R12D*=12; R12W*=12; R12B*=12; R13* = 13;R13D*=13; R13W*=13; R13B*=13; R14* = 14;R14D*=14; R14W*=14; R14B*=14; R15* = 15;R15D*=15; R15W*=15; R15B*=15; RIP* = 16; (* segment registers *) segES = 0; segCS = 1; segSS = 2; segDS = 3; segFS = 4; segGS = 5; (* sizes *) bitsDefault* = 0; bits8* = 1; bits16* = 2; bits32* = 4; bits64* = 8; bits128* = 16; bits256* = 32; (** constants from InstructionSet **) (* instruction encoding *) opCode = InstructionSet.opCode; modRMExtension= InstructionSet.modRMExtension; modRMBoth= InstructionSet.modRMBoth; cb= InstructionSet.cb; cw= InstructionSet.cw; cd= InstructionSet.cd; cp= InstructionSet.cp; ib= InstructionSet.ib; iw= InstructionSet.iw; id= InstructionSet.id; iq= InstructionSet.iq; rb= InstructionSet.rb; rw= InstructionSet.rw; rd= InstructionSet.rd; rq= InstructionSet.rq; mem64Operand= InstructionSet.mem64Operand; mem128Operand= InstructionSet.mem128Operand; fpStackOperand= InstructionSet.fpStackOperand; directMemoryOffset= InstructionSet.directMemoryOffset; RXB = InstructionSet.RXB; Src1Prefix = InstructionSet.Src1Prefix; (* limits *) maxNumberOperands = InstructionSet.maxNumberOperands; (* operand types, values have no meaning but do coincide with symbols in the instruction set module *) reg8*= InstructionSet.reg8; reg16*= InstructionSet.reg16; reg32*= InstructionSet.reg32; reg64*= InstructionSet.reg64; CRn*= InstructionSet.CRn; DRn*= InstructionSet.DRn; segReg*= InstructionSet.segReg; mmx*= InstructionSet.mmx; xmm*= InstructionSet.xmm; ymm*= InstructionSet.ymm; mem*=InstructionSet.mem; sti*= InstructionSet.sti; imm*= InstructionSet.imm; ioffset*=InstructionSet.ioffset; pntr1616*= InstructionSet.pntr1616; pntr1632*=InstructionSet.pntr1632; (* scanner codes *) TAB = 09X; LF = 0AX; CR = 0DX; SPACE = 20X; (* symbol values *) symNone = 0; symIdent = 1; symLabel = 2; symNumber = 3; symSemicolon = 4; symColon = 5; symLn = 6; symComma = 7; symString = 8; symPlus = 9; symMinus = 10; symTimes = 11; symDiv = 12; symLParen = 13; symRParen = 14; symLBrace = 15; symRBrace = 16; symLBraket = 17; symRBraket = 18; symPC = 19; symPCOffset = 20; symNegate = 21; symMod = 22; symPeriod = 23; symAt = 24; symEnd = 25; TYPE Name = Scanner.IdentifierString; Size = SHORTINT; Register* = LONGINT; (* index for InstructionSet.registers *) (* an implementation of Operands as objects is very elegant but unfortunately also very costly in terms of number of allocations *) Operand* = RECORD type-: SHORTINT; (* reg8..reg64, CRn,DRn, segReg, sti, mmx, xmm, mem, imm, moffset, pntr1616, pntr1632 *) (* assembler examples: reg8: AL => register = InstructionSet.regAL reg16: CX => register = InstructionSet.regCX reg32: EBX => register = InstructionSet.regEBX reg64: RCX => register = InstructionSet.regRCX mem: BYTE [EAX+EBX*4+16] => register = EAX, index = EBX, scale = 4, displacement = 16, size = 8 imm: DWORD 256 => val = 256, size = 32 *) register-: Register; (* for registers and mem *) sizeInBytes-: Size; (* for mem and imm and moffset *) segment-,index-: Register; (* registers for mem *) scale-, displacement-: LONGINT; (* for mem *) symbol- : ObjectFile.Identifier; (* for imm and mem *) symbolOffset-: LONGINT; (* offset in immediate code (source) for a fixup *) val-: HUGEINT; (* for imm and moffset *) pc-: LONGINT; selector-, offset-: LONGINT; (* for pntr1616 / pntr1632 *) END; Code* = BinaryCode.Section; NamedLabel*= OBJECT VAR offset: LONGINT; name-: SyntaxTree.IdentifierString; nextNamedLabel-: NamedLabel; index-: LONGINT; PROCEDURE &InitNamedLabel(offset: LONGINT; CONST name: ARRAY OF CHAR); BEGIN SELF.offset := offset; COPY(name,SELF.name); nextNamedLabel := NIL; END InitNamedLabel; PROCEDURE SetOffset*(ofs: LONGINT); BEGIN SELF.offset := ofs; END SetOffset; END NamedLabel; NamedLabelList*=OBJECT VAR first-,last-: NamedLabel; number-: LONGINT; PROCEDURE & InitNamedLabelList; BEGIN first := NIL; last := NIL; number := 0; END InitNamedLabelList; PROCEDURE Add*(n: NamedLabel); BEGIN IF first = NIL THEN first := n ELSE last.nextNamedLabel := n; last.nextNamedLabel := n; END; last := n; INC(number); n.index := number; END Add; PROCEDURE Find*(CONST name: ARRAY OF CHAR): NamedLabel; VAR label: NamedLabel; BEGIN label := first; WHILE (label # NIL) & (label.name # name) DO label := label.nextNamedLabel; END; RETURN label END Find; END NamedLabelList; Emitter*=OBJECT VAR code-: Code; error-: BOOLEAN; diagnostics: Diagnostics.Diagnostics; assembly: Assembly; (* for error position *) (* overal state *) cpuBits: Size; (* supported bit width for this cpu / target *) cpuOptions: InstructionSet.CPUOptions; dump: Streams.Writer; PROCEDURE & InitEmitter*(diagnostics: Diagnostics.Diagnostics); BEGIN SELF.diagnostics := diagnostics; cpuBits := bits32; cpuOptions := {0..31}; error := FALSE; END InitEmitter; PROCEDURE SetCode*(code: BinaryCode.Section); BEGIN SELF.code := code; dump := code.comments END SetCode; PROCEDURE SetBits* (numberBits: LONGINT): BOOLEAN; BEGIN CASE numberBits OF 16: cpuBits := bits16; | 32: cpuBits := bits32; | 64: cpuBits := bits64; ELSE Error("number bits not supported"); RETURN FALSE; END; RETURN TRUE; END SetBits; PROCEDURE Error(CONST message: ARRAY OF CHAR); VAR msg,name: ARRAY 256 OF CHAR; errPos: Basic.Position; BEGIN COPY(message,msg); Strings.Append(msg," in "); ObjectFile.SegmentedNameToString(code.os.identifier.name,name); Strings.Append(msg, name); IF assembly # NIL THEN errPos := assembly.errPos ELSE errPos := Basic.invalidPosition END; Basic.Error(diagnostics,"",errPos,msg); error := TRUE; IF dump # NIL THEN dump.Update; END; END Error; PROCEDURE ErrorSS(CONST msg1,msg2: ARRAY OF CHAR); VAR message: ARRAY 256 OF CHAR; BEGIN COPY(msg1,message); Strings.Append(message," : "); Strings.Append(message, msg2); Error(message); END ErrorSS; PROCEDURE ErrorSI(CONST msg1: ARRAY OF CHAR; mnemonic: LONGINT; CONST operands: ARRAY OF Operand); VAR s: Streams.StringWriter; msg: Basic.MessageString; BEGIN NEW(s,LEN(msg)); DumpInstruction(s,mnemonic,operands); s.String(" @"); s.Int(code.pc,1); s.Get(msg); ErrorSS(msg1,msg); END ErrorSI; PROCEDURE AddFixup (mode: SHORTINT; size: SHORTINT; pc: LONGINT; symbol: ObjectFile.Identifier; symbolOffset, displacement: LONGINT); VAR fixup: BinaryCode.Fixup; format: BinaryCode.FixupPatterns; id: ObjectFile.Identifier; BEGIN NEW(format,1); format[0].bits:= size*8; format[0].offset := 0; fixup := BinaryCode.NewFixup(mode,pc,symbol,symbolOffset,displacement,0,format); code.fixupList.AddFixup(fixup); END AddFixup; PROCEDURE EmitInstruction (mnem: LONGINT; VAR operands: ARRAY OF Operand; lastPass: BOOLEAN): BOOLEAN; VAR instr, i, oppos, op: LONGINT; val: LONGINT; regOperand: LONGINT; addressOperand: LONGINT; regField, modField, rmField: LONGINT; scaleField, indexField, baseField: LONGINT; free: ARRAY maxNumberOperands OF BOOLEAN; byte: LONGINT; offset: LONGINT; opPrefix, adrPrefix: BOOLEAN; segPrefix: LONGINT; rexPrefix: SET; bitwidthOptions: SET; opcode: ARRAY InstructionSet.maxCodeLength OF InstructionSet.Code; pc0: LONGINT; debug,temp: LONGINT; PROCEDURE FindInstruction(mnem: LONGINT; CONST operands: ARRAY OF Operand): LONGINT; VAR instr: LONGINT; PROCEDURE MatchesInstruction (): BOOLEAN; VAR i: LONGINT; BEGIN FOR i := 0 TO maxNumberOperands - 1 DO IF (i>=LEN(operands)) OR (operands[i].type = none) THEN (* no operand -> check if instruction has no operand here *) IF InstructionSet.instructions[instr].operands[i] # none THEN RETURN FALSE END; ELSIF ~Matches(operands[i],InstructionSet.instructions[instr].operands[i]) THEN (* instruction operand type and this operand do not match *) RETURN FALSE ELSIF (cpuBits = bits64) & (InstructionSet.optNot64 IN InstructionSet.instructions[instr].bitwidthOptions) THEN (* instruction is invalid in 64 bit mode *) RETURN FALSE; END; END; RETURN TRUE; END MatchesInstruction; BEGIN instr := InstructionSet.mnemonics[mnem].firstInstruction; WHILE (instr <= InstructionSet.mnemonics[mnem].lastInstruction) & (~MatchesInstruction ()) DO INC (instr); END; IF instr > InstructionSet.mnemonics[mnem].lastInstruction THEN ErrorSI("invalid combination of opcode and operands", mnem,operands); RETURN none; ELSIF InstructionSet.instructions[instr].cpuOptions * cpuOptions # InstructionSet.instructions[instr].cpuOptions THEN ErrorSI("invalid instruction for current target", mnem,operands); RETURN none; END; RETURN instr END FindInstruction; PROCEDURE GetRegOperand (): LONGINT; VAR i: LONGINT; BEGIN FOR i := 0 TO maxNumberOperands -1 DO CASE InstructionSet.instructions[instr].operands[i] OF InstructionSet.reg8, InstructionSet.reg16, InstructionSet.reg32, InstructionSet.reg64, InstructionSet.xmm, InstructionSet.mmx, InstructionSet.ymm: RETURN i; ELSE END; END; RETURN none; END GetRegOperand; PROCEDURE GetAddressOperand (): LONGINT; VAR i: LONGINT; BEGIN FOR i := 0 TO maxNumberOperands -1 DO CASE InstructionSet.instructions[instr].operands[i] OF InstructionSet.mem, InstructionSet.mem8, InstructionSet.mem16, InstructionSet.mem32, InstructionSet.mem64, InstructionSet.mem128, InstructionSet.regmem8, InstructionSet.regmem16, InstructionSet.regmem32, InstructionSet.regmem64, InstructionSet.mmxmem32, InstructionSet.mmxmem64, InstructionSet.ymmmem128, InstructionSet.ymmmem256, InstructionSet.xmmmem32, InstructionSet.xmmmem64, InstructionSet.xmmmem128: RETURN i; ELSE END; END; RETURN none; END GetAddressOperand; PROCEDURE GetSpecialOperand (): LONGINT; VAR i: LONGINT; BEGIN FOR i := 0 TO maxNumberOperands -1 DO CASE InstructionSet.instructions[instr].operands[i] OF InstructionSet.segReg, InstructionSet.mmx, InstructionSet.xmm, InstructionSet.ymm, InstructionSet.CRn, InstructionSet.DRn: RETURN i; ELSE END; END; RETURN none; END GetSpecialOperand; PROCEDURE ModRM (mod, reg, rm: LONGINT); BEGIN IF Trace THEN KernelLog.String("ModRM"); KernelLog.Int(mod,1); KernelLog.String(","); KernelLog.Int(reg,1); KernelLog.String(","); KernelLog.Int(rm,1); KernelLog.Ln; END; code.PutByte (mod MOD 4 * 40H + reg MOD 8 * 8H + rm MOD 8); END ModRM; PROCEDURE SIB (scale, index, base: LONGINT); BEGIN code.PutByte (scale MOD 4 * 40H + index MOD 8 * 8H + base MOD 8); END SIB; PROCEDURE FPOrSSEOperation(instr: LONGINT): BOOLEAN; BEGIN RETURN {InstructionSet.cpuFPU, InstructionSet.cpuSSE, InstructionSet.cpuSSE2, InstructionSet.cpuSSE3} * InstructionSet.instructions[instr].cpuOptions # {} END FPOrSSEOperation; PROCEDURE FPOperation(instr: LONGINT): BOOLEAN; BEGIN RETURN {InstructionSet.cpuFPU} * InstructionSet.instructions[instr].cpuOptions # {} END FPOperation; PROCEDURE IsPreREXPrefix(c1,c2: CHAR): BOOLEAN; BEGIN RETURN (c1 = CHR(opCode)) & ((c2 = 0F2X) OR (c2 = 0F3X) ) ; END IsPreREXPrefix; BEGIN IF (dump # NIL) & (lastPass) THEN pc0 := code.pc; DumpInstruction(dump,mnem,operands); dump.Update; END; IF Trace THEN DumpInstruction(kernelWriter,mnem,operands); kernelWriter.Update; END; instr := FindInstruction(mnem,operands); IF instr = none THEN RETURN FALSE END; IF Trace THEN KernelLog.String("instr = "); KernelLog.Int(instr,1); KernelLog.Ln; END; bitwidthOptions := InstructionSet.instructions[instr].bitwidthOptions; FOR i := 0 TO InstructionSet.maxCodeLength-1 DO opcode[i] := InstructionSet.instructions[instr].code[i] END; opPrefix := FALSE; adrPrefix := FALSE; segPrefix := none; rexPrefix := {}; IF (InstructionSet.optO16 IN bitwidthOptions) & (cpuBits # bits16) THEN IF Trace THEN KernelLog.String(" optO16 "); KernelLog.Ln; END; opPrefix := TRUE; END; IF (InstructionSet.optO32 IN bitwidthOptions) & (cpuBits = bits16) THEN IF Trace THEN KernelLog.String(" optO32 "); KernelLog.Ln; END; opPrefix := TRUE; END; IF (InstructionSet.optO64 IN bitwidthOptions) & (cpuBits = bits64) THEN IF Trace THEN KernelLog.String(" optO64 "); KernelLog.Ln; END; INCL (rexPrefix, rexW) END; IF InstructionSet.optPOP IN bitwidthOptions THEN IF Trace THEN KernelLog.String(" optPOP "); KernelLog.Ln; END; opPrefix := TRUE; END; regOperand := GetSpecialOperand (); addressOperand := GetAddressOperand (); IF regOperand = none THEN regOperand := GetRegOperand (); END; IF addressOperand = none THEN addressOperand := GetRegOperand (); IF regOperand # none THEN temp := InstructionSet.instructions[instr].operands[regOperand]; IF (temp = xmm) OR (temp = mmx) THEN (* patch case such as PEXTRW EDX, XMM3, 0 *) temp := addressOperand; addressOperand := regOperand; regOperand := temp; END; ELSE END; END; IF mnem = InstructionSet.opMOVQ2DQ THEN (* patch *) regOperand := 0; addressOperand :=1; END; (* KernelLog.String (InstructionSet.mnemonics[mnem].name); KernelLog.Int (regOperand, 10); KernelLog.Int (addressOperand, 10); KernelLog.Ln; *) FOR i := 0 TO maxNumberOperands - 1 DO IF operands[i].type # none THEN IF operands[i].type = mem THEN IF Trace THEN KernelLog.String("mem"); KernelLog.Ln; END; IF operands[i].segment# none THEN IF Trace THEN KernelLog.String(" segment "); KernelLog.Ln; END; segPrefix := InstructionSet.RegisterIndex(operands[i].segment); END; IF operands[i].register# none THEN IF Trace THEN KernelLog.String(" register "); KernelLog.Int(operands[i].register,1); KernelLog.Ln; END; IF (InstructionSet.RegisterIndex(operands[i].register) >= 8) THEN IF Trace THEN KernelLog.String(" rexprefix "); KernelLog.Ln; END; INCL (rexPrefix, rexB) END; IF (InstructionSet.RegisterType(operands[i].register) = reg32) & (cpuBits # bits32) THEN IF cpuBits = bits64 THEN ErrorSI("invalid effective address (1)", mnem,operands); RETURN FALSE; ELSE IF Trace THEN KernelLog.String(" adr prefix "); KernelLog.Ln; END; adrPrefix := TRUE; END; END; IF InstructionSet.RegisterType(operands[i].register)=reg16 THEN IF cpuBits = bits64 THEN ErrorSI("invalid effective address (1)", mnem,operands); RETURN FALSE; ELSIF cpuBits = bits32 THEN IF Trace THEN KernelLog.String(" adr prefix (2) "); KernelLog.Ln; END; adrPrefix := TRUE; END; END; END; IF operands[i].index # none THEN IF Trace THEN KernelLog.String(" mem index "); KernelLog.Int(operands[i].index,1); KernelLog.Ln; END; IF (InstructionSet.RegisterType(operands[i].index)=reg64) & (InstructionSet.RegisterIndex(operands[i].index) >= 8) THEN INCL (rexPrefix, rexX) END END; IF (operands[i].sizeInBytes = bits64) & ~(InstructionSet.optD64 IN bitwidthOptions) & ~FPOperation(instr) THEN IF (InstructionSet.instructions[instr].operands[i] = InstructionSet.regmem64) OR (InstructionSet.instructions[instr].operands[i] = InstructionSet.mem) THEN IF Trace THEN KernelLog.String(" rex prefix bits64 "); KernelLog.Ln; END; INCL(rexPrefix,rexW); END; END; IF InstructionSet.instructions[instr].operands[i] = InstructionSet.moffset64 THEN IF Trace THEN KernelLog.String(" moffset64 "); KernelLog.Ln; END; adrPrefix := TRUE; END; ELSIF IsRegisterOperand(operands[i]) (* is register *) THEN IF Trace THEN KernelLog.String("register"); KernelLog.Ln; END; IF (operands[i].type = reg64) & ~(InstructionSet.optD64 IN bitwidthOptions) THEN IF Trace THEN KernelLog.String(" reg64 "); KernelLog.Ln; END; INCL (rexPrefix, rexW) END; IF InstructionSet.RegisterIndex(operands[i].register) >= 8 THEN IF i = addressOperand THEN INCL (rexPrefix, rexB) ELSIF i = regOperand THEN INCL (rexPrefix, rexR) END; ELSIF (cpuBits = bits64) & (operands[i].type = reg8) & (operands[i].register >= InstructionSet.regSPL) & (operands[i].register <= InstructionSet.regDIL) THEN INCL (rexPrefix, rex); END; END; END; free[i] := operands[i].type # none; END; CASE segPrefix OF none: | segES: code.PutByte (InstructionSet.prfES); | segCS: code.PutByte (InstructionSet.prfCS); | segSS: code.PutByte (InstructionSet.prfSS); | segDS: code.PutByte (InstructionSet.prfDS); | segFS: code.PutByte (InstructionSet.prfFS); | segGS: code.PutByte (InstructionSet.prfGS); END; IF opPrefix THEN code.PutByte (InstructionSet.prfOP) END; IF adrPrefix THEN code.PutByte (InstructionSet.prfADR) END; IF InstructionSet.optPLOCK IN bitwidthOptions THEN code.PutByte (InstructionSet.prfLOCK) END; IF InstructionSet.optPREP IN bitwidthOptions THEN code.PutByte (InstructionSet.prfREP) END; IF InstructionSet.optPREPN IN bitwidthOptions THEN code.PutByte (InstructionSet.prfREPNE) END; op := 0; oppos := 0; val := -1; IF rexPrefix # {} THEN ASSERT(cpuBits = bits64); byte := 40H; WHILE (oppos < LEN(opcode)-1) & IsPreREXPrefix(opcode[oppos], opcode[oppos+1]) DO code.PutByte(ORD(opcode[oppos+1])); INC(oppos,2); END; IF rexB IN rexPrefix THEN byte := byte + 1H END; IF rexX IN rexPrefix THEN byte := byte + 2H END; IF rexR IN rexPrefix THEN byte := byte + 4H END; IF rexW IN rexPrefix THEN byte := byte + 8H END; code.PutByte (byte); END; WHILE (oppos < LEN(opcode)) & (opcode[oppos] # CHR(none)) DO IF opcode[oppos] = CHR(opCode) THEN IF Trace THEN KernelLog.String("opcode "); KernelLog.Hex(ORD(opcode[oppos+1]),-2); END; IF val # -1 THEN code.PutByte (val) END; INC(oppos); val := ORD(opcode[oppos]); ELSE CASE ORD(opcode[oppos]) OF | modRMExtension, modRMBoth: IF Trace THEN KernelLog.String(" modRMExtension/Both "); END; IF val # -1 THEN code.PutByte (val); val := -1 END; IF opcode[oppos] = CHR(modRMBoth) (* /r *) THEN regField := InstructionSet.RegisterIndex(operands[regOperand].register) MOD 8; ELSE (* /digit *) INC(oppos); regField := ORD(opcode[oppos]); IF Trace THEN KernelLog.String(" digit: "); KernelLog.Int(regField,1); KernelLog.Ln; END; END; IF IsRegisterOperand(operands[addressOperand]) THEN IF Trace THEN KernelLog.String(" isRegisterOperand "); END; ModRM (3, regField, InstructionSet.RegisterIndex(operands[addressOperand].register) MOD 8); ELSIF (cpuBits = bits16) & (InstructionSet.RegisterType(operands[addressOperand].register) # reg32) THEN IF Trace THEN KernelLog.String(" cpuBits=16 "); END; IF (operands[addressOperand].scale # 1) OR (operands[addressOperand].symbol.name # "") THEN ErrorSI("invalid effective address (2)", mnem,operands); RETURN FALSE; ELSIF operands[addressOperand].register= none THEN IF operands[addressOperand].index =none THEN ErrorSI("invalid effective address (3)", mnem,operands); RETURN FALSE; END; ModRM (0, regField, 6); code.PutWord (operands[addressOperand].displacement); ELSIF InstructionSet.RegisterType(operands[addressOperand].register) = reg16 THEN IF operands[addressOperand].displacement = 0 THEN modField := 0; ELSIF (operands[addressOperand].displacement >= -80H) & (operands[addressOperand].displacement < 80H) THEN modField := 1; ELSIF (operands[addressOperand].displacement >= -8000H) & (operands[addressOperand].displacement < 8000H) THEN modField := 2; ELSE Error("value exceeds bounds"); RETURN FALSE; END; CASE InstructionSet.RegisterIndex(operands[addressOperand].register) OF | RBX: IF operands[addressOperand].index = none THEN rmField := 7; ELSIF InstructionSet.RegisterIndex(operands[addressOperand].index) = RSI THEN rmField := 0; ELSIF InstructionSet.RegisterIndex(operands[addressOperand].index) = RDI THEN rmField := 1; ELSE ErrorSI("invalid effective address (4)", mnem,operands); RETURN FALSE; END | RBP: IF operands[addressOperand].index = none THEN rmField := 6; IF modField = 0 THEN modField := 1 END; ELSIF InstructionSet.RegisterIndex(operands[addressOperand].index) = RSI THEN rmField := 2; ELSIF InstructionSet.RegisterIndex(operands[addressOperand].index) = RDI THEN rmField := 3; ELSE ErrorSI("invalid effective address (5)", mnem,operands); RETURN FALSE; END | RSI: IF operands[addressOperand].index = none THEN rmField := 4; ELSIF InstructionSet.RegisterIndex(operands[addressOperand].index) = RBX THEN rmField := 0; ELSIF InstructionSet.RegisterIndex(operands[addressOperand].index) = RBP THEN rmField := 2; ELSE ErrorSI("invalid effective address (6)", mnem,operands); RETURN FALSE; END; | RDI: IF operands[addressOperand].index = none THEN rmField := 5; ELSIF InstructionSet.RegisterIndex(operands[addressOperand].index) = RBX THEN rmField := 1; ELSIF InstructionSet.RegisterIndex(operands[addressOperand].index) = RBP THEN rmField := 3; ELSE ErrorSI("invalid effective address (7)", mnem,operands); RETURN FALSE; END; ELSE ErrorSI("invalid effective address (8)", mnem,operands); RETURN FALSE; END; ModRM (modField, regField, rmField); IF modField = 1 THEN code.PutByte (operands[addressOperand].displacement); ELSIF modField = 2 THEN code.PutWord (operands[addressOperand].displacement); END; END; ELSE (* cpuBits # 16 *) ASSERT(operands[addressOperand].type = mem); IF Trace THEN KernelLog.String(" cpuBits # 16 "); END; IF (operands[addressOperand].register= none) & (operands[addressOperand].index = none) THEN IF Trace THEN KernelLog.String(" no register, no index "); END; IF operands[addressOperand].scale # 1 THEN ErrorSI("invalid effective address (9)", mnem,operands); RETURN FALSE; END; IF cpuBits = bits64 THEN ModRM (0, regField, 4); SIB (0, 4, 5); ELSE ModRM (0, regField, 5); END; (* fixup must be 8bit wide for linker! IF lastPass & (operands[addressOperand].fixup # NIL) THEN AddFixup (operands[addressOperand].fixup, pc); END; *) IF lastPass & (operands[addressOperand].symbol.name # "") THEN AddFixup(BinaryCode.Absolute,4,code.pc,operands[addressOperand].symbol, operands[addressOperand].symbolOffset,operands[addressOperand].displacement) END; code.PutDWord (operands[addressOperand].displacement); ELSE IF (operands[addressOperand].index # none) THEN (* index register available: must use SIB memory reference *) IF Trace THEN KernelLog.String(" index "); END; IF (InstructionSet.RegisterIndex(operands[addressOperand].index) = RSP) OR (InstructionSet.RegisterIndex(operands[addressOperand].index) = RIP) THEN ErrorSI("invalid effective address: unsupported stack / instruction pointer index", mnem,operands); RETURN FALSE; END; IF (operands[addressOperand].register# none) & (InstructionSet.RegisterIndex(operands[addressOperand].register) = RIP) THEN ErrorSI("invalid effective address: unsupported instruction base pointer with index", mnem,operands); RETURN FALSE; END; CASE operands[addressOperand].scale OF 1: scaleField := 0; | 2: scaleField := 1; | 4: scaleField := 2; | 8: scaleField := 3; ELSE ErrorSI("invalid effective address (12)", mnem,operands); RETURN FALSE; END; rmField := 4; (* indicates usage of SIB byte *) ELSE (* no index register available *) IF Trace THEN KernelLog.String(" no index ") END; IF (operands[addressOperand].scale # 1) THEN ErrorSI("invalid effective address: scale without index register", mnem,operands); RETURN FALSE; END; IF operands[addressOperand].register = none THEN (* no index, no base *) rmField := 4; (* indicates usage of SIB byte *) ELSIF InstructionSet.RegisterIndex(operands[addressOperand].register) = RIP THEN rmField := 5; (* indicates usage of instruction pointer, must be followed by 32 bit displacement, modField must be 0 *) ELSIF InstructionSet.RegisterIndex(operands[addressOperand].register) MOD 8 = RSP THEN rmField := 4; (* indicates usage of SIB byte => stack pointer must be referenced in SIB byte *) ELSE rmField := InstructionSet.RegisterIndex(operands[addressOperand].register) MOD 8; (* any other register can be encoded via modRM field *) END; END; (* IF operands[addressOperand].fixup # NIL THEN modField := 2; mem fixups only for local variables and parameters *) IF operands[addressOperand].displacement = 0 THEN (* no displacement => modRM = 0 except for base pointer, which must be encoded with (zero) displacement *) IF Trace THEN KernelLog.String(" no displacement "); END; IF (operands[addressOperand].register # none) & (InstructionSet.RegisterIndex(operands[addressOperand].register) = RBP) THEN modField := 1; ELSIF (operands[addressOperand].register # none) & (InstructionSet.RegisterIndex(operands[addressOperand].register) = R13) THEN modField := 1; ELSE modField := 0; END; ELSIF (operands[addressOperand].register = none) & (operands[addressOperand].index # none) THEN modField := 0; (* 32 bit displacement without base register encoded via SIB byte *) ELSIF (operands[addressOperand].register # none) & (InstructionSet.RegisterIndex(operands[addressOperand].register) = RIP) THEN (* if there is displacement on RIP, we still have to use the modRM = 0 case *) IF cpuBits = 64 THEN modField := 0; ELSE Error("invalid effective address: instruction pointer relative addressing only in 64 bit mode") END; ELSIF (operands[addressOperand].displacement >= -80H) & (operands[addressOperand].displacement < 80H) THEN (* 8 bit displacement *) modField := 1; ELSE (* 32 bit displacement *) modField := 2; END; ModRM (modField, regField, rmField); IF (rmField = 4) THEN (* must emit SIB encoding scale, index and base (operand.register --> base) *) IF operands[addressOperand].index # none THEN (* index register present *) indexField := InstructionSet.RegisterIndex(operands[addressOperand].index) MOD 8; ELSE (* no index register *) indexField := 4; END; IF operands[addressOperand].register# none THEN (* base register present, can also be the base pointer (5) *) baseField := InstructionSet.RegisterIndex(operands[addressOperand].register) MOD 8; ELSE (* no register present *) debug := operands[addressOperand].register; ASSERT(modField = 0); baseField := 5; END; SIB (scaleField, indexField, baseField); END; IF modField = 0 THEN IF rmField = 5 THEN IF lastPass & (operands[addressOperand].symbol.name # "") THEN AddFixup(BinaryCode.Absolute,4,code.pc,operands[addressOperand].symbol,operands[addressOperand].symbolOffset,operands[addressOperand].displacement) END; code.PutDWord(operands[addressOperand].displacement); ELSIF (rmField = 4) & (baseField = 5) THEN (* special case: SIB without base register: mandatory displacement *) IF lastPass & (operands[addressOperand].symbol.name # "") THEN AddFixup(BinaryCode.Absolute,4,code.pc,operands[addressOperand].symbol,operands[addressOperand].symbolOffset,operands[addressOperand].displacement) END; code.PutDWord(operands[addressOperand].displacement); END; ELSIF modField = 1 THEN IF lastPass & (operands[addressOperand].symbol.name # "") THEN AddFixup(BinaryCode.Absolute,1,code.pc,operands[addressOperand].symbol,operands[addressOperand].symbolOffset,operands[addressOperand].displacement) END; code.PutByte(operands[addressOperand].displacement); ELSIF modField = 2 THEN IF lastPass & (operands[addressOperand].symbol.name # "") THEN AddFixup(BinaryCode.Absolute,4,code.pc,operands[addressOperand].symbol,operands[addressOperand].symbolOffset,operands[addressOperand].displacement) END; code.PutDWord (operands[addressOperand].displacement); END; END; END; | cb: IF Trace THEN KernelLog.String(" cb "); END; IF val # -1 THEN code.PutByte (val); val := -1 END; FOR i := 0 TO maxNumberOperands - 1 DO IF (free[i]) & (operands[i].type = ioffset) THEN IF Trace THEN KernelLog.String(" ioffset "); END; offset := SHORT(operands[i].val - code.pc - 1); IF lastPass & ~ValueInByteRange (offset) THEN Error( "value exceeds bounds"); RETURN FALSE; END; operands[i].pc := code.pc; code.PutByte (offset); free[i] := FALSE; i:= maxNumberOperands; ELSIF (free[i]) & (operands[i].type = imm) THEN IF Trace THEN KernelLog.String(" imm "); END; offset := SHORT (operands[i].val); IF lastPass & ~ValueInByteRange (offset) THEN Error( "value exceeds bounds"); RETURN FALSE; END; operands[i].pc := code.pc; code.PutByte (offset); free[i] := FALSE; i:= maxNumberOperands; END END; | cw: IF Trace THEN KernelLog.String(" cw "); END; IF val # -1 THEN code.PutByte (val); val := -1 END; FOR i := 0 TO maxNumberOperands - 1 DO IF (free[i]) & (InstructionSet.instructions[instr].operands[i] = InstructionSet.rel16off) THEN offset := SHORT(operands[i].val - code.pc - 2); IF lastPass & ~ValueInWordRange (offset) THEN Error( "value exceeds bounds"); END; operands[i].pc := code.pc; code.PutWord (offset); free[i] := FALSE; i:= maxNumberOperands; ELSIF (free[i]) & InstructionSet.IsImmediate16(InstructionSet.instructions[instr].operands[i]) THEN offset := SHORT (operands[i].val); IF lastPass & ~ValueInWordRange (offset) THEN Error( "value exceeds bounds"); RETURN FALSE; END; operands[i].pc := code.pc; code.PutWord (offset); free[i] := FALSE; i:= maxNumberOperands; END END; | cd: IF Trace THEN KernelLog.String(" cd "); END; IF val # -1 THEN code.PutByte (val); val := -1 END; FOR i := 0 TO maxNumberOperands - 1 DO IF (free[i]) & (InstructionSet.instructions[instr].operands[i] = InstructionSet.rel32off) THEN operands[i].pc := code.pc; IF lastPass & (operands[i].symbol.name # "") THEN AddFixup(BinaryCode.Relative,4,code.pc,operands[i].symbol,operands[i].symbolOffset,operands[i].displacement-4); code.PutDWord(SHORT(operands[i].val)); ELSE code.PutDWord (SHORT (operands[i].val - code.pc - 4)); END; free[i] := FALSE; i:= maxNumberOperands; ELSIF (free[i]) & InstructionSet.IsImmediate32(InstructionSet.instructions[instr].operands[i]) THEN operands[i].pc := code.pc; IF lastPass & (operands[i].symbol.name # "") THEN AddFixup(BinaryCode.Absolute,4,code.pc,operands[i].symbol,operands[i].symbolOffset,operands[i].displacement); END; code.PutDWord (SHORT (operands[i].val)); free[i] := FALSE; i:= maxNumberOperands; END END; | cp: IF Trace THEN KernelLog.String(" cp "); END; IF val # -1 THEN code.PutByte (val); val := -1 END; | ib: IF Trace THEN KernelLog.String(" ib "); END; IF val # -1 THEN code.PutByte (val); val := -1 END; FOR i := 0 TO maxNumberOperands - 1 DO IF (free[i]) & (operands[i].type = imm) OR (operands[i].type = ioffset) THEN offset := SHORT (operands[i].val); IF FALSE & lastPass & ~ValueInByteRange (offset) THEN Error( "value exceeds bounds"); RETURN FALSE; END; operands[i].pc := code.pc; IF lastPass & (operands[i].symbol.name # "") THEN AddFixup(BinaryCode.Absolute,1,code.pc,operands[i].symbol,operands[i].symbolOffset,operands[i].displacement) END; code.PutByte (SHORT (operands[i].val)); free[i] := FALSE; i:= maxNumberOperands; END END; | iw: IF Trace THEN KernelLog.String(" iw "); END; IF val # -1 THEN code.PutByte (val); val := -1 END; FOR i := 0 TO maxNumberOperands - 1 DO IF (free[i]) & (operands[i].type = imm) OR (operands[i].type = ioffset) THEN operands[i].pc := code.pc; code.PutWord (SHORT (operands[i].val)); free[i] := FALSE; i:= maxNumberOperands; END END; | id: IF Trace THEN KernelLog.String(" id "); END; IF val # -1 THEN code.PutByte (val); val := -1 END; FOR i := 0 TO maxNumberOperands - 1 DO IF (free[i]) & (InstructionSet.instructions[instr].operands[i] = InstructionSet.rel32off) THEN operands[i].pc := code.pc; IF lastPass & (operands[i].symbol.name # "") THEN AddFixup(BinaryCode.Relative,4,code.pc,operands[i].symbol,operands[i].symbolOffset,operands[i].displacement-4) END; code.PutDWord (SHORT (operands[i].val - code.pc - 4)); free[i] := FALSE; i:= maxNumberOperands; ELSIF (free[i]) & InstructionSet.IsImmediate32(InstructionSet.instructions[instr].operands[i]) THEN operands[i].pc := code.pc; IF lastPass & (operands[i].symbol.name # "") THEN AddFixup(BinaryCode.Absolute,4,code.pc,operands[i].symbol,operands[i].symbolOffset,operands[i].displacement) END; code.PutDWord (SHORT (operands[i].val)); free[i] := FALSE; i:= maxNumberOperands; END END; | iq: IF Trace THEN KernelLog.String(" iq "); END; IF val # -1 THEN code.PutByte (val); val := -1 END; FOR i := 0 TO maxNumberOperands - 1 DO IF (free[i]) & InstructionSet.IsImmediate64(InstructionSet.instructions[instr].operands[i]) THEN operands[i].pc := code.pc; IF lastPass & (operands[i].symbol.name # "") THEN AddFixup(BinaryCode.Absolute,8,code.pc,operands[i].symbol,operands[i].symbolOffset,operands[i].displacement) END; code.PutQWord (operands[i].val); free[i] := FALSE; i:= maxNumberOperands; END END; | rb, rw, rd, rq: IF Trace THEN KernelLog.String(" r* "); END; regOperand := GetRegOperand (); val := val + InstructionSet.RegisterIndex(operands[regOperand].register) MOD 8; code.PutByte (val); val := -1; free[regOperand] := FALSE; | fpStackOperand: IF Trace THEN KernelLog.String(" fp "); END; FOR i := 0 TO maxNumberOperands - 1 DO IF (free[i]) & (operands[i].type = sti) & (InstructionSet.instructions[instr].operands[i] # InstructionSet.st0) THEN val := val + InstructionSet.RegisterIndex(operands[i].register); code.PutByte (val); val := -1; free[i] := FALSE; i:= maxNumberOperands; END; END; | directMemoryOffset: IF Trace THEN KernelLog.String(" memoffset "); END; IF val # -1 THEN code.PutByte (val); val := -1 END; FOR i := 0 TO maxNumberOperands - 1 DO IF (free[i]) & (operands[i].type = mem) THEN IF cpuBits = bits16 THEN code.PutWord (operands[i].displacement); ELSE IF lastPass & (operands[i].symbol.name # "") THEN AddFixup(BinaryCode.Absolute,4,code.pc,operands[i].symbol,operands[i].symbolOffset,operands[i].displacement) END; code.PutDWord (operands[i].displacement); END; free[i] := FALSE; i:= maxNumberOperands; END; END; | mem64Operand, mem128Operand: (* ignored *) IF Trace THEN KernelLog.String(" mem64/mem128 "); END; | RXB: IF val # -1 THEN code.PutByte (val); val := -1 END; IF Trace THEN KernelLog.String(" RXB "); TRACE(rexPrefix) END; INC(oppos); byte := ORD(opcode[oppos]); IF ~(rexB IN rexPrefix) THEN byte := byte + 80H END; IF ~(rexX IN rexPrefix) THEN byte := byte + 40H END; IF ~(rexR IN rexPrefix) THEN byte := byte + 20H END; code.PutByte(byte); | Src1Prefix: IF val # -1 THEN code.PutByte (val); val := -1 END; IF Trace THEN KernelLog.String(" Src1Prefix "); END; INC(oppos); ASSERT((operands[1].type = xmm) OR (operands[1].type = ymm)); code.PutByte(ORD(opcode[oppos])+(0FH -InstructionSet.RegisterIndex(operands[1].register))*0x08); ELSE HALT(100) (* decoding error *) END; END; INC(oppos); IF Trace THEN KernelLog.Ln; END; END; IF val # -1 THEN code.PutByte (val) END; ASSERT(oppos < LEN(opcode)); (* decoding or representation error otherwise *) RETURN TRUE; END EmitInstruction; PROCEDURE EmitPrefix* (prefix: LONGINT); BEGIN code.PutByte (prefix); END EmitPrefix; PROCEDURE Emit*(mnem: LONGINT; VAR op1,op2,op3: Operand); VAR operands: ARRAY maxNumberOperands OF Operand; res: BOOLEAN; i: LONGINT; noOperand: Operand; BEGIN operands[0] := op1; operands[1] := op2; operands[2] := op3; noOperand.type := none; FOR i := 3 TO maxNumberOperands-1 DO operands[i] := noOperand; END; res := EmitInstruction(mnem,operands,TRUE); op1 := operands[0]; op2 := operands[1]; op3 := operands[2]; END Emit; PROCEDURE EmitAt*(pc: LONGINT;mnem: LONGINT; VAR op1,op2,op3: Operand); VAR prevPC: LONGINT; prevDump: Streams.Writer; BEGIN prevDump := dump; dump := NIL; prevPC := code.pc; code.SetPC(pc); Emit(mnem,op1,op2,op3); code.SetPC(prevPC); dump := prevDump; END EmitAt; PROCEDURE StartEmitAt*(VAR pc: LONGINT): LONGINT; VAR prevPC: LONGINT; BEGIN prevPC := code.pc; dump := NIL; code.SetPC(pc); RETURN prevPC; END StartEmitAt; PROCEDURE EndEmitAt*(pc: LONGINT); BEGIN code.SetPC(pc); SELF.dump := code.comments; END EndEmitAt; PROCEDURE Emit0* (mnem: LONGINT); VAR noOperand: Operand; BEGIN noOperand.type := none; Emit(mnem,noOperand,noOperand,noOperand); END Emit0; PROCEDURE Emit1* (mnem: LONGINT; VAR op1: Operand); VAR noOperand: Operand; BEGIN noOperand.type := none; Emit(mnem,op1,noOperand,noOperand); END Emit1; PROCEDURE Emit2* (mnem: LONGINT; VAR op1, op2: Operand); VAR noOperand: Operand; BEGIN noOperand.type := none; Emit(mnem,op1,op2,noOperand); END Emit2; PROCEDURE Emit3* (mnem: LONGINT; VAR op1, op2, op3: Operand); BEGIN Emit(mnem,op1,op2,op3); END Emit3; END Emitter; RegisterMapEntry*= POINTER TO RECORD name-: Strings.String; register-: LONGINT; next: RegisterMapEntry; END; RegisterMap*= OBJECT VAR first: RegisterMapEntry; PROCEDURE & Init *; BEGIN first := NIL END Init; PROCEDURE Find*(CONST name: ARRAY OF CHAR): LONGINT; VAR map: RegisterMapEntry; BEGIN map := first; WHILE (map # NIL) & (map.name^#name) DO map := map.next END; IF map = NIL THEN RETURN InstructionSet.none ELSE RETURN map.register END; END Find; PROCEDURE Add*(name: Strings.String; register: LONGINT); VAR map: RegisterMapEntry; BEGIN NEW(map); map.name := name; map.register := register; map.next := first; first := map; END Add; END RegisterMap; Assembly* = OBJECT VAR (* output *) errPos: Basic.Position; error-: BOOLEAN; useLineNumbers*: BOOLEAN; emitter: Emitter; (* overal state *) diagnostics: Diagnostics.Diagnostics; dump: Streams.Writer; (* temporaries *) fixup: BinaryCode.Fixup; type: SHORTINT; currentFixup: Sections.SectionName; currentLabel: NamedLabel; sourceName: Basic.FileName; PROCEDURE & InitAssembly*(diagnostics: Diagnostics.Diagnostics; emit: Emitter); BEGIN SELF.diagnostics := diagnostics; errPos := Basic.invalidPosition; error := FALSE; SELF.emitter := emit; sourceName := ""; END InitAssembly; PROCEDURE Error( CONST message: ARRAY OF CHAR); VAR pos: Basic.Position; msg,name: ARRAY 256 OF CHAR; BEGIN pos := errPos; COPY(message,msg); IF (pos.start = Streams.Invalid) OR (sourceName = "") THEN Strings.Append(msg," in "); ObjectFile.SegmentedNameToString(emitter.code.os.identifier.name, name); Strings.Append(msg, name); Basic.Error(diagnostics, sourceName,errPos,msg); ELSE Basic.Error(diagnostics, sourceName,errPos,msg); END; error := TRUE; IF dump # NIL THEN dump.Update; END; END Error; PROCEDURE ErrorSS(CONST msg1,msg2: ARRAY OF CHAR); VAR message: ARRAY 256 OF CHAR; BEGIN COPY(msg1,message); Strings.Append(message," : "); Strings.Append(message, msg2); Error(message); END ErrorSS; PROCEDURE Assemble* (reader: Streams.Reader; orgPos: Basic.Position; scope: SyntaxTree.Scope; in: IntermediateCode.Section; out: IntermediateCode.Section; module: Sections.Module; exported, inlined: BOOLEAN; map: RegisterMap ); CONST maxPasses = 2; VAR symbol, reg: LONGINT; ident, idents: Name; val, times: HUGEINT; currentLabel: NamedLabel; labels: NamedLabelList; prevPC: LONGINT; pass: LONGINT; absoluteMode: BOOLEAN; absoluteOffset: HUGEINT; orgOffset: HUGEINT; char: CHAR; orgReaderPos: LONGINT; orgCodePos: LONGINT; prevSourceName: Basic.FileName; position: Basic.Position; prevCpuBits: Size; prevCpuOptions: InstructionSet.CPUOptions; prevAssembly: Assembly; PROCEDURE NextChar; BEGIN (* IF (dump # NIL) & (pass = maxPasses) THEN dump.Char (char) END; *) reader.Char(char); INC(position.start); END NextChar; PROCEDURE SkipBlanks; BEGIN (* tf returns 01X when an embedded object is encountered *) WHILE (char = SPACE) OR (char = TAB) OR (char = 01X) DO NextChar END; IF char = ";" THEN WHILE (char # CR) & (char # LF) & (char # 0X) DO NextChar END (* Skip comments *) END; END SkipBlanks; PROCEDURE GetNumber (VAR intval: HUGEINT); VAR i, m, n: INTEGER; dig: ARRAY 24 OF CHAR; BEGIN i := 0; m := 0; n := 0; WHILE ('0' <= char) & (char <= '9') OR ('A' <= CAP (char)) & (CAP (char) <= 'F') DO IF (m > 0) OR (char # "0") THEN (* ignore leading zeros *) IF n < LEN(dig) THEN dig[n] := char; INC(n) END; INC(m) END; NextChar; INC(i) END; IF n = m THEN intval := 0; i := 0; IF (CAP (char) = "H") OR (char = "X") THEN NextChar; IF (n = Scanner.MaxHexDigits) & (dig[0] > "7") THEN (* prevent overflow *) intval := -1 END; WHILE i < n DO intval := intval * 10H + HexOrd (dig[i]); INC(i) END; ELSE IF (n = Scanner.MaxHugeHexDigits) & (dig[0] > "7") THEN (* prevent overflow *) intval := -1 END; WHILE i < n DO intval := intval * 10 + Ord (dig[i]); INC(i) END END END; END GetNumber; PROCEDURE GetIdentifier; VAR i: LONGINT; BEGIN i := 0; REPEAT IF i < Scanner.MaxIdentifierLength - 1 THEN IF ('0' <= char) & (char <= '9') THEN ident[i] := char; idents[i] := char; ELSE ident[i] := (* CAP *) (char); idents[i] := char; END; INC (i); END; NextChar UNTIL ~( ('A' <= CAP(char)) & (CAP(char) <= 'Z') OR ('0' <= char) & (char <= '9') OR (char = '_') ); ident[i] := 0X; idents[i] := 0X; END GetIdentifier; PROCEDURE GetString; VAR i: LONGINT; BEGIN i := 0; NextChar; WHILE (char # "'") & (i < Scanner.MaxIdentifierLength - 1) DO ident[i] := char; INC (i); NextChar; END; ident[i] := 0X; NextChar; END GetString; PROCEDURE NextSymbol; BEGIN SkipBlanks; errPos := position; CASE char OF 'A' .. 'Z', 'a' .. 'z', '_' : GetIdentifier; SkipBlanks; IF char = ':' THEN NextChar; symbol := symLabel; ELSE symbol := symIdent; END; | '0' .. '9': GetNumber (val); symbol := symNumber; | "'": GetString; symbol := symString; | '.': symbol := symPeriod; NextChar; | ';': symbol := symSemicolon; NextChar; | ':': symbol := symColon; NextChar; | CR: symbol := symLn; NextChar; INC(position.line); position.linepos := position.start; IF char = LF THEN NextChar END; | LF: symbol := symLn; NextChar;INC(position.line); position.linepos := position.start; IF char = CR THEN NextChar END; | ',': symbol := symComma; NextChar; | '+': symbol := symPlus; NextChar; | '-': symbol := symMinus; NextChar; | '*': symbol := symTimes; NextChar; | '/': symbol := symDiv; NextChar; | '%': symbol := symMod; NextChar; | '~': symbol := symNegate; NextChar; | '(': symbol := symLParen; NextChar; | ')': symbol := symRParen; NextChar; | '[': symbol := symLBraket; NextChar; | ']': symbol := symRBraket; NextChar; | '{': symbol := symLBrace; NextChar; | '}': symbol := symRBrace; NextChar; | '@': symbol := symAt; NextChar; | '$': NextChar; IF char = '$' THEN symbol := symPCOffset; NextChar; ELSE symbol := symPC; END | 0X: symbol := symEnd; ELSE symbol := symNone; NextChar; END; END NextSymbol; PROCEDURE SkipLine; BEGIN WHILE (symbol # symLn) & (symbol # symNone) DO NextSymbol; END; END SkipLine; PROCEDURE Ensure (desiredSymbol, errNumber : LONGINT) : BOOLEAN; VAR temp: LONGINT; BEGIN temp := symbol; IF symbol = desiredSymbol THEN NextSymbol; RETURN TRUE; ELSE Error("other symbol expected"); RETURN FALSE; END; END Ensure; PROCEDURE GetCPU (cumulateOptions: BOOLEAN): BOOLEAN; VAR i: LONGINT; BEGIN SkipBlanks; GetIdentifier; Strings.UpperCase(ident); i := InstructionSet.FindCPU (ident); IF i # InstructionSet.none THEN IF cumulateOptions THEN emitter.cpuOptions := emitter.cpuOptions + InstructionSet.cpus[i].cpuOptions; ELSE emitter.cpuOptions := InstructionSet.cpus[i].cpuOptions + InstructionSet.cpuOptions; END; NextSymbol; RETURN TRUE; ELSE ErrorSS ("cpu unknown",ident); emitter.cpuOptions := prevCpuOptions; RETURN FALSE; END; END GetCPU; PROCEDURE Factor (VAR x: HUGEINT; critical: BOOLEAN; VAR type: SHORTINT): BOOLEAN; VAR label: NamedLabel; l: LONGINT; BEGIN IF symbol = symNumber THEN x := val; NextSymbol; RETURN TRUE; ELSIF symbol = symPC THEN x := (orgOffset + emitter.code.pc ); NextSymbol; RETURN TRUE; ELSIF symbol = symPCOffset THEN x := orgOffset; NextSymbol; RETURN TRUE; ELSIF symbol = symString THEN x := 0; l := Strings.Length (ident); IF l > 0 THEN INC (x, ORD (ident [0])) END; IF l > 1 THEN INC (x, ORD (ident [1])*100H) END; IF l > 2 THEN INC (x, ORD (ident [2])*10000H) END; IF l > 3 THEN INC (x, ORD (ident [3])*1000000H) END; NextSymbol; RETURN TRUE; ELSIF symbol = symIdent THEN label := labels.Find (idents); NextSymbol; IF label # NIL THEN x := (label.offset ); type := ioffset; currentLabel := label; (* IF x = MAX(HUGEINT) THEN x := -label.index; currentFixup := in; END; *) RETURN TRUE; ELSIF scope # NIL THEN IF ~GetValue(idents,x) THEN IF (pass = maxPasses) THEN Error("constant expected"); END; RETURN FALSE; ELSE RETURN TRUE; END END; IF (~critical) & (pass # maxPasses) THEN x := 0; RETURN TRUE END; Error("undefined symbol"); RETURN FALSE; ELSIF symbol = symLParen THEN NextSymbol; RETURN Expression (x, critical,type) & Ensure (symRParen, 555); END; Error("parse error in expression"); RETURN FALSE END Factor; PROCEDURE Term (VAR x: HUGEINT; critical: BOOLEAN; VAR type: SHORTINT): BOOLEAN; VAR y: HUGEINT; op : WORD; BEGIN IF Factor (x, critical,type) THEN WHILE (symbol = symTimes) OR (symbol = symDiv) OR (symbol = symMod) DO op := symbol; NextSymbol; IF Factor (y, critical,type) THEN IF op = symTimes THEN x := x * y ELSIF op = symDiv THEN x := x DIV y ELSE x := x MOD y END; ELSE RETURN FALSE; END; END; RETURN TRUE; ELSE RETURN FALSE; END; END Term; PROCEDURE Expression (VAR x: HUGEINT; critical: BOOLEAN; VAR type: SHORTINT): BOOLEAN; VAR y: HUGEINT; op : WORD; BEGIN IF symbol = symMinus THEN op := symbol; NextSymbol; IF Term (x, critical,type) THEN x := -x ELSE RETURN FALSE; END; ELSIF symbol = symPlus THEN op := symbol; NextSymbol; IF ~Term (x, critical,type) THEN RETURN FALSE; END; ELSIF symbol = symNegate THEN op := symbol; NextSymbol; IF Term (x, critical,type) THEN x := -x - 1 ELSE RETURN FALSE; END; ELSIF ~Term (x, critical,type) THEN RETURN FALSE; END; WHILE (symbol = symPlus) OR (symbol = symMinus) DO op := symbol; NextSymbol; IF Term (y, critical,type) THEN IF op = symPlus THEN x := x + y ELSE x := x - y END; ELSE RETURN FALSE; END; END; RETURN TRUE; END Expression; PROCEDURE Align(size: LONGINT); VAR pc: LONGINT; BEGIN IF size <= 0 THEN Error("invalid alignment size"); RETURN END; pc := emitter.code.pc DIV 8; (* bytes *) WHILE pc MOD size # 0 DO emitter.code.PutByte(0); INC(pc); END; END Align; PROCEDURE PutData (size: Size): BOOLEAN; VAR i: SIZE; x: HUGEINT; type:SHORTINT; ofs: Operand; BEGIN NextSymbol; WHILE symbol # symLn DO IF symbol = symString THEN i := 0; WHILE ident[i] # 0X DO emitter.code.PutByte (ORD (ident[i])); INC (i); END; IF size # bits8 THEN i := (size ) - i MOD (size ); WHILE i # 0 DO emitter.code.PutByte (0); DEC (i) END; END; NextSymbol; ELSIF (scope # NIL) & (symbol = symAt) THEN NextSymbol; IF symbol # symIdent THEN Error("identifier missing") END; GetOffsetFixup (idents, ofs); NextSymbol; IF symbol = symPlus THEN NextSymbol; IF Expression(x, FALSE, type) THEN ofs.displacement := LONGINT (x) END; ELSIF symbol = symMinus THEN NextSymbol; IF Expression(x, FALSE, type) THEN ofs.displacement := - LONGINT (x) END; END; IF pass = maxPasses THEN emitter.AddFixup(BinaryCode.Absolute, ofs.sizeInBytes, emitter.code.pc, ofs.symbol, ofs.symbolOffset,ofs.displacement); END; emitter.code.PutBytes (0, size ); ELSIF Expression (x, FALSE,type) THEN emitter.code.PutBytes (x, size ); ELSE RETURN FALSE; END; IF symbol = symComma THEN NextSymbol; ELSIF symbol # symLn THEN Error("operand missing"); END END; Duplicate ((emitter.code.pc - prevPC) , NIL); RETURN TRUE; END PutData; PROCEDURE Duplicate (size: LONGINT; fixup: BinaryCode.Fixup); VAR i: LONGINT; buffer: ARRAY 100 OF CHAR; pc: LONGINT; BEGIN IF times = 1 THEN RETURN END; pc := (prevPC ); IF (dump # NIL) & (pass = maxPasses) THEN dump.Hex (emitter.code.pc, 1); dump.Char (' ') END; FOR i := 0 TO size - 1 DO buffer[i] := emitter.code.GetByte (pc); INC(pc); IF (dump # NIL) & (pass = maxPasses) THEN dump.Hex (ORD (buffer[i]), -2); END; END; pc := (prevPC ); IF times > 1 THEN WHILE times # 1 DO IF fixup # NIL THEN HALT(200); (*!! AddFixup (fixup.adr, pc + fixup.offset - prevPC); *) END; FOR i := 0 TO size - 1 DO emitter.code.PutByteAt (pc, ORD (buffer[i])); INC(pc); IF (dump # NIL) & (pass = maxPasses) THEN dump.Hex (ORD (buffer[i]), -2); END; END; DEC (times); END; ELSE times := 1; END; IF (dump # NIL) & (pass = maxPasses) THEN dump.Ln END; END Duplicate; PROCEDURE Reserve (size: Size) : BOOLEAN; VAR type : SHORTINT; x: HUGEINT; BEGIN IF Expression (x, TRUE, type) THEN absoluteOffset := absoluteOffset + x * size; RETURN TRUE; ELSE RETURN FALSE; END; END Reserve; PROCEDURE GetScopeSymbol (CONST ident: ARRAY OF CHAR): SyntaxTree.Symbol; VAR sym: SyntaxTree.Symbol; localScope: SyntaxTree.Scope; identifier: SyntaxTree.Identifier; BEGIN localScope := scope; identifier := SyntaxTree.NewIdentifier(ident); IF Trace THEN KernelLog.String("GetScopeSymbol:"); KernelLog.String(ident); KernelLog.Ln; END; WHILE (sym = NIL) & (localScope # NIL) DO sym := localScope.FindSymbol(identifier); localScope := localScope.outerScope END; IF (sym # NIL) & (sym IS SyntaxTree.Import) THEN NextSymbol; IF Ensure(symPeriod,0) & (symbol = symIdent) THEN identifier := SyntaxTree.NewIdentifier(idents); IF Trace THEN KernelLog.String("GetScopeSymbol :"); KernelLog.String(idents); KernelLog.Ln; END; localScope := sym(SyntaxTree.Import).module.moduleScope; sym := NIL; WHILE (sym = NIL) & (localScope # NIL) DO sym := localScope.FindSymbol(identifier); localScope := localScope.outerScope END; END; END; IF Trace THEN IF sym = NIL THEN KernelLog.String("not found") ELSE KernelLog.String("found"); END; KernelLog.Ln; END; RETURN sym END GetScopeSymbol; PROCEDURE GetValue(CONST ident: ARRAY OF CHAR; VAR x: HUGEINT): BOOLEAN; VAR scopeSymbol:SyntaxTree.Symbol; BEGIN scopeSymbol := GetScopeSymbol (ident); IF scopeSymbol = NIL THEN RETURN FALSE ELSIF ~(scopeSymbol IS SyntaxTree.Constant) THEN RETURN FALSE ELSE IF (scopeSymbol.type.resolved IS SyntaxTree.CharacterType) & (scopeSymbol.type.resolved.sizeInBits=8) THEN x := ORD(scopeSymbol(SyntaxTree.Constant).value.resolved(SyntaxTree.CharacterValue).value) ELSIF scopeSymbol.type.resolved IS SyntaxTree.IntegerType THEN x := scopeSymbol(SyntaxTree.Constant).value.resolved(SyntaxTree.IntegerValue).value ELSE Error("number expected"); RETURN FALSE; END; RETURN TRUE; END; END GetValue; PROCEDURE GetMemFixup (CONST ident: ARRAY OF CHAR; VAR operand: Operand); VAR scopeSymbol:SyntaxTree.Symbol; BEGIN scopeSymbol := GetScopeSymbol (ident); IF scopeSymbol = NIL THEN RETURN END; IF scopeSymbol IS SyntaxTree.Constant THEN RETURN END; IF inlined & exported THEN Error("no symbols may be accessed in exported and inlined procedures"); END; IF (scopeSymbol IS SyntaxTree.Variable) & (scopeSymbol.scope = module.module.moduleScope) THEN (* global variable. offset not supported *) Error("global variables cannot be accessed as memory operands"); ELSIF (scopeSymbol IS SyntaxTree.Variable) THEN (* local variable *) operand.displacement := (scopeSymbol.offsetInBits DIV 8) ELSIF (scopeSymbol IS SyntaxTree.Parameter) THEN (* local parameter *) operand.displacement := (scopeSymbol.offsetInBits DIV 8) ELSE RETURN (* ? *) END; (*! mem.fixup := scopeSymbol.adr; *) NextSymbol; END GetMemFixup; PROCEDURE GetOffsetFixup (CONST ident: ARRAY OF CHAR; VAR operand: Operand); VAR scopeSymbol: SyntaxTree.Symbol;name: Basic.SegmentedName; symbol: IntermediateCode.Section; BEGIN IF labels.Find(ident) # NIL THEN RETURN END; scopeSymbol := GetScopeSymbol (ident); IF (scopeSymbol = NIL) OR (scopeSymbol IS SyntaxTree.Constant) THEN RETURN END; IF inlined & exported THEN Error("no symbols may be accessed in exported and inlined procedures"); END; Global.GetSymbolSegmentedName(scopeSymbol,name); IF scopeSymbol.scope IS SyntaxTree.ModuleScope THEN IF (scopeSymbol IS SyntaxTree.Variable) THEN InitMem(operand,IntermediateCode.Bits32,none,0); (* or immediate ?? *) ELSIF (scopeSymbol IS SyntaxTree.Procedure) & (scopeSymbol.scope = module.module.moduleScope) THEN IF scopeSymbol(SyntaxTree.Procedure).isInline THEN Error("fobidden reference to inline call"); ELSE InitOffset32(operand,0); (* or immediate ?? *) END; ELSIF (scopeSymbol IS SyntaxTree.Procedure) THEN InitOffset32(operand,0); (* or immediate ?? *) END; SetSymbol(operand,name,0,0,0); ELSE Error("direct access to local variable offset forbidden"); END; operand.sizeInBytes := emitter.cpuBits; END GetOffsetFixup; (* the following procedure is used to adapt sizes for relative jumps *) PROCEDURE AdaptOperandSizes(VAR operands: ARRAY OF Operand); VAR i: LONGINT; PROCEDURE OffsetSize(val: HUGEINT): SHORTINT; BEGIN DEC(val,emitter.code.pc); IF (val > MIN(SHORTINT)+2) & (val < MAX(SHORTINT)) THEN RETURN bits8 (* We do not support word (16-bit) displacement jumps (i.e. prefixing the jump instruction with the `addr16' opcode prefix), since the 80386 insists upon masking `%eip' to 16 bits after the word displacement is added. *) ELSIF (val > MIN(LONGINT)+2) & (val < MAX(LONGINT)-2) THEN RETURN bits32 ELSE RETURN bits64 END; END OffsetSize; BEGIN i := 0; WHILE (i< LEN(operands)) & (operands[i].type # none) DO IF (operands[i].type = ioffset) & (operands[i].sizeInBytes = bitsDefault) THEN IF operands[i].symbol.name = "" THEN operands[i].sizeInBytes := OffsetSize(operands[i].val); ELSE operands[i].sizeInBytes := bits32 END; END; INC(i) END; END AdaptOperandSizes; PROCEDURE GetInstruction (): BOOLEAN; VAR position: Basic.Position; mnem, opCount: LONGINT; size: Size; operands: ARRAY InstructionSet.maxNumberOperands OF Operand; prevFixup: BinaryCode.Fixup; mem: Operand; offset: Operand; i: LONGINT; x: HUGEINT; type: SHORTINT; BEGIN position := errPos; mnem := InstructionSet.FindMnemonic (ident); IF mnem = InstructionSet.none THEN ErrorSS("unkown instruction",idents); RETURN FALSE; END; opCount := 0; NextSymbol; FOR i := 0 TO LEN(operands)-1 DO InitOperand(operands[i]); END; WHILE (symbol # symLn) & (symbol # symNone) & (symbol # symEnd) DO IF symbol = symIdent THEN IF (ident = "BYTE") OR (ident = "SHORT") THEN size := bits8; NextSymbol; ELSIF (ident = "WORD") OR (ident = "NEAR") THEN size := bits16; NextSymbol; ELSIF ident = "DWORD" THEN size := bits32; NextSymbol; ELSIF ident = "QWORD" THEN size := bits64; NextSymbol; ELSIF ident = "TWORD" THEN size := bits128; NextSymbol; ELSE size := bitsDefault; END; ELSE size := bitsDefault; END; IF symbol = symIdent THEN (* register ?, for example EAX *) reg := InstructionSet.FindRegister (ident); IF reg = InstructionSet.none THEN reg := map.Find(ident) END; IF reg # InstructionSet.none THEN IF size # bitsDefault THEN Error ("invalid register size specification"); RETURN FALSE; END; InitRegister(operands[opCount], reg); INC (opCount); NextSymbol; END; ELSE reg := InstructionSet.none; END; IF reg = InstructionSet.none THEN IF symbol = symLBraket THEN (* mem, written as [....] *) NextSymbol; InitMem(mem, size, InstructionSet.none,0); (*! ??? *) IF symbol = symLabel THEN (* register segment as in [ES:...] *) reg := InstructionSet.FindRegister (ident); IF reg = InstructionSet.none THEN ErrorSS("undefined symbol",idents); RETURN FALSE; END; mem.segment := reg; NextSymbol; END; IF symbol = symIdent THEN (* register, for example [EAX] or [ES:EAX] *) reg := InstructionSet.FindRegister (ident); IF reg # InstructionSet.none THEN mem.register := reg; NextSymbol; IF symbol = symTimes THEN (* register multiply as in [EAX*4] *) NextSymbol; IF ~Factor (x, FALSE,type) THEN RETURN FALSE; END; mem.scale := LONGINT (x); mem.index := mem.register; mem.register := InstructionSet.none; END; IF symbol = symPlus THEN (* register add as in [EAX + EBX] *) NextSymbol; IF symbol = symIdent THEN reg := InstructionSet.FindRegister (ident); IF reg # InstructionSet.none THEN (* maybe it is this: [EAX + EBX * 4] *) NextSymbol; IF mem.index = InstructionSet.none THEN mem.index := reg; IF symbol = symTimes THEN NextSymbol; IF ~Factor (x, FALSE,type) THEN RETURN FALSE; END; mem.scale := LONGINT (x); END; ELSE mem.register := reg; END; END; END; END; END; END; IF symbol = symPlus THEN NextSymbol; END; IF (scope # NIL) & (symbol = symIdent) THEN GetMemFixup (idents, mem); END; IF (symbol # symRBraket) & (symbol # symNegate) THEN IF ~Expression (x, FALSE ,type) THEN RETURN FALSE; END; INC (mem.displacement, LONGINT (x)); ELSIF (mem.register = InstructionSet.none) & (mem.index = InstructionSet.none) THEN Error("operand missing: no register provided"); RETURN FALSE; END; operands[opCount] := mem; INC (opCount); IF ~Ensure (symRBraket, 556) THEN RETURN FALSE; END; ELSE (* number or identifier (symbol) *) InitImm(offset,size,0); IF (scope # NIL) & (symbol = symIdent) THEN (* identifier: must be a symbol *) GetOffsetFixup (idents, offset); END; IF offset.symbol.name = "" THEN (* nothing could be fixuped, must be a number / constant *) type := offset.type; currentFixup := ""; currentLabel := NIL; IF ~Expression (offset.val, FALSE,type) THEN RETURN FALSE; END; offset.type := type; IF currentFixup # "" THEN offset.symbol.name := currentFixup; offset.symbolOffset := LONGINT (offset.val); ELSIF currentLabel # NIL THEN IF (offset.sizeInBytes = bitsDefault ) & (offset.val > emitter.code.pc) THEN (* forward jump *) offset.sizeInBytes := bits32 END; (* IF offset.sizeInBytes = bitsDefault THEN offset.sizeInBytes := bits32; END; *) END; IF symbol = symColon THEN (* additional prefixed operand separated by ":", segmentation register *) NextSymbol; IF ~Expression (x, FALSE, type) THEN RETURN FALSE; END; InitOffset(operands[opCount],bitsDefault,LONGINT (x)); INC (opCount); END; ELSE NextSymbol; END; operands[opCount] := offset; INC (opCount); END; END; IF symbol = symComma THEN NextSymbol; ELSIF (symbol # symLn) & (symbol # symEnd) THEN Error("operand missing"); END END; prevFixup := fixup; AdaptOperandSizes(operands); errPos := position; IF ~emitter.EmitInstruction (mnem, operands, pass = maxPasses) THEN RETURN FALSE; END; IF fixup = prevFixup THEN Duplicate ((emitter.code.pc - prevPC) , NIL); ELSE Duplicate ((emitter.code.pc - prevPC) , fixup); END; RETURN TRUE; END GetInstruction; PROCEDURE Reset; BEGIN reader.SetPos(orgReaderPos); emitter.code.SetPC(orgCodePos); NextChar; position := orgPos; END Reset; PROCEDURE FindLabels; VAR firstInLine : BOOLEAN; label: NamedLabel; BEGIN IF Trace THEN KernelLog.String("find labels"); KernelLog.Ln; END; LOOP NextSymbol; IF symbol = symLn THEN firstInLine := TRUE; ELSIF symbol = symLabel THEN IF firstInLine THEN IF labels.Find(idents) # NIL THEN Error("multiply declared identifier") ELSE NEW(label,MAX(LONGINT),idents); labels.Add(label); IF Trace THEN KernelLog.String("found label"); KernelLog.String(idents); KernelLog.Ln; END; END END; ELSIF symbol = symEnd THEN EXIT ELSE firstInLine := FALSE; END; END; END FindLabels; PROCEDURE FixupLabels; VAR label: NamedLabel; BEGIN IF Trace THEN KernelLog.String("patch fixups "); KernelLog.Ln; END; fixup := emitter.code.fixupList.firstFixup; WHILE fixup # NIL DO IF (fixup.symbol.name = in.name) & (fixup.symbolOffset < 0) THEN label := labels.first; WHILE (label # NIL) & (label.index # -fixup.symbolOffset) DO label := label.nextNamedLabel END; (* fixup.SetSymbolOffset(label.offset); *) fixup.SetSymbol(out.name,0,0,label.offset+fixup.displacement); IF Trace THEN KernelLog.String("patch fixup: "); KernelLog.Hex(fixup.offset,1); KernelLog.String(" "); KernelLog.Hex(-fixup.displacement, 1); KernelLog.String(" "); KernelLog.Hex(label.offset, 1); KernelLog.Ln; END; END; fixup := fixup.nextFixup; END; END FixupLabels; BEGIN prevAssembly := emitter.assembly; prevSourceName := sourceName; prevCpuBits := emitter.cpuBits; prevCpuOptions := emitter.cpuOptions; emitter.assembly := SELF; IF scope # NIL THEN sourceName := scope.ownerModule.sourceName; END; NEW(labels); orgReaderPos := reader.Pos(); orgCodePos := emitter.code.pc; NextChar; position := orgPos; (* first we have to find all labels as their names might collide with symbol names *) FindLabels; FOR pass := 1 TO maxPasses DO (*! currently maxPasses = 1 *) Reset; times := 1; prevPC := emitter.code.pc; currentLabel := NIL; absoluteMode := FALSE; orgOffset := 0; NextSymbol; IF (scope # NIL) THEN IF symbol # symLBrace THEN (* treat CPU options as an optional limitation and not vice versa *) ELSE emitter.cpuOptions := {}; NextSymbol; (* parse code flags such as {SYSTEM.i386 .... } *) LOOP IF ~Ensure (symIdent, 551) THEN RETURN END; IF ident # "SYSTEM" THEN Error("unsupportorted target identifier"); RETURN END; IF symbol # symPeriod THEN Error("identifier expected"); RETURN; END; IF ~GetCPU (TRUE) THEN RETURN; END; IF symbol = symRBrace THEN EXIT ELSIF symbol = symComma THEN NextSymbol ELSE Error("target specifier expected"); RETURN; END; END; NextSymbol; END END; LOOP IF symbol = symLn THEN NextSymbol; ELSIF symbol = symLabel THEN currentLabel := labels.Find(idents); ASSERT(currentLabel # NIL); IF absoluteMode THEN currentLabel.SetOffset(LONGINT (absoluteOffset)); ELSE currentLabel.SetOffset(emitter.code.pc) END; NextSymbol; ELSIF symbol = symIdent THEN IF ident = "END" THEN symbol := symNone; ELSIF ident = "BITS" THEN NextSymbol; IF ~Ensure (symNumber, 553) OR ~emitter.SetBits (LONGINT (val)) THEN SkipLine; ELSE NextSymbol; END; ELSIF ident = "ALIGN" THEN NextSymbol; IF Expression(val, TRUE, type) THEN Align(LONGINT (val)); END; ELSIF ~(scope # NIL) & (ident = "CPU") THEN IF ~GetCPU (FALSE) THEN SkipLine; END; ELSIF ~(scope # NIL) & (ident = "ABSOLUTE") THEN absoluteMode := TRUE; NextSymbol; IF ~Expression (absoluteOffset, TRUE,type) THEN SkipLine; END; ELSIF ~(scope # NIL) & (ident = "ORG") THEN NextSymbol; IF (orgOffset # 0) OR ~Expression (orgOffset, TRUE,type) THEN SkipLine; END; ELSIF ~(scope # NIL) & (ident = "RESB") THEN NextSymbol; IF ~Reserve (1) THEN SkipLine END; ELSIF ~(scope # NIL) & (ident = "RESW") THEN NextSymbol; IF ~Reserve (2) THEN SkipLine END; ELSIF ~(scope # NIL) & (ident = "RESD") THEN NextSymbol; IF ~Reserve (4) THEN SkipLine END; (* ELSIF ident = "EQU" THEN IF currentLabel # NIL THEN NextSymbol; IF Expression (val2, FALSE) THEN currentLabel.pc := val2; currentLabel.equ := TRUE; ELSE SkipLine; END; ELSE Error("???"); RETURN; END; *) ELSIF ident = "TIMES" THEN NextSymbol; IF ~Expression (times, TRUE,type) THEN SkipLine; ELSIF times < 0 THEN Error("unsupported negative value"); RETURN; ELSE prevPC := emitter.code.pc; END; ELSIF ident = "DB" THEN IF ~PutData (bits8) THEN SkipLine END; ELSIF ident = "DW" THEN IF ~PutData (bits16) THEN SkipLine END; ELSIF ident = "DD" THEN IF ~PutData (bits32) THEN SkipLine END; ELSIF ident = "DQ" THEN IF ~PutData (bits64) THEN SkipLine END; ELSIF ident = "REP" THEN NextSymbol; emitter.code.PutByte (InstructionSet.prfREP); ELSIF ident = "LOCK" THEN NextSymbol; emitter.code.PutByte (InstructionSet.prfLOCK); ELSIF ident = "REPE" THEN NextSymbol; emitter.code.PutByte (InstructionSet.prfREPE); ELSIF ident = "REPZ" THEN NextSymbol; emitter.code.PutByte (InstructionSet.prfREPZ); ELSIF ident = "REPNE" THEN NextSymbol; emitter.code.PutByte (InstructionSet.prfREPNE); ELSIF ident = "REPNZ" THEN NextSymbol; emitter.code.PutByte (InstructionSet.prfREPNZ); ELSIF ~GetInstruction () THEN SkipLine END; currentLabel := NIL; ELSIF (symbol = symNone) OR (symbol = symEnd) THEN EXIT ELSE Error("identifier expected"); RETURN; END; END; END; (* FixupLabels(); *) (*! FixupLabels(labels.first,code) *) sourceName := prevSourceName; emitter.cpuBits := prevCpuBits; emitter.cpuOptions := prevCpuOptions; emitter.assembly := prevAssembly; END Assemble; END Assembly; VAR kernelWriter: Streams.Writer; PROCEDURE Ord (ch: CHAR): INTEGER; BEGIN RETURN ORD (ch) - ORD ("0") END Ord; PROCEDURE HexOrd (ch: CHAR): INTEGER; BEGIN IF ch <= "9" THEN RETURN ORD (ch) - ORD ("0") ELSE RETURN ORD (CAP (ch)) - ORD ("A") + 10 END END HexOrd; PROCEDURE IsRegisterOperand*(CONST op: Operand): BOOLEAN; BEGIN RETURN op.type IN {reg8, reg16, reg32, reg64, CRn, DRn, segReg, sti, mmx, xmm, ymm} END IsRegisterOperand; PROCEDURE IsMemoryOperand*(CONST op: Operand): BOOLEAN; BEGIN RETURN op.type = mem END IsMemoryOperand; PROCEDURE IsImmediateOperand*(CONST op: Operand): BOOLEAN; BEGIN RETURN op.type = imm END IsImmediateOperand; PROCEDURE DumpType*(w: Streams.Writer; type: LONGINT); BEGIN CASE type OF reg8: w.String("reg8") |reg16: w.String("reg16"); |reg32: w.String("reg32"); |reg64: w.String("reg64"); |CRn: w.String("CRn"); |DRn: w.String("DRn"); |segReg: w.String("segReg"); |mmx: w.String("mmx"); |xmm: w.String("xmm"); |ymm: w.String("ymm"); |mem: w.String("mem"); |sti: w.String("sti"); |imm: w.String("imm"); |ioffset: w.String("ioffset"); |pntr1616: w.String("pntr1616"); |pntr1632: w.String("pntr1632"); ELSE w.String("?"); w.Int(type,1); w.String("?"); END; END DumpType; PROCEDURE DumpOperand*(w: Streams.Writer; CONST operand: Operand); BEGIN CASE operand.type OF |reg8, reg16, reg32, reg64, CRn, DRn, segReg, sti, mmx, xmm, ymm: w.String(InstructionSet.registers[operand.register].name); |mem: IF operand.sizeInBytes = 1 THEN w.String("BYTE ") ELSIF operand.sizeInBytes= 2 THEN w.String("WORD ") ELSIF operand.sizeInBytes = 4 THEN w.String("DWORD ") ELSIF operand.sizeInBytes = 8 THEN w.String("QWORD ") END; w.String("["); IF operand.register # none THEN w.String(InstructionSet.registers[operand.register].name); IF operand.index # none THEN w.String("+") END; END; IF operand.index # none THEN w.String(InstructionSet.registers[operand.index].name); IF operand.scale # 1 THEN w.String("*"); w.Int(operand.scale,1); END; END; IF operand.symbol.name # "" THEN Basic.WriteSegmentedName(w, operand.symbol.name); w.String(":"); w.Int(operand.displacement,1); IF operand.symbolOffset # 0 THEN w.String("(@"); w.Int(operand.symbolOffset,1); w.String(")") END; ELSIF operand.displacement # 0 THEN IF (operand.displacement > 0) & ((operand.register # none) OR (operand.index # none)) THEN w.String("+");END; w.Int(operand.displacement,1); END; w.String("]"); |imm,ioffset: IF operand.symbol.name # "" THEN Basic.WriteSegmentedName(w, operand.symbol.name); w.String(":"); w.Int(operand.displacement,1); IF operand.symbolOffset # 0 THEN w.String("(@"); w.Int(operand.symbolOffset,1); w.String(")") END; ELSE IF (operand.val > MAX(LONGINT)) OR (operand.val < MIN(LONGINT)) THEN w.Hex(operand.val,1); w.String("H"); ELSE w.Int(SHORT(operand.val),1); END; END; |pntr1616: |pntr1632: ELSE HALT(100) END; END DumpOperand; PROCEDURE DumpInstruction(w: Streams.Writer; mnemonic: LONGINT; CONST operands: ARRAY OF Operand); VAR i: LONGINT; CONST DebugSize = FALSE; BEGIN IF mnemonic # none THEN w.String(InstructionSet.mnemonics[mnemonic].name); i := 0; WHILE(i= -80H) & (operand.val < 100H) | InstructionSet.simm8: RETURN ((operand.sizeInBytes = bitsDefault) OR (operand.sizeInBytes = bits8)) & (operand.val >= -80H) & (operand.val < 80H) | InstructionSet.uimm8: RETURN ((operand.sizeInBytes = bitsDefault) OR (operand.sizeInBytes = bits8)) & (operand.val >= 0H) & (operand.val < 100H) | InstructionSet.rel16off: RETURN (operand.sizeInBytes = bitsDefault) OR (operand.sizeInBytes = bits16) & FALSE (* do not allow 16 bit jumps *) | InstructionSet.imm16: RETURN ((operand.sizeInBytes = bitsDefault) OR (operand.sizeInBytes = bits16)) & (operand.val >= -8000H) & (operand.val < 10000H) | InstructionSet.simm16: RETURN ((operand.sizeInBytes = bitsDefault) OR (operand.sizeInBytes = bits16)) & (operand.val >= -8000H) & (operand.val < 8000H) | InstructionSet.uimm16: RETURN ((operand.sizeInBytes = bitsDefault) OR (operand.sizeInBytes = bits16)) & (operand.val >= 0H) & (operand.val < 10000H) | InstructionSet.rel32off: RETURN (operand.sizeInBytes = bitsDefault) OR (operand.sizeInBytes = bits32) (* & & (operand.val >= -80000000H) & (operand.val < 100000000H) PACO confused? *) | InstructionSet.imm32: RETURN ((operand.sizeInBytes = bitsDefault) OR (operand.sizeInBytes = bits32)) (* & & (operand.val >= -80000000H) & (operand.val < 100000000H) PACO confused? *) | InstructionSet.simm32: RETURN ((operand.sizeInBytes = bitsDefault) OR (operand.sizeInBytes = bits32)) (* & & (operand.val >= -80000000H) & (operand.val < 80000000H) PACO confused? *) | InstructionSet.uimm32: RETURN ((operand.sizeInBytes = bitsDefault) OR (operand.sizeInBytes = bits32)) & (operand.val >= 0H) (* & (operand.val < 100000000H) PACO confused? *) | InstructionSet.imm64: RETURN (operand.sizeInBytes = bitsDefault) OR (operand.sizeInBytes = bits64) ELSE RETURN FALSE END |pntr1616: RETURN type = InstructionSet.pntr1616; |pntr1632: RETURN type = InstructionSet.pntr1632; ELSE HALT(100) END; END Matches; PROCEDURE ValueInByteRange (value: HUGEINT): BOOLEAN; BEGIN RETURN SYSTEM.VAL (SHORTINT, value) = value END ValueInByteRange; PROCEDURE ValueInWordRange (value: HUGEINT): BOOLEAN; BEGIN RETURN SYSTEM.VAL (INTEGER, value) = value END ValueInWordRange; PROCEDURE InitOperand*(VAR operand: Operand); BEGIN operand.type := none; operand.index := none; operand.register:= none; operand.segment:= none; operand.sizeInBytes := none; operand.scale := 1; operand.displacement := 0; operand.val := 0; operand.pc := none; operand.symbol.name := ""; operand.symbol.fingerprint := 0; operand.selector := none; operand.offset := 0; END InitOperand; PROCEDURE InitRegister* (VAR operand: Operand; register: Register); BEGIN InitOperand(operand); operand.type := InstructionSet.RegisterType(register); operand.register :=register; CASE operand.type OF reg8,reg16,reg32,reg64,segReg,CRn,DRn,sti,xmm,mmx,ymm: (* ok *) |InstructionSet.st0: operand.type := InstructionSet.sti; ELSE HALT(100); END; operand.sizeInBytes := InstructionSet.registers[register].sizeInBytes END InitRegister; PROCEDURE NewRegister*(register: Register): Operand; VAR operand: Operand; BEGIN InitRegister(operand,register); RETURN operand END NewRegister; PROCEDURE InitMem*(VAR operand: Operand; size: Size; reg: Register; displacement: LONGINT); BEGIN InitOperand(operand); operand.type := mem; operand.sizeInBytes := size; operand.register:= reg; operand.displacement := displacement; operand.scale := 1; END InitMem; PROCEDURE SetIndexScale*(VAR operand: Operand; index: Register; scale: LONGINT); BEGIN operand.index := index; operand.scale := scale END SetIndexScale; PROCEDURE NewMem*(size: Size; reg: Register; displacement: LONGINT): Operand; VAR operand: Operand; BEGIN InitMem(operand,size,reg,displacement); RETURN operand END NewMem; PROCEDURE InitMem8* (VAR operand: Operand; reg: Register; displacement: LONGINT); BEGIN InitMem (operand, bits8, reg, displacement); END InitMem8; PROCEDURE NewMem8* (reg: Register; displacement: LONGINT): Operand; VAR operand: Operand; BEGIN InitMem8 (operand,reg, displacement); RETURN operand END NewMem8; PROCEDURE InitMem16* (VAR operand: Operand; reg: Register; displacement: LONGINT); BEGIN InitMem (operand,bits16, reg, displacement); END InitMem16; PROCEDURE NewMem16* (reg: Register; displacement: LONGINT): Operand; VAR operand: Operand; BEGIN InitMem16 (operand,reg, displacement); RETURN operand END NewMem16; PROCEDURE InitMem32* (VAR operand: Operand; reg: Register; displacement: LONGINT); BEGIN InitMem (operand,bits32, reg, displacement); END InitMem32; PROCEDURE NewMem32* (reg: Register; displacement: LONGINT): Operand; VAR operand: Operand; BEGIN InitMem32 (operand,reg, displacement); RETURN operand END NewMem32; PROCEDURE InitMem64* (VAR operand: Operand; reg: Register; displacement: LONGINT); BEGIN InitMem (operand,bits64, reg, displacement); END InitMem64; PROCEDURE NewMem64* (reg: Register; displacement: LONGINT): Operand; VAR operand: Operand; BEGIN InitMem64 (operand,reg, displacement); RETURN operand END NewMem64; PROCEDURE InitMem128* (VAR operand: Operand; reg: Register; displacement: LONGINT); BEGIN InitMem (operand,bits128, reg, displacement); END InitMem128; PROCEDURE NewMem128* (reg: Register; displacement: LONGINT): Operand; VAR operand: Operand; BEGIN InitMem128 (operand,reg, displacement); RETURN operand END NewMem128; PROCEDURE SetSymbol*(VAR operand: Operand; symbol: Sections.SectionName; fingerprint: Basic.Fingerprint; symbolOffset, displacement: LONGINT); BEGIN operand.symbol.name := symbol; operand.symbol.fingerprint := fingerprint; operand.symbolOffset := symbolOffset; operand.displacement := displacement; END SetSymbol; PROCEDURE InitImm* (VAR operand: Operand; size: SHORTINT; val: HUGEINT); BEGIN InitOperand(operand); operand.type := imm; operand.sizeInBytes := size; operand.val := val; END InitImm; PROCEDURE InitImm8* (VAR operand: Operand; val: HUGEINT); BEGIN InitImm (operand, bits8, val); END InitImm8; PROCEDURE NewImm8*(val: HUGEINT): Operand; VAR operand: Operand; BEGIN InitImm8(operand,val); RETURN operand END NewImm8; PROCEDURE InitImm16* (VAR operand: Operand; val: HUGEINT); BEGIN InitImm (operand, bits16, val); END InitImm16; PROCEDURE NewImm16*(val: HUGEINT): Operand; VAR operand:Operand; BEGIN InitImm16(operand,val); RETURN operand END NewImm16; PROCEDURE InitImm32* (VAR operand: Operand; val: HUGEINT); BEGIN InitImm (operand, bits32, val); END InitImm32; PROCEDURE NewImm32*(val: HUGEINT): Operand; VAR operand: Operand; BEGIN InitImm32(operand,val); RETURN operand END NewImm32; PROCEDURE InitImm64* (VAR operand: Operand; val: HUGEINT); BEGIN InitImm (operand, bits64, val); END InitImm64; PROCEDURE NewImm64*(val: HUGEINT): Operand; VAR operand: Operand; BEGIN InitImm64(operand,val); RETURN operand END NewImm64; PROCEDURE InitOffset* (VAR operand: Operand; size: SHORTINT; val: HUGEINT); BEGIN InitOperand(operand); operand.type := ioffset; operand.sizeInBytes := size; operand.val := val; END InitOffset; PROCEDURE InitOffset8* (VAR operand: Operand; val: HUGEINT); BEGIN InitOffset (operand, bits8, val); END InitOffset8; PROCEDURE NewOffset8*(val: HUGEINT): Operand; VAR operand: Operand; BEGIN InitOffset8(operand,val); RETURN operand END NewOffset8; PROCEDURE InitOffset16* (VAR operand: Operand; val: HUGEINT); BEGIN InitOffset (operand, bits16, val); END InitOffset16; PROCEDURE NewOffset16*(val: HUGEINT): Operand; VAR operand: Operand; BEGIN InitOffset16(operand,val); RETURN operand END NewOffset16; PROCEDURE InitOffset32* (VAR operand: Operand; val: HUGEINT); BEGIN InitOffset (operand, bits32, val); END InitOffset32; PROCEDURE NewOffset32*(val: HUGEINT): Operand; VAR operand: Operand; BEGIN InitOffset32(operand,val); RETURN operand END NewOffset32; PROCEDURE InitOffset64* (VAR operand: Operand; val: HUGEINT); BEGIN InitOffset (operand, bits64, val); END InitOffset64; PROCEDURE NewOffset64*(val: HUGEINT): Operand; VAR operand: Operand; BEGIN InitOffset64(operand,val); RETURN operand END NewOffset64; PROCEDURE InitPntr1616* (VAR operand: Operand; s, o: LONGINT); BEGIN InitOperand(operand); operand.type := pntr1616; operand.selector := s; operand.offset := o; END InitPntr1616; PROCEDURE InitPntr1632* (VAR operand: Operand; s, o: LONGINT); BEGIN InitOperand(operand); operand.type := pntr1632; operand.selector := s; operand.offset := o; END InitPntr1632; PROCEDURE SetSize*(VAR operand: Operand;sizeInBytes: Size); BEGIN operand.sizeInBytes := sizeInBytes END SetSize; PROCEDURE SameOperand*(CONST left,right: Operand): BOOLEAN; BEGIN IF (left.type # right.type) OR (left.sizeInBytes # right.sizeInBytes) OR (left.symbol # right.symbol) THEN RETURN FALSE END; CASE left.type OF reg8,reg16,reg32,reg64,segReg,CRn,DRn,sti,xmm,mmx,ymm: RETURN left.register = right.register | imm,ioffset: RETURN (left.val = right.val) & ((left.symbol.name="") OR (left.displacement = right.displacement)) | mem:RETURN (left.register = right.register) & (left.displacement = right.displacement) & (left.index = right.index) & (left.scale = right.scale) | pntr1616,pntr1632: RETURN (left.selector=right.selector) & (left.offset=right.offset) END; RETURN FALSE END SameOperand; PROCEDURE Test*(context: Commands.Context); VAR assembly: Emitter; (*errorHandler: ErrorHandler; *) op1,op2,op3: Operand; diagnostics: Diagnostics.StreamDiagnostics; code: Code; pooledName: Basic.SegmentedName; PROCEDURE Op(CONST name: ARRAY OF CHAR): LONGINT; BEGIN RETURN InstructionSet.FindMnemonic(name) END Op; BEGIN InitOperand(op1); InitOperand(op2); InitOperand(op3); NEW(diagnostics,context.error); Basic.ToSegmentedName("test", pooledName); NEW(code,Sections.CodeSection,8,pooledName,TRUE,TRUE); NEW(assembly,diagnostics); assembly.SetCode(code); InitRegister(op1,InstructionSet.regEAX); InitImm32(op2,10); assembly.Emit2(Op("MOV"),op1,op2); context.out.Update; code.Dump(context.out); END Test; BEGIN IF Trace THEN NEW(kernelWriter,KernelLog.Send,1000); END; END FoxAMD64Assembler. OCAMD64Assembler.Test ~