home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turbo Toolbox
/
Turbo_Toolbox.iso
/
1990
/
11
/
trash
/
trash.pas
< prev
Wrap
Pascal/Delphi Source File
|
1989-11-10
|
40KB
|
969 lines
(* ------------------------------------------------------ *)
(* TRASH.PAS *)
(* (c) 1990 Georg Willmann & TOOLBOX *)
(* ------------------------------------------------------ *)
{$R-,S-,I-,V-,B-,D-,E-,F-,N-,L-}
{$M 4096,0,0}
USES Dos, MemWrite; { für SetIntVec/GetIntVec }
CONST
Version = 'TRASH v2.01';
HotKey = $5500;
HotKeyName = 'Shift-F2';
VAR
WhereY : BYTE ABSOLUTE $0000:$0451;
KbdStart : WORD ABSOLUTE $0040:$001A;
KbdTail : WORD ABSOLUTE $0040:$001C;
SaveLine : ARRAY[0..159] OF BYTE;
CharBuffer : ARRAY[0..84] OF WORD;
SaveInt16,
CurrInt : POINTER;
SaveSS, SaveSP,
ProgSS, ProgSP : WORD;
KeyPtr, Nr, i : BYTE;
PROCEDURE SwitchStack; { wie immer bei Residenten }
INLINE($8C/$16/SaveSS/$89/$26/SaveSp/$FA/
$8E/$16/ProgSS/$8B/$26/ProgSP/$FB);
PROCEDURE SwitchBack;
INLINE($FA/$8E/$16/SaveSS/$8B/$26/SaveSP/$FB);
PROCEDURE Assemble; { urspl. Hauptprogramm }
TYPE
SetType = 0..24; { Adressierungsart siehe Text }
ByteWordType = (NoLen, BLen, WLen);
BefehlType = (MOV, PUSH, POP, XCHG, IN_, OUT, XLAT, LEA,
LDS, LES, LAHF, SAHF, PUSHF, POPF, ADD,
ADC, INC_, AAA, DAA, SUB, SBB, DEC_, NEG,
CMP, AAS, DAS, MUL, IMUL, AAM, DIV_, IDIV,
AAD, CBW, CWD, NOT_, SHL_, SAL, SHR_, SAR,
ROL, ROR, RCL, RCR, AND_, TEST, OR_, XOR_,
REP, REPZ, REPE, REPNE, REPNZ, MOVSB,
CMPSB, SCASB, LODSB, STOSB, CALL, JMP,
RET, JE, JZ, JL, JNGE, JLE, JNG, JB, JNAE,
JP, JPE, JO, JS, JNE, JNZ, JNL, JGE, JNLE,
JG, JNB, JAE, JNBE, JA, JNP, JPO, JNO,
JNS, JNA, JBE, LOOP, LOOPZ, LOOPE, LOOPNZ,
LOOPNE, JCXZ, INT, INTO, IRET, CLC, STC,
CMC, CLD, CLI, HLT, LOCK, NOP, STD, STI,
WAIT, MOVSW, CMPSW, SCASW, LODSW, STOSW,
CALLF, RETF, JMPF, CS, SS, DS, ES, NOBEF);
CONST
BefBez : ARRAY [BefehlType] OF STRING [6] =
('MOV', 'PUSH', 'POP', 'XCHG', 'IN', 'OUT',
'XLAT', 'LEA', 'LDS', 'LES', 'LAHF',
'SAHF', 'PUSHF', 'POPF', 'ADD', 'ADC',
'INC', 'AAA', 'DAA', 'SUB', 'SBB', 'DEC',
'NEG', 'CMP', 'AAS', 'DAS', 'MUL', 'IMUL',
'AAM', 'DIV', 'IDIV', 'AAD', 'CBW', 'CWD',
'NOT', 'SHL', 'SAL', 'SHR', 'SAR', 'ROL',
'ROR', 'RCL', 'RCR', 'AND', 'TEST', 'OR',
'XOR', 'REP', 'REPZ', 'REPE', 'REPNE',
'REPNZ', 'MOVSB', 'CMPSB', 'SCASB',
'LODSB', 'STOSB', 'CALL', 'JMP', 'RET',
'JE', 'JZ',' JL', 'JNGE', 'JLE', 'JNG',
'JB', 'JNAE', 'JP', 'JPE', 'JO', 'JS',
'JNE', 'JNZ', 'JNL', 'JGE', 'JNLE', 'JG',
'JNB', 'JAE', 'JNBE', 'JA', 'JNP', 'JPO',
'JNO', 'JNS', 'JNA', 'JBE', 'LOOP',
'LOOPZ', 'LOOPE', 'LOOPNZ', 'LOOPNE',
'JCXZ', 'INT', 'INTO', 'IRET', 'CLC',
'STC', 'CMC', 'CLD', 'CLI', 'HLT', 'LOCK',
'NOP', 'STD', 'STI', 'WAIT', 'MOVSW',
'CMPSW', 'SCASW', 'LODSW', 'STOSW',
'CALLF', 'RETF', 'JMPF', 'CS:', 'SS:',
'DS:', 'ES:', 'NOBEF');
BefAnz = 178; { Anzahl der Befehle }
BefBytes : ARRAY [0..BefAnz] OF RECORD
Befehl : BefehlType;
AddType : SetType;
first, next : BYTE;
END =
((Befehl : MOV; AddType : 15; first : $A0; next : $00),
(Befehl : MOV; AddType : 16; first : $A2; next : $00),
(Befehl : MOV; AddType : 13; first : $B0; next : $00),
(Befehl : MOV; AddType : 9; first : $88; next : $00),
(Befehl : MOV; AddType : 10; first : $8A; next : $00),
(Befehl : MOV; AddType : 11; first : $8C; next : $00),
(Befehl : MOV; AddType : 12; first : $8E; next : $00),
(Befehl : MOV; AddType : 14; first : $C6; next : $00),
(Befehl : PUSH; AddType : 03; first : $50; next : $00),
(Befehl : PUSH; AddType : 04; first : $06; next : $00),
(Befehl : PUSH; AddType : 05; first : $FF; next : $30),
(Befehl : POP; AddType : 03; first : $58; next : $00),
(Befehl : POP; AddType : 04; first : $07; next : $00),
(Befehl : POP; AddType : 05; first : $8F; next : $00),
(Befehl : XCHG; AddType : 17; first : $90; next : $00),
(Befehl : XCHG; AddType : 09; first : $86; next : $00),
(Befehl : XCHG; AddType : 10; first : $86; next : $00),
(Befehl : IN_; AddType : 18; first : $E4; next : $00),
(Befehl : IN_; AddType : 19; first : $EC; next : $00),
(Befehl : OUT; AddType : 18; first : $E6; next : $00),
(Befehl : OUT; AddType : 19; first : $EE; next : $00),
(Befehl : XLAT; AddType : 00; first : $D7; next : $00),
(Befehl : LEA; AddType : 10; first : $8D; next : $00),
(Befehl : LDS; AddType : 10; first : $C5; next : $00),
(Befehl : LES; AddType : 10; first : $C4; next : $00),
(Befehl : LAHF; AddType : 00; first : $9F; next : $00),
(Befehl : SAHF; AddType : 00; first : $9E; next : $00),
(Befehl : PUSHF; AddType : 00; first : $9C; next : $00),
(Befehl : POPF; AddType : 00; first : $9D; next : $00),
(Befehl : ADD; AddType : 21; first : $04; next : $00),
(Befehl : ADD; AddType : 09; first : $00; next : $00),
(Befehl : ADD; AddType : 10; first : $02; next : $00),
(Befehl : ADD; AddType : 20; first : $80; next : $00),
(Befehl : ADC; AddType : 21; first : $14; next : $00),
(Befehl : ADC; AddType : 09; first : $10; next : $00),
(Befehl : ADC; AddType : 10; first : $12; next : $00),
(Befehl : ADC; AddType : 20; first : $80; next : $10),
(Befehl : INC_; AddType : 03; first : $40; next : $00),
(Befehl : INC_; AddType : 06; first : $FE; next : $00),
(Befehl : AAA; AddType : 00; first : $37; next : $00),
(Befehl : DAA; AddType : 00; first : $27; next : $00),
(Befehl : SUB; AddType : 21; first : $4C; next : $00),
(Befehl : SUB; AddType : 09; first : $28; next : $00),
(Befehl : SUB; AddType : 10; first : $2A; next : $00),
(Befehl : SUB; AddType : 20; first : $80; next : $28),
(Befehl : SBB; AddType : 21; first : $1C; next : $00),
(Befehl : SBB; AddType : 09; first : $18; next : $00),
(Befehl : SBB; AddType : 10; first : $1A; next : $00),
(Befehl : SBB; AddType : 20; first : $80; next : $18),
(Befehl : DEC_; AddType : 03; first : $48; next : $00),
(Befehl : DEC_; AddType : 06; first : $FE; next : $00),
(Befehl : NEG; AddType : 06; first : $F6; next : $18),
(Befehl : CMP; AddType : 21; first : $3C; next : $00),
(Befehl : CMP; AddType : 20; first : $80; next : $38),
(Befehl : CMP; AddType : 09; first : $38; next : $00),
(Befehl : CMP; AddType : 10; first : $3A; next : $00),
(Befehl : AAS; AddType : 00; first : $3F; next : $00),
(Befehl : DAS; AddType : 00; first : $2F; next : $00),
(Befehl : MUL; AddType : 06; first : $F6; next : $20),
(Befehl : IMUL; AddType : 06; first : $F6; next : $28),
(Befehl : AAM; AddType : 00; first : $D4; next : $0A),
(Befehl : DIV_; AddType : 06; first : $F6; next : $30),
(Befehl : IDIV; AddType : 06; first : $F6; next : $38),
(Befehl : AAD; AddType : 00; first : $D5; next : $0A),
(Befehl : CBW; AddType : 00; first : $98; next : $00),
(Befehl : CWD; AddType : 00; first : $99; next : $00),
(Befehl : NOT_; AddType : 06; first : $F6; next : $10),
(Befehl : SHL_; AddType : 06; first : $D0; next : $20),
(Befehl : SHL_; AddType : 07; first : $D2; next : $20),
(Befehl : SAL; AddType : 06; first : $D0; next : $20),
(Befehl : SAL; AddType : 07; first : $D2; next : $20),
(Befehl : SHR_; AddType : 06; first : $D0; next : $28),
(Befehl : SHR_; AddType : 07; first : $D2; next : $28),
(Befehl : SAR; AddType : 06; first : $D0; next : $38),
(Befehl : SAR; AddType : 07; first : $D2; next : $38),
(Befehl : ROL; AddType : 06; first : $D0; next : $00),
(Befehl : ROL; AddType : 07; first : $D2; next : $00),
(Befehl : ROR; AddType : 06; first : $D0; next : $08),
(Befehl : ROR; AddType : 07; first : $D2; next : $08),
(Befehl : RCL; AddType : 06; first : $D0; next : $10),
(Befehl : RCL; AddType : 07; first : $D2; next : $10),
(Befehl : RCR; AddType : 06; first : $D0; next : $18),
(Befehl : RCR; AddType : 07; first : $D2; next : $18),
(Befehl : AND_; AddType : 21; first : $24; next : $00),
(Befehl : AND_; AddType : 14; first : $80; next : $20),
(Befehl : AND_; AddType : 09; first : $20; next : $00),
(Befehl : AND_; AddType : 10; first : $22; next : $00),
(Befehl : TEST; AddType : 21; first : $A8; next : $00),
(Befehl : TEST; AddType : 14; first : $F6; next : $00),
(Befehl : TEST; AddType : 09; first : $84; next : $00),
(Befehl : TEST; AddType : 10; first : $84; next : $00),
(Befehl : OR_; AddType : 21; first : $0C; next : $00),
(Befehl : OR_; AddType : 14; first : $80; next : $08),
(Befehl : OR_; AddType : 09; first : $08; next : $00),
(Befehl : OR_; AddType : 10; first : $0A; next : $00),
(Befehl : XOR_; AddType : 21; first : $34; next : $00),
(Befehl : XOR_; AddType : 14; first : $80; next : $30),
(Befehl : XOR_; AddType : 09; first : $30; next : $00),
(Befehl : XOR_; AddType : 10; first : $32; next : $00),
(Befehl : REP; AddType : 00; first : $F2; next : $00),
(Befehl : REPZ; AddType : 00; first : $F3; next : $00),
(Befehl : REPNZ; AddType : 00; first : $F2; next : $00),
(Befehl : REPE; AddType : 00; first : $F3; next : $00),
(Befehl : REPNE; AddType : 00; first : $F2; next : $00),
(Befehl : MOVSB; AddType : 00; first : $A4; next : $00),
(Befehl : CMPSB; AddType : 00; first : $A6; next : $00),
(Befehl : SCASB; AddType : 00; first : $AE; next : $00),
(Befehl : LODSB; AddType : 00; first : $AC; next : $00),
(Befehl : STOSB; AddType : 00; first : $AA; next : $00),
(Befehl : CALL; AddType : 22; first : $E8; next : $00),
(Befehl : CALL; AddType : 05; first : $FF; next : $10),
(Befehl : JMP; AddType : 05; first : $FF; next : $20),
(Befehl : JMP; AddType : 24; first : $E9; next : $00),
(Befehl : RET; AddType : 00; first : $C3; next : $00),
(Befehl : RET; AddType : 01; first : $C2; next : $00),
(Befehl : JE; AddType : 02; first : $74; next : $00),
(Befehl : JZ; AddType : 02; first : $74; next : $00),
(Befehl : JL; AddType : 02; first : $7C; next : $00),
(Befehl : JNGE; AddType : 02; first : $7C; next : $00),
(Befehl : JLE; AddType : 02; first : $7E; next : $00),
(Befehl : JNG; AddType : 02; first : $7E; next : $00),
(Befehl : JB; AddType : 02; first : $72; next : $00),
(Befehl : JNAE; AddType : 02; first : $72; next : $00),
(Befehl : JP; AddType : 02; first : $7A; next : $00),
(Befehl : JPE; AddType : 02; first : $7A; next : $00),
(Befehl : JO; AddType : 02; first : $70; next : $00),
(Befehl : JS; AddType : 02; first : $78; next : $00),
(Befehl : JNE; AddType : 02; first : $75; next : $00),
(Befehl : JNZ; AddType : 02; first : $75; next : $00),
(Befehl : JNL; AddType : 02; first : $7D; next : $00),
(Befehl : JGE; AddType : 02; first : $7D; next : $00),
(Befehl : JNLE; AddType : 02; first : $7F; next : $00),
(Befehl : JG; AddType : 02; first : $7F; next : $00),
(Befehl : JNB; AddType : 02; first : $73; next : $00),
(Befehl : JAE; AddType : 02; first : $73; next : $00),
(Befehl : JNBE; AddType : 02; first : $77; next : $00),
(Befehl : JA; AddType : 02; first : $77; next : $00),
(Befehl : JNP; AddType : 02; first : $7B; next : $00),
(Befehl : JPO; AddType : 02; first : $7B; next : $00),
(Befehl : JNO; AddType : 02; first : $71; next : $00),
(Befehl : JNS; AddType : 02; first : $79; next : $00),
(Befehl : JNA; AddType : 02; first : $76; next : $00),
(Befehl : JBE; AddType : 02; first : $76; next : $00),
(Befehl : LOOP; AddType : 02; first : $E2; next : $00),
(Befehl : LOOPZ; AddType : 02; first : $E1; next : $00),
(Befehl : LOOPE; AddType : 02; first : $E1; next : $00),
(Befehl : LOOPNZ; AddType : 02; first : $E0; next : $00),
(Befehl : LOOPNE; AddType : 02; first : $E0; next : $00),
(Befehl : JCXZ; AddType : 02; first : $E3; next : $00),
(Befehl : INT; AddType : 08; first : $CD; next : $00),
(Befehl : INTO; AddType : 00; first : $CE; next : $00),
(Befehl : IRET; AddType : 00; first : $CF; next : $00),
(Befehl : CLC; AddType : 00; first : $F8; next : $00),
(Befehl : STC; AddType : 00; first : $F9; next : $00),
(Befehl : CMC; AddType : 00; first : $F5; next : $00),
(Befehl : CLD; AddType : 00; first : $FC; next : $00),
(Befehl : CLI; AddType : 00; first : $FA; next : $00),
(Befehl : HLT; AddType : 00; first : $F4; next : $00),
(Befehl : LOCK; AddType : 00; first : $F0; next : $00),
(Befehl : NOP; AddType : 00; first : $90; next : $00),
(Befehl : STD; AddType : 00; first : $FD; next : $00),
(Befehl : STI; AddType : 00; first : $FB; next : $00),
(Befehl : WAIT; AddType : 00; first : $9B; next : $00),
(Befehl : MOVSW; AddType : 00; first : $A5; next : $00),
(Befehl : CMPSW; AddType : 00; first : $A7; next : $00),
(Befehl : SCASW; AddType : 00; first : $AF; next : $00),
(Befehl : LODSW; AddType : 00; first : $AD; next : $00),
(Befehl : STOSW; AddType : 00; first : $AB; next : $00),
(Befehl : CALLF; AddType : 05; first : $FF; next : $18),
(Befehl : CALLF; AddType : 23; first : $9A; next : $00),
(Befehl : JMPF; AddType : 05; first : $FF; next : $28),
(Befehl : JMPF; AddType : 23; first : $EA; next : $00),
(Befehl : RETF; AddType : 00; first : $CB; next : $00),
(Befehl : RETF; AddType : 01; first : $CA; next : $00),
(Befehl : LAHF; AddType : 00; first : $9F; next : $00),
(Befehl : CS; AddType : 00; first : $2E; next : $00),
(Befehl : SS; AddType : 00; first : $36; next : $00),
(Befehl : DS; AddType : 00; first : $3E; next : $00),
(Befehl : ES; AddType : 00; first : $26; next:$00));
{ Alle Register }
WRegs : ARRAY [0..7] OF STRING [2] =
('AX', 'CX', 'DX', 'BX', 'SP', 'BP', 'SI', 'DI');
BRegs : ARRAY [0..7] OF STRING [2] =
('AL', 'CL', 'DL', 'BL', 'AH', 'CH', 'DH', 'BH');
SRegs : ARRAY [0..3] OF STRING [2] =
('ES', 'CS', 'SS', 'DS');
MRegs : ARRAY [0..7] OF STRING [6] =
('[BX+SI', '[BX+DI', '[BP+SI', '[BP+DI',
'[SI', '[DI', '[BP', '[BX');
BWOR : ARRAY [ByteWordType] OF BYTE = (0, 0, 1);
Home = $4700;
Ctrl_Q = $1011;
Ctrl_Y = $2C19;
Down = $5000;
TYPE
Operands = (nichts, Imm, Regs, EA, SegRegs,
Abs, RegCl, RegDX, RegAW);
OperandsType = SET OF Operands;
DOperandsType = SET OF SetType;
VAR
DOperand : DOperandsType; { Adressierungsart }
ByteWord : ByteWordType; { Datenbreite }
PutString, { Ergebnis-String }
AssemblerCode,
Mnemo,
Source,
Dest : STRING [80];
OpAnz, { Anzahl der Operanden }
i, Col : INTEGER;
FUNCTION Space(Len : BYTE) : STRING;
VAR
Dummy : STRING;
BEGIN
FillChar(Dummy[1], Len, ' ');
Dummy[0] := Chr(Len);
Space := Dummy;
END;
PROCEDURE Error(Nr : BYTE); { erledigt den Ausstieg }
BEGIN
Move(Ptr(VideoBuffer, 3840)^, SaveLine, 160);
WriteMem(1, 25, ' ' +
' ', 112);
WriteMem(1, 25, 'Error : ', 112);
CASE Nr OF
1 : WriteMem(9,25,'} wird erwartet',112);
2 : WriteMem(9,25,'Syntaxfehler',112);
3 : WriteMem(9,25,'Unerlaubtes Zeichen in Zahl',112);
4 : WriteMem(9,25,'Länge von Ziel- und Quelloperand'+
' verschieden',112);
5 : WriteMem(9,25,'Unbekannter Befehl',112);
6 : WriteMem(9,25,'] wird erwartet',112);
7 : WriteMem(9,25,'Word Register wird erwartet',112);
8 : WriteMem(9,25,'{ wird erwartet',112);
9 : WriteMem(9,25,'Falsches Format der Adresse',112);
END;
WriteMem(65,25,'Weiter mit Taste',240);
REPEAT UNTIL KbdStart <> KbdTail;
KbdStart := KbdTail; { Tastasturpuffer löschen }
Move(SaveLine, Ptr(VideoBuffer, 3840)^, 160);
SetIntVec($16, CurrInt); { Vektor zurücksetzen }
SwitchBack; { Stapel umschalten }
INLINE($5D/$07/$1F/$5F/
$5E/$5A/$59/$5B/ { Register wiederherstellen }
$58/$CF); { und IRET ausführen }
END;
FUNCTION FirstIn(Str1, Str2 : STRING) : BOOLEAN;
{ prüft ob Str1 in Str2 ab }
{ Anfang enthalten ist }
VAR
ip : INTEGER;
BEGIN
FirstIn := TRUE;
IF Length(Str1) > Length(Str2) THEN
FirstIn := FALSE
ELSE
FOR ip := 1 TO Length(Str1) DO
IF Str1[ip] <> Str2[ip] THEN FirstIn := FALSE;
END;
PROCEDURE ReadAssemblerCode;
{ liest String vom Bildschirm }
{ Ergebnis steht in }
{ 'AssemblerCode' }
VAR
i, Offset : WORD;
BEGIN
Offset := WhereY * 160;
i := 0;
AssemblerCode := '';
WHILE (Chr(Mem[VideoBuffer:Offset+i]) <> '{') AND
(i < 156) DO Inc(i, 2);
Inc(i, 2);
IF i = 158 THEN Error(8); { Klammer auf fehlt }
WHILE (Chr(Mem[VideoBuffer:Offset+i]) <> '}') AND
(i < 158) DO BEGIN
Insert(UpCase(Chr(Mem[VideoBuffer:Offset+i])),
AssemblerCode, 255);
Inc(i, 2);
END;
IF i = 158 THEN Error(1); { Klammer zu fehlt }
i := 1; { Leerzeichen entfernen }
WHILE (i < Length(AssemblerCode)) AND
(AssemblerCode[i] = ' ') DO Inc(i);
Delete(AssemblerCode, 1, Pred(i));
i := Length(AssemblerCode);
WHILE (i > 0) AND (AssemblerCode[i] = ' ') DO Dec(i);
AssemblerCode[0] := Chr(i);
END;
PROCEDURE SplitLine; { Trennt AssemblerCode in }
{ Mnemo,Dest und Source auf }
{ und ermittelt OpAnz }
VAR
i : INTEGER;
Len : BYTE ABSOLUTE AssemblerCode;
BEGIN
i := 1;
OpAnz := 0;
Mnemo := ''; Source := ''; Dest := '';
WHILE (AssemblerCode[i] <> ' ') AND (i <= Len) DO BEGIN
Insert(AssemblerCode[i], Mnemo, 255);
Inc(i);
END;
WHILE (AssemblerCode[i] = ' ') AND (i <= Len) DO Inc(i);
IF i > Len THEN BEGIN
OpAnz := 0; Exit;
END;
WHILE (AssemblerCode[i] <> ' ') AND
(AssemblerCode[i] <> ',') AND
(i <= Len) DO BEGIN
Insert(AssemblerCode[i], Dest, 255);
Inc(i);
END;
IF (AssemblerCode[i] = ',') AND (i <= Len) THEN
IF (i < Len) THEN BEGIN
OpAnz := 2;
Inc(i);
END ELSE Error(2)
ELSE BEGIN
OpAnz := 1; Exit;
END;
WHILE (AssemblerCode[i] <> ' ') AND (i <= Len) DO BEGIN
Insert(AssemblerCode[i], Source, 255);
Inc(i);
END;
END;
PROCEDURE Store(Code : WORD); { schreibt Code in Puffer }
BEGIN
CharBuffer[Nr] := Code;
Inc(Nr);
END;
PROCEDURE Init; { Initialisierung }
BEGIN
KeyPtr := 0;
Nr := 0;
END;
FUNCTION TestImm(VAR Operand : STRING) : BOOLEAN;
{ prüft ob Direktdatum }
{ einen gültigen Wert hat }
CONST
HexChars : SET OF CHAR = ['0'..'9', 'A'..'F'];
DezChars : SET OF CHAR = ['-', '0'..'9'];
VAR
i : INTEGER;
Hex : BOOLEAN;
BEGIN
TestImm := TRUE;
Hex := Operand[1] = '$';
IF Operand[1] IN ['$','#','+'] THEN Delete(Operand,1,1);
FOR i := 1 TO Length(Operand) DO
IF (( Hex) AND Not (Operand[i] in HexChars)) OR
((Not Hex) AND Not (Operand[i] in DezChars)) THEN
Error(3);
IF Hex THEN Insert('$', Operand, 1);
END;
FUNCTION SegOfs(VAR Adresse : STRING) : STRING;
{ wandelt die Adresse in Hex-Codes um }
{ $FFFF0000 ══> $00/$00/$FF/$FF }
VAR
i : INTEGER;
OneByte : STRING [4];
Dummy : STRING [16];
BEGIN
IF (Adresse[0] <> #9) THEN Error(9); { falsche Länge }
FOR i := 4 DOWNTO 1 DO BEGIN
Insert('/$' + Copy(Adresse, i SHL 1, 2), OneByte, 1);
Move(OneByte[1], Dummy[(4-i) SHL 2], 4);
END;
Dummy[0] := #15;
SegOfs := Dummy;
END;
PROCEDURE GetOperandsType(VAR Operand : STRING;
VAR OpSet : OperandsType;
VAR BW : ByteWordType);
{ Ermittelt den Typ des }
{ Operanden "Operand" }
VAR
i, j : INTEGER;
BEGIN
OpSet :=[]; { OpSet löschen }
BW := NoLen; { keine Datenwortbreite }
IF Length(Operand) = 2 THEN BEGIN
i := 7; { auf Wort-Register prüfen }
WHILE (i >= 0) AND (WRegs[i] <> Operand) DO Dec(i);
IF i >= 0 THEN BEGIN { wenn ja dann }
BW := WLen; { Datenbreite gleich WORT }
OpSet := [Regs,EA]; { Register/Effektive Addresse }
IF i = 0 THEN { bei i = 0 auch AX }
OpSet := [Regs, EA, RegAW];
END ELSE BEGIN
i := 7; { auf Byte-Register prüfen }
WHILE (i >= 0) AND (BRegs[i] <> Operand) DO Dec(i);
IF i >= 0 THEN BEGIN
BW := BLen; { Datenbreite gleich BYTE }
OpSet := [Regs, EA];
IF i = 0 THEN { bei i = 0 auch AH/AL }
OpSet := [Regs, EA, RegAW];
IF i = 1 THEN { bei i = 1 CL für SHIFTS u.a.}
OpSet := [Regs, EA, RegCL];
END ELSE BEGIN
i := 3; { auf Segment-Register prüfen }
WHILE (i >= 0) AND (SRegs[i] <> Operand) DO
Dec(i);
IF i >= 0 THEN { ja, dann Segment-Register }
OpSet := [SegRegs]
ELSE
IF TestImm(Operand) THEN { gültig ? }
OpSet := [Imm]; { also Direktdatum }
END;
END;
END ELSE { Länge Operand > 2 }
IF Operand = '[DX]' THEN
OpSet := [RegDX] { RegDX für IN/OUT }
ELSE BEGIN
IF Operand[1] = '[' THEN BEGIN
i := 7; { indirekte Adresse ? }
WHILE (i >= 0) AND NOT FirstIn(MRegs[i], Operand)
DO Dec(i);
IF (i >= 0) AND
(Operand[Length(MRegs[i])+1] IN ['+','-',']'])
THEN OpSet := [EA] { ja : dann indirekt }
ELSE OpSet := [Abs,EA]; { nein : evtl. direkt }
END ELSE BEGIN
IF FirstIn('WORD PTR', Operand) THEN BEGIN
OpSet := [Abs,EA]; { absolute Adresse mit }
BW := WLen; { Datenbreite WORT }
END ELSE
IF FirstIn('BYTE PTR', Operand) THEN BEGIN
OpSet := [Abs,EA]; { absolute Adresse mit }
BW := BLen; { Datenbreite BYTE }
END ELSE
IF TestImm(Operand) THEN { gültig ? }
OpSet := [Imm]; { also Direktdatum }
END;
END;
END; { of GetOperandsType }
PROCEDURE GetDOperandsType; { Erklärung siehe Text }
VAR
i : INTEGER;
SourceType, { Typ des Quelloperanden }
DestType : OperandsType; { Typ des Zieloperanden }
BW : ByteWordType;
BEGIN
DOperand := [];
CASE OpAnz OF { in Abhängigkeit von OpAnz }
0 : DOperand := [0]; { Adressierungsart ermitteln }
1 : BEGIN { siehe Tabelle BegleitText }
GetOperandsType(Dest, DestType, ByteWord);
IF Imm IN DestType THEN
DOperand := [1, 2, 8, 22, 23, 24];
IF EA IN DestType THEN
IF ByteWord = BLen THEN DOperand := [6]
ELSE DOperand := [5, 6];
IF (Regs IN DestType) AND (ByteWord = WLen) THEN
DOperand := DOperand + [3];
IF SegRegs IN DestType THEN DOperand := [4];
END;
2 : BEGIN
GetOperandsType(Dest, DestType, ByteWord);
GetOperandsType(Source, SourceType, BW);
IF EA IN DestType THEN BEGIN
IF RegCL IN SourceType THEN DOperand := [7];
IF Regs IN SourceType THEN
DOperand := DOperand + [9];
IF SegRegs IN SourceType THEN
DOperand := DOperand + [11];
IF Imm IN SourceType THEN
DOperand := DOperand + [14, 20];
END;
IF Regs IN DestType THEN BEGIN
IF EA IN SourceType THEN
DOperand := DOperand + [10];
IF Imm IN SourceType THEN
DOperand := DOperand + [13];
END;
IF (SegRegs IN DestType) AND
(EA IN SourceType) THEN
DOperand := [12];
IF RegAW IN DestType THEN BEGIN
IF Abs IN SourceType THEN
DOperand := DOperand + [15];
IF Imm IN SourceType THEN
DOperand := DOperand + [18, 21];
IF (Regs IN SourceType) AND
(ByteWord = WLen) THEN
DOperand := DOperand + [17];
IF RegDX IN SourceType THEN
DOperand := DOperand + [19];
END;
IF (Abs IN DestType) AND
(RegAW IN SourceType) THEN
DOperand := DOperand + [16];
IF ByteWord = NoLen THEN
ByteWord := BW
ELSE
IF (BW <> NoLen) AND (BW <> ByteWord) AND
(NOT (7 IN DOperand)) THEN Error(4);
END;
END;
END; { of GetDOperandsType }
FUNCTION CheckMnemo : BefehlType;
{ prüft ob der Befehl in der }
{ Liste existiert }
VAR
Bef : BefehlType;
BEGIN
BefBez[NOBEF] := Mnemo;
Bef := MOV;
WHILE Mnemo <> BefBez[Bef] DO Inc(Bef);
IF Bef = NOBEF THEN Error(5);
CheckMnemo := Bef;
END;
FUNCTION GetBefehl : INTEGER;
{ Holt den richtigen Befehl }
{ in Abhängigkeit der }
{ Befehlsbezeichnung und }
{ Adressierungsart }
VAR
BefBez : BefehlType;
i : INTEGER;
BEGIN
BefBez := CheckMnemo;
GetDOperandsType;
FOR i := 0 TO BefAnz DO
IF (BefBez = BefBytes[i].Befehl) AND
(BefBytes[i].AddType in DOperand) THEN BEGIN
GetBefehl := i;
Exit; { wenn gefunden dann EXIT }
END;
Error(2); { sonst Fehler }
END;
FUNCTION RegNr(S : STRING) : BYTE;
{ WORD- oder BYTE-Register- }
{ nummer ermitteln }
VAR
i : BYTE;
BEGIN
i := 7;
WHILE (i<8) AND (S <> WRegs[i]) AND (S <> BRegs[i]) DO
Dec(i);
RegNr := i;
END;
FUNCTION SegNr(S : STRING) : BYTE;
{ Segment-Registernummer }
{ ermitteln }
VAR
i : BYTE;
BEGIN
i := 3;
WHILE (i > 0) AND (S <> SRegs[i]) DO Dec(i);
SegNr := i;
END;
PROCEDURE InitPut; { String Initialisieren }
BEGIN
PutString := ' INLINE(';
END;
PROCEDURE PutB(B : BYTE); { HexByte in String schreiben }
CONST
Digit : ARRAY [0..15] OF CHAR = '0123456789ABCDEF';
BEGIN
PutString := PutString + '$' + Digit[b SHR 4] +
Digit[b AND $0F] + '/';
END;
PROCEDURE PutS(S : STRING);{ String in String schreiben }
BEGIN
PutString := PutString + S + '/';
END;
PROCEDURE EndPut; { String beenden }
BEGIN
PutString[Length(PutString)] := ')';
PutString := PutString + ';' +
Space(40-Length(PutString)) + '{ ' + Mnemo;
CASE OpAnz OF
1 : PutString := PutString +
Space(50-Length(PutString)) + Dest;
2 : PutString := PutString +
Space(50-Length(PutString)) + Dest +
',' + Source;
END;
PutString := PutString +
Space(78-Length(PutString)) + '}';
END;
PROCEDURE PutEA(Mask : BYTE; OP : STRING);
{ R/M Operand Compilieren }
{ Byte 7/6 = Modus }
{ Byte 5/4/3 = Maske }
{ Byte 2/1/0 = Reg oder R/M }
VAR
RM, Modus : BYTE;
Disp : STRING;
BEGIN
RM := RegNr(OP); { Register ? }
IF RM < 8 THEN Modus := 3 { wenn ja dann Modus = 3 }
ELSE BEGIN
IF OP[1] <> '[' THEN BEGIN { wenn BYTE/WORD PTR }
i := Pos('[', OP);
IF i = 0 THEN Error(2);
Delete(OP, 1, Pred(i)); { dieses entfernen }
END;
i := 0; { auf ind. Adr. prüfen }
WHILE (i < 8) AND NOT FirstIn(MRegs[i],OP) DO Inc(i);
IF i = 8 THEN BEGIN { nein, dann Abs. Adresse }
Modus := 0;
RM := 6;
IF OP[Length(OP)] <> ']' THEN Error(6);
Disp := Copy(OP, 2, Length(OP)-2);
{ '[' und ']' entfernen }
IF Disp[1] <> '>' THEN { hier nur 16 Bit möglich }
Insert('>', Disp, 1);
END ELSE BEGIN
RM := i; { sonst indirekte Adr. }
Disp := Copy(OP, 1+Length(MRegs[i]), 255);
{ Displacement ermitteln }
IF Disp[1] IN ['+', ']'] THEN
Delete(Disp, 1, 1); { '+'/']' entfernen }
IF Disp = '' THEN { wenn kein Displacement }
IF RM = 6 THEN BEGIN { dann, wenn RM = 6 }
Modus := 1; { besondere Beachtung von }
Disp := '$00'; { [BP] ═> [BP+0] }
END ELSE Modus := 0 { also Mod.=0 kein Disp }
ELSE BEGIN { wenn doch Displacement }
IF Disp[Length(Disp)] <> ']' THEN Error(1);
{ dann mit ']' beendet }
Dec(Disp[0]); { ']' hinten entfernen }
CASE Disp[1] OF { 1. Zeichen auswerten }
'<' : Modus := 1; { 8 Bit Displacement }
'>' : Modus := 2; { 16 Bit Disp. }
'$' : IF TestImm(Disp) THEN { gültig ? }
IF Length(Disp) < 4 { wenn ja dann }
THEN Modus := 1 { je nach Länge }
ELSE Modus := 2; { 1 oder 2 }
'0'..'9',
'-' : BEGIN
Val(Disp, i, Col);
IF Col <> 0 THEN Error(3);
IF (i >= -128) AND (i <= 127) THEN
Modus := 1
ELSE Modus := 2;
END;
ELSE BEGIN
Insert('>', Disp, 1); { Default 16 Bit }
Modus := 2;
END;
END; { of case }
END;
END;
END;
PutB(Mask OR RM OR Modus SHL 6); { Ergebnis eintragen }
IF ((Modus = 0) AND (((Mask OR RM) AND 7) = 6)) OR
(Modus = 1) OR (Modus = 2) THEN PutS(Disp);
END; { of PutEA }
FUNCTION ImmLen(VAR S : STRING; Flag : BOOLEAN) : BYTE;
{ Datenbreite des Direkt- }
{ datums S ermitteln }
{ 1 = Byte/0 = Word }
VAR
i : INTEGER;
BEGIN
CASE S[1] OF
'<' : ImmLen := 1;
'>' : ImmLen := 0;
'$' : IF TestImm(S) THEN
IF Length(S) < 4 THEN ImmLen := 1
ELSE ImmLen := 0;
'0'..'9',
'-' : BEGIN
Val(S, i, Col);
IF Col <> 0 THEN Error(3);
IF (i >= -128) AND (i <= 127) THEN ImmLen:=1
ELSE ImmLen:=0;
END;
ELSE BEGIN
ImmLen := 0;
IF Flag THEN Insert('>', S, 1);
END;
END; { of case }
END; { of ImmLen }
PROCEDURE PutBWS(S : STRING);
VAR
Len : BYTE;
BEGIN
Len := ImmLen(S, TRUE);
IF Len <> BWOR[ByteWord] THEN PutS(S)
ELSE
IF Len = 0 THEN Error(2)
ELSE
IF S[1] = '<' THEN Error(2)
ELSE PutS(S);
END;
PROCEDURE PutLS(S : STRING);
VAR
Len : BYTE;
BEGIN
Len := ImmLen(S, TRUE);
IF Len <> BWOR[ByteWord] THEN PutS(S)
ELSE
IF Len = 0 THEN Error(2)
ELSE
IF S[1] = '<' THEN Error(2)
ELSE PutS('>' + S);
END;
PROCEDURE MakeCommand;
{ Befehl gemäß Vorschrift }
{ zusammenbauen }
VAR
Bef : INTEGER;
BEGIN
InitPut;
Bef := GetBefehl;
WITH BefBytes[Bef] DO
CASE AddType OF
0 : BEGIN
PutB(First);
IF Next > 0 THEN PutB(Next);
END;
1, 22 : BEGIN PutB(First); PutS('>' + Dest) END;
2, 8 : BEGIN PutB(First); PutS('<' + Dest) END;
3 : PutB(First OR RegNr(Dest));
4 : PutB(First OR SegNr(Dest) SHL 3);
5 : BEGIN PutB(First); PutEA(Next,Dest) END;
6, 7 : BEGIN
PutB(First OR BWOR[ByteWord]);
PutEA(Next, Dest)
END;
9 : BEGIN
PutB(First OR BWOR[ByteWord]);
PutEA(RegNr(Source) SHL 3, Dest);
END;
10 : BEGIN
IF (Befehl IN [LDS,LEA,LES]) THEN BEGIN
{ nur 16Bit Register }
IF (ByteWord <> WLen) THEN Error(7)
ELSE ByteWord := NoLen;
END;
PutB(First OR BWOR[ByteWord]);
PutEA(RegNr(Dest) SHL 3, Source);
END;
11 : BEGIN
PutB(First);
PutEA(Next OR SegNr(Source) SHL 3, Dest);
END;
12 : BEGIN
PutB(First);
PutEA(Next OR SegNr(Dest) SHL 3, Source);
END;
13 : BEGIN
PutB(First OR RegNr(Dest) OR
BWOR[ByteWord] SHL 3);
PutS(Source);
END;
14 : BEGIN
PutB(First OR BWOR[ByteWord]);
PutEA(Next, Dest);
PutLS(Source);
END;
15 : BEGIN
PutB(First OR BWOR[ByteWord]);
PutS(Copy(Source, 2, Length(Source)-2));
END;
16 : BEGIN
PutB(First OR BWOR[ByteWord]);
PutS(Copy(Dest, 2, Length(Dest)-2));
END;
17 : PutB(First OR RegNr(Source));
18 : BEGIN
PutB(First OR BWOR[ByteWord]);
PutS(Source);
END;
19 : PutB(First OR BWOR[ByteWord]);
20 : BEGIN
PutB(First OR
ImmLen(Source, FALSE) SHL 1 OR
BWOR[ByteWord]);
PutEA(Next,Dest);
PutBWS(Source);
END;
21 : BEGIN
PutB(First OR BWOR[ByteWord]);
PutLS(Source);
END;
23 : BEGIN
PutB(First);
PutS(SegOfs(Dest));
END;
24 : BEGIN
PutB(First OR ImmLen(Dest, FALSE) SHL 1);
PutS(Dest);
END;
END; { of case }
EndPut;
END; { of MakeCommand }
BEGIN { of Assemble }
Init; { Initialisieren }
ReadAssemblerCode; { Code vom Bildschirm einlesen }
SplitLine; { Mnemo,Dest,Source ermitteln }
MakeCommand; { Befehl zusammenbauen }
Store(Home); { an Zeilenanfang }
Store(Ctrl_Q); { bis Zeilenende löschen }
Store(Ctrl_Y);
FOR i := 1 TO Length(PutString) DO
Store(Word(PutString[i])); { Inline-Code ═> Puffer }
Store(Home); { und wieder an Zeilenanfang }
Store(Down); { und eine Zeile runter }
KbdStart := $1E; { Tastaturpuffer auf Anfang }
KbdTail := $1E; { und löschen }
Inc(KbdTail, 2); { und Tastendruck vortäuschen }
END;
{$F+}
PROCEDURE Int16(Flags, CS, IP, AX, BX, CX, DX, SI, DI,
DS, ES, BP : WORD); INTERRUPT;
PROCEDURE ChainInt(Adress : POINTER);
INLINE($5B/$58/$87/$5E/$0E/$87/$46/$10/$89/
$EC/$5D/$07/$1F/$5F/$5E/$5A/$59/$CB);
FUNCTION KeyFromOldInt16 : WORD;
INLINE($31/$C0/$9C/$FF/$1E/SaveInt16);
BEGIN
IF (Hi(AX) = 0) THEN BEGIN
IF KeyPtr < Nr THEN BEGIN { wenn Zeichen vorliegen }
AX := CharBuffer[KeyPtr]; { dann in AX übergeben }
Inc(KeyPtr); { und KeyPtr erhöhen }
IF KeyPtr = Nr THEN
Inc(KbdStart, 2); { und nun wieder zurück }
END ELSE BEGIN
AX := KeyFromOldInt16; { alten Int16 aufrufen }
IF AX = HotKey THEN BEGIN { wenn AX = HotKey }
SwitchStack; { dann ... }
GetIntVec($16, CurrInt);
SetIntVec($16, SaveInt16);
Assemble; { jetzt gehts los... }
SetIntVec($16, CurrInt);
SwitchBack;
END;
END;
END ELSE ChainInt(SaveInt16);
END;
{$F-}
BEGIN { Installation des Programms }
ProgSS := SSeg;
ProgSP := SPtr;
WriteLn(^M^J, Version, ' installiert,',
^M^J, 'aktivieren mit ', HotkeyName, '.');
SwapVectors;
GetIntVec($16, SaveInt16);
SetIntVec($16, @Int16);
KeyPtr := 0;
Nr := 0;
Keep(0);
END.
(* ------------------------------------------------------ *)
(* Ende von TRASH.PAS *)