MODULE FoxIntermediateCode;
IMPORT
Sections := FoxSections, Basic := FoxBasic, SyntaxTree := FoxSyntaxTree, BinaryCode := FoxBinaryCode, Backend := FoxBackend,
SYSTEM, Streams, Global := FoxGlobal, D := Debugging, ObjectFile;
CONST
Undefined*=0;
ModeRegister*=1;
ModeMemory*=2;
ModeImmediate*=3;
ModeNumber*=4;
ModeString*=5;
Undef* = {Undefined};
Imm*={ModeImmediate};
Reg*={ModeRegister};
RegMem* = {ModeRegister,ModeMemory};
RegMemImm* = {ModeRegister,ModeMemory,ModeImmediate};
UndefReg*={Undefined,ModeRegister};
UndefRegMem*={Undefined, ModeRegister, ModeMemory};
Num* = {ModeNumber};
Str*= {ModeString};
Any = {Undefined, ModeRegister, ModeMemory, ModeImmediate};
SignedInteger* = 1;
UnsignedInteger* = 2;
Integer*= {SignedInteger,UnsignedInteger};
Float* = 3;
SameType12*=0;
SameType23*=1;
Op1IsDestination*=2;
Commute23*=3;
SameSize12*=4;
Bits8*=8; Bits16*=16; Bits32*=32; Bits64*=64; Bits128*=128;
GeneralPurpose*=0;
Parameter*=1;
None*=-1;
SP*=-2;
FP*=-3;
HwRegister*=-32;
nop*= 0; mov*= 1; conv*= 2; call*= 3; enter*= 4; exit*= 5; leave*= 6; return*= 7;
result*= 8; trap*= 9; br*= 10; breq*= 11; brne*= 12; brge*= 13; brlt*= 14; pop*= 15;
push*= 16; neg*= 17; not*= 18; abs*= 19; mul*= 20; div*= 21; mod*= 22; sub*= 23;
add*= 24; and*= 25; or*= 26; xor*= 27; shl*= 28; shr*= 29; rol*= 30; ror*= 31;
copy*= 32; fill*= 33; asm*= 34; data*= 35; reserve*= 36; label*= 37; special*=38; NofOpcodes*= 39;
NotYetCalculatedSize = -2;
TYPE
Type*=RECORD
form-: SHORTINT;
sizeInBits-: INTEGER;
END;
RegisterClass*=RECORD
class-: SHORTINT;
number-: INTEGER;
END;
Operand* = RECORD
mode-: SHORTINT;
type-: Type;
register-: LONGINT;
registerClass-: RegisterClass;
offset-: LONGINT;
intValue-: HUGEINT;
floatValue-: LONGREAL;
symbol-: ObjectFile.Identifier;
symbolOffset-: LONGINT;
resolved*: Sections.Section;
string-: SyntaxTree.SourceCode;
END;
Instruction* = RECORD
opcode-: SHORTINT;
subtype-: SHORTINT;
textPosition-: LONGINT;
pc-: LONGINT;
op1*,op2*,op3*: Operand;
END;
InstructionFormat* = RECORD
name-: ARRAY 16 OF CHAR;
op1-,op2-,op3-: SET;
flags-: SET;
END;
Instructions*=POINTER TO ARRAY OF Instruction;
Section*= OBJECT (Sections.Section)
VAR
instructions-: Instructions;
pc-: LONGINT;
finally-: LONGINT;
resolved-: BinaryCode.Section;
comments-: Sections.CommentWriter;
validPAFEnter-,validPAFExit-: LONGINT;
sizeInUnits: LONGINT;
PROCEDURE GetPC(): LONGINT;
BEGIN RETURN pc
END GetPC;
PROCEDURE & InitIntermediateSection*(type: SHORTINT; priority: INTEGER; CONST n: Basic.SegmentedName; symbol: SyntaxTree.Symbol; comment: BOOLEAN);
BEGIN
InitSection(type,priority,n,symbol); pc := 0; resolved := NIL;
IF comment THEN NEW(comments,GetPC) ELSE comments := NIL END;
finally := -1;
validPAFEnter := 0; validPAFExit := 0;
sizeInUnits := NotYetCalculatedSize
END InitIntermediateSection;
PROCEDURE EnterValidPAF*;
BEGIN validPAFEnter := pc
END EnterValidPAF;
PROCEDURE ExitValidPAF*;
BEGIN validPAFExit := pc
END ExitValidPAF;
PROCEDURE DeleteComments*;
BEGIN comments := NIL
END DeleteComments;
PROCEDURE SetResolved*(section: BinaryCode.Section);
BEGIN resolved := section
END SetResolved;
PROCEDURE SetFinally*(atPc: LONGINT);
BEGIN finally := atPc
END SetFinally;
PROCEDURE GetSize*(): LONGINT;
VAR
i: LONGINT;
instruction: Instruction;
BEGIN
IF sizeInUnits = NotYetCalculatedSize THEN
sizeInUnits := Sections.UnknownSize;
IF bitsPerUnit # Sections.UnknownSize THEN
IF (type = Sections.VarSection) OR (type = Sections.ConstSection) THEN
sizeInUnits := 0;
FOR i := 0 TO pc - 1 DO
instruction := instructions[i];
CASE instruction.opcode OF
| data:
ASSERT((instruction.op1.mode = ModeImmediate) OR (instruction.op1.mode = ModeMemory));
ASSERT((instruction.op1.type.sizeInBits MOD bitsPerUnit) = 0);
INC(sizeInUnits, instruction.op1.type.sizeInBits DIV bitsPerUnit);
| reserve:
ASSERT(instruction.op1.mode = ModeNumber);
INC(sizeInUnits, LONGINT(instruction.op1.intValue))
ELSE
HALT(100);
END
END
END
END
END;
RETURN sizeInUnits
END GetSize;
PROCEDURE InitArray;
CONST MinInstructions = 8;
BEGIN
IF instructions = NIL THEN NEW(instructions, MinInstructions); END;
pc := 0;
END InitArray;
PROCEDURE Emit*(instruction: Instruction);
VAR new: Instructions;
op1size,op2size,op3size,op1form,op2form,op3form: LONGINT;
BEGIN
op1size := instruction.op1.type.sizeInBits;
op2size := instruction.op2.type.sizeInBits;
op3size := instruction.op3.type.sizeInBits;
op1form := instruction.op1.type.form;
op2form := instruction.op2.type.form;
op3form := instruction.op3.type.form;
Assert(instruction.op1.symbol.name[0] # 0, "not intialized operand 1");
Assert(instruction.op2.symbol.name[0] # 0, "not intialized operand 2");
Assert(instruction.op3.symbol.name[0] # 0, "not intialized operand 3");
IF (instructions = NIL) THEN
NEW(instructions, 16);
ELSIF pc = LEN(instructions) THEN
NEW(new,4*LEN(instructions));
SYSTEM.MOVE(SYSTEM.ADR(instructions[0]), SYSTEM.ADR(new[0]), LEN(instructions)*SYSTEM.SIZEOF(Instruction));
instructions := new;
END;
instruction.pc := pc;
instructions[pc] := instruction;
INC(pc);
END Emit;
PROCEDURE EmitAt*(at: LONGINT; instruction: Instruction);
VAR oldpc: LONGINT;
BEGIN
oldpc := pc;
pc := at; Assert(pc < LEN(instructions),"EmitAt only in existing code");
Emit(instruction);
pc := oldpc;
END EmitAt;
PROCEDURE PatchOperands*(pc: LONGINT; op1,op2,op3: Operand);
BEGIN instructions[pc].op1 := op1; instructions[pc].op2 := op2; instructions[pc].op3 := op3;
END PatchOperands;
PROCEDURE PatchAddress*(pc: LONGINT; symbolOffset: LONGINT);
BEGIN
ASSERT((br <= instructions[pc].opcode) & (instructions[pc].opcode <= brlt));
ASSERT(instructions[pc].op1.symbol.name = SELF.name);
instructions[pc].op1.symbolOffset := symbolOffset;
END PatchAddress;
PROCEDURE SetPC*(at: LONGINT; pc: LONGINT);
BEGIN instructions[at].pc := pc;
END SetPC;
PROCEDURE DumpCode*(w: Streams.Writer; from,to: LONGINT);
VAR
i: LONGINT;
c: Sections.Comment;
BEGIN
IF comments # NIL THEN
c := comments.firstComment;
WHILE(c # NIL) & (c.pos <from) DO
c := c.nextComment;
END;
i := from;
WHILE(i<=to) DO
IF (c # NIL) & (c.pos = i) THEN
c.Dump(w); w.Ln;
c := c.nextComment;
END;
w.Int(i,2); w.String(": ");
DumpInstruction(w,instructions[i]);
w.Ln;
INC(i);
END;
IF (c#NIL) & (c.pos = to) THEN
c.Dump(w); w.Ln;
END;
ELSE
i := from;
WHILE(i<=to) DO
w.Int(i,2); w.String(": ");
DumpInstruction(w,instructions[i]); w.Ln;
INC(i);
END;
END;
END DumpCode;
PROCEDURE Dump(w: Streams.Writer);
VAR ww: Basic.Writer;
BEGIN
IF resolved # NIL THEN
Dump^(w);
resolved.Dump(w)
ELSE
Dump^(w);
ww := Basic.GetWriter(w);
ww.IncIndent;
ww.Ln;
DumpCode(ww,0,pc-1);
ww.DecIndent;
END;
END Dump;
END Section;
IntermediateBackend*= OBJECT (Backend.Backend)
VAR
runtimeModuleName-: SyntaxTree.IdentifierString;
PROCEDURE SupportedInstruction*(CONST instr: Instruction; VAR moduleName,procedureName: ARRAY OF CHAR): BOOLEAN;
BEGIN
moduleName := ""; procedureName := "";
RETURN TRUE
END SupportedInstruction;
PROCEDURE SetRuntimeModuleName*(CONST name: ARRAY OF CHAR);
BEGIN
COPY(name, runtimeModuleName);
END SetRuntimeModuleName;
END IntermediateBackend;
VAR
instructionFormat-: ARRAY NofOpcodes OF InstructionFormat;
int8-, int16-, int32-, int64-, uint8-, uint16-, uint32-, uint64-, float32-, float64-, undef-: Type;
GeneralPurposeRegister-: RegisterClass;
PROCEDURE Assert(condition: BOOLEAN; CONST reason: ARRAY OF CHAR);
BEGIN ASSERT(condition);
END Assert;
PROCEDURE NewSection*(list: Sections.SectionList; type: SHORTINT; CONST name: Basic.SegmentedName; syntaxTreeSymbol: SyntaxTree.Symbol; dump: BOOLEAN): Section;
VAR
t0: SHORTINT;
result: Sections.Section;
section: Section;
BEGIN
ASSERT(name[0] > 0);
IF syntaxTreeSymbol # NIL THEN
result := list.FindBySymbol(syntaxTreeSymbol);
END;
IF result = NIL THEN
result := list.FindByName(name);
END;
IF result # NIL THEN
section := result(Section);
ASSERT(result.name= name); ASSERT(result.symbol = syntaxTreeSymbol);
RETURN section
END;
ASSERT(name[0] > 0);
NEW(section, type, 0 , name, syntaxTreeSymbol, dump);
IF syntaxTreeSymbol # NIL THEN section.SetFingerprint(syntaxTreeSymbol.fingerprint.shallow) END;
list.AddSection(section);
RETURN section
END NewSection;
PROCEDURE SameOperand*(CONST left, right: Operand): BOOLEAN;
VAR mode: LONGINT;
BEGIN
mode := left.mode;
IF (left.type.form =right.type.form) & (left.type.sizeInBits=right.type.sizeInBits) & (mode = right.mode) THEN
CASE mode OF
ModeRegister: RETURN (left.register = right.register) & (left.offset = right.offset)
|ModeMemory: RETURN (left.register = right.register) &(left.offset = right.offset) & (left.symbol = right.symbol) & (left.symbolOffset = right.symbolOffset);
|ModeImmediate:
IF left.type.form = Float THEN
RETURN (left.floatValue = right.floatValue) & (left.symbol = right.symbol) & (left.symbolOffset = right.symbolOffset)
ELSE
RETURN (left.intValue = right.intValue) & (left.symbol = right.symbol) & (left.symbolOffset = right.symbolOffset)
END;
|ModeNumber:
RETURN left.intValue = right.intValue
|ModeString:
RETURN left.string = right.string
|Undefined: RETURN TRUE
END;
ELSE RETURN FALSE
END;
END SameOperand;
PROCEDURE CheckOperand*(operand: Operand; opCode, location: LONGINT; VAR message: ARRAY OF CHAR): BOOLEAN;
VAR
validOperandModes: SET;
BEGIN
validOperandModes := {};
CASE location OF
| 0: validOperandModes := instructionFormat[opCode].op1
| 1: validOperandModes := instructionFormat[opCode].op2
| 2: validOperandModes := instructionFormat[opCode].op3
END;
IF ~(operand.mode IN validOperandModes) THEN
message := "operand mode mismatch"; RETURN FALSE
END;
CASE operand.mode OF
| Undefined:
| ModeNumber:
| ModeMemory:
IF operand.type.form = Undefined THEN message := "memory type form undefined"; RETURN FALSE END;
IF operand.type.sizeInBits = 0 THEN message :="memory type size undefined"; RETURN FALSE END;
IF operand.register # None THEN
IF operand.symbol.name # "" THEN message :="symbol and register cannot be both set in a memory operand"; RETURN FALSE END
ELSIF operand.symbol.name # "" THEN
IF operand.intValue # 0 THEN message :="memory operand on non zero immediate with symbol # NIL"; RETURN FALSE END
END
| ModeRegister:
IF operand.type.form = Undefined THEN message :="register type form undefined"; RETURN FALSE END;
IF operand.type.sizeInBits = 0 THEN message :="register type size undefined"; RETURN FALSE END;
IF operand.register = None THEN message :="register undefined in register operand"; RETURN FALSE END
| ModeImmediate:
IF operand.symbol.name # "" THEN
IF operand.intValue # 0 THEN message :="forbidden immediate with symbol and intValue # 0"; RETURN FALSE END;
IF operand.floatValue # 0 THEN message :="forbidden immediate with symbol and floatValue # 0"; RETURN FALSE END
END
| ModeString:
IF operand.string = NIL THEN message :="nil string in string operand"; RETURN FALSE END
END;
RETURN TRUE
END CheckOperand;
PROCEDURE CheckInstruction*(instruction: Instruction; VAR message: ARRAY OF CHAR): BOOLEAN;
BEGIN
IF (SameType12 IN instructionFormat[instruction.opcode].flags) & ~TypeEquals(instruction.op1.type, instruction.op2.type) THEN
message := "operands 1 and 2 not of same type";
RETURN FALSE
END;
IF (SameSize12 IN instructionFormat[instruction.opcode].flags) & (instruction.op1.type.sizeInBits # instruction.op2.type.sizeInBits) THEN
message := "operands 1 and 2 not of same size";
RETURN FALSE
END;
IF (SameType23 IN instructionFormat[instruction.opcode].flags) & ~TypeEquals(instruction.op2.type, instruction.op3.type) THEN
message := "operands 2 and 3 not of same type";
RETURN FALSE
END;
IF (Op1IsDestination IN instructionFormat[instruction.opcode].flags) & (instruction.op1.mode = ModeRegister) & (instruction.op1.offset # 0) THEN
message := "destination operand may not be register with nonzero offset";
RETURN FALSE
END;
RETURN TRUE
END CheckInstruction;
PROCEDURE DumpRegister*(w: Streams.Writer; registerNumber: LONGINT; CONST registerClass: RegisterClass);
BEGIN
IF registerNumber = SP THEN
w.String("sp")
ELSIF registerNumber = FP THEN
w.String("fp")
ELSIF registerNumber > None THEN
w.String("r"); w.Int(registerNumber, 0);
IF registerClass.class = Parameter THEN w.String(":p"); w.Int(registerClass.number,0) END;
ELSIF registerNumber <= HwRegister THEN
w.String("h"); w.Int(HwRegister - registerNumber, 0)
ELSE
w.String("(invalid register)")
END
END DumpRegister;
PROCEDURE DumpType*(w: Streams.Writer; type: Type);
BEGIN
CASE type.form OF
| Undefined: w.String("(invalid type)")
| UnsignedInteger: w.String("u"); w.Int(type.sizeInBits, 0)
| SignedInteger: w.String("s"); w.Int(type.sizeInBits, 0)
| Float: w.String("f"); w.Int(type.sizeInBits, 0)
END
END DumpType;
PROCEDURE DumpOperand*(w: Streams.Writer; CONST operand: Operand );
PROCEDURE DumpString(CONST str: ARRAY OF CHAR);
VAR
i: LONGINT;
ch: CHAR;
newln: BOOLEAN;
BEGIN
w.String('"');
i := 0;
ch := str[i];
WHILE ch # 0X DO
IF (ch = 0DX) OR (ch = 0AX) THEN
newln := TRUE
ELSE
IF newln THEN
w.Ln;
newln := FALSE;
END;
IF (ch = '"') OR (ch = '\') THEN
w.Char( '\' );
w.Char(ch);
ELSE
w.Char(ch);
END
END;
INC(i);
ch := str[i];
END;
w.String('"');
END DumpString;
BEGIN
IF operand.type.form # Undefined THEN
DumpType(w,operand.type); w.String(" ");
END;
CASE operand.mode OF
Undefined: w.String("!Undefined");
|ModeMemory:
w.String("[");
IF operand.register # None THEN
DumpRegister(w,operand.register, operand.registerClass);
IF operand.offset > 0 THEN w.String("+"); w.Int(operand.offset,1);
ELSIF operand.offset < 0 THEN w.String("-"); w.Int(-operand.offset,1);
END;
ELSIF operand.symbol.name # "" THEN
Basic.WriteSegmentedName(w,operand.symbol.name);
IF operand.symbol.fingerprint # 0 THEN w.String("["); w.Hex(operand.symbol.fingerprint,-8); w.String("]"); END;
w.String(":"); w.Int(operand.symbolOffset,1);
IF operand.offset > 0 THEN w.String("+"); w.Int(operand.offset, 1);
ELSIF operand.offset < 0 THEN w.String("-"); w.Int(-operand.offset, 1);
END;
ELSE w.Int(SHORT(operand.intValue),1);
END;
w.String("]");
|ModeRegister:
DumpRegister(w,operand.register, operand.registerClass);
IF operand.offset > 0 THEN w.String("+"); w.Int(operand.offset,1);
ELSIF operand.offset < 0 THEN w.String("-"); w.Int(-operand.offset,1);
END;
|ModeImmediate:
IF operand.symbol.name # "" THEN
Basic.WriteSegmentedName(w,operand.symbol.name);
IF operand.symbol.fingerprint # 0 THEN w.String("["); w.Hex(operand.symbol.fingerprint,-8); w.String("]"); END;
w.String(":"); w.Int(operand.symbolOffset,1);
IF operand.offset > 0 THEN w.String("+"); w.Int(operand.offset, 1);
ELSIF operand.offset < 0 THEN w.String("-"); w.Int(-operand.offset, 1);
END
ELSE
IF operand.type.form IN Integer THEN
IF (operand.intValue > MAX(LONGINT)) OR (operand.intValue < MIN(LONGINT)) THEN
w.String("0");
w.Hex(operand.intValue,0);
w.String("H");
ELSE
w.Int(SHORT(operand.intValue),1);
END
ELSE
w.Float(operand.floatValue,24);
END;
END;
|ModeString:
DumpString(operand.string^);
|ModeNumber: w.Int(SHORT(operand.intValue),1);
END;
END DumpOperand;
PROCEDURE TypeEquals*(CONST s1,s2: Type): BOOLEAN;
BEGIN RETURN (s1.form = s2.form) & (s1.sizeInBits = s2.sizeInBits);
END TypeEquals;
PROCEDURE OperandEquals*(CONST s1,s2: Operand) : BOOLEAN;
BEGIN
RETURN (s1.mode = s2.mode) & (s1.register = s2.register) & (s1.offset = s2.offset) & (s1.intValue = s2.intValue) & (s1.floatValue = s2.floatValue)
& (s1.symbol.name = s2.symbol.name) & (s1.string = s2.string) & (s1.symbolOffset = s2.symbolOffset) & TypeEquals(s1.type,s2.type);
END OperandEquals;
PROCEDURE DumpInstruction*(w: Streams.Writer; CONST instr: Instruction);
BEGIN
w.String(instructionFormat[instr.opcode].name);
IF instr.op1.mode # Undefined THEN w.String(" "); DumpOperand(w,instr.op1) END;
IF instr.op2.mode # Undefined THEN w.String(", "); DumpOperand(w,instr.op2) END;
IF instr.op3.mode # Undefined THEN w.String(", "); DumpOperand(w,instr.op3) END;
IF instr.opcode = special THEN w.String(" sub "); w.Int(instr.subtype,1) END;
END DumpInstruction;
PROCEDURE InitInstructions;
PROCEDURE AddFormat(opcode: SHORTINT; CONST name: ARRAY OF CHAR; op1,op2,op3: SET; flags: SET);
BEGIN
COPY(name,instructionFormat[opcode].name);
instructionFormat[opcode].op1 := op1;
instructionFormat[opcode].op2 := op2;
instructionFormat[opcode].op3 := op3;
instructionFormat[opcode].flags := flags
END AddFormat;
BEGIN
AddFormat(nop, "nop", Undef, Undef, Undef, {});
AddFormat(mov, "mov", RegMem, RegMemImm, UndefReg, {SameSize12,Op1IsDestination});
AddFormat(conv, "conv", RegMem, RegMemImm, Undef, {Op1IsDestination});
AddFormat(call, "call", RegMemImm, Num, Undef,{});
AddFormat(enter, "enter", Num, Num, Num ,{});
AddFormat(leave, "leave", Num, Undef, Undef ,{});
AddFormat(return,"return",RegMemImm, Undef, Undef,{});
AddFormat(exit, "exit", Num, Num, Num ,{});
AddFormat(result,"result",RegMem,Undef,Undef,{Op1IsDestination});
AddFormat(trap, "trap", Num, Undef, Undef,{});
AddFormat(br, "br", RegMemImm, Undef, Undef,{});
AddFormat(breq, "breq", RegMemImm, RegMemImm, RegMemImm, {SameType23});
AddFormat(brne, "brne", RegMemImm, RegMemImm, RegMemImm, {SameType23});
AddFormat(brlt, "brlt", RegMemImm, RegMemImm, RegMemImm, {SameType23});
AddFormat(brge, "brge", RegMemImm, RegMemImm, RegMemImm, {SameType23});
AddFormat(pop, "pop", RegMem, Undef, Undef,{Op1IsDestination});
AddFormat(push, "push", RegMemImm, Undef, Undef,{});
AddFormat(not, "not", RegMem, RegMemImm, Undef,{SameType12,Op1IsDestination});
AddFormat(neg, "neg", RegMem, RegMemImm, Undef,{SameType12,Op1IsDestination});
AddFormat(abs, "abs", RegMem, RegMemImm, Undef,{SameType12,Op1IsDestination});
AddFormat(mul, "mul", RegMem, RegMemImm, RegMemImm,{SameType12,SameType23,Op1IsDestination,Commute23});
AddFormat(div, "div", RegMem, RegMemImm, RegMemImm,{SameType12,SameType23,Op1IsDestination});
AddFormat(mod, "mod", RegMem, RegMemImm, RegMemImm,{SameType12,SameType23,Op1IsDestination});
AddFormat(sub, "sub", RegMem, RegMemImm, RegMemImm,{SameType12,SameType23,Op1IsDestination});
AddFormat(add, "add", RegMem, RegMemImm, RegMemImm,{SameType12,SameType23,Op1IsDestination,Commute23});
AddFormat(and, "and", RegMem, RegMemImm, RegMemImm,{SameType12,SameType23,Op1IsDestination,Commute23});
AddFormat(or, "or", RegMem, RegMemImm, RegMemImm,{SameType12,SameType23,Op1IsDestination,Commute23});
AddFormat(xor, "xor", RegMem, RegMemImm, RegMemImm,{SameType12,SameType23,Op1IsDestination,Commute23});
AddFormat(shl, "shl", RegMem, RegMemImm, RegMemImm,{SameType12,Op1IsDestination});
AddFormat(shr, "shr", RegMem, RegMemImm, RegMemImm,{SameType12,Op1IsDestination});
AddFormat(rol, "rol", RegMem, RegMemImm, RegMemImm,{SameType12,Op1IsDestination});
AddFormat(ror, "ror", RegMem, RegMemImm, RegMemImm,{SameType12,Op1IsDestination});
AddFormat(copy, "copy", RegMemImm, RegMemImm, RegMemImm,{SameType12,SameType23});
AddFormat(fill, "fill", RegMemImm, RegMemImm, RegMemImm,{SameType12});
AddFormat(asm, "asm", Str, Undef, Undef,{});
AddFormat(data, "data", Imm, Undef, Undef,{});
AddFormat(reserve, "reserve",Num,Undef,Undef,{});
AddFormat(label, "label",Num,Undef,Undef,{});
AddFormat(special,"special",Str, Any, Any, {} );
END InitInstructions;
PROCEDURE InitInstruction*(VAR instr: Instruction; textPosition: LONGINT; opcode: SHORTINT; op1,op2,op3: Operand);
VAR format: InstructionFormat; mode1, mode2, mode3: LONGINT;
BEGIN
format := instructionFormat[opcode];
mode1 := op1.mode;
mode2 := op2.mode;
mode3 := op3.mode;
Assert(op1.symbol.name[0] # 0, "not intialized operand 1");
Assert(op2.symbol.name[0] # 0, "not intialized operand 2");
Assert(op3.symbol.name[0] # 0, "not intialized operand 3");
instr.opcode := opcode;
instr.op1 := op1;
instr.op2 := op2;
instr.op3 := op3;
instr.textPosition := textPosition;
END InitInstruction;
PROCEDURE SetSubType*(VAR instr: Instruction; subType: SHORTINT);
BEGIN
instr.subtype := subType
END SetSubType;
PROCEDURE InitOperand*(VAR op: Operand);
BEGIN
op.mode := Undefined; op.type.form := Undefined; op.type.sizeInBits := Undefined;
op.register := None; op.offset := 0; op.registerClass := GeneralPurposeRegister;
op.intValue := 0;
op.floatValue := 0;
op.symbol.name := "";
op.symbol.fingerprint := 0;
op.symbolOffset := 0;
END InitOperand;
PROCEDURE InitRegister*(VAR op: Operand; type: Type; registerClass: RegisterClass; register: LONGINT);
BEGIN
Assert((register >0) OR (register = SP) OR (register = FP) OR (register <= HwRegister) ,"unmapped register number");
InitOperand(op);
op.mode := ModeRegister;
op.type := type;
op.registerClass := registerClass;
op.register := register;
END InitRegister;
PROCEDURE Register*(type: Type; registerClass: RegisterClass; register: LONGINT): Operand;
VAR op: Operand;
BEGIN InitRegister(op,type,registerClass, register); RETURN op
END Register;
PROCEDURE AddOffset*(VAR op: Operand; offset: LONGINT);
BEGIN
Assert((op.mode = ModeRegister) OR (op.mode = ModeImmediate) & (op.type.form IN {SignedInteger, UnsignedInteger}),"offset not on register or integer immediate");
IF (op.mode = ModeImmediate) & (op.symbol.name = "") THEN
INC(op.intValue,offset)
ELSE
INC(op.offset,offset)
END
END AddOffset;
PROCEDURE SetOffset*(VAR op: Operand; offset: LONGINT);
BEGIN
Assert((op.mode = ModeRegister) OR (op.mode = ModeImmediate) & (op.type.form IN {SignedInteger, UnsignedInteger}),"offset not on register or integer immediate");
op.offset := offset
END SetOffset;
PROCEDURE SetSymbol*(VAR op: Operand; symbol: Sections.SectionName; fp: LONGINT);
BEGIN
op.symbol.name := symbol;
op.symbol.fingerprint := fp;
END SetSymbol;
PROCEDURE SetIntValue*(VAR op: Operand; intValue: HUGEINT);
BEGIN op.intValue := intValue
END SetIntValue;
PROCEDURE MakeMemory*(VAR op: Operand; type: Type);
BEGIN
Assert((op.mode = ModeRegister) OR (op.mode = ModeMemory) OR (op.mode = ModeImmediate) & (op.type.form = UnsignedInteger) ,"operand mode not of register or unsigned integer immediate");
op.type := type;
op.mode := ModeMemory;
ASSERT(op.register # 0);
END MakeMemory;
PROCEDURE InitAddress*(VAR op: Operand; type: Type; symbol: Sections.SectionName; fp: LONGINT; symbolOffset: LONGINT);
BEGIN
Assert(symbol # "","forbidden nil symbol");
ASSERT(symbol[0] # 0);
InitImmediate(op,type,0); op.symbol.name := symbol; op.symbol.fingerprint := fp; op.type := type; op.symbolOffset := symbolOffset
END InitAddress;
PROCEDURE Address*(type: Type; symbol: Sections.SectionName; fp: LONGINT; offset: LONGINT): Operand;
VAR op: Operand;
BEGIN InitAddress(op,type,symbol,fp, offset); RETURN op
END Address;
PROCEDURE InitMemory*(VAR op:Operand; type: Type; base: Operand; offset: LONGINT);
BEGIN
Assert((base.mode = ModeRegister) OR (base.mode = ModeImmediate) & ((offset=0) OR (base.symbol.name#"")),"base operand must be register");
op := base; INC(op.offset,offset); MakeMemory(op,type);
END InitMemory;
PROCEDURE Memory*(type: Type; base: Operand; offset: LONGINT): Operand;
VAR op: Operand;
BEGIN InitMemory(op,type,base,offset); RETURN op
END Memory;
PROCEDURE IsConstantInteger*(CONST op: Operand; VAR value: HUGEINT): BOOLEAN;
BEGIN
IF (op.mode = ModeImmediate) & (op.type.form IN Integer) & (op.symbol.name = "") THEN
value := op.intValue;
RETURN TRUE
ELSE
RETURN FALSE
END;
END IsConstantInteger;
PROCEDURE InitImmediate*(VAR op: Operand; type: Type; value: HUGEINT);
BEGIN
Assert(type.form IN Integer,"operand type does not match value type");
InitOperand(op); op.mode := ModeImmediate; op.type := type; op.intValue := value;
END InitImmediate;
PROCEDURE Immediate*(type: Type; value: LONGINT): Operand;
VAR op: Operand;
BEGIN InitImmediate(op,type,value); RETURN op
END Immediate;
PROCEDURE InitFloatImmediate*(VAR op: Operand; type: Type; value: LONGREAL);
BEGIN
Assert(type.form = Float,"operand type does not match value type");
InitOperand(op); op.mode := ModeImmediate; op.type := type; op.floatValue := value;
END InitFloatImmediate;
PROCEDURE FloatImmediate*(type: Type; value: LONGREAL): Operand;
VAR op: Operand;
BEGIN InitFloatImmediate(op,type,value); RETURN op
END FloatImmediate;
PROCEDURE InitNumber*(VAR op: Operand; value: HUGEINT);
BEGIN InitOperand(op); op.mode := ModeNumber; op.intValue := value;
END InitNumber;
PROCEDURE Number*(value: HUGEINT): Operand;
VAR op: Operand;
BEGIN InitNumber(op,value); RETURN op
END Number;
PROCEDURE InitString*(VAR op: Operand; string: SyntaxTree.SourceCode);
BEGIN InitOperand(op); op.mode := ModeString; op.string := string;
END InitString;
PROCEDURE String*(string: SyntaxTree.SourceCode): Operand;
VAR op: Operand;
BEGIN InitString(op,string); RETURN op
END String;
PROCEDURE InitType*(VAR type: Type; form: SHORTINT; sizeInBits: INTEGER);
BEGIN type.form := form; type.sizeInBits := sizeInBits;
END InitType;
PROCEDURE InitRegisterClass*(VAR registerClass: RegisterClass; class: SHORTINT; number: INTEGER);
BEGIN registerClass.class := class; registerClass.number := number
END InitRegisterClass;
PROCEDURE NewType*(form: SHORTINT; sizeInBits: INTEGER): Type;
VAR type: Type;
BEGIN InitType(type,form,sizeInBits); RETURN type
END NewType;
PROCEDURE SetType*(VAR op: Operand; CONST type: Type);
BEGIN op.type := type
END SetType;
PROCEDURE FindMnemonic*(CONST name: ARRAY OF CHAR): SHORTINT;
VAR i: SHORTINT;
BEGIN
FOR i := 0 TO NofOpcodes-1 DO
IF name = instructionFormat[i].name THEN
RETURN i
END;
END;
RETURN None;
END FindMnemonic;
PROCEDURE SetRegister*(VAR op: Operand; reg: LONGINT);
BEGIN
op.register := reg; ASSERT(reg # 0);
END SetRegister;
PROCEDURE DecimalNumber(ch: CHAR; VAR nr: LONGINT): BOOLEAN;
BEGIN
IF (ch < "0") OR (ch > "9") THEN RETURN FALSE
ELSE
nr := nr *10;
INC(nr,ORD(ch)-ORD("0"));
RETURN TRUE
END;
END DecimalNumber;
PROCEDURE Numbers(CONST name: ARRAY OF CHAR; VAR pos: LONGINT; VAR number: LONGINT): BOOLEAN;
BEGIN
number := 0;
IF DecimalNumber(name[pos], number) THEN
INC(pos);
WHILE (pos<LEN(name)) & DecimalNumber(name[pos], number) DO INC(pos) END;
RETURN TRUE
ELSE
RETURN FALSE
END;
END Numbers;
PROCEDURE Character(CONST name: ARRAY OF CHAR; VAR pos: LONGINT; char: CHAR): BOOLEAN;
BEGIN
IF name[pos] = char THEN INC(pos); RETURN TRUE ELSE RETURN FALSE END;
END Character;
PROCEDURE DenotesRegister*(CONST name: ARRAY OF CHAR; VAR registerClass: RegisterClass; VAR register: LONGINT): BOOLEAN;
VAR pos, registerNumber: LONGINT;
BEGIN
pos := 0;
IF Character(name,pos,'r') THEN
IF Numbers(name,pos,register) THEN
IF Character(name,pos,0X) THEN registerClass := GeneralPurposeRegister; RETURN TRUE
ELSIF Character(name,pos,':') & Character(name,pos,'p') & Numbers(name,pos,registerNumber) & Character(name,pos,0X) THEN
InitRegisterClass(registerClass, Parameter, SHORT(registerNumber));
RETURN TRUE
END
END;
ELSIF Character(name,pos,'h') THEN
IF Numbers(name,pos,register) & Character(name,pos,0X) THEN
register := HwRegister - register; RETURN TRUE
END;
ELSIF name = "sp" THEN register := SP; RETURN TRUE
ELSIF name = "fp" THEN register := FP ; RETURN TRUE
ELSE RETURN FALSE
END;
END DenotesRegister;
PROCEDURE UnsignedIntegerType*(bits: LONGINT): Type;
BEGIN
IF bits = 8 THEN RETURN uint8
ELSIF bits=16 THEN RETURN uint16
ELSIF bits=32 THEN RETURN uint32
ELSIF bits=64 THEN RETURN uint64
ELSE RETURN NewType(UnsignedInteger, SHORTINT(bits))
END;
END UnsignedIntegerType;
PROCEDURE SignedIntegerType*(bits: LONGINT): Type;
BEGIN
IF bits = 8 THEN RETURN int8
ELSIF bits=16 THEN RETURN int16
ELSIF bits=32 THEN RETURN int32
ELSIF bits=64 THEN RETURN int64
ELSE RETURN NewType(SignedInteger, SHORTINT(bits))
END;
END SignedIntegerType;
PROCEDURE FloatType*(bits: LONGINT): Type;
BEGIN
IF bits=32 THEN RETURN float32
ELSIF bits=64 THEN RETURN float64
ELSE RETURN NewType(Float, SHORTINT(bits))
END;
END FloatType;
PROCEDURE ToUnsigned*(operand: Operand): Operand;
VAR
type: Type;
result: Operand;
BEGIN
ASSERT(operand.type.form IN Integer);
result := operand;
result.type.form := UnsignedInteger;
RETURN result
END ToUnsigned;
PROCEDURE DenotesType*(CONST name: ARRAY OF CHAR; VAR type: Type): BOOLEAN;
VAR
sizeInBits: LONGINT; pos: LONGINT;
BEGIN
pos := 0;
IF Character(name,pos,'s') THEN
IF Numbers(name, pos, sizeInBits) & Character(name,pos,0X) & (sizeInBits >0) THEN
type := SignedIntegerType(sizeInBits); RETURN TRUE
END;
ELSIF Character(name,pos,'u') THEN
IF Numbers(name, pos, sizeInBits) & Character(name,pos,0X) & (sizeInBits >0) THEN
type := UnsignedIntegerType(sizeInBits); RETURN TRUE
END;
ELSIF Character(name,pos, 'f') THEN
IF Numbers(name, pos, sizeInBits) & Character(name,pos,0X) & (sizeInBits >0) THEN
type := FloatType(sizeInBits); RETURN TRUE
END;
ELSE RETURN FALSE
END;
END DenotesType;
PROCEDURE GetType*(system: Global.System; type: SyntaxTree.Type): Type;
BEGIN
type := type.resolved;
IF type IS SyntaxTree.CharacterType THEN
RETURN UnsignedIntegerType(system.SizeOf(type))
ELSIF type IS SyntaxTree.IntegerType THEN
RETURN SignedIntegerType(system.SizeOf(type))
ELSIF type IS SyntaxTree.FloatType THEN
RETURN FloatType(system.SizeOf(type))
ELSIF type IS SyntaxTree.RangeType THEN
RETURN GetType(system,system.addressType)
ELSIF type IS SyntaxTree.BasicType THEN
IF type IS SyntaxTree.SizeType THEN RETURN SignedIntegerType(system.SizeOf(type))
ELSE
RETURN UnsignedIntegerType(system.SizeOf(type))
END;
ELSIF type IS SyntaxTree.PointerType THEN
RETURN GetType(system,system.addressType)
ELSIF type IS SyntaxTree.EnumerationType THEN
RETURN int32
ELSIF type IS SyntaxTree.ProcedureType THEN
RETURN GetType(system,system.addressType)
ELSIF type IS SyntaxTree.MathArrayType THEN
RETURN GetType(system,system.addressType);
ELSIF type IS SyntaxTree.PortType THEN
RETURN GetType(system, system.addressType);
ELSE
HALT(100);
END;
END GetType;
BEGIN
InitInstructions;
InitType(int8, SignedInteger,8);
InitType(int16, SignedInteger,16);
InitType(int32, SignedInteger,32);
InitType(int64, SignedInteger,64);
InitType(uint8, UnsignedInteger,8);
InitType(uint16, UnsignedInteger,16);
InitType(uint32, UnsignedInteger,32);
InitType(uint64, UnsignedInteger,64);
InitType(float32, Float,32);
InitType(float64, Float,64);
InitType(undef, Undefined,0);
END FoxIntermediateCode.