(* Module DC-002.INC *) (* Procedures and Functions of the CodeGenerator *) (* Just replace previous version *) PROCEDURE Gen(x, y, z:INTEGER; Comment:str40); LABEL 99; CONST s : STRING[10] = ' '; VAR i : INTEGER; obj : ObjPtr; BP : Str4; FUNCTION MakeHex(s:Str2) : CHAR; (* Convert 2 Character -> CHAR; without Errorcheck !!! *) VAR i , j : INTEGER; BEGIN i := ORD(s[l]) - 48; IF i > 9 THEN i := i - 7; (* Process A..F *) j := i * 16; i := ORD(s[2]) - 48; IF i > 9 THEN i := i - 7; (* Process A..F *) MakeHex := CHAR(j + i); END (* MakeHex *); PROCEDURE WriteCode(OpCode:Str4; Address,OpCodeLength:INTEGER) VAR Code1, Code2, Code3, Code4 : CHAR; s1 : Str2; BEGIN (* WriteCode *) IF COM_Gen THEN BEGIN Code1 := MakeHex(COPY(OpCode,1,2)); IF OpCodeLength > 1 THEN BEGIN IF Length(OpCode) > 2 THEN (* This is NOT fool proof *) Code2 := MakeHex(COPY(OpCode,3,2)); Code3 := CHAR(LO(Address)); (* Low Byte off the Address *) Code4 := CHAR(HI(Address)); (* High Byte off the Address *) END; IF OpCodeLength = 1 THEN WRITE(COM File,Code1) ELSE IF OpCodeLength = 2 THEN WRITE(COM File,Code1,Code2) ELSE IF OpCodeLength = 3 THEN (* Cases : 1) LD HL,0006 becomes 21 86 00 Hex *) (* with a one bute opcode and two byte data *) (* 2) LD H,(IX+5) becomes DD 66 05 Hex *) (* with two byte opcode and one byte data *) (* Case can be determined by the length of the opcode string *) IF Length(OpCode) = 2 THEN (* Is case 1) *) WRITE(COM_File,Code1,Code3,Code*) ELSE BEGIN (* Is case 2) *) WRITE(COM_File,Code1,Code2,Code3); END ELSE IF OpCodeLength = 4 THEN BEGIN (* Two Byte OpCode and Two Byte Data *) WRITE(COM_File,Code1,Code2,Code3,Code*); END; MCode_Address := MCode_Address + OpCodeLength; END (* IF COM_Gen *) IF ASM_Gen THEN WRITE(ASM_File,ASMCode); END (* WriteCode *) PROCEDURE Set_ASM_Address; BEGIN ASMCode.nr := ASMCode_Address; ASMCode_Address := ASMCode_Address + 1; END (* Set_ASM_Address *) BEGIN (* Gen *) IF NOT Noerr THEN GOTO 99; s := ''; i := 8; WITH ASMCode DO BEGIN nr := 0; bc := ''; op1 := ''; op2 := ''; km := ''; END; (* Small optimization when Save und Load on the same *) WITH ZCode DO (* Variable follow each othern *) IF ((bc = 5) OR (bc = 63) AND (ad = z> THEN BEGIN x := 8; z := 2; END; (* correct the Zcode *) (* Processing of all IntermediateCode and translation into *) (* (one or more) (Z80->Assembler- and Maschinencodestamements. *) (* The next WITH works on the complete CASE..Statement *) WITH ASMCode DO CASE x OF 0, 1 : BEGIN (* Push constant onto stack *) Set_ASM_Address; IF x = 1 THEN BEGIN (* Character, '$' -> H, ch -> L *) z := 256 * ORD('$') + z; km := 'Load character constant into register'; END ELSE km := 'Load integer constant into register'; bc := 'LD '; op1 := 'HL'; STR(z,s); op2 := s; WriteCode('21',z,3); Set_ASM_Address; bc := 'PUSH'; op1 := 'HL'; op2 := ''; km := 'and push on stack '; WriteCode('E5',0,1); END; 2 : BEGIN (* Arithmetic Operations, *) Set_ASM_Address; (* as with a Call_RTsystem (11) *) i := TPA_Start + z; (* calculate Address off RT-Lib *) bc := 'CALL'; STR(i,s); op1 := s; op2 := ''; km := 'Arithmetic Operations'; WriteCode('CD',i,3); END; 3 : BEGIN (* LoadIntegerVariable-processing *) (* Basicly a distinction has to be made between global and *) (* local variables, by using pass parameter y. *) (* The following convention is used : *) (* - y = 0 : local Variable (IX is BasePointer) *) (* - y = 1 : global Variable (IY is BasePointer) *) Set_ASM_Address; bc := 'LD '; op1 := 'H'; STR(z+1,s); IF y = 0 THEN BEGIN op2 := '(IX-'+s+')'; BP := 'DD66'; END ELSE BEGIN op2 := '(IY-'+s+')'; BP := 'FD66'; END; km := 'Integervariable'; WriteCode(BP,255-z,3); z := z + 1; Set_ASM_Address; bc := 'LD '; op1 := 'L'; STR(z+1,s); IF y = 0 THEN BEGIN op2 := '(IX-'+s+')'; BP := 'DD6E'; END ELSE BEGIN op2 := '(IY-'+s+')'; BP := 'FD6E'; END; km := 'load from memory and'; WriteCode(BP,255-z,3); (* push variable on the stack *) Set_ASM_Address; bc := 'PUSH'; op1 := 'HL'; op2 := ''; km := 'push on stack'; WriteCode('E5',0,1); z := z - 1; END; 4 : BEGIN (* LoadCharacterUariable-processing *) (* same remarks as for LoadIntegerVariable-processing *) Set_ASM_Address; bc := 'LD '; op1 := 'H'; STR(z+1,s); IF y = 0 THEN BEGIN op2 := '(IX-'+s+')'; BP := 'DD66'; END ELSE BEGIN op2 := '(IY-'+s+')'; BP := 'FD66'; END; km := 'Charactervariable'; WriteCode(BP,255-z,3); z := z + 1; Set_ASM_Address; bc := 'LD '; op1 := 'L';STR(z+1,s); km := 'und $'; IF y = 0 THEN BEGIN op2 := '(lX-'+s+')'; BP := 'DD6E'; END ELSE BEGIN op2 := '(IY-'+s+')'; BP := 'FD6E'; END; WriteCode(BP,255-z,3); (* push variable on the stack *) Set_ASM_Address; bc := 'PUSH'; op1 := 'HL'; op2 := ''; km := 'push on stack'; WriteCode('E5',0,1); z := z - 1; END; 5 : BEGIN (* SaveIntegervariable-processing *) (* pop variable from the stack *) Set_ASM_Address; bc := 'POP '; op1 := 'HL'; op2 := ''; km := 'Get Integer from Stack'; Write Code('E1',0,1); (* Write variable to its (memory) Activation-Record *) Set_ASM_Address; bc := 'LD '; STR(z+1,s); IF y = 0 THEN BEGIN op1 := '(IX-'+s+')'; BP := 'DD74'; END ELSE BEGIN op1 := '(IY-'+s+')'; BP := 'FD74'; END; op2 := 'H'; km := 'and'; WriteCode(BP,255-z,3); z := z + 1; Set_ASM_Address; bc := 'LD '; STR(z+1,s); IF y = 0 THEN BEGIN op1 := '(IX-'+s+')'; BP := 'DD75'; END ELSE BEGIN op1 := '(IY-'+s+')'; BP := 'FD75'; END; op2 := 'L'; km := 'write to memory'; WriteCode(BP,255-z,3); z := z - 1; END; 6 : BEGIN (* SaveCharacterVariable-processing *) (* Get Variable from Stack *) Set_ASM_Address; bc := 'POP '; op1 := 'HL'; op2 := ''; km := 'Get Character from Stack'; WriteCode('E1',8,1); (* Write variable to its (memory) Activation-Record *) Set_ASM_Address; bc := 'LD '; STR(z+1,s); IF y = 0 THEN BEGIN op1 := '(IX-'+s+')'; BP := 'DD74'; END ELSE BEGIN op2 := '(IY-'+s+')'; BP := 'FD74'; END; op2 := 'H'; km := 'and'; WriteCode(BP,255-z,3); z := z + 1; Set_ASM_Address; bc := 'LD '; STR(z+1,s); op1 := '(lX-'+s+')'; IF y = 0 THEN BEGIN op1 := '(IX-'+s+')'; BP := 'DD75'; END ELSE BEGIN op1 := '(IY-'+s+')'; BP := 'FD75'; END; op2 := 'L'; km := 'write to memory'; WriteCode(BP,255-z,3); z := z - 1; END; 7 : BEGIN (* Call-processing, z contains UP-Address *) (* A difference must be made for main program and procedure*) (* use. The variable z contains, depending on the way this *) (* is called, the address of the main program (thanks to *) (* TURBO-PASCAL) or a pointer into the symbol table which *) (* contain the procedure names. *) Set_ASM Address; IF y > 0 THEN BEGIN (* Procedure usea, get UP-Address *) Obj := ptr(z); i := Obj^.ASM_Startadresse; STR(i,s); j := Obj^.COM_Startadresse; z := Obj^.ZWC_Startadresse; km := 'Procedure call'; END ELSE BEGIN (* Main program call, MP-Address *) i := ASMCode_0ffset + z +5; STR(i,s); i := MCode_Address + 6; km := 'Main program'; END; bc := 'CALL'; op1 := s; op2 := WriteCode('CD',i,3); END; 8 : BEGIN (* DECR_SP-processing *) (* Decrement Stackpointer with *) bc := 'DEC '; op1 := 'SP'; op2 := ''; km := 'Decrement Stackpointer'; FOR i := 1 TO z DO BEGIN Set_ASM_Address: WriteCode('3B',0,1); END; END; 9 : BEGIN (* Unconditional jump: JUMP-Processing *) Set_ASM_Address; bc := 'JP '; op1 := '0'; op2 := ''; km := 'unconditional jump'; Write Code ('C3',0,3); END; 10 : BEGIN (* Conditional jump: JUMP_COND-processing *) Set_ASM_Address; bc := 'POP '; op1 := 'HL'; op2 := ''; km := 'logical result to HL,'; WriteCode('E1',8,1); Set_ASM_Address; bc := 'LD '; op1 := 'A'; op2 := 'H'; km := 'Than to ACCU,'; WriteCode('7C',8,1); Set_ASM_Address; bc := 'OR '; op1 := 'A'; op2 := ''; km := 'set FLAGs,'; WriteCode('B7',0,1); Set_ASM_Address; bc := 'JP '; op1 := 'Z'; op2 := ''; km := 'Jump, if ACCU = 0'; WriteCode('CA',0,3); END; 11 : BEGIN ( Call RunTimeSystem processing, z contains the *) (* Address the RTS-Vector of the required function *) Set_ASM_Address; bc := 'CALL'; STR(TPA_Start+z,s); op1 := s; op2 := ''; km := 'RTS-Call'; WriteCode('CD',TPA_Start+z,3); END; 12 : BEGIN (* RETURN-processing: Get old Basepointer from the *) Set_ASM_Address; (* Stack *) bc := 'LD '; op1 := 'SP'; op2 := 'IX'; km := 'Get old basepointer from stack'; WriteCode('DDF9',0,2); Set_ASM_Address; bc := 'DEC '; op1 := 'SP'; op2 := ''; km := 'Decrement Stackpointer'; WriteCode('3B',0,1); Set_ASM_Address; bc := 'POP '; op1 := 'IX'; op2 := ''; km := 'Get old basepointer from stack'; WriteCode('DDE1',0,2); Set_ASM_Address; bc := 'RET '; op1 := ''; op2 := ''; km := 'Return from procedure call'; IF Level = 0 THEN km := 'Return to Main program'; WriteCode('C9',0,1); END; 13 : BEGIN (* Bei Up-Aufruf Basepointer (= IX-Register) *) 13 : BEGIN (* If procedure call save Basepoiter and load with *) (* SP - 1 *) Set_ASM_Address; i := MCode_Offset - 2; bc := 'LD '; STR(i,s); op1 := '('+s+')'; op2 := 'SP'; km := 'Temp. save StackPointer'; WriteCode('ED73',i,4); Set_ASM_Address; bc := 'PUSH'; op1 := 'IX'; op2 := ''; km := 'Push BasePointer to Stack'; WriteCode('DDE5',0,2); Set_ASM_Address; bc := 'LD '; op1 := 'IX'; op2 := '('+s+')'; km := 'Get BasePointer from temp. storage'; WriteCode('DD2A',i,4); Set_ASM_Address; bc := 'DEC ' ; op1 := 'IX'; op2 := ''; km := ''; WriteCode('DD2B',0,2); END; 14 : BEGIN (* Stack- and BasePointer at program start *) Set_ASM_Address; (* initialise *) bc := 'LD '; op1 := 'SP'; op2 := '(0006)'; km := 'StackPointer to'; WriteCode('ED78',6,4); Set_ASM_Address; bc := 'LD '; op1 := 'IY'; op2 := '(0006)'; km := 'the BasePointer for global'; WriteCode('FD2A',6,4); bc := 'DEC '; op1 := 'IY'; op2 := ''; km := ''; (* DEC IY 3x because of Ret.Adr. main prog. *) FOR i := 1 TO 3 DO BEGIN Set_ASM_Address; WriteCode('FD2B',0,2); END; Set_ASM_Address; bc := 'LD '; op1 := 'IX'; op2 := '(0006)'; km := 'the same for local variables'; Wr1teCode('DD2A',6,4); END; END (* CASE x OF ... *); (* Marks new intermediate code in ZCODE and write it *) WITH ZCode DO BEGIN nr := ZCode_Address; bc := x; lv := y; ad := z; km := Comment; END; IF ZWC_Gen THEN WRITE(ZWC_File,ZCode); ZCode_Address := ZCode_Address + 1; 99: END (* Gen *); (* --------------------------------------------------------- *) (* These procedures must be used(?) declared(?) in DC-003.INC*) (* --------------------------------------------------------- *) PROCEDURE PatchASMFile; VAR ASMCode2 : ASM_Instruction; i,j : INTEGER; BEGIN WRITELN; WRITELN('Assemblercode-File...'); RESET(ASM_File); i := 1; REPEAT WITH ASMCode2 DO WITH PatchField[i] DO BEGIN j := A_Address - ASMCode_0ffset; SEEK(ASM_File,j); READ(ASM_File,ASMCode2); IF JPC THEN STR(A_Patch,Op2) ELSE STR(A_Patch,Opl); SEEK(ASM_File,j); WRITE(ASM_File,ASMCode2); WRITELN('Patch Nr: ', i:2,' Address:',A_Address:5, ' Patch: ',A_Patch:5,' LineNr: ',j:3); END; i := i + 1; UNTIL i = ipatch; END (* PatchASMFile *); PROCEDURE PatchCOMFile; TYPE Buffer = ARRAY[8..127] OF BYTE; VAR Sectorbuffer : Buffer; Sector, pos, i, j : INTEGER; CMD : FILE; BEGIN WRITELN; WRITELN('Maschinecode-File...'); FOR i := O TO 127 DO SectorBuffer[i] := 0; CLOSE(COM_File); ASSIGN(CMD,ProgramName+'.COM'); RESET(CMD); WRITELN('Filesize = ',FILESIZE(CMD):3,' CP/M Sectoren'); FOR i := 1 TO ipatch - 1 DO WITH PatchField[i] DO BEGIN j := M_Address - TPA_Start; (* TPA-Start = 0100H *) Sector := j DIV 128; pos := j MOD 128; SEEK(CMD,Sector); BLOCKREAD(CMD,SectorBuffer,1); SectorBuffer[pos] := BYTE(LO(M_Patch)); SectorBuffer[pos+1] := BYTE(HI(M_Patch)); SEEK(CMD,Sector); BLOCKWRITE(CMD,SectorBuffer,1); WRITELN('Patch Nr: ',i:2,' Address:',M_Address:5, ' Patch: ',M_Patch:5,' Sector: ',Sector(3); END; CLOSE(CMD); Ist_Offen(COM) := FALSE; END (* PatchCOMFile *);