home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
drdobbs
/
1986
/
05
/
xassm.lst
< prev
Wrap
File List
|
1986-05-31
|
143KB
|
4,970 lines
LISTING ONE
DEFINITION MODULE LongNumbers;
(* Routines to handle HEX digits for the X68000 cross assembler. *)
(* All but LongPut and LongWrite are limited to 8 digit numbers. *)
FROM Files IMPORT
FILE;
EXPORT QUALIFIED
LONG, LongClear, LongAdd, LongSub, LongInc, LongDec,
LongCompare, CardToLong, LongToCard, LongToInt,
LongPut, LongWrite, StringToLong, AddrBoundL, AddrBoundW;
CONST
DIGITS = 8;
BASE = 16;
TYPE
LONG = ARRAY [1..DIGITS] OF INTEGER;
PROCEDURE LongClear (VAR A : LONG);
(* Sets LONG to Zero *)
PROCEDURE LongAdd (A, B : LONG; VAR Result : LONG);
(* Add two LONGs, giving Result *)
PROCEDURE LongSub (A, B : LONG; VAR Result : LONG);
(* Subtract two LONGs (A - B), giving Result *)
PROCEDURE CardToLong (n : CARDINAL; VAR A : LONG);
(* Converts CARDINAL to LONG *)
PROCEDURE LongToCard (A : LONG; VAR n : CARDINAL) : BOOLEAN;
(* Converts LONG TO CARDINAL, returns FALSE if conversion impossible *)
PROCEDURE LongToInt (A : LONG; VAR n : INTEGER) : BOOLEAN;
(* Converts LONG to INTEGER, returns FALSE if conversion impossible *)
PROCEDURE LongInc (VAR A : LONG; n : CARDINAL);
(* Increment LONG by n *)
PROCEDURE LongDec (VAR A : LONG; n : CARDINAL);
(* Decrement LONG by n *)
PROCEDURE LongCompare (A, B : LONG) : INTEGER;
(* Returns: 0 if A = B, -1 if A < B, +1 if A > B *)
PROCEDURE LongPut (f : FILE; A : ARRAY OF INTEGER; Size : CARDINAL);
(* Put LONG number in FILE f *)
PROCEDURE LongWrite (A : ARRAY OF INTEGER; Size : CARDINAL);
(* Write LONG number to console screen *)
PROCEDURE StringToLong (S : ARRAY OF CHAR; VAR A : LONG) : BOOLEAN;
(* Converts a string (in HEX) into a LONG *)
PROCEDURE AddrBoundL (VAR A : LONG);
(* Forces Address to a 68000 long word boundary *)
PROCEDURE AddrBoundW (VAR A : LONG);
(* Forces Address to a 68000 word boundary *)
END LongNumbers.
-------------------------------
LISTING TWO
DEFINITION MODULE CmdLin2;
(* Parses command line - returns pointer to an array of pointer to strings *)
FROM SYSTEM IMPORT
ADDRESS;
EXPORT QUALIFIED
ReadCmdLin;
PROCEDURE ReadCmdLin (VAR ArgC : CARDINAL; VAR ArgV : ADDRESS);
(* Gives count of items in command line, and an array of pointer to them *)
END CmdLin2.
--------------------------------
LISTING THREE
DEFINITION MODULE Parser;
(* Reads the Source file, and splits each *)
(* line into Label, OpCode & Operand(s). *)
FROM Strings IMPORT
STRING;
FROM Files IMPORT
FILE;
EXPORT QUALIFIED
TOKEN, OPERAND, Line, LineCount, OpLoc, SrcLoc, DestLoc, LineParts;
CONST
TokenSize = 8;
OperandSize = 20;
TYPE
TOKEN = ARRAY [0..TokenSize] OF CHAR;
OPERAND = ARRAY [0..OperandSize] OF CHAR;
VAR
OpLoc, SrcLoc, DestLoc : CARDINAL;
Line : STRING;
LineCount : CARDINAL;
PROCEDURE LineParts (f : FILE; VAR EndFile : BOOLEAN;
VAR Label, OpCode : TOKEN;
VAR SrcOp, DestOp : OPERAND);
(* Reads Line, breaks into tokens, on-passes to symbol & code generators *)
END Parser.
-----------------------------------------------
LISTING FOUR
DEFINITION MODULE SymbolTable;
(* Initializes symbol table. Maintains list of all labels, *)
(* along with their values. Provides access to the list. *)
FROM LongNumbers IMPORT
LONG;
FROM Parser IMPORT
TOKEN;
EXPORT QUALIFIED
FillSymTab, SortSymTab, ReadSymTab, ListSymTab;
PROCEDURE FillSymTab (Label : TOKEN; Value : LONG; VAR Full : BOOLEAN);
(* Add a symbol to the table *)
PROCEDURE SortSymTab (VAR NumSyms : CARDINAL);
(* Sort symbols into alphabetical order *)
PROCEDURE ReadSymTab (Label : ARRAY OF CHAR;
VAR Value : LONG; VAR Duplicate : BOOLEAN) : BOOLEAN;
(* Passes Value of Label to calling program -- returns FALSE if the *)
(* Label is not defined. Also checks for Multiply Defined Symbols *)
PROCEDURE ListSymTab (i : CARDINAL; VAR Label : TOKEN; VAR Value : LONG);
(* Returns the i-th item in the symbol table *)
END SymbolTable.
-------------------------------------------
LISTING FIVE
DEFINITION MODULE CodeGenerator;
(* Uses information supplied by Parser, OperationCodes, *)
(* and SyntaxAnalyzer to produce the object code. *)
FROM Parser IMPORT
TOKEN, OPERAND;
FROM LongNumbers IMPORT
LONG;
EXPORT QUALIFIED
LZero, AddrCnt, Pass2, BuildSymTable, AdvAddrCnt, GetObjectCode;
VAR
LZero, AddrCnt : LONG;
Pass2 : BOOLEAN;
PROCEDURE BuildSymTable (VAR AddrCnt : LONG;
Label, OpCode : TOKEN; SrcOp, DestOp : OPERAND);
(* Builds symbol table from symbolic information of Source File *)
PROCEDURE AdvAddrCnt (VAR AddrCnt : LONG);
(* Advances the address counter based on the length of the instruction *)
PROCEDURE GetObjectCode (Label, OpCode : TOKEN;
SrcOp, DestOp : OPERAND;
VAR AddrCnt, ObjOp, ObjSrc, ObjDest : LONG;
VAR nA, nO, nS, nD : CARDINAL);
(* Determines the object code for the operation as well as the operands *)
(* Returns each (up to 3 fields), along with their length *)
END CodeGenerator.
-------------------------------------
LISTING SIX
DEFINITION MODULE SyntaxAnalyzer;
(* Analyzes the operands to provide information for CodeGenerator *)
FROM LongNumbers IMPORT
LONG;
FROM OperationCodes IMPORT
ModeTypeA, ModeTypeB, ModeA, ModeB;
FROM Parser IMPORT
TOKEN, OPERAND, OpLoc, SrcLoc, DestLoc;
EXPORT QUALIFIED
OpMode, Xtype, SizeType, OpConfig, (* TYPEs *)
Size, InstSize, (* VARs *)
AddrModeA, AddrModeB, Op, Src, Dest, (* VARs *)
GetValue, GetSize, (* PROCEDURE's *)
GetInstModeSize, GetOperand, GetMultReg; (* PROCEDURE's *)
TYPE
OpMode = (DReg, (* Data Register *)
ARDir, (* Address Register Direct *)
ARInd, (* Address Register Indirect *)
ARPost, (* Address Register with Post-Increment *)
ARPre, (* Address Register with Pre-Decrement *)
ARDisp, (* Address Register with Displacement *)
ARDisX, (* Address Register with Disp. & Index *)
AbsW, (* Absolute Word (16-bit Address) *)
AbsL, (* Absolute Word (32-bit Address) *)
PCDisp, (* Program Counter Relative, with Displacement *)
PCDisX, (* Program Counter Relative, with Disp. & Index *)
Imm, (* Immediate *)
MultiM, (* Multiple Register Move *)
SR, (* Status Register *)
CCR, (* Condition Code Register *)
USP, (* User's Stack Pointer *)
Null); (* Error Condition, or Operand missing *)
Xtype = (X0, Dreg, Areg);
SizeType = (S0, Byte, Word, S3, Long);
OpConfig = RECORD (* OPERAND CONFIGURATION *)
Mode : OpMode;
Value : LONG;
Loc : CARDINAL; (* Location of Operand on line *)
Rn : CARDINAL; (* Register number *)
Xn : CARDINAL; (* Index Reg. nbr. *)
Xsize : SizeType; (* size of Index *)
X : Xtype; (* Is index Data or Address register? *)
END;
VAR
Size : SizeType; (* size for OpCode *)
AbsSize : SizeType; (* size of operand (Absolute only) *)
InstSize : CARDINAL;
AddrModeA : ModeA; (* Addressing modes for this instruction *)
AddrModeB : ModeB; (* ditto *)
Op : BITSET; (* Raw bit pattern for OpCode *)
Src, Dest : OpConfig;
PROCEDURE GetValue (Operand : OPERAND; VAR Value : LONG);
(* determines value of operand (in Decimal, HEX, or via Symbol Table) *)
PROCEDURE GetSize (VAR Symbol : ARRAY OF CHAR; VAR Size : SizeType);
(* determines size of opcode: Byte, Word, or Long *)
PROCEDURE GetAbsSize (VAR Symbol : ARRAY OF CHAR; VAR AbsSize : SizeType);
(* determines size of operand: Word or Long *)
PROCEDURE GetInstModeSize (Mode : OpMode; Size : SizeType;
VAR InstSize : CARDINAL) : CARDINAL;
(* Determines the size for the various instruction modes. *)
PROCEDURE GetOperand (Oper : OPERAND; VAR Op : OpConfig);
(* Finds mode and value for source or destination operand *)
PROCEDURE GetMultReg (Oper : OPERAND; PreDec : BOOLEAN;
Loc : CARDINAL; VAR MultExt : BITSET);
(* Builds a BITSET marking each register used in a MOVEM instruction *)
END SyntaxAnalyzer.
------------------------------------
LISTING SEVEN
DEFINITION MODULE ErrorX68;
(* Displays error messages for X68000 cross assembler *)
FROM Files IMPORT
FILE;
EXPORT QUALIFIED
ErrorType, ErrorCount, Error, WriteErrorCount;
TYPE
ErrorType = (Dummy, TooLong, NoCode, SymDup, Undef, SymFull, Phase,
ModeErr, OperErr, BraErr, AddrErr, SizeErr, EndErr);
VAR
ErrorCount : CARDINAL;
PROCEDURE Error (Pos : CARDINAL; ErrorNbr : ErrorType);
(* Displays Error #ErrorNbr, then waits for any key to continue *)
PROCEDURE WriteErrorCount (f : FILE);
(* Error count output to Console & Listing file *)
END ErrorX68.
---------------------------------------
LISTING EIGHT
DEFINITION MODULE Listing;
(* Creates a program listing, including Addresses, Code & Source. *)
FROM Files IMPORT
FILE;
FROM LongNumbers IMPORT
LONG;
EXPORT QUALIFIED
StartListing, WriteListLine, WriteSymTab;
PROCEDURE StartListing (f : FILE);
(* Sign on messages for listing file -- initialize *)
PROCEDURE WriteListLine (f : FILE;
AddrCnt, ObjOp, ObjSrc, ObjDest : LONG;
nA, nO, nS, nD : CARDINAL);
(* Writes one line to the Listing file, Including Object Code *)
PROCEDURE WriteSymTab (f : FILE; NumSym : CARDINAL);
(* Lists symbol table in alphabetical order *)
END Listing.
------------------------------------------
LISTING NINE
DEFINITION MODULE Srecord;
(* Creates Motorola S-records of program: *)
(* S0 = header record, *)
(* S2 = code/data records (24 bit address), *)
(* S8 = termination record (24 bit address). *)
FROM Files IMPORT
FILE;
FROM LongNumbers IMPORT
LONG;
EXPORT QUALIFIED
StartSrec, WriteSrecLine, EndSrec;
PROCEDURE StartSrec (f : FILE; SourceFN : ARRAY OF CHAR);
(* Writes S0 record (HEADER) and initializes *)
PROCEDURE WriteSrecLine (f : FILE;
AddrCnt, ObjOp, ObjSrc, ObjDest : LONG;
nA, nO, nS, nD : CARDINAL);
(* Collects Object Code -- Writes an S2 record to file if line is full *)
PROCEDURE EndSrec (f : FILE);
(* Finishes off any left-over (Partial) S2 line, *)
(* and then writes S8 record (TRAILER) *)
END Srecord.
--------------------------------
LISITNG TEN
MODULE X68000;
(*------------------------------------------------------------------*)
(* *)
(* MC68000 Cross Assembler *)
(* Copyright (c) 1985 by Brian R. Anderson *)
(* *)
(* This program may be copied for personal, non-commercial use *)
(* only, provided that the above copyright notice is included *)
(* on all copies of the source code. Copying for any other use *)
(* without the consent of the author is prohibited. *)
(* *)
(*------------------------------------------------------------------*)
FROM Terminal IMPORT
WriteString, WriteLn, ReadString;
FROM Files IMPORT
FILE, FileState, Open, Create, Write, Close;
FROM Strings IMPORT
STRING, CompareStr, Assign, Concat, Length, Delete;
IMPORT ASCII;
FROM CmdLin2 IMPORT (* Access CP/M command line *)
ReadCmdLin;
FROM LongNumbers IMPORT
LONG;
FROM SymbolTable IMPORT
SortSymTab;
FROM Parser IMPORT
TOKEN, OPERAND, LineCount, LineParts;
FROM CodeGenerator IMPORT
LZero, AddrCnt, Pass2, BuildSymTable, AdvAddrCnt, GetObjectCode;
FROM Listing IMPORT
StartListing, WriteListLine, WriteSymTab;
FROM Srecord IMPORT
StartSrec, WriteSrecLine, EndSrec;
FROM ErrorX68 IMPORT
ErrorCount, WriteErrorCount;
TYPE
FileName = ARRAY [0..14] OF CHAR;
VAR
ArgC : CARDINAL;
ArgV : POINTER TO ARRAY [1..3] OF POINTER TO STRING; (* Command Line *)
SourceFN, ListFN, SrecFN : FileName;
Source, List, Srec : FILE;
Label, OpCode : TOKEN;
SrcOp, DestOp : OPERAND;
EndFile : BOOLEAN;
NumSyms : CARDINAL;
ObjOp, ObjSrc, ObjDest : LONG;
nA, nO, nS, nD : CARDINAL;
PROCEDURE MakeNames (VAR S, L, R : FileName);
(* builds names for Source, Listing & S-Record files *)
VAR
T : FileName; (* temporary work name *)
i, l : CARDINAL;
BEGIN
L := ''; R := ''; (* set Listing & S-rec names to null *)
i := 0; l := 0;
WHILE (S[i] # 0C) AND (S[i] # ' ') DO
IF S[i] = '.' THEN (* mark beginning of file extension *)
l := i;
END;
S[i] := CAP (S[i]);
INC (i);
END;
IF S[i] = ' ' THEN
Delete (S, i, Length (S) - i);
END;
Assign (S, T);
IF l = 0 THEN
Concat (T, ".ASM", S);
ELSE
Delete (T, l, i - l);
END;
Concat (T, ".LST", L);
Concat (T, ".S", R);
END MakeNames;
PROCEDURE OpenFiles;
BEGIN
IF Open (Source, SourceFN) # FileOK THEN
WriteLn;
WriteString ("No Source File: "); WriteString (SourceFN);
WriteLn;
HALT;
END;
IF Create (List, ListFN) # FileOK THEN (* DOS may trap this *)
WriteLn;
WriteString ("Cannot create disk files!"); WriteLn;
HALT;
END;
IF Create (Srec, SrecFN) # FileOK THEN
WriteLn;
WriteString ("Cannot create disk files!"); WriteLn;
HALT;
END;
END OpenFiles;
PROCEDURE StartPass2;
BEGIN
IF (Close (Source) # FileOK) OR
(Open (Source, SourceFN) # FileOK) THEN
WriteString ("Unable to 'Reset' Source file for 2nd Pass.");
WriteLn;
HALT;
END;
Pass2 := TRUE; (* Pass2 IMPORTed from CodeGenerator *)
AddrCnt := LZero; (* Assume ORG = 0 to start *)
ErrorCount := 0; (* ErrorCount IMPORTed from ErrorX68 *)
LineCount := 0; (* LineCount IMPORTed from Parser *)
EndFile := FALSE;
END StartPass2;
PROCEDURE CloseFiles;
BEGIN
(*--------------------------------------------------------*)
(* *)
(* Ctrl-Z written to files before closing *)
(* due to bug in "Files" module. Remove these *)
(* before submitting listing for publication. *)
(* *)
(*--------------------------------------------------------*)
Write (List, ASCII.sub); Write (Srec, ASCII.sub);
IF (Close (Source) # FileOK)
OR (Close (List) # FileOK)
OR (Close (Srec) # FileOK) THEN
WriteString ("Error closing files..."); WriteLn;
HALT;
END;
END CloseFiles;
BEGIN (* X68000 -- main program *)
ReadCmdLin (ArgC, ArgV);
IF ArgC = 0 THEN
WriteLn;
WriteString ("Enter Source Filename: ");
ReadString (SourceFN);
WriteLn;
ELSE
Assign (ArgV^[1]^, SourceFN);
END;
MakeNames (SourceFN, ListFN, SrecFN);
OpenFiles;
WriteLn;
WriteString (" 68000 Cross Assembler"); WriteLn;
WriteString (" Copyright (c) 1985 by Brian R. Anderson");
WriteLn; WriteLn;
WriteString (" Assembling "); WriteString (SourceFN);
WriteLn; WriteLn; WriteLn;
(*---
Begin Pass 1
---*)
WriteString ("PASS 1"); WriteLn;
AddrCnt := LZero; (* Assume ORG = 0 to start *)
EndFile := FALSE;
REPEAT
LineParts (Source, EndFile, Label, OpCode, SrcOp, DestOp);
BuildSymTable (AddrCnt, Label, OpCode, SrcOp, DestOp);
AdvAddrCnt (AddrCnt);
UNTIL EndFile OR (CompareStr (OpCode, "END") = 0);
(*---
Begin Pass 2
---*)
WriteString ("PASS 2"); WriteLn;
StartPass2; (* get Source file, Parser & ErrorX68 ready for 2nd pass *)
SortSymTab (NumSyms);
StartListing (List);
StartSrec (Srec, SourceFN);
REPEAT
LineParts (Source, EndFile, Label, OpCode, SrcOp, DestOp);
GetObjectCode (Label, OpCode,
SrcOp, DestOp,
AddrCnt, ObjOp, ObjSrc, ObjDest,
nA, nO, nS, nD );
WriteListLine (List, AddrCnt, ObjOp, ObjSrc, ObjDest, nA, nO, nS, nD);
WriteSrecLine (Srec, AddrCnt, ObjOp, ObjSrc, ObjDest, nA, nO, nS, nD);
AdvAddrCnt (AddrCnt);
UNTIL EndFile OR (CompareStr (OpCode, "END") = 0);
EndSrec (Srec); (* Also: Finish off any partial line *)
WriteErrorCount (List); (* Error count output to Console & Listing file *)
WriteSymTab (List, NumSyms); (* Write Symbol Table to Listing File *)
CloseFiles;
END X68000.
--------------------------------
LISTINGS CONTINUED- KEYWORD:MAY86
LISTING ELEVEN
IMPLEMENTATION MODULE LongNumbers;
(* Routines to handle HEX digits for the X68000 cross assembler. *)
(* All but LongPut and LongWrite are limited to 8 digit numbers. *)
FROM Files IMPORT
FILE;
IMPORT Files; (* Write *)
IMPORT Terminal; (* Write *)
(*---
(* These objects are declared in the DEFINITION MODULE *)
CONST
DIGITS = 8;
BASE = 16;
TYPE
LONG = ARRAY [1..DIGITS] OF INTEGER;
---*)
CONST
Zero = 30H;
Nine = 39H;
hexA = 41H;
hexF = 46H;
PROCEDURE LongClear (VAR A : LONG);
(* Sets A to Zero *)
VAR
i : CARDINAL;
BEGIN
FOR i := 1 TO DIGITS DO
A[i] := 0;
END;
END LongClear;
PROCEDURE LongAdd (A, B : LONG; VAR Result : LONG);
(* Add two LONGs, giving Result *)
VAR
Carry : INTEGER;
i : CARDINAL;
BEGIN
Carry := 0;
FOR i := 1 TO DIGITS DO
Result[i] := (A[i] + Carry) + B[i];
IF Result[i] >= BASE THEN
Result[i] := Result[i] - BASE;
Carry := 1;
ELSE
Carry := 0;
END;
END;
END LongAdd;
PROCEDURE LongSub (A, B : LONG; VAR Result : LONG);
(* Subtract two LONGs (A - B), giving Result *)
VAR
Borrow : INTEGER;
i : CARDINAL;
BEGIN
Borrow := 0;
FOR i := 1 TO DIGITS DO
Result[i] := (A[i] - Borrow) - B[i];
IF Result[i] < 0 THEN
Result[i] := Result[i] + BASE;
Borrow := 1;
ELSE
Borrow := 0;
END;
END;
END LongSub;
PROCEDURE CardToLong (n : CARDINAL; VAR A : LONG);
(* Converts CARDINALs to LONGs *)
VAR
i : CARDINAL;
BEGIN
LongClear (A);
i := 1;
REPEAT
A[i] := n MOD BASE;
INC (i);
n := n DIV BASE;
UNTIL n = 0;
END CardToLong;
PROCEDURE LongToCard (A : LONG; VAR n : CARDINAL) : BOOLEAN;
(* Converts LONG TO CARDINAL, returns FALSE if conversion impossible *)
BEGIN
n := (A[4] * 4096) + (A[3] * 256) + (A[2] * 16) + A[1];
RETURN ((A[5] = 0) AND (A[6] = 0) AND (A[7] = 0) AND (A[8] = 0));
END LongToCard;
PROCEDURE LongToInt (A : LONG; VAR n : INTEGER) : BOOLEAN;
(* Converts LONG to INTEGER, returns FALSE if conversion impossible *)
VAR
TempC : CARDINAL;
Neg : BOOLEAN;
BEGIN
IF (A[5] = 0) AND (A[6] = 0) AND (A[7] = 0) AND (A[8] = 0) THEN
Neg := FALSE;
ELSIF (A[5] = 15) AND (A[6] = 15) AND (A[7] = 15) AND (A[8] = 15) THEN
Neg := TRUE;
ELSE
RETURN FALSE; (* Out of INTEGER range *)
END;
TempC := (A[4] * 4096) + (A[3] * 256) + (A[2] * 16) + A[1];
IF ((TempC <= 32767) AND (NOT Neg)) OR ((TempC > 32767) AND Neg) THEN
n := INTEGER (TempC);
RETURN TRUE;
ELSE
RETURN FALSE;
END;
END LongToInt;
PROCEDURE LongInc (VAR A : LONG; n : CARDINAL);
(* Increment LONG by n *)
VAR
T : LONG;
BEGIN
CardToLong (n, T);
LongAdd (A, T, A);
END LongInc;
PROCEDURE LongDec (VAR A : LONG; n : CARDINAL);
(* Decrement LONG by n *)
VAR
T : LONG;
BEGIN
CardToLong (n, T);
LongSub (A, T, A);
END LongDec;
PROCEDURE LongCompare (A, B : LONG) : INTEGER;
(* Returns: 0 if A = B, -1 if A < B, +1 if A > B *)
VAR
i : CARDINAL;
BEGIN
i := DIGITS;
WHILE (i > 0) AND (A[i] = B[i]) DO
DEC (i);
END;
IF i = 0 THEN
RETURN 0;
ELSIF A[i] < B[i] THEN
RETURN -1;
ELSIF A[i] > B[i] THEN
RETURN +1;
ELSE
(* Impossible! *)
END;
END LongCompare;
PROCEDURE GetDigit (n : INTEGER) : CHAR;
(* Function returning HEX character corresponding to digit *)
BEGIN
IF (n >= 0) AND (n <= 9) THEN
RETURN CHR (CARDINAL (n) + Zero);
ELSIF (n >= 10) AND (n <= 15) THEN
RETURN CHR ((CARDINAL (n) - 10) + hexA);
ELSE
RETURN '*';
END;
END GetDigit;
PROCEDURE LongPut (f : FILE; A : ARRAY OF INTEGER; Size : CARDINAL);
(* Put LONG number in FILE f *)
VAR
i : CARDINAL;
BEGIN
IF Size = 0 THEN
RETURN;
END;
DEC (Size); (* adjust for zero-based array *)
IF Size > HIGH (A) THEN
Size := HIGH (A);
END;
FOR i := Size TO 0 BY -1 DO
Files.Write (f, GetDigit (A[i]));
END;
END LongPut;
PROCEDURE LongWrite (A : ARRAY OF INTEGER; Size : CARDINAL);
(* Write LONG number to console screen *)
VAR
i : CARDINAL;
BEGIN
IF Size = 0 THEN
RETURN;
END;
DEC (Size);
IF Size > HIGH (A) THEN
Size := HIGH (A);
END;
FOR i := Size TO 0 BY -1 DO
Terminal.Write (GetDigit (A[i]));
END;
END LongWrite;
PROCEDURE IsHEX (c : CHAR) : BOOLEAN;
(* checks if c is one of 0..9, A..F *)
VAR
C : CARDINAL;
BEGIN
C := ORD (CAP (c));
RETURN (((C >= Zero) AND (C <= Nine)) OR
((C >= hexA) AND (C <= hexF)));
END IsHEX;
PROCEDURE GetHEX (c : CHAR) : INTEGER;
(* returns HEX value of character *)
VAR
C : CARDINAL;
BEGIN
C := ORD (CAP (c));
IF C < hexA THEN
RETURN INTEGER (C - Zero);
ELSE
RETURN 10 + INTEGER (C - hexA);
END;
END GetHEX;
PROCEDURE StringToLong (S : ARRAY OF CHAR; VAR A : LONG) : BOOLEAN;
(* Converts a string (in HEX) into a LONG *)
VAR
i, j : CARDINAL;
BEGIN
LongClear (A);
IF S[0] # '$' THEN
RETURN FALSE; (* not a HEX string *)
ELSE
j := 1;
WHILE (IsHEX (S[j])) AND (j <= DIGITS) DO
INC (j);
END;
DEC (j); (* gone too far, so back up one *)
i := 1;
WHILE j > 0 DO
A[i] := GetHEX (S[j]);
INC (i); DEC (j);
END;
RETURN (i > 1);
END;
END StringToLong;
PROCEDURE AddrBoundL (VAR A : LONG);
(* Forces A to a long word boundary *)
BEGIN
WHILE NOT (CARDINAL (A[1]) IN {0, 4, 8, 12}) DO
LongInc (A, 1);
END;
END AddrBoundL;
PROCEDURE AddrBoundW (VAR A : LONG);
(* Forces A to a word boundary *)
BEGIN
WHILE NOT (CARDINAL (A[1]) IN {0, 2, 4, 6, 8, 10, 12, 14}) DO
LongInc (A, 1);
END;
END AddrBoundW;
END LongNumbers.
----------------------------------------
LISTING TWELVE
IMPLEMENTATION MODULE CmdLin2;
(* Parses command line - returns pointer to an array of pointer to strings *)
FROM SYSTEM IMPORT
ADDRESS, ADR;
CONST
MAXARGS = 5;
VAR
CommandLine[80H] : ARRAY [0..7FH] OF CHAR;
Arguments : ARRAY [0..MAXARGS - 1] OF ADDRESS;
PROCEDURE ReadCmdLin (VAR ArgC : CARDINAL; VAR ArgV : ADDRESS);
(* Gives count of items in command line, and an array of pointer to them *)
VAR
i, C : CARDINAL;
BEGIN
IF ORD (CommandLine[0]) = 0 THEN
ArgC := 0; (* Nothing in Command Tail Buffer *)
ArgV := NIL;
ELSE
i := 1; C := 0;
LOOP
WHILE CommandLine[i] = ' ' DO (* Skip Blanks *)
INC (i);
END;
IF CommandLine[i] = 0C THEN (* end of tail buffer *)
EXIT;
ELSE
Arguments[C] := ADR (CommandLine[i]);
INC (C);
IF C = MAXARGS THEN
EXIT;
END;
END;
WHILE CommandLine[i] # ' ' DO (* Advance to next Argument *)
INC (i);
IF CommandLine[i] = 0C THEN
EXIT;
END;
END;
CommandLine[i] := 0C; (* Terminate Argument *)
INC (i);
END; (* LOOP *)
CommandLine[0] := 0C; (* Command Tail must only be used once *)
ArgC := C;
ArgV := ADR (Arguments);
END;
END ReadCmdLin;
END CmdLin2.
----------------------------------------
LISITNG THIRTEEN
IMPLEMENTATION MODULE Parser;
(* Reads the Source file, and splits each *)
(* line into Label, OpCode & Operand(s). *)
FROM Strings IMPORT
STRING;
FROM Files IMPORT
FILE, EOF, Read;
FROM ErrorX68 IMPORT
ErrorType, Error;
IMPORT ASCII;
(*---
(* These objects are declared in the DEFINITION MODULE *)
CONST
TokenSize = 8;
OperandSize = 20;
TYPE
TOKEN = ARRAY [0..TokenSize] OF CHAR;
OPERAND = ARRAY [0..OperandSize] OF CHAR;
VAR
OpLoc, SrcLoc, DestLoc : CARDINAL; (* location of line parts *)
Line : STRING;
LineCount : CARDINAL;
---*)
PROCEDURE GetLine (f : FILE; VAR EndFile : BOOLEAN);
(* Inputs a Line -- up to 80 characters ending in cr/lf -- from a file. *)
CONST
MAXLINE = 80;
VAR
i : CARDINAL;
ch : CHAR;
PROCEDURE Get (VAR c : CHAR) : CHAR;
BEGIN
IF NOT EOF (f) THEN
Read (f, c);
RETURN c;
ELSE
EndFile := TRUE;
END;
END Get;
BEGIN (* GetLine *)
EndFile := FALSE;
i := 0;
WHILE (i < MAXLINE) AND (Get (ch) # ASCII.lf) AND (NOT EndFile) DO
Line[i] := ch;
INC (i);
END;
IF Line[i - 1] = ASCII.cr THEN (* Strip cr/lf - terminate with 0C *)
Line[i - 1] := 0C;
ELSE
Line[i] := 0C;
END;
INC (LineCount);
END GetLine;
PROCEDURE SplitLine (VAR Label, OpCode : TOKEN;
VAR SrcOp, DestOp : OPERAND);
(* Separates TOKENs & OPERANDs from Line. *)
CONST
Quote = 47C;
StringMAX = 12;
VAR
i, j : CARDINAL;
ParCnt : INTEGER; (* Tracks open parentheses *)
c : CHAR;
InQuotes : BOOLEAN;
PROCEDURE Cap (ch : CHAR) : CHAR;
BEGIN
IF InQuotes THEN
RETURN (ch);
ELSE
RETURN CAP (ch);
END;
END Cap;
PROCEDURE White (ch : CHAR) : BOOLEAN;
BEGIN
RETURN ((ch = ASCII.ht) OR (ch = ' '));
END White;
PROCEDURE Delimiter (ch : CHAR) : BOOLEAN;
BEGIN
RETURN ((NOT InQuotes) AND
((ch = ASCII.ht) OR (ch = ' ') OR (ch = 0C)));
END Delimiter;
PROCEDURE OpDelimiter (ch : CHAR) : BOOLEAN;
BEGIN
RETURN ((NOT InQuotes) AND (ch = ',') AND (ParCnt = 0));
END OpDelimiter;
PROCEDURE Done (ch : CHAR) : BOOLEAN;
(* look for start of comment or NULL terminator *)
BEGIN
RETURN ((ch = ';') OR (ch = 0C) OR ((ch = '*') AND (i = 0)));
END Done;
BEGIN (* SplitLine *)
i := 0;
InQuotes := FALSE;
IF Done (Line[i]) THEN (* look for blank or all-comment line *)
RETURN;
END;
IF White (Line[i]) THEN
INC (i);
WHILE White (Line[i]) DO
INC (i); (* Skip spaces & tabs *)
END;
ELSE (* Found a Label *)
j := 0;
c := Line[i];
WHILE (NOT Delimiter (c)) AND (j < TokenSize) DO
Label[j] := CAP (c);
INC (i); INC (j);
c := Line[i];
END;
Label[j] := 0C; (* terminate Label string *)
IF j = TokenSize THEN
Error (i, TooLong);
END;
WHILE NOT Delimiter (Line[i]) DO
INC (i); (* Skip remainder of Too-Long Token *)
END;
END;
WHILE White (Line[i]) DO
INC (i);
END;
IF Done (Line[i]) THEN
RETURN;
ELSE (* Found an OpCode *)
OpLoc := i;
j := 0;
c := Line[i];
WHILE (NOT Delimiter (c)) AND (j < TokenSize) DO
OpCode[j] := CAP (c);
INC (i); INC (j);
c := Line[i];
END;
OpCode[j] := 0C;
IF j = TokenSize THEN
Error (i, TooLong);
END;
WHILE NOT Delimiter (Line[i]) DO
INC (i); (* Skip remainder of Too-Long Token *)
END;
END;
WHILE White (Line[i]) DO
INC (i);
END;
IF Done (Line[i]) THEN
RETURN;
ELSE (* Found 1st Operand *)
SrcLoc := i;
j := 0;
ParCnt := 0;
c := Line[i];
IF c = Quote THEN (* String Constant *)
SrcOp[j] := c;
INC (i); INC (j);
REPEAT
c := Line[i];
SrcOp[j] := c;
INC (i); INC (j);
UNTIL (c = Quote) OR (j > StringMAX) OR (c = 0C);
SrcOp[j] := 0C;
IF j > StringMAX THEN
Error (i, TooLong);
END;
RETURN; (* second operand not allowed after string constant *)
ELSE (* Normal Operand *)
WHILE (NOT Delimiter (c))
AND (NOT OpDelimiter (c))
AND (j < OperandSize) DO
IF c = Quote THEN
InQuotes := NOT InQuotes; (* Toggle Switch *)
END;
IF NOT InQuotes THEN
IF c = '(' THEN
INC (ParCnt);
END;
IF c = ')' THEN
DEC (ParCnt);
END;
END;
SrcOp[j] := Cap (c); (* Switched CAP function *)
INC (i); INC (j);
c := Line[i];
END;
SrcOp[j] := 0C;
IF j = OperandSize THEN
Error (i, TooLong);
END;
END;
WHILE (NOT Delimiter (Line[i])) AND (NOT OpDelimiter (Line[i])) DO
INC (i); (* Skip remainder of Too-Long Operand *)
END;
END;
IF NOT OpDelimiter (Line[i]) THEN
RETURN; (* because only one OPERAND *)
ELSE (* Found 2nd Operand *)
INC (i); (* Skip OpDelimiter (comma) *)
DestLoc := i;
j := 0;
c := Line[i];
WHILE (NOT Delimiter (c)) AND (j < OperandSize) DO
DestOp[j] := CAP (c);
INC (i); INC (j);
c := Line[i];
END;
DestOp[j] := 0C;
IF j = OperandSize THEN
Error (i, TooLong);
END;
END;
END SplitLine;
PROCEDURE LineParts (f : FILE; VAR EndFile : BOOLEAN;
VAR Label, OpCode : TOKEN;
VAR SrcOp, DestOp : OPERAND);
(* Reads line, breaks into tokens, on-passes to symbol & code generators *)
BEGIN
Line := "";
GetLine (f, EndFile); (* read a line from the file *)
Label := ""; OpCode := ""; SrcOp := ""; DestOp := "";
IF EndFile THEN
Error (0, EndErr);
ELSE
SplitLine (Label, OpCode, SrcOp, DestOp);
END;
END LineParts;
BEGIN (* MODULE Initialization *)
OpLoc := 0; SrcLoc := 0; DestLoc := 0; LineCount := 0;
END Parser.
----------------------------------------
LISTING FOURTEEN
IMPLEMENTATION MODULE SymbolTable;
(* Initializes symbol table. Maintains list of all labels, *)
(* along with their values. Provides access to the list. *)
FROM LongNumbers IMPORT
LONG, LongClear;
FROM Parser IMPORT
TOKEN;
FROM Strings IMPORT
CompareStr;
CONST
MAXSYM = 500; (* Maximum entries in Symbol Table *)
TYPE
SYMBOL = RECORD
Name : TOKEN;
Value : LONG;
END;
VAR
SymTab : ARRAY [1..MAXSYM] OF SYMBOL;
Next : CARDINAL; (* Array index into next entry in Symbol Table *)
Top : INTEGER; (* Last used array position as seen by Sort *)
PROCEDURE FillSymTab (Label : TOKEN; Value : LONG; VAR Full : BOOLEAN);
(* Add a symbol to the table *)
BEGIN
IF Next <= MAXSYM THEN
SymTab[Next].Name := Label;
SymTab[Next].Value := Value;
INC (Next);
Full := FALSE;
ELSE
Full := TRUE;
END;
END FillSymTab;
PROCEDURE SortSymTab (VAR NumSyms : CARDINAL);
(* Sort symbols into alphabetical order *)
VAR
i, j, gap : INTEGER; (* Shell Sort causes j to go negative *)
Temp : SYMBOL;
PROCEDURE Swap;
BEGIN
Temp := SymTab[j];
SymTab[j] := SymTab[j + gap];
SymTab[j + gap] := Temp;
END Swap;
BEGIN (* Sort *)
Top := Next - 1;
gap := (Top + 1) DIV 2;
WHILE gap > 0 DO
i := gap;
WHILE i <= Top DO
j := i - gap;
WHILE j >= 1 DO
IF CompareStr (SymTab[j].Name, SymTab[j + gap].Name) > 0 THEN
Swap;
END;
j := j - gap;
END;
INC (i);
END;
gap := gap DIV 2;
END;
NumSyms := Top;
END SortSymTab;
PROCEDURE ReadSymTab (LABEL : ARRAY OF CHAR;
VAR Value : LONG; VAR Duplicate : BOOLEAN) : BOOLEAN;
(* Passes Value of Label to calling program -- returns FALSE if the *)
(* Label is not defined. Also checks for Multiply Defined Symbols *)
CONST
GoLower = -1;
GoHigher = +1;
VAR
i, j, mid : INTEGER;
Search : INTEGER;
Found : BOOLEAN;
c : CHAR;
Label : TOKEN;
BEGIN
LongClear (Value);
Duplicate := FALSE;
i := 0;
REPEAT
c := LABEL[i];
Label[i] := c;
INC (i);
UNTIL (c = 0C) OR (i > 8);
IF c # 0C THEN (* Operand label too long --> Undefined *)
RETURN FALSE;
END;
i := 1;
j := Top;
Found := FALSE;
REPEAT (* Binary search *)
mid := (i + j) DIV 2;
Search := CompareStr (Label, SymTab[mid].Name);
IF Search = GoLower THEN
j := mid - 1;
ELSIF Search = GoHigher THEN
i := mid + 1;
ELSE (* Got It! *)
Found := TRUE;
END;
UNTIL (j < i) OR Found;
IF Found THEN
IF mid > 1 THEN
IF CompareStr (SymTab[mid].Name, SymTab[mid - 1].Name) = 0 THEN
Duplicate := TRUE; (* Multiply Defined Symbol *)
END;
END;
IF mid < Top THEN
IF CompareStr (SymTab[mid].Name, SymTab[mid + 1].Name) = 0 THEN
Duplicate := TRUE; (* Multiply Defined Symbol *)
END;
END;
Value := SymTab[mid].Value;
RETURN TRUE;
ELSE
RETURN FALSE;
END;
END ReadSymTab;
PROCEDURE ListSymTab (i : CARDINAL; VAR Label : TOKEN; VAR Value : LONG);
(* Returns the i-th item in the symbol table *)
BEGIN
IF i < Next THEN
Label := SymTab[i].Name;
Value := SymTab[i].Value;
END;
END ListSymTab;
BEGIN (* MODULE Initialization *)
FOR Next := 1 TO MAXSYM DO
SymTab[Next].Name := "";
LongClear (SymTab[Next].Value);
END;
Top := 0;
Next := 1;
END SymbolTable.
----------------------------------------
LISTING FIFTEEN
IMPLEMENTATION MODULE OperationCodes;
(* Initializes lookup table for Mnemonic OpCodes. Searches the table *)
(* and returns the bit pattern along with address mode information. *)
FROM Files IMPORT
FILE, FileState, Open, ReadRec, Close;
FROM Terminal IMPORT
WriteString, WriteLn;
FROM Strings IMPORT
STRING, CompareStr;
FROM Parser IMPORT
TOKEN;
FROM ErrorX68 IMPORT
ErrorType, Error;
CONST
FIRST = 1; (* First 68000 OpCode *)
LAST = 118; (* Last 68000 OpCode *)
(*---
(* These objects are declared in the DEFINITION MODULE *)
TYPE
ModeTypeA = (RegMem3, (* 0 = Register, 1 = Memory *)
Ry02, (* Register Rx -- Bits 0-2 *)
Rx911, (* Register Ry -- Bits 9-11 *)
Data911, (* Immediate Data -- Bits 9-11 *)
CntR911, (* Count Register or Immediate Data *)
Brnch, (* Relative Branch *)
DecBr, (* Decrement and Branch *)
Data03, (* Used for VECT only *)
Data07, (* MOVEQ *)
OpM68D, (* Data *)
OpM68A, (* Address *)
OpM68C, (* Compare *)
OpM68X, (* XOR *)
OpM68S, (* Sign Extension *)
OpM68R, (* Register/Memory *)
OpM37); (* Exchange Registers *)
ModeTypeB = (Bit811, (* BIT operations - bits 8/11 as switch *)
Size67, (* 00 = Byte, 01 = Word, 10 = Long *)
Size6, (* 0 = Word, 1 = Long *)
Size1213A, (* 01 = Byte, 11 = Word, 10 = Long *)
Size1213, (* 11 = Word, 10 = Long *)
Exten, (* OpCode extension required *)
EA05a, (* Effective Address - ALL *)
EA05b, (* Less 1 *)
EA05c, (* Less 1, 11 *)
EA05d, (* Less 9, 10, 11 *)
EA05e, (* Less 1, 9, 10, 11 *)
EA05f, (* Less 0, 1, 3, 4, 11 *)
EA05x, (* Dual mode - OR/AND *)
EA05y, (* Dual mode - ADD/SUB *)
EA05z, (* Dual mode - MOVEM *)
EA611); (* Used only by MOVE *)
ModeA = SET OF ModeTypeA;
ModeB = SET OF ModeTypeB;
---*)
TYPE
TableRecord = RECORD
Mnemonic : TOKEN;
Op : BITSET;
AddrModeA : ModeA;
AddrModeB : ModeB;
END;
VAR
Table68K : ARRAY [FIRST..LAST] OF TableRecord;
i : CARDINAL; (* index variable for initializing Table68K *)
f : FILE;
PROCEDURE Instructions (MnemonSym : TOKEN;
OpLoc : CARDINAL; VAR Op : BITSET;
VAR AddrModeA : ModeA; VAR AddrModeB : ModeB);
(* Uses lookup table to find addressing mode & bit pattern of opcode. *)
CONST
GoLower = -1;
GoHigher = +1;
VAR
Top, Bottom, Look : CARDINAL; (* index to Op-code table *)
Found : BOOLEAN;
Search : INTEGER;
BEGIN
Bottom := FIRST;
Top := LAST;
Found := FALSE;
REPEAT (* Binary Search *)
Look := (Bottom + Top) DIV 2;
Search := CompareStr (MnemonSym, Table68K[Look].Mnemonic);
IF Search = GoLower THEN
Top := Look - 1;
ELSIF Search = GoHigher THEN
Bottom := Look + 1;
ELSE (* Got It! *)
Found := TRUE;
END;
UNTIL (Top < Bottom) OR Found;
IF Found THEN
(* Return the instruction, mode, and address restristictions *)
Op := Table68K[Look].Op;
AddrModeA := Table68K[Look].AddrModeA;
AddrModeB := Table68K[Look].AddrModeB;
ELSE
Error (OpLoc, NoCode);
END;
END Instructions;
BEGIN (* MODULE Initialization *)
IF Open (f, "OPCODE.DAT") # FileOK THEN
WriteString ("Can't Find 'OPCODE.DAT'.");
WriteLn;
HALT;
END;
FOR i := FIRST TO LAST DO
ReadRec (f, Table68K[i]);
END;
IF Close (f) # FileOK THEN
(* Don't worry about it! *)
END;
END OperationCodes.
----------------------------------------
LISTING SIXTEEN
MODULE InitOperationCodes;
(* Module to construct the file containing the Operation Code Data Table *)
FROM Files IMPORT
FILE, FileState, Create, WriteRec, Close;
FROM Terminal IMPORT
WriteString, WriteLn;
FROM Parser IMPORT
TOKEN;
CONST
FIRST = 1;
LAST = 118;
TYPE
ModeTypeA = (RegMem3, (* 0 = Register, 1 = Memory *)
Ry02, (* Register Rx -- Bits 0-2 *)
Rx911, (* Register Ry -- Bits 9-11 *)
Data911, (* Immediate Data -- Bits 9-11 *)
CntR911, (* Count Register or Immediate Data *)
Brnch, (* Relative Branch *)
DecBr, (* Decrement and Branch *)
Data03, (* Used for VECT only *)
Data07, (* Branch & MOVEQ *)
OpM68D, (* Data *)
OpM68A, (* Address *)
OpM68C, (* Compare *)
OpM68X, (* XOR *)
OpM68S, (* Sign Extension *)
OpM68R, (* Register/Memory *)
OpM37); (* Exchange Registers *)
ModeTypeB = (Bit811, (* BIT operations - bits 8/11 as switch *)
Size67, (* 00 = Byte, 01 = Word, 10 = Long *)
Size6, (* 0 = Word, 1 = Long *)
Size1213A, (* 01 = Byte, 11 = Word, 10 = Long *)
Size1213, (* 11 = Word, 10 = Long *)
Exten, (* OpCode extension required *)
EA05a, (* Effective Address - ALL *)
EA05b, (* Less 1 *)
EA05c, (* Less 1, 11 *)
EA05d, (* Less 9, 10, 11 *)
EA05e, (* Less 1, 9, 10, 11 *)
EA05f, (* Less 0, 1, 3, 4, 11 *)
EA05x, (* Dual mode - OR/AND *)
EA05y, (* Dual mode - ADD/SUB *)
EA05z, (* Dual mode - MOVEM *)
EA611); (* Used only by MOVE *)
ModeA = SET OF ModeTypeA;
ModeB = SET OF ModeTypeB;
TableRecord = RECORD
Mnemonic : TOKEN;
Op : BITSET;
AddrModeA : ModeA;
AddrModeB : ModeB;
END;
VAR
Table68K : ARRAY [FIRST..LAST] OF TableRecord;
i : CARDINAL; (* index variable for initializing Table68K *)
f : FILE; (* "OPCODE.DAT" *)
BEGIN
i := 1;
WITH Table68K[i] DO
Mnemonic := "ABCD";
Op := {15, 14, 8};
AddrModeA := ModeA{Rx911, RegMem3, Ry02};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "ADD";
Op := {15, 14, 12};
AddrModeA := ModeA{OpM68D};
AddrModeB := ModeB{EA05y};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "ADDA";
Op := {15, 14, 12};
AddrModeA := ModeA{OpM68A};
AddrModeB := ModeB{EA05a};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "ADDI";
Op := {10, 9};
AddrModeA := ModeA{};
AddrModeB := ModeB{Size67, EA05e, Exten};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "ADDQ";
Op := {14, 12};
AddrModeA := ModeA{Data911};
AddrModeB := ModeB{Size67, EA05d};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "ADDX";
Op := {15, 14, 12, 8};
AddrModeA := ModeA{RegMem3, Rx911, Ry02};
AddrModeB := ModeB{Size67};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "AND";
Op := {15, 14};
AddrModeA := ModeA{OpM68D};
AddrModeB := ModeB{EA05x};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "ANDI";
Op := {9};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05e, Size67, Exten};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "ASL";
Op := {15, 14, 13, 8};
AddrModeA := ModeA{CntR911};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "ASR";
Op := {15, 14, 13};
AddrModeA := ModeA{CntR911};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "BCC";
Op := {14, 13, 10};
AddrModeA := ModeA{Brnch};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "BCHG";
Op := {6};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05e, Exten, Bit811};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "BCLR";
Op := {7};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05e, Exten, Bit811};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "BCS";
Op := {14, 13, 10, 8};
AddrModeA := ModeA{Brnch};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "BEQ";
Op := {14, 13, 10, 9, 8};
AddrModeA := ModeA{Brnch};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "BGE";
Op := {14, 13, 11, 10};
AddrModeA := ModeA{Brnch};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "BGT";
Op := {14, 13, 11, 10, 9};
AddrModeA := ModeA{Brnch};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "BHI";
Op := {14, 13, 9};
AddrModeA := ModeA{Brnch};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "BLE";
Op := {14, 13, 11, 10, 9, 8};
AddrModeA := ModeA{Brnch};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "BLS";
Op := {14, 13, 9, 8};
AddrModeA := ModeA{Brnch};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "BLT";
Op := {14, 13, 11, 10, 8};
AddrModeA := ModeA{Brnch};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "BMI";
Op := {14, 13, 11, 9, 8};
AddrModeA := ModeA{Brnch};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "BNE";
Op := {14, 13, 10, 9};
AddrModeA := ModeA{Brnch};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "BPL";
Op := {14, 13, 11, 9};
AddrModeA := ModeA{Brnch};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "BRA";
Op := {14, 13};
AddrModeA := ModeA{Brnch};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "BSET";
Op := {7, 6};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05e, Exten, Bit811};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "BSR";
Op := {14, 13, 8};
AddrModeA := ModeA{Brnch};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "BTST";
Op := {};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05c, Exten, Bit811};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "BVC";
Op := {14, 13, 11};
AddrModeA := ModeA{Brnch};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "BVS";
Op := {14, 13, 11, 8};
AddrModeA := ModeA{Brnch};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "CHK";
Op := {14, 8, 7};
AddrModeA := ModeA{Rx911};
AddrModeB := ModeB{EA05b};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "CLR";
Op := {14, 9};
AddrModeA := ModeA{};
AddrModeB := ModeB{Size67, EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "CMP";
Op := {15, 13, 12};
AddrModeA := ModeA{OpM68C};
AddrModeB := ModeB{EA05a};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "CMPA";
Op := {15, 13, 12};
AddrModeA := ModeA{OpM68A};
AddrModeB := ModeB{EA05a};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "CMPI";
Op := {11, 10};
AddrModeA := ModeA{};
AddrModeB := ModeB{Size67, EA05e, Exten};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "CMPM";
Op := {15, 13, 12, 8, 3};
AddrModeA := ModeA{Rx911, Ry02};
AddrModeB := ModeB{Size67};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "DBCC";
Op := {14, 12, 10, 7, 6, 3};
AddrModeA := ModeA{DecBr};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "DBCS";
Op := {14, 12, 10, 8, 7, 6, 3};
AddrModeA := ModeA{DecBr};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "DBEQ";
Op := {14, 12, 10, 9, 8, 7, 6, 3};
AddrModeA := ModeA{DecBr};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "DBF";
Op := {14, 12, 8, 7, 6, 3};
AddrModeA := ModeA{DecBr};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "DBGE";
Op := {14, 12, 11, 10, 7, 6, 3};
AddrModeA := ModeA{DecBr};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "DBGT";
Op := {14, 12, 11, 10, 9, 7, 6, 3};
AddrModeA := ModeA{DecBr};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "DBHI";
Op := {14, 12, 9, 7, 6, 3};
AddrModeA := ModeA{DecBr};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "DBLE";
Op := {14, 12, 11, 10, 9, 8, 7, 6, 3};
AddrModeA := ModeA{DecBr};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "DBLS";
Op := {14, 12, 9, 8, 7, 6, 3};
AddrModeA := ModeA{DecBr};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "DBLT";
Op := {14, 12, 11, 10, 8, 7, 6, 3};
AddrModeA := ModeA{DecBr};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "DBMI";
Op := {14, 12, 11, 9, 8, 7, 6, 3};
AddrModeA := ModeA{DecBr};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "DBNE";
Op := {14, 12, 10, 9, 7, 6, 3};
AddrModeA := ModeA{DecBr};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "DBPL";
Op := {14, 12, 11, 9, 7, 6, 3};
AddrModeA := ModeA{DecBr};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "DBRA";
Op := {14, 12, 8, 7, 6, 3};
AddrModeA := ModeA{DecBr};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "DBT";
Op := {14, 12, 7, 6, 3};
AddrModeA := ModeA{DecBr};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "DBVC";
Op := {14, 12, 11, 7, 6, 3};
AddrModeA := ModeA{DecBr};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "DBVS";
Op := {14, 12, 11, 8, 7, 6, 3};
AddrModeA := ModeA{DecBr};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "DIVS";
Op := {15, 8, 7, 6};
AddrModeA := ModeA{Rx911};
AddrModeB := ModeB{EA05b};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "DIVU";
Op := {15, 7, 6};
AddrModeA := ModeA{Rx911};
AddrModeB := ModeB{EA05b};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "EOR";
Op := {15, 13, 12};
AddrModeA := ModeA{OpM68X};
AddrModeB := ModeB{EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "EORI";
Op := {11, 9};
AddrModeA := ModeA{};
AddrModeB := ModeB{Size67, EA05e, Exten};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "EXG";
Op := {15, 14, 8};
AddrModeA := ModeA{OpM37};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "EXT";
Op := {14, 11};
AddrModeA := ModeA{OpM68S};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "ILLEGAL";
Op := {14, 11, 9, 7, 6, 5, 4, 3, 2};
AddrModeA := ModeA{};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "JMP";
Op := {14, 11, 10, 9, 7, 6};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05f};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "JSR";
Op := {14, 11, 10, 9, 7};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05f};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "LEA";
Op := {14, 8, 7, 6};
AddrModeA := ModeA{Rx911};
AddrModeB := ModeB{EA05f};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "LINK";
Op := {14, 11, 10, 9, 6, 4};
AddrModeA := ModeA{Ry02};
AddrModeB := ModeB{Exten};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "LSL";
Op := {15, 14, 13, 9, 8, 3};
AddrModeA := ModeA{CntR911};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "LSR";
Op := {15, 14, 13, 9, 3};
AddrModeA := ModeA{CntR911};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "MOVE";
Op := {};
AddrModeA := ModeA{};
AddrModeB := ModeB{Size1213A, EA611};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "MOVEA";
Op := {6};
AddrModeA := ModeA{Rx911};
AddrModeB := ModeB{Size1213, EA05a};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "MOVEM";
Op := {14, 11, 7};
AddrModeA := ModeA{};
AddrModeB := ModeB{Size6, EA05z, Exten};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "MOVEP";
Op := {3};
AddrModeA := ModeA{OpM68R};
AddrModeB := ModeB{Exten};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "MOVEQ";
Op := {14, 13, 12};
AddrModeA := ModeA{Data07};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "MULS";
Op := {15, 14, 8, 7, 6};
AddrModeA := ModeA{Rx911};
AddrModeB := ModeB{EA05b};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "MULU";
Op := {15, 14, 7, 6};
AddrModeA := ModeA{Rx911};
AddrModeB := ModeB{EA05b};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "NBCD";
Op := {14, 11};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "NEG";
Op := {14, 10};
AddrModeA := ModeA{};
AddrModeB := ModeB{Size67, EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "NEGX";
Op := {14};
AddrModeA := ModeA{};
AddrModeB := ModeB{Size67, EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "NOP";
Op := {14, 11, 10, 9, 6, 5, 4, 0};
AddrModeA := ModeA{};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "NOT";
Op := {14, 10, 9};
AddrModeA := ModeA{};
AddrModeB := ModeB{Size67, EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "OR";
Op := {15};
AddrModeA := ModeA{OpM68D};
AddrModeB := ModeB{EA05x};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "ORI";
Op := {};
AddrModeA := ModeA{};
AddrModeB := ModeB{Size67, EA05e, Exten};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "PEA";
Op := {14, 11, 6};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05f};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "RESET";
Op := {14, 11, 10, 9, 6, 5, 4};
AddrModeA := ModeA{};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "ROL";
Op := {15, 14, 13, 10, 9, 8, 4, 3};
AddrModeA := ModeA{CntR911};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "ROR";
Op := {15, 14, 13, 10, 9, 4, 3};
AddrModeA := ModeA{CntR911};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "ROXL";
Op := {15, 14, 13, 10, 8, 4};
AddrModeA := ModeA{CntR911};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "ROXR";
Op := {15, 14, 13, 10, 4};
AddrModeA := ModeA{CntR911};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "RTE";
Op := {14, 11, 10, 9, 6, 5, 4, 1, 0};
AddrModeA := ModeA{};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "RTR";
Op := {14, 11, 10, 9, 6, 5, 4, 2, 1, 0};
AddrModeA := ModeA{};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "RTS";
Op := {14, 11, 10, 9, 6, 5, 4, 2, 0};
AddrModeA := ModeA{};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "SBCD";
Op := {15, 8};
AddrModeA := ModeA{Rx911, RegMem3, Ry02};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "SCC";
Op := {14, 12, 10, 7, 6};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "SCS";
Op := {14, 12, 10, 8, 7, 6};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "SEQ";
Op := {14, 12, 10, 9, 8, 7, 6};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "SF";
Op := {14, 12, 8, 7, 6};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "SGE";
Op := {14, 12, 11, 10, 7, 6};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "SGT";
Op := {14, 12, 11, 10, 9, 7, 6};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "SHI";
Op := {14, 12, 9, 7, 6};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "SLE";
Op := {14, 12, 11, 10, 9, 8, 7, 6};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "SLS";
Op := {14, 12, 9, 8, 7, 6};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "SLT";
Op := {14, 12, 11, 10, 8, 7, 6};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "SMI";
Op := {14, 12, 11, 9, 8, 7, 6};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "SNE";
Op := {14, 12, 10, 9, 7, 6};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "SPL";
Op := {14, 12, 11, 9, 7, 6};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "ST";
Op := {14, 12, 7, 6};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "STOP";
Op := {14, 11, 10, 9, 6, 5, 4, 1};
AddrModeA := ModeA{};
AddrModeB := ModeB{Exten};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "SUB";
Op := {15, 12};
AddrModeA := ModeA{OpM68D};
AddrModeB := ModeB{EA05y};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "SUBA";
Op := {15, 12};
AddrModeA := ModeA{OpM68A};
AddrModeB := ModeB{EA05a};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "SUBI";
Op := {10};
AddrModeA := ModeA{};
AddrModeB := ModeB{Size67, EA05e, Exten};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "SUBQ";
Op := {14, 12, 8};
AddrModeA := ModeA{Data911};
AddrModeB := ModeB{Size67, EA05d};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "SUBX";
Op := {15, 12, 8};
AddrModeA := ModeA{Rx911, RegMem3, Ry02};
AddrModeB := ModeB{Size67};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "SVC";
Op := {14, 12, 11, 7, 6};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "SVS";
Op := {14, 12, 11, 8, 7, 6};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "SWAP";
Op := {14, 11, 6};
AddrModeA := ModeA{Ry02};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "TAS";
Op := {14, 11, 9, 7, 6};
AddrModeA := ModeA{};
AddrModeB := ModeB{EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "TRAP";
Op := {14, 11, 10, 9, 6};
AddrModeA := ModeA{Data03};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "TRAPV";
Op := {14, 11, 10, 9, 6, 5, 4, 2, 1};
AddrModeA := ModeA{};
AddrModeB := ModeB{};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "TST";
Op := {14, 11, 9};
AddrModeA := ModeA{};
AddrModeB := ModeB{Size67, EA05e};
END;
INC (i);
WITH Table68K[i] DO
Mnemonic := "UNLK";
Op := {14, 11, 10, 9, 6, 4, 3};
AddrModeA := ModeA{Ry02};
AddrModeB := ModeB{};
END;
IF Create (f, "OPCODE.DAT") # FileOK THEN
WriteString ("Unable to create OpCode File.");
WriteLn;
HALT;
END;
FOR i := FIRST TO LAST DO
WriteRec (f, Table68K[i]);
END;
IF Close (f) # FileOK THEN
WriteString ("Unable to close OpCode File.");
WriteLn;
END;
END InitOperationCodes.
----------------------------------------
IMPLEMENTATION MODULE CodeGenerator;
(* Uses information supplied by Parser, OperationCodes, *)
(* and SyntaxAnalyzer to produce the object code. *)
FROM Strings IMPORT
Length, CompareStr;
FROM SymbolTable IMPORT
FillSymTab, ReadSymTab;
FROM Parser IMPORT
TOKEN, OPERAND, OpLoc, SrcLoc, DestLoc;
FROM LongNumbers IMPORT
LONG, LongAdd, LongSub, LongInc, LongDec,
LongClear, CardToLong, LongToCard, LongToInt,
LongCompare, AddrBoundW, AddrBoundL;
FROM OperationCodes IMPORT
ModeTypeA, ModeTypeB, ModeA, ModeB, Instructions;
FROM ErrorX68 IMPORT
ErrorType, Error;
FROM SyntaxAnalyzer IMPORT
OpMode, Xtype, SizeType, OpConfig, Src, Dest,
Size, Op, AddrModeA, AddrModeB, InstSize,
GetValue, GetSize, GetInstModeSize, GetOperand, GetMultReg;
CONST
JMP = {14, 11, 10, 9, 7, 6};
JSR = {14, 11, 10, 9, 7};
RTE = {14, 11, 10, 9, 6, 5, 4, 1, 0};
RTR = {14, 11, 10, 9, 6, 5, 4, 2, 1, 0};
RTS = {14, 11, 10, 9, 6, 5, 4, 2, 0};
TRAPV = {14, 11, 10, 9, 6, 5, 4, 2, 1};
STOP = {14, 11, 10, 9, 6, 5, 4, 1};
LINK = {14, 11, 10, 9, 6, 4};
SWAP = {14, 11, 6};
UNLK = {14, 11, 10, 9, 6, 4, 3};
Quote = 47C;
VAR
(*---
(* Defined in DEFINITION MODULE *)
LZero, AddrCnt : LONG;
Pass2 : BOOLEAN;
---*)
AddrAdv : LONG;
TempL : LONG; (* Temporary variables *)
TempI : INTEGER;
TempC : CARDINAL;
BrValue : LONG; (* Used to calculate relative branches *)
RevBr : BOOLEAN;
PROCEDURE BuildSymTable (VAR AddrCnt : LONG;
Label, OpCode : TOKEN; SrcOp, DestOp : OPERAND);
(* Builds symbol table from symbolic information of Source File *)
VAR
Value : LONG;
Full : BOOLEAN;
PseudoOp : BOOLEAN;
BEGIN
Value := LZero;
AddrAdv := LZero;
InstSize := 0;
PseudoOp := FALSE;
Size := S0;
IF Length (OpCode) = 0 THEN
RETURN; (* Nothing added to symbol table, AddrCnt not changed *)
END;
GetSize (OpCode, Size);
IF CompareStr (OpCode, "ORG") = 0 THEN
GetValue (SrcOp, AddrCnt);
AddrBoundW (AddrCnt);
Value := AddrCnt;
PseudoOp := TRUE;
ELSIF CompareStr (OpCode, "EQU") = 0 THEN
GetValue (SrcOp, Value);
PseudoOp := TRUE;
ELSIF CompareStr (OpCode, "DC") = 0 THEN
CASE Size OF
Word : AddrBoundW (AddrCnt);
| Long : AddrBoundL (AddrCnt);
| Byte : ;
END;
IF SrcOp[0] = Quote THEN (* String Constant *)
TempC := Length (SrcOp);
IF TempC > 2 THEN
InstSize := TempC - 2;
END;
ELSE
InstSize := ORD (Size);
END;
CardToLong (InstSize, AddrAdv);
Value := AddrCnt;
PseudoOp := TRUE;
ELSIF CompareStr (OpCode, "DS") = 0 THEN
GetValue (SrcOp, AddrAdv);
Value := AddrCnt;
PseudoOp := TRUE;
ELSIF CompareStr (OpCode, "EVEN") = 0 THEN
AddrBoundW (AddrCnt);
Value := AddrCnt;
PseudoOp := TRUE;
ELSIF CompareStr (OpCode, "END") = 0 THEN
PseudoOp := TRUE;
ELSE
Value := AddrCnt;
END;
IF Length (Label) # 0 THEN
FillSymTab (Label, Value, Full);
IF Full THEN
Error (0, SymFull);
END;
END;
IF NOT PseudoOp THEN
Instructions (OpCode, OpLoc, Op, AddrModeA, AddrModeB);
AddrBoundW (AddrCnt);
Src.Loc := SrcLoc; Dest.Loc := DestLoc;
GetOperand (SrcOp, Src);
GetOperand (DestOp, Dest);
InstSize := 2; (* minimum size of instruction *)
IF Brnch IN AddrModeA THEN
IF Size # Byte THEN
INC (InstSize, 2);
END;
ELSIF DecBr IN AddrModeA THEN
INC (InstSize, 2);
ELSE
IF (Op = JMP) OR (Op = JSR) THEN (* Allows for 'JMP.S' *)
IF (Size = Byte) AND (Src.Mode = AbsL) THEN
Src.Mode := AbsW;
END;
END;
TempC := GetInstModeSize (Src.Mode, Size, InstSize);
TempC := GetInstModeSize (Dest.Mode, Size, InstSize);
END;
IF (Src.Mode = Imm) AND
((Data911 IN AddrModeA) OR (Data03 IN AddrModeA) OR
(Data07 IN AddrModeA) OR (CntR911 IN AddrModeA)) THEN
(* Quick instruction *)
InstSize := 2;
END;
CardToLong (InstSize, AddrAdv);
END;
END BuildSymTable;
PROCEDURE MergeModes (VAR SrcOp, DestOp : OPERAND;
VAR ObjOp, ObjSrc, ObjDest : LONG;
VAR nO, nS, nD : CARDINAL);
(* Uses information from Instructions & GetOperand (among others) *)
(* to complete calculation of Object Code. *)
(* Op, AddrModeA, AddrModeB, Size, and Src & Dest records are all *)
(* Global variables imported from the SyntaxAnalyzer MODULE. *)
CONST
(* BITSETs of the modes MISSING from effective address modes *)
ea = {}; (* Effective addressing - all modes *)
dea = {1}; (* Data effective addressing *)
mea = {1, 0}; (* Memory effective addressing *)
cea = {11, 4, 3, 1, 0}; (* Control effective addressing *)
aea = {11, 10, 9}; (* Alterable effective addressing *)
xxx = {15, 14, 13}; (* extra modes: CCR/SR/USP *)
(* 2 "AND" masks to turn off switch bits for shift/rotate *)
Off910 = {15, 14, 13, 12, 11, 8, 7, 6, 5, 4, 3, 2, 1, 0};
Off34 = {15, 14, 13, 12, 11, 10, 9, 8, 7, 6, 5, 2, 1, 0};
VAR
M : CARDINAL;
i : CARDINAL;
Ext : BITSET; (* Bit pattern for instruction extension word *)
ExtL : LONG;
Xext : BITSET;
Quick : BOOLEAN;
PROCEDURE OperExt (VAR EA : OpConfig);
(* Calculate Operand Extension word, and check range of Operands *)
VAR
GoodCard, GoodInt : BOOLEAN;
BEGIN
GoodCard := LongToCard (EA.Value, TempC);
GoodInt := LongToInt (EA.Value, TempI);
CASE EA.Mode OF
AbsL : ; (* No range checking needed *)
| AbsW : IF NOT GoodCard THEN
Error (EA.Loc, SizeErr);
END;
| ARDisp,
PCDisp : IF NOT GoodInt THEN
Error (EA.Loc, SizeErr);
END;
| ARDisX,
PCDisX : IF (TempI < -128) OR (TempI > 127) THEN
Error (EA.Loc, SizeErr);
END;
Xext := BITSET (EA.Xn * 4096);
IF EA.X = Areg THEN
Xext := Xext + {15};
END;
IF EA.Xsize = Long THEN
Xext := Xext + {11};
END;
CardToLong (CARDINAL (Xext), TempL);
EA.Value[3] := TempL[3];
EA.Value[4] := TempL[4];
| Imm : IF Size = Long THEN
(* No range check needed *)
ELSE
IF GoodInt THEN
IF Size = Byte THEN
IF (TempI < -128) OR (TempI > 127) THEN
Error (EA.Loc, SizeErr);
END;
END;
ELSE
Error (EA.Loc, SizeErr);
END;
END;
ELSE
(* No Action *)
END;
END OperExt;
PROCEDURE EffAdr (VAR EA : OpConfig; Bad : BITSET);
(* adds effective address field to Op (BITSET representing opcode) *)
VAR
M : CARDINAL;
i : CARDINAL;
Xext : BITSET;
BEGIN
M := ORD (EA.Mode);
IF M IN Bad THEN
Error (EA.Loc, ModeErr);
RETURN;
ELSIF M > 11 THEN
RETURN;
ELSIF M < 7 THEN
Op := Op + BITSET (M * 8) + BITSET (EA.Rn);
ELSE (* 7 <= M <= 11 *)
Op := Op + {5, 4, 3} + BITSET (M - 7);
END;
OperExt (EA);
END EffAdr;
BEGIN (* MergeModes *)
ExtL := LZero;
Quick := FALSE;
(* Check for 5 special cases first *)
IF (Op = RTE) OR (Op = RTR) OR (Op = RTS) OR (Op = TRAPV) THEN
IF Src.Mode # Null THEN
Error (SrcLoc, OperErr);
END;
END;
IF Op = STOP THEN
IF (Src.Mode # Imm) OR (Dest.Mode # Null) THEN
Error (SrcLoc, OperErr);
END;
END;
IF Op = LINK THEN
Op := Op + BITSET (Src.Rn);
IF (Src.Mode # ARDir) OR (Dest.Mode # Imm) THEN
Error (SrcLoc, ModeErr);
END;
END;
IF Op = SWAP THEN
IF EA05f IN AddrModeB THEN
(* Ignore, this is PEA instruction! *)
ELSE
Op := Op + BITSET (Src.Rn);
IF (Src.Mode # DReg) OR (Dest.Mode # Null) THEN
Error (SrcLoc, OperErr);
END;
END;
END;
IF Op = UNLK THEN
Op := Op + BITSET (Src.Rn);
IF (Src.Mode # ARDir) OR (Dest.Mode # Null) THEN
Error (SrcLoc, OperErr);
END;
END;
(* Now do generalized address modes *)
IF (Ry02 IN AddrModeA) AND (Rx911 IN AddrModeA) THEN
Op := Op + BITSET (Src.Rn) + BITSET (Dest.Rn * 512);
(* Now do some error checking! *)
IF RegMem3 IN AddrModeA THEN
IF Src.Mode = DReg THEN
IF Dest.Mode # DReg THEN
Error (DestLoc, ModeErr);
END;
ELSIF Src.Mode = ARPre THEN
Op := Op + {3};
IF Dest.Mode # ARPre THEN
Error (DestLoc, ModeErr);
END;
ELSE
Error (SrcLoc, OperErr);
END;
ELSE
IF Src.Mode = ARPost THEN
IF Dest.Mode # ARPost THEN
Error (DestLoc, ModeErr);
END;
ELSE
Error (SrcLoc, OperErr);
END;
END;
END;
IF Data911 IN AddrModeA THEN
Quick := TRUE;
IF Src.Mode = Imm THEN
IF LongToInt (Src.Value, TempI)
AND (TempI > 0)
AND (TempI <= 8) THEN
IF TempI < 8 THEN (* Data of 8 is coded as 000 *)
Op := Op + BITSET (TempI * 512);
END;
ELSE
Error (SrcLoc, SizeErr);
END;
ELSE
Error (SrcLoc, OperErr);
END;
END;
IF CntR911 IN AddrModeA THEN
(* Only Shift/Rotate use this *)
IF Dest.Mode = DReg THEN
Op := (Op * Off910) + BITSET (Dest.Rn);
CASE Size OF
Byte : ;
| Word : Op := Op + {6};
| Long : Op := Op + {7};
END;
IF Src.Mode = DReg THEN
Op := Op + {5} + BITSET (Src.Rn * 512);
ELSIF Src.Mode = Imm THEN
Quick := TRUE;
(* Range Check *)
IF LongToInt (Src.Value, TempI)
AND (TempI > 0)
AND (TempI <= 8) THEN
IF TempI < 8 THEN (* Data of 8 is coded as 000 *)
Op := Op + BITSET (TempI * 512);
END;
ELSE
Error (SrcLoc, SizeErr);
END;
ELSE
Error (SrcLoc, OperErr);
END;
ELSIF Dest.Mode = Null THEN
Op := (Op * Off34) + {7, 6};
EffAdr (Src, (mea + aea));
ELSE
Error (SrcLoc, OperErr);
END;
END;
IF Data03 IN AddrModeA THEN
Quick := TRUE;
IF Src.Mode = Imm THEN
IF LongToInt (Src.Value, TempI)
AND (TempI >= 0)
AND (TempI < 16) THEN
Op := Op + BITSET (TempI);
ELSE
Error (SrcLoc, SizeErr);
END;
ELSE
Error (SrcLoc, OperErr);
END;
END;
IF Data07 IN AddrModeA THEN
Quick := TRUE;
IF (Src.Mode = Imm) AND (Dest.Mode = DReg) THEN
IF LongToInt (Src.Value, TempI)
AND (TempI >= -128)
AND (TempI <= 127) THEN
Op := Op + (BITSET (TempI) * {7, 6, 5, 4, 3, 2, 1, 0})
+ BITSET (Dest.Rn * 512);
ELSE
Error (SrcLoc, SizeErr);
END;
ELSE
Error (SrcLoc, OperErr);
END;
END;
IF OpM68D IN AddrModeA THEN
IF Dest.Mode = DReg THEN
Op := Op + BITSET (Dest.Rn * 512);
IF (Src.Mode = ARDir) AND (Size = Byte) THEN
Error (SrcLoc, SizeErr);
END;
ELSE (* Assume Src.Mode = DReg -- Error trapped elsewhere *)
Op := Op + BITSET (Src.Rn * 512);
Op := Op + {8};
END;
CASE Size OF
Byte : ;
| Word : Op := Op + {6};
| Long : Op := Op + {7};
END;
END;
IF OpM68A IN AddrModeA THEN
IF Dest.Mode = ARDir THEN
Op := Op + BITSET (Dest.Rn * 512);
ELSE
Error (DestLoc, ModeErr);
END;
CASE Size OF
Byte : Error (OpLoc, SizeErr);
| Word : Op := Op + {7, 6};
| Long : Op := Op + {8, 7, 6};
END;
END;
IF OpM68C IN AddrModeA THEN
IF Dest.Mode = DReg THEN
Op := Op + BITSET (Dest.Rn * 512);
ELSE
Error (DestLoc, ModeErr);
END;
CASE Size OF
Byte : IF Src.Mode = ARDir THEN
Error (OpLoc, SizeErr);
END;
| Word : Op := Op + {6};
| Long : Op := Op + {7};
END;
END;
IF OpM68X IN AddrModeA THEN
IF Src.Mode = DReg THEN
Op := Op + BITSET (Src.Rn * 512);
ELSE
Error (SrcLoc, ModeErr);
END;
CASE Size OF
Byte : Op := Op + {8};
| Word : Op := Op + {8, 6};
| Long : Op := Op + {8, 7};
END;
END;
IF OpM68S IN AddrModeA THEN
IF Src.Mode = DReg THEN
Op := Op + BITSET (Src.Rn);
ELSE
Error (SrcLoc, ModeErr);
END;
CASE Size OF
Byte : Error (OpLoc, SizeErr);
| Word : Op := Op + {7};
| Long : Op := Op + {7, 6};
END;
END;
IF OpM68R IN AddrModeA THEN
IF (Src.Mode = DReg) AND (Dest.Mode = ARDisp) THEN
CASE Size OF
Byte : Error (OpLoc, SizeErr);
| Word : Op := Op + {8, 7};
| Long : Op := Op + {8, 7, 6};
END;
Op := Op + BITSET (Src.Rn * 512) + BITSET (Dest.Rn);
ELSIF (Src.Mode = ARDisp) AND (Dest.Mode = DReg) THEN
CASE Size OF
Byte : Error (OpLoc, SizeErr);
| Word : Op := Op + {8};
| Long : Op := Op + {8, 6};
END;
Op := Op + BITSET (Src.Rn) + BITSET (Dest.Rn * 512);
ELSE
Error (SrcLoc, ModeErr);
END;
END;
IF OpM37 IN AddrModeA THEN
IF (Src.Mode = DReg) AND (Dest.Mode = DReg) THEN
Op := Op + {6} + BITSET (Src.Rn * 512) + BITSET (Dest.Rn);
ELSIF (Src.Mode = ARDir) AND (Dest.Mode = ARDir) THEN
Op := Op + {6, 3} + BITSET (Src.Rn * 512) + BITSET (Dest.Rn);
ELSIF (Src.Mode = ARDir) AND (Dest.Mode = DReg) THEN
Op := Op + {7, 3} + BITSET (Dest.Rn * 512) + BITSET (Src.Rn);
ELSIF (Src.Mode = DReg) AND (Dest.Mode = ARDir) THEN
Op := Op + {7, 3} + BITSET (Src.Rn * 512) + BITSET (Dest.Rn);
ELSE
Error (SrcLoc, ModeErr);
END;
END;
IF Bit811 IN AddrModeB THEN
IF Src.Mode = DReg THEN
Op := Op + {8} + BITSET (Src.Rn * 512);
ELSIF Src.Mode = Imm THEN
Op := Op + {11};
ELSE
Error (SrcLoc, ModeErr);
END;
END;
IF Size67 IN AddrModeB THEN
CASE Size OF
Byte : ;(* No action -- bits already 0's *)
| Word : Op := Op + {6};
| Long : Op := Op + {7};
END;
END;
IF Size6 IN AddrModeB THEN
CASE Size OF
Byte : Error (OpLoc, SizeErr);
| Word : (* No Action -- BIT is already 0 *)
| Long : Op := Op + {6};
END;
END;
IF Size1213A IN AddrModeB THEN
CASE Size OF
Byte : Op := Op + {12};
| Word : Op := Op + {13, 12};
| Long : Op := Op + {13};
END;
END;
IF Size1213 IN AddrModeB THEN
Op := Op + BITSET (Dest.Rn * 512);
CASE Size OF
Byte : Error (OpLoc, SizeErr);
| Word : Op := Op + {13, 12};
| Long : Op := Op + {13};
END;
END;
IF EA05a IN AddrModeB THEN
IF (Dest.Mode = DReg) OR (Dest.Mode = ARDir) THEN
EffAdr (Src, ea);
ELSE
Error (DestLoc, ModeErr);
END;
END;
IF EA05b IN AddrModeB THEN
IF Dest.Mode = DReg THEN
EffAdr (Src, dea);
Op := Op + BITSET (Dest.Rn * 512);
ELSE
Error (DestLoc, ModeErr);
END;
END;
IF EA05c IN AddrModeB THEN
EffAdr (Dest, {11, 1});
END;
IF EA05d IN AddrModeB THEN
EffAdr (Dest, aea);
IF (Dest.Mode = ARDir) AND (Size = Byte) THEN
Error (OpLoc, SizeErr);
END;
END;
IF EA05e IN AddrModeB THEN
IF Dest.Mode = Null THEN
EffAdr (Src, (dea + aea));
ELSIF (Src.Mode = Imm) OR (Src.Mode = DReg) THEN
EffAdr (Dest, (dea + aea));
ELSE
Error (SrcLoc, ModeErr);
END;
END;
IF EA05f IN AddrModeB THEN (* LEA & PEA / JMP & JSR *)
EffAdr (Src, cea);
IF Rx911 IN AddrModeA THEN
IF Dest.Mode = ARDir THEN
Op := Op + BITSET (Dest.Rn * 512);
ELSE
Error (DestLoc, ModeErr);
END;
ELSE
IF Dest.Mode # Null THEN
Error (DestLoc, OperErr);
END;
END;
END;
IF EA05x IN AddrModeB THEN
IF Dest.Mode = DReg THEN
EffAdr (Src, dea);
ELSIF Src.Mode = DReg THEN
EffAdr (Dest, mea + aea);
ELSE
Error (SrcLoc, OperErr);
END;
END;
IF EA05y IN AddrModeB THEN
IF Dest.Mode = DReg THEN
EffAdr (Src, ea);
IF (Src.Mode = ARDir) AND (Size = Byte) THEN
Error (OpLoc, SizeErr);
END;
ELSIF Src.Mode = DReg THEN
EffAdr (Dest, (mea + aea));
ELSE
Error (SrcLoc, ModeErr);
END;
END;
IF EA05z IN AddrModeB THEN
IF Src.Mode = MultiM THEN
EffAdr (Dest, (mea + aea + {3}));
GetMultReg (SrcOp, (Dest.Mode = ARPre), SrcLoc, Ext);
ELSIF Dest.Mode = MultiM THEN
EffAdr (Src, (mea + {11, 4}));
GetMultReg (DestOp, (Src.Mode = ARPre), DestLoc, Ext);
Op := Op + {10}; (* set direction *)
ELSE
Error (SrcLoc, OperErr);
END;
INC (nO, 4); (* extension is part of OpCode *)
INC (InstSize, 2);
CardToLong (CARDINAL (Ext), ExtL);
END;
IF EA611 IN AddrModeB THEN
IF Dest.Mode = CCR THEN
Op := {14, 10, 7, 6};
EffAdr (Src, dea);
ELSIF Dest.Mode = SR THEN
Op := {14, 10, 9, 7, 6};
EffAdr (Src, dea);
ELSIF Src.Mode = SR THEN
Op := {14, 7, 6};
EffAdr (Dest, dea + aea);
ELSIF Dest.Mode = USP THEN
Op := {14, 11, 10, 9, 6, 5};
IF Src.Mode = ARDir THEN
Op := Op + BITSET (Src.Rn);
ELSE
Error (SrcLoc, ModeErr);
END;
ELSIF Src.Mode = USP THEN
Op := {14, 11, 10, 9, 6, 5, 3};
IF Dest.Mode = ARDir THEN
Op := Op + BITSET (Dest.Rn);
ELSE
Error (DestLoc, ModeErr);
END;
ELSE
EffAdr (Src, (ea + xxx));
IF (Size = Byte) AND (Src.Mode = ARDir) THEN
Error (SrcLoc, SizeErr);
END;
M := ORD (Dest.Mode);
IF (M IN (dea + aea)) OR (M > 11) THEN
Error (DestLoc, ModeErr);
ELSIF M < 7 THEN
Op := Op + BITSET (M * 64) + BITSET (Dest.Rn * 512);
ELSE (* 7 <= M <= 11 *)
Op := Op + {8, 7, 6} + BITSET ((M - 7) * 512);
END;
OperExt (Dest);
END;
END;
IF (Dest.Mode = CCR) AND (Src.Mode = Imm) THEN
IF (Size67 IN AddrModeB)
AND (EA05e IN AddrModeB)
AND (Exten IN AddrModeB) THEN
IF 10 IN Op THEN (* NOT ANDI/EORI/ORI *)
Error (DestLoc, ModeErr);
ELSE
Op := Op * {15, 14, 13, 12, 11, 10, 9, 8}; (* AND mask *)
Op := Op + {5, 4, 3, 2}; (* OR mask *)
END;
END;
END;
IF (Dest.Mode = SR) AND (Src.Mode = Imm) THEN
IF (Size67 IN AddrModeB)
AND (EA05e IN AddrModeB)
AND (Exten IN AddrModeB) THEN
IF 10 IN Op THEN (* NOT ANDI/EORI/ORI *)
Error (DestLoc, ModeErr);
ELSE
Op := Op * {15, 14, 13, 12, 11, 10, 9, 8}; (* AND mask *)
Op := Op + {6, 5, 4, 3, 2}; (* OR mask *)
END;
END;
END;
CardToLong (CARDINAL (Op), ObjOp);
INC (InstSize, 2);
INC (nO, 4);
IF nO > 4 THEN
FOR i := 1 TO 4 DO (* move ObjOp -- make room for extension *)
ObjOp[i + 4] := ObjOp[i];
ObjOp[i] := ExtL[i];
END;
END;
nS := GetInstModeSize (Src.Mode, Size, InstSize);
ObjSrc := Src.Value;
nD := GetInstModeSize (Dest.Mode, Size, InstSize);
ObjDest := Dest.Value;
IF Quick THEN
InstSize := 2;
nS := 0; nD := 0;
END;
CardToLong (InstSize, AddrAdv);
END MergeModes;
TYPE
DirType = (None, Org, Equ, DC, DS, Even, End);
PROCEDURE ObjDir (OpCode : TOKEN; SrcOp : OPERAND; Size : SizeType;
VAR AddrCnt, ObjOp, ObjSrc, ObjDest : LONG;
VAR nA, nO, nS, nD : CARDINAL) : DirType;
(* Generates Object Code for Assembler Directives *)
VAR
Dir : DirType;
i, j : CARDINAL;
LongString : ARRAY [1..20] OF INTEGER;
BEGIN
AddrAdv := LZero;
IF CompareStr (OpCode, "ORG") = 0 THEN
GetValue (SrcOp, AddrCnt);
AddrBoundW (AddrCnt);
Dir := Org;
ELSIF CompareStr (OpCode, "EQU") = 0 THEN
GetValue (SrcOp, ObjSrc);
nS := 8;
Dir := Equ;
ELSIF CompareStr (OpCode, "DC") = 0 THEN
CASE Size OF
Word : AddrBoundW (AddrCnt);
| Long : AddrBoundL (AddrCnt);
| Byte : ;
END;
IF SrcOp[0] = Quote THEN (* String constant *)
TempC := Length (SrcOp);
IF TempC > 2 THEN
InstSize := TempC - 2; (* Don't count the Quotes *)
END;
i := 1; j := 20;
WHILE i <= InstSize DO (* Change from ASCII to LONG *)
CardToLong (ORD (SrcOp[i]), TempL);
LongString[j] := TempL[2];
LongString[j - 1] := TempL[1];
INC (i); DEC (j, 2);
END;
i := 1; INC (j);
WHILE j <= 20 DO (* Left Justify String *)
LongString[i] := LongString[j];
INC (i); INC (j);
END;
DEC (i);
WHILE i > 16 DO (* Transfer 2 bytes to OpCode *)
ObjOp[i - 16] := LongString[i];
INC (nO); DEC (i);
END;
WHILE i > 8 DO (* Transfer 4 bytes to Source Operand *)
ObjSrc[i - 8] := LongString[i];
INC (nS); DEC (i);
END;
WHILE i > 0 DO (* Transfer 4 bytes to Destination Operand *)
ObjDest[i] := LongString[i];
INC (nD); DEC (i);
END;
IF SrcOp[InstSize + 1] # Quote THEN
Error ((SrcLoc + InstSize + 1), OperErr);
END;
ELSE (* not a string constant *)
GetValue (SrcOp, ObjSrc);
InstSize := ORD (Size);
nS := InstSize * 2;
END;
CardToLong (InstSize, AddrAdv);
nA := 6;
Dir := DC;
ELSIF CompareStr (OpCode, "DS") = 0 THEN
GetValue (SrcOp, AddrAdv);
nA := 6; nS := 2; ObjSrc := LZero;
Dir := DS;
ELSIF CompareStr (OpCode, "EVEN") = 0 THEN
AddrBoundW (AddrCnt);
Dir := Even;
ELSIF CompareStr (OpCode, "END") = 0 THEN
nA := 6;
Dir := End;
ELSE
Dir := None;
END;
RETURN (Dir);
END ObjDir;
PROCEDURE AdvAddrCnt (VAR AddrCnt : LONG);
(* Advances the address counter based on the length of the instruction *)
BEGIN
LongAdd (AddrCnt, AddrAdv, AddrCnt);
END AdvAddrCnt;
PROCEDURE GetObjectCode (Label, OpCode : TOKEN;
SrcOp, DestOp : OPERAND;
VAR AddrCnt, ObjOp, ObjSrc, ObjDest : LONG;
VAR nA, nO, nS, nD : CARDINAL);
(* Determines the object code for the operation as well as the operands *)
(* Returns each (up to 3 fields), along with the length of each. *)
VAR
Dummy : BOOLEAN;
Dir : DirType;
BEGIN
AddrAdv := LZero;
InstSize := 0;
nA := 0; nO := 0; nS := 0; nD := 0;
IF Length (OpCode) = 0 THEN
(* ensure no code generated *)
RETURN;
END;
GetSize (OpCode, Size);
Dir := ObjDir (OpCode, SrcOp, Size,
AddrCnt, ObjOp, ObjSrc, ObjDest,
nA, nO, nS, nD );
IF (Length (Label) # 0) AND (Dir # Equ) THEN
(* Check for phase error *)
Dummy := ReadSymTab (Label, TempL, Dummy);
IF LongCompare (TempL, AddrCnt) # 0 THEN
Error (0, Phase);
END;
END;
IF Dir = None THEN (* Instruction *)
AddrBoundW (AddrCnt);
ELSE
RETURN;
END;
Instructions (OpCode, OpLoc, Op, AddrModeA, AddrModeB);
Src.Loc := SrcLoc; Dest.Loc := DestLoc;
GetOperand (SrcOp, Src); (* Src & Dest are RECORDS *)
GetOperand (DestOp, Dest);
IF DecBr IN AddrModeA THEN (* Decrement & Branch *)
IF Src.Mode # DReg THEN
Error (SrcLoc, ModeErr);
END;
BrValue := Dest.Value;
TempL := AddrCnt;
TempC := 32767; (* Maximum Branch *)
LongInc (TempL, 2); (* move past instruction for Rel Adr Calc *)
IF LongCompare (BrValue, TempL) < 0 THEN
RevBr := TRUE;
LongSub (TempL, BrValue, BrValue);
INC (TempC); (* can branch 1 farther in reverse *)
ELSE
RevBr := FALSE;
LongSub (BrValue, TempL, BrValue);
END;
CardToLong (TempC, TempL); (* Maximum Branch distance *)
IF LongCompare (BrValue, TempL) > 0 THEN
Error (DestLoc, BraErr);
END;
IF RevBr THEN (* Make Negative *)
LongSub (LZero, BrValue, BrValue)
END;
CardToLong (4, AddrAdv);
nA := 6; nO := 4; nS := 4;
CardToLong (CARDINAL (Op + BITSET (Src.Rn)), ObjOp);
ObjSrc := BrValue;
RETURN;
END;
IF Brnch IN AddrModeA THEN (* Branch *)
BrValue := Src.Value; (* Destination of Branch *)
TempL := AddrCnt;
LongInc (TempL, 2);
IF Size # Byte THEN (* Byte Size ---> Short Branch *)
TempC := 32767; (* Set maximum branch distance *)
ELSE
TempC := 127;
END;
CASE LongCompare (BrValue, TempL) OF
-1 : (* Reverse Branch *)
RevBr := TRUE;
INC (TempC); (* can branch 1 farther in reverse *)
LongSub (TempL, BrValue, BrValue);
| +1 : (* Forward Branch *)
RevBr := FALSE;
LongSub (BrValue, TempL, BrValue);
| 0 : IF Size = Byte THEN
Error (SrcLoc, BraErr);
END;
END;
CardToLong (TempC, TempL);
IF LongCompare (BrValue, TempL) > 0 THEN
Error (SrcLoc, BraErr);
END;
IF RevBr THEN
LongSub (LZero, BrValue, BrValue); (* Make negative *)
END;
IF Size # Byte THEN
InstSize := 4;
nS := 4;
ObjSrc := BrValue;
ELSE
InstSize := 2;
Dummy := LongToInt (BrValue, TempI);
Op := Op + (BITSET (TempI) * {7, 6, 5, 4, 3, 2, 1, 0});
END;
nA := 6; nO := 4;
CardToLong (InstSize, AddrAdv);
CardToLong (CARDINAL (Op), ObjOp);
RETURN;
END;
nA := 6;
IF (Op = JMP) OR (Op = JSR) THEN (* Allows for 'JMP.S' *)
IF (Size = Byte) AND (Src.Mode = AbsL) THEN
Src.Mode := AbsW;
END;
END;
MergeModes (SrcOp, DestOp, ObjOp, ObjSrc, ObjDest, nO, nS, nD);
END GetObjectCode;
BEGIN (* MODULE Initialization *)
LongClear (LZero); (* Used as a constant *)
AddrCnt := LZero;
Pass2 := FALSE;
END CodeGenerator.
IMPLEMENTATION MODULE SyntaxAnalyzer;
(* Analyzes the operands to provide information for CodeGenerator *)
FROM Conversions IMPORT
StrToCard;
FROM Strings IMPORT
Length;
FROM LongNumbers IMPORT
LONG, LongAdd, LongSub, CardToLong, StringToLong;
FROM SymbolTable IMPORT
SortSymTab, ReadSymTab;
FROM ErrorX68 IMPORT
ErrorType, Error;
FROM Parser IMPORT
OPERAND, SrcLoc;
FROM CodeGenerator IMPORT
LZero, AddrCnt, Pass2; (* BOOLEAN Switch *)
CONST
Zero = 30H; (* The Ordinal value of the Character '0' *)
Seven = 37H; (* The Ordinal value of the Character '7' *)
Quote = 47C;
(*---
TYPE
OpMode = (DReg, (* Data Register *)
ARDir, (* Address Register Direct *)
ARInd, (* Address Register Indirect *)
ARPost, (* Address Register with Post-Increment *)
ARPre, (* Address Register with Pre-Decrement *)
ARDisp, (* Address Register with Displacement *)
ARDisX, (* Address Register with Disp. & Index *)
AbsW, (* Absolute Word (16-bit Address) *)
AbsL, (* Absolute Word (32-bit Address) *)
PCDisp, (* Program Counter Relative, with Displacement *)
PCDisX, (* Program Counter Relative, with Disp. & Index *)
Imm, (* Immediate *)
MultiM, (* Multiple Register Move *)
SR, (* Status Register *)
CCR, (* Condition Code Register *)
USP, (* User's Stack Pointer *)
Null); (* Error Condition, or Operand missing *)
Xtype = (X0, Dreg, Areg);
SizeType = (S0, Byte, Word, S3, Long);
OpConfig = RECORD (* OPERAND CONFIGURATION *)
Mode : OpMode;
Value : LONG;
Loc : CARDINAL; (* Location of Operand on line *)
Rn : CARDINAL; (* Register number *)
Xn : CARDINAL; (* Index Reg. nbr. *)
Xsize : SizeType; (* size of Index *)
X : Xtype; (* Is index Data or Address reg? *)
END;
VAR
Size : SizeType; (* size for OpCode *)
AbsSize : SizeType; (* size of operand (Absolute only) *)
InstSize : CARDINAL; (* Size of instruction, including operands *)
AddrModeA : ModeA; (* Addressing modes for this instruction *)
AddrModeB : ModeB; (* ditto *)
Op : BITSET; (* Raw bit pattern for OpCode *)
Src, Dest : OpConfig;
---*)
PROCEDURE CalcValue (Operand : OPERAND; VAR Value : LONG);
(* Calculates left and right values for GetValue *)
VAR
Full : BOOLEAN;
Neg : BOOLEAN;
Dup : BOOLEAN;
Num : CARDINAL;
NumSyms : CARDINAL;
BEGIN
IF Operand[0] = '-' THEN
Neg := TRUE;
Operand[0] := '0';
ELSE
Neg := FALSE;
END;
IF StrToCard (Operand, Num) THEN
(* It is a number *)
CardToLong (Num, Value);
IF Neg THEN
LongSub (LZero, Value, Value);
END;
ELSIF StringToLong (Operand, Value) THEN
(* It is a HEX number *)
ELSIF (Operand[0] = Quote) AND (Operand[2] = Quote) THEN
CardToLong (ORD (Operand[1]), Value);
ELSIF (Length (Operand) = 1) AND (Operand[0] = '*') THEN
Value := AddrCnt;
ELSE
(* It is a label, but may be undefined! *)
IF NOT Pass2 THEN
SortSymTab (NumSyms);
END;
IF NOT ReadSymTab (Operand, Value, Dup) THEN
Error (SrcLoc, Undef);
END;
IF Dup THEN
Error (SrcLoc, SymDup);
END;
END;
END CalcValue;
PROCEDURE GetValue (Operand : OPERAND; VAR Value : LONG);
(* determines value of operand (in Decimal, HEX, or via Symbol Table) *)
VAR
TempOp : OPERAND;
TempVal : LONG;
c, op : CHAR;
i, j : CARDINAL;
InQuotes : BOOLEAN;
BEGIN
i := 0;
Value := LZero;
InQuotes := FALSE;
op := '+';
REPEAT
j := 0;
LOOP
c := Operand[i];
TempOp[j] := c;
IF c = Quote THEN
InQuotes := NOT InQuotes;
END;
INC (i); INC (j);
IF c = 0C THEN
EXIT;
END;
IF (c = '+') AND (NOT InQuotes) THEN
EXIT;
END;
IF (c = '-') AND (i > 1) AND (NOT InQuotes) THEN
EXIT;
END;
END;
TempOp[j - 1] := 0C; (* in case c is +/- *)
CalcValue (TempOp, TempVal);
IF op = '-' THEN
LongSub (Value, TempVal, Value);
ELSE
LongAdd (Value, TempVal, Value);
END;
op := c;
UNTIL op = 0C;
END GetValue;
PROCEDURE GetSize (VAR Symbol : ARRAY OF CHAR; VAR Size : SizeType);
(* determines size of opcode/operand: Byte, Word, Long *)
VAR
i : CARDINAL;
c : CHAR;
BEGIN
i := 0;
REPEAT
c := Symbol[i];
INC (i);
UNTIL (c = 0C) OR (c = '.');
IF c = 0C THEN
Size := Word; (* Default to size Word = 16 bits *)
ELSE
c := Symbol[i]; (* Record size extension *)
Symbol[i - 1] := 0C; (* Chop size extension off *)
IF (c = 'B') OR (c = 'S') THEN (* Byte or Short Branch/Jump *)
Size := Byte;
ELSIF c = 'L' THEN
Size := Long;
ELSE
Size := Word; (* Default size *)
END;
END;
END GetSize;
PROCEDURE GetAbsSize (VAR Symbol : ARRAY OF CHAR; VAR AbsSize : SizeType);
(* determines size of operand: Word or Long *)
VAR
i : CARDINAL;
c : CHAR;
ParCnt : INTEGER;
BEGIN
ParCnt := 0;
i := 0;
REPEAT
c := Symbol[i];
IF c = '(' THEN
INC (ParCnt);
END;
IF c = ')' THEN
DEC (ParCnt);
END;
INC (i);
UNTIL (c = 0C) OR ((c = '.') AND (ParCnt = 0));
IF c = 0C THEN
AbsSize := Long;
ELSE
c := Symbol[i]; (* Record size extension *)
Symbol[i - 1] := 0C; (* Chop size extension off *)
IF (c = 'W') OR (c = 'S') THEN
AbsSize := Word;
ELSE
AbsSize := Long;
END;
END;
END GetAbsSize;
PROCEDURE GetInstModeSize (Mode : OpMode; Size : SizeType;
VAR InstSize : CARDINAL) : CARDINAL;
(* Determines the size for the various instruction modes. *)
VAR
n : CARDINAL;
BEGIN
CASE Mode OF
ARDisp,
ARDisX,
PCDisp,
PCDisX,
AbsW : n := 2;
| AbsL : n := 4;
| MultiM : IF Pass2 THEN
n := 0; (* accounted for by code generator *)
ELSE
n := 2;
END;
| Imm : IF Size = Long THEN
n := 4;
ELSE
n := 2;
END;
ELSE
n := 0;
END;
INC (InstSize, n);
RETURN (n * 2);
END GetInstModeSize;
PROCEDURE GetOperand (Oper : OPERAND; VAR Op : OpConfig);
(* Finds mode and value for source or destination operand *)
VAR
ch : CHAR;
C : CARDINAL; (* holds the ordinal value of a charcter *)
i, j : CARDINAL;
Len : CARDINAL; (* Calculated Length of Oper *)
TempOp : OPERAND;
MultFlag : BOOLEAN;
BEGIN
Op.Mode := Null; Op.X := X0;
Len := Length (Oper);
IF Len = 0 THEN
RETURN;
END;
GetAbsSize (Oper, AbsSize);
IF Oper[0] = '#' THEN (* Immediate *)
IF Pass2 THEN
i := 0;
REPEAT
INC (i);
Oper[i - 1] := Oper[i];
UNTIL Oper[i] = 0C;
GetValue (Oper, Op.Value);
END;
Op.Mode := Imm;
RETURN;
END;
IF Len = 2 THEN (* possible Addr or Data Register *)
C := ORD (Oper[1]);
IF (Oper[0] = 'S') AND (Oper[1] = 'R') THEN
(* Status Register *)
Op.Mode := SR;
RETURN;
ELSIF (Oper[0] = 'S') AND (Oper[1] = 'P') THEN
(* Stack Pointer *)
Op.Mode := ARDir;
Op.Rn := 7;
RETURN;
ELSIF (C >= Zero) AND (C <= Seven) THEN
(* Looks Like an Addr or Data Reg *)
IF Oper[0] = 'A' THEN (* Address Register *)
Op.Mode := ARDir;
Op.Rn := C - Zero;
RETURN;
ELSIF Oper[0] = 'D' THEN (* Data Register *)
Op.Mode := DReg;
Op.Rn := C - Zero;
RETURN;
ELSE
(* may be a label -- ignore for now *)
END;
ELSE
(* may be a label -- ignore for now *)
END;
END;
IF Len = 3 THEN
IF (Oper[0] = 'C') AND (Oper[1] = 'C') AND (Oper[2] = 'R') THEN
(* Condition Code Register *)
Op.Mode := CCR;
RETURN;
ELSIF (Oper[0] = 'U') AND (Oper[1] = 'S') AND (Oper[2] = 'P') THEN
(* User's Stack Pointer *)
Op.Mode := USP;
RETURN;
ELSE
(* may be a label -- ignore for now *)
END;
END;
IF (Len = 4) AND (Oper[0] = '(') AND (Oper[3] = ')') THEN
IF (Oper[1] = 'S') AND (Oper[2] = 'P') THEN
Op.Mode := ARInd;
Op.Rn := 7;
RETURN;
ELSIF Oper[1] = 'A' THEN
C := ORD (Oper[2]);
IF (C >= Zero) AND (C <= Seven) THEN
Op.Mode := ARInd;
Op.Rn := C - Zero;
RETURN;
ELSE
Error (Op.Loc, SizeErr);
RETURN;
END;
ELSE
Error (Op.Loc, AddrErr);
RETURN;
END;
END;
IF (Len = 5) AND (Oper[0] = '(')
AND (Oper[3] = ')') AND (Oper[4] = '+') THEN
(* Address Indirect with Post Inc *)
IF (Oper[1] = 'S') AND (Oper[2] = 'P') THEN
(* System Stack Pointer *)
Op.Mode := ARPost;
Op.Rn := 7;
RETURN
ELSIF Oper[1] = 'A' THEN
C := ORD (Oper[2]);
IF (C >= Zero) AND (C <= Seven) THEN
Op.Mode := ARPost;
Op.Rn := C - Zero;
RETURN;
ELSE
Error (Op.Loc, SizeErr);
RETURN;
END;
ELSE
Error (Op.Loc, AddrErr);
RETURN;
END;
END;
IF (Len = 5) AND (Oper[0] = '-')
AND (Oper[1] = '(') AND (Oper[4] = ')') THEN
IF (Oper[2] = 'S') AND (Oper[3] = 'P') THEN
(* System Stack Pointer *)
Op.Mode := ARPre;
Op.Rn := 7;
RETURN;
ELSIF Oper[2] = 'A' THEN
C := ORD (Oper[3]);
IF (C >= Zero) AND (C <= Seven) THEN
Op.Mode := ARPre;
Op.Rn := C - Zero;
RETURN;
ELSE
Error (Op.Loc, SizeErr);
RETURN;
END;
ELSE
Error (Op.Loc, AddrErr);
RETURN;
END;
END;
(* Try to split off displacement (if present) *)
i := 0;
ch := Oper[i];
WHILE (ch # '(') AND (ch # 0C) DO (* move to TempOp *)
TempOp[i] := ch;
INC (i);
ch := Oper[i];
END;
TempOp[i] := 0C; (* Displacement (it it exists) now in TempOp *)
IF ch = '(' THEN (* looks like a displacement mode *)
IF Pass2 THEN
GetValue (TempOp, Op.Value); (* Value of Disp. *)
END;
j := 0;
REPEAT (* put rest of operand (eg. (An,Xi) in TempOp *)
ch := Oper[i];
TempOp[j] := ch;
INC (i); INC (j);
UNTIL ch = 0C;
IF Length (TempOp) > 4 THEN (* Index may be present *)
i := 4; (* Index starts at 4 *)
j := 0;
REPEAT (* put Xi in Oper *)
ch := TempOp[i];
Oper[j] := ch;
INC (i); INC (j);
UNTIL ch = 0C;
IF Oper[j - 2] = ')' THEN
Oper[j - 2] := 0C;
ELSE
Error (Op.Loc, AddrErr);
RETURN;
END;
GetSize (Oper, Op.Xsize);
IF Op.Xsize = Byte THEN
Error (Op.Loc, SizeErr);
RETURN;
END;
C := ORD (Oper[1]);
IF (Oper[0] = 'S') AND (Oper[1] = 'P') THEN
(* Stack Pointer *)
Op.X := Areg;
Op.Xn := 7;
ELSIF Oper[0] = 'A' THEN
IF (C >= Zero) AND (C <= Seven) THEN
Op.X := Areg;
Op.Xn := C - Zero;
ELSE
Error (Op.Loc, SizeErr);
RETURN;
END;
ELSIF Oper[0] = 'D' THEN
IF (C >= Zero) AND (C <= Seven) THEN
Op.X := Dreg;
Op.Xn := C - Zero;
ELSE
Error (Op.Loc, SizeErr);
RETURN;
END;
ELSE
Error (Op.Loc, AddrErr);
RETURN;
END;
IF (TempOp[1] = 'P') AND (TempOp[2] = 'C') THEN
Op.Mode :=PCDisX;
RETURN;
ELSIF (TempOp[1] = 'S') AND (TempOp[2] = 'P') THEN
(* Stack Pointer *)
Op.Rn := 7;
Op.Mode := ARDisX;
RETURN;
ELSIF TempOp[1] = 'A' THEN
C := ORD (TempOp[2]);
IF (C >= Zero) AND (C <= Seven) THEN
Op.Rn := C - Zero;
Op.Mode := ARDisX;
RETURN;
ELSE
Error (Op.Loc, SizeErr);
RETURN;
END;
ELSE
Error (Op.Loc, AddrErr);
RETURN;
END;
ELSE (* No Index *)
IF (TempOp[1] = 'P') AND (TempOp[2] = 'C') THEN
Op.Mode := PCDisp;
RETURN;
ELSIF (TempOp[1] = 'S') AND (TempOp[2] = 'P') THEN
(* Stack Pointer *)
Op.Mode := ARDisp;
Op.Rn := 7;
RETURN;
ELSIF TempOp[1] = 'A' THEN
C := ORD (TempOp[2]);
IF (C >= Zero) AND (C <= Seven) THEN
Op.Rn := C - Zero;
Op.Mode := ARDisp;
RETURN;
ELSE
Error (Op.Loc, SizeErr);
RETURN;
END;
ELSE
Error (Op.Loc, AddrErr);
RETURN;
END;
END;
END;
(* Check to see if this could be a register list for MOVEM: *)
i := 0;
MultFlag := FALSE;
LOOP
ch := Oper[i]; INC (i);
IF ch = 0C THEN
MultFlag := FALSE;
EXIT;
END;
IF (ch = 'A') OR (ch = 'D') THEN
ch := Oper[i]; INC (i); C := ORD (ch);
IF ch = 0C THEN
MultFlag := FALSE;
EXIT;
END;
IF (C >= Zero) AND (C <= Seven) THEN
ch := Oper[i]; INC (i);
IF ch = 0C THEN
EXIT
END;
IF (ch = '/') OR (ch = '-') THEN
MultFlag := TRUE;
END;
ELSE
MultFlag := FALSE;
EXIT;
END;
ELSE
MultFlag := FALSE;
EXIT;
END;
END;
IF MultFlag THEN
Op.Mode := MultiM;
RETURN;
END;
(* Must be absolute mode! *)
IF Pass2 THEN
GetValue (Oper, Op.Value);
END;
IF AbsSize = Word THEN
Op.Mode := AbsW;
ELSE
Op.Mode := AbsL;
END;
END GetOperand;
PROCEDURE GetMultReg (Oper : OPERAND; PreDec : BOOLEAN;
Loc : CARDINAL; VAR MultExt : BITSET);
(* Builds a BITSET marking each register used in a MOVEM instruction *)
TYPE
MReg = (D0, D1, D2, D3, D4, D5, D6, D7,
A0, A1, A2, A3, A4, A5, A6, A7);
VAR
i, j : CARDINAL;
ch : CHAR;
C : CARDINAL; (* ORD value of ch *)
T1, T2 : MReg; (* Temporary variables for registers *)
RegStack : ARRAY [0..15] OF MReg; (* Holds specified registers *)
SP : CARDINAL; (* Pointer for Register Stack *)
RegType : (D, A, Nil);
Range : BOOLEAN;
BEGIN
SP := 0;
Range := FALSE;
RegType := Nil;
i := 0;
ch := Oper[i];
WHILE ch # 0C DO
IF SP > 15 THEN
Error (Loc, SizeErr);
RETURN;
END;
C := ORD (ch);
IF ch = 'A' THEN
IF RegType = Nil THEN
RegType := A;
ELSE
Error (Loc, OperErr);
RETURN;
END;
ELSIF ch = 'D' THEN
IF RegType = Nil THEN
RegType := D;
ELSE
Error (Loc, OperErr);
RETURN;
END;
ELSIF (C >= Zero) AND (C <= Seven) THEN
IF RegType # Nil THEN
T2 := VAL (MReg, (ORD (RegType) * 8) + (C - Zero));
IF Range THEN
Range := FALSE;
T1 := RegStack[SP - 1]; (* retreive 1st Reg in range *)
FOR j := (ORD (T1) + 1) TO ORD (T2) DO
RegStack[SP] := VAL (MReg, j);
INC (SP);
END;
ELSE
RegStack[SP] := T2;
INC (SP);
END;
ELSE
Error (Loc, OperErr);
RETURN;
END;
ELSIF ch = '-' THEN
IF (Range = FALSE) AND (RegType # Nil) AND (i > 0) THEN
RegType := Nil;
Range := TRUE;
ELSE
Error (Loc, OperErr);
RETURN;
END;
ELSIF ch = '/' THEN
IF (Range = FALSE) AND (RegType # Nil) AND (i > 0) THEN
RegType := Nil;
ELSE
Error (Loc, OperErr);
RETURN;
END;
ELSE
Error (Loc, OperErr);
RETURN;
END;
INC (i);
ch := Oper[i];
END;
MultExt := {};
FOR j := 0 TO SP - 1 DO
C := ORD (RegStack[j]);
IF PreDec THEN
C := 15 - C;
END;
INCL (MultExt, C);
END;
END GetMultReg;
END SyntaxAnalyzer.
IMPLEMENTATION MODULE Listing;
(* Creates a program listing, including Addresses, Code & Source. *)
FROM Files IMPORT
FILE, Write;
FROM LongNumbers IMPORT
LONG, LongPut;
FROM Parser IMPORT
TOKEN, Line;
FROM SymbolTable IMPORT
ListSymTab;
FROM Conversions IMPORT
CardToStr;
IMPORT ASCII;
CONST
LnMAX = 55;
VAR
LnCnt : CARDINAL; (* counts number of lines per page *)
PgCnt : CARDINAL; (* count of page numbers *)
PROCEDURE WriteStrF (f : FILE; Str : ARRAY OF CHAR);
(* Writes a string to the file *)
VAR
i : CARDINAL;
BEGIN
i := 0;
WHILE Str[i] # 0C DO
Write (f, Str[i]);
INC (i);
END;
END WriteStrF;
PROCEDURE CheckPage (f : FILE);
(* Checks if end of page reached yet -- if so, advances to next page. *)
VAR
i : CARDINAL;
PgCntStr : ARRAY [0..6] OF CHAR;
BEGIN
INC (LnCnt);
IF LnCnt >= LnMAX THEN
LnCnt := 1;
INC (PgCnt);
Write (f, ASCII.ff); (* Form Feed for new page *)
IF CardToStr (PgCnt, PgCntStr) THEN (* Print New Page Number *)
FOR i := 1 TO 60 DO
Write (f, ' ');
END;
WriteStrF (f, "Page ");
WriteStrF (f, PgCntStr);
END;
FOR i := 1 TO 3 DO
Write (f, ASCII.cr);
Write (f, ASCII.lf);
END;
END;
END CheckPage;
PROCEDURE StartListing (f : FILE);
(* Sign on messages for listing file -- initialize *)
BEGIN
Write (f, ASCII.ff); (* Start on a clean page *)
WriteStrF (f, " 68000 Cross Assembler");
Write (f, ASCII.cr);
Write (f, ASCII.lf);
WriteStrF (f, " Copyright (c) 1985 by Brian R. Anderson");
Write (f, ASCII.cr);
Write (f, ASCII.lf);
Write (f, ASCII.cr);
Write (f, ASCII.lf);
LnCnt := 1;
PgCnt := 1;
END StartListing;
PROCEDURE WriteListLine (f : FILE;
AddrCnt, ObjOp, ObjSrc, ObjDest : LONG;
nA, nO, nS, nD : CARDINAL);
(* Writes one line to the Listing file, Including Object Code *)
CONST
ObjMAX = 30;
VAR
i : CARDINAL;
BEGIN
IF nA = 0 THEN (* nA is always either 0 or 6. Address field = 8 *)
FOR i := 1 TO 8 DO
Write (f, ' ');
END;
ELSE
LongPut (f, AddrCnt, 6);
Write (f, ' ');
Write (f, ' ');
END;
LongPut (f, ObjOp, nO);
LongPut (f, ObjSrc, nS);
LongPut (f, ObjDest, nD);
i := 8 + nO + nS + nD;
WHILE i < ObjMAX DO
Write (f, ' ');
INC (i);
END;
WriteStrF (f, Line);
Write (f, ASCII.cr);
Write (f, ASCII.lf);
CheckPage (f);
END WriteListLine;
PROCEDURE WriteSymTab (f : FILE; NumSym : CARDINAL);
(* Lists symbol table in alphabetical order *)
VAR
Label : TOKEN;
Value : LONG;
i : CARDINAL;
BEGIN
LnCnt := 1;
INC (PgCnt);
WriteStrF (f, " * * * Symbolic Reference Table * * *");
FOR i := 1 TO 3 DO
Write (f, ASCII.cr);
Write (f, ASCII.lf);
END;
FOR i := 1 TO NumSym DO
ListSymTab (i, Label, Value);
WriteStrF (f, Label);
WriteStrF (f, " : ");
LongPut (f, Value, 8);
Write (f, ASCII.cr);
Write (f, ASCII.lf);
CheckPage (f);
END;
Write (f, ASCII.ff);
END WriteSymTab;
END Listing.
IMPLEMENTATION MODULE Srecord;
(* Creates Motorola S-records of program: *)
(* S0 = header record, *)
(* S2 = code/data records (24 bit address), *)
(* S8 = termination record (24 bit address). *)
FROM Files IMPORT
FILE, Write;
FROM Strings IMPORT
Length;
FROM LongNumbers IMPORT
LONG, LongAdd, LongSub, LongInc, LongDec, LongClear,
LongCompare, CardToLong, LongPut;
IMPORT ASCII;
CONST
CountMAX = 16;
SrecMAX = CountMAX * 2;
XrecMAX = SrecMAX;
VAR
StartAddr : LONG; (* address that record starts on *)
TempAddr : LONG; (* running address of where we are now *)
CheckSum : LONG;
Count : CARDINAL; (* count of HEX-pairs in S-record *)
Sdata : ARRAY [1..SrecMAX] OF INTEGER; (* S-record data, HEX digits *)
Sindex : CARDINAL; (* index for Sdata array *)
Xdata : ARRAY [1..XrecMAX] OF INTEGER; (* Overflow for Sdata *)
Xindex : CARDINAL; (* index for Xdata array *)
Boundary : BOOLEAN; (* marks Address MOD 16 boundary of S-record *)
LZero : LONG; (* used as a constant = 0 *)
PROCEDURE Complement; (* CheckSum *)
BEGIN
LongSub (LZero, CheckSum, CheckSum); (* 2's Complement *)
LongDec (CheckSum, 1); (* Make it 1's Complement *)
END Complement;
PROCEDURE AppendSdata (Data : LONG; n : CARDINAL) : BOOLEAN;
(* Transfers data to Sdata, and updates Count & CheckSum. *)
(* If no room: Data goes to Xdata & FALSE returned. *)
VAR
T : LONG; (* temporary -- used only as a 2 digit HEX number *)
BEGIN
T := LZero;
WHILE (n # 0) AND (Count # CountMAX) AND (NOT Boundary) DO
Sdata[Sindex] := Data[n];
Sdata[Sindex - 1] := Data[n - 1];
T[2] := Data[n]; T[1] := Data[n - 1];
LongAdd (T, CheckSum, CheckSum);
DEC (n, 2);
DEC (Sindex, 2);
INC (Count);
LongInc (TempAddr, 1);
IF TempAddr[1] = 0 THEN (* i.e., TempAddr MOD 16 = 0 *)
Boundary := TRUE;
END;
END;
IF (Count = CountMAX) OR (Boundary) THEN
WHILE n > 0 DO (* Add Data to Xdata (in reverse) *)
INC (Xindex);
Xdata[Xindex] := Data[n];
DEC (n);
END;
RETURN FALSE; (* Sdata is full *)
ELSE
RETURN TRUE;
END;
END AppendSdata;
PROCEDURE DumpSdata (f : FILE);
(* Writes an S2 record to the file *)
VAR
T : LONG; (* temporary -- used to output Count & CheckSum *)
i, j : CARDINAL;
BEGIN
IF Count = 0 THEN
RETURN; (* nothing to dump *)
END;
Write (f, 'S');
Write (f, '2');
CardToLong (Count + 4, T); (* extra for Address & Checksum *)
LongPut (f, T, 2);
LongAdd (T, CheckSum, CheckSum); (* Add Count to CheckSum *)
LongPut (f, StartAddr, 6);
(* Add Address to CheckSum *)
T := LZero;
T[1] := StartAddr[1]; T[2] := StartAddr[2];
LongAdd (T, CheckSum, CheckSum);
T[1] := StartAddr[3]; T[2] := StartAddr[4];
LongAdd (T, CheckSum, CheckSum);
T[1] := StartAddr[5]; T[2] := StartAddr[6];
LongAdd (T, CheckSum, CheckSum);
IF Count < CountMAX THEN (* adjust short record -- shuffle down *)
j := 1;
FOR i := Sindex + 1 TO SrecMAX DO
Sdata[j] := Sdata[i];
INC (j);
END;
END;
LongPut (f, Sdata, Count * 2); (* S-record Code/Data *)
Complement; (* CheckSum *)
LongPut (f, CheckSum, 2);
Write (f, ASCII.cr);
Write (f, ASCII.lf);
LongInc (StartAddr, Count);
Sindex := SrecMAX;
Count := 0;
Boundary := FALSE;
CheckSum := LZero;
END DumpSdata;
PROCEDURE GetXdata;
(* Transfer Xdata into new Sdata line -- N.B.: Xdata stored in reverse *)
VAR
i : CARDINAL;
T : LONG;
BEGIN
i := 1;
T := LZero;
(* No need for either of the tests (CountMAX or Boundary) *)
(* used in AppendSdata. GetXdata is only ever called *)
(* after DumpSdata and is therefore only putting (up to 20) *)
(* HEX digits in an empty buffer (which could hold 32). *)
WHILE i < Xindex DO
Sdata[Sindex] := Xdata[i];
Sdata[Sindex - 1] := Xdata[i + 1];
T[2] := Sdata[Sindex]; T[1] := Sdata[Sindex - 1];
LongAdd (T, CheckSum, CheckSum);
INC (i, 2);
DEC (Sindex, 2);
INC (Count);
LongInc (TempAddr, 1);
END;
Xindex := 0;
END GetXdata;
PROCEDURE StartSrec (f : FILE; SourceFN : ARRAY OF CHAR);
(* Writes S0 record (HEADER) and initializes *)
VAR
T : LONG; (* temporary *)
i : CARDINAL;
BEGIN
Write (f, 'S');
Write (f, '0');
CheckSum := LZero;
Count := Length (SourceFN) + 3; (* extra for Address & Checksum *)
CardToLong (Count, T);
LongPut (f, T, 2);
LongAdd (T, CheckSum, CheckSum);
LongPut (f, LZero, 4); (* Address is 4 digit, all zero, for S0 *)
i := 0;
WHILE SourceFN[i] # 0C DO
CardToLong (ORD (SourceFN[i]), T);
LongAdd (T, CheckSum, CheckSum);
LongPut (f, T, 2);
INC (i);
END;
Complement; (* CheckSum *)
LongPut (f, CheckSum, 2);
Write (f, ASCII.cr);
Write (f, ASCII.lf);
Sindex := SrecMAX;
Xindex := 0;
Count := 0;
Boundary := FALSE;
CheckSum := LZero;
StartAddr := LZero;
TempAddr := LZero;
END StartSrec;
PROCEDURE WriteSrecLine (f : FILE;
AddrCnt, ObjOp, ObjSrc, ObjDest : LONG;
nA, nO, nS, nD : CARDINAL);
(* Collects Object Code -- Writes an S2 record to file if line is full *)
VAR
dummy : BOOLEAN;
BEGIN
IF nA = 0 THEN
RETURN; (* Nothing to add to S-record *)
END;
IF Xindex # 0 THEN
GetXdata; (* transfers Xdata into Sdata *)
END;
IF LongCompare (AddrCnt, TempAddr) # 0 THEN
DumpSdata (f);
END;
IF Count = 0 THEN
StartAddr := AddrCnt;
TempAddr := AddrCnt;
END;
dummy := AppendSdata (ObjOp, nO);
dummy := AppendSdata (ObjSrc, nS);
IF NOT AppendSdata (ObjDest, nD) THEN
DumpSdata (f);
END;
END WriteSrecLine;
PROCEDURE EndSrec (f : FILE);
(* Finishes off any left-over (Partial) S2 line, *)
(* and then writes S8 record (TRAILER) *)
BEGIN
IF Xindex # 0 THEN
GetXdata;
END;
DumpSdata (f);
Write (f, 'S'); (* Fixed format for S8 record *)
Write (f, '8');
Write (f, '0');
Write (f, '4');
Write (f, '0');
Write (f, '0');
Write (f, '0');
Write (f, '0');
Write (f, '0');
Write (f, '0');
Write (f, 'F');
Write (f, 'C');
Write (f, ASCII.cr);
Write (f, ASCII.lf);
Write (f, ASCII.cr);
Write (f, ASCII.lf);
END EndSrec;
BEGIN (* Initialization *)
LongClear (LZero);
END Srecord.
IMPLEMENTATION MODULE ErrorX68;
(* Displays error messages for X68000 cross assembler *)
FROM Terminal IMPORT
WriteString, WriteLn;
IMPORT Terminal; (* for Read/Write *)
FROM Files IMPORT
FILE;
IMPORT Files; (* for Write *)
FROM Strings IMPORT
Length;
FROM Conversions IMPORT
CardToStr;
IMPORT ASCII;
FROM Parser IMPORT
Line, LineCount;
(*---
TYPE
ErrorType = (Dummy, TooLong, NoCode, SymDup, Undef, SymFull, Phase,
ModeErr, OperErr, BraErr, AddrErr, SizeErr, EndErr);
VAR
ErrorCount : CARDINAL;
---*)
VAR
FirstTime : BOOLEAN;
PROCEDURE FileWriteString (f : FILE; VAR Str : ARRAY OF CHAR);
VAR
i : CARDINAL;
BEGIN
i := 0;
WHILE Str[i] # 0C DO
Files.Write (f, Str[i]);
INC (i);
END;
END FileWriteString;
PROCEDURE Error (Pos : CARDINAL; ErrorNbr : ErrorType);
(* Displays Error #ErrorNbr, then waits for any key to continue *)
VAR
i : CARDINAL;
c : CHAR;
CntStr : ARRAY [0..6] OF CHAR;
dummy : BOOLEAN;
BEGIN
WriteLn;
dummy := CardToStr (LineCount, CntStr);
WriteString (CntStr);
WriteString (" ");
WriteString (Line); WriteLn;
(* Make up for LineCnt so ^ in right spot *)
FOR i := 1 TO Length (CntStr) DO
Terminal.Write (' ');
END;
WriteString (" ");
IF Pos > 0 THEN
FOR i := 1 TO Pos DO
Terminal.Write (' ');
END;
Terminal.Write ('^'); WriteLn;
END;
CASE ErrorNbr OF
TooLong : WriteString ("Identifier too long -- Truncated!");
| NoCode : WriteString ("No such op-code.");
| SymDup : WriteString ("Duplicate Symbol.");
| Undef : WriteString ("Undefined Symbol.");
| SymFull : WriteString ("Symbol Table Full -- Maximum = 500!");
WriteLn;
WriteString ("Program Terminated."); WriteLn;
HALT;
| Phase : WriteString ("Pass 1/Pass 2 Address Count Mis-Match.");
| ModeErr : WriteString ("This addressing mode not allowed here.");
| OperErr : WriteString ("Error in operand format.");
| BraErr : WriteString ("Error in relative branch.");
| AddrErr : WriteString ("Address mode error.");
| SizeErr : WriteString ("Operand size error.");
| EndErr : WriteString ("Missing END Pseudo-Op.");
ELSE
WriteString ("Unknown Error.");
END;
WriteLn;
IF FirstTime THEN
WriteString ("Hit any key to continue.... ");
Terminal.Read (c);
WriteLn;
FirstTime := FALSE;
ELSE
Terminal.Read (c);
END;
INC (ErrorCount);
IF ErrorCount > 500 THEN
WriteString ("Too many errors!"); WriteLn;
WriteString ("Program Terminated."); WriteLn;
HALT;
END;
END Error;
PROCEDURE WriteErrorCount (f : FILE);
(* Error count output to Console & Listing file *)
VAR
CntStr : ARRAY [0..6] OF CHAR;
Msg0 : ARRAY [0..25] OF CHAR;
Msg1 : ARRAY [0..10] OF CHAR;
Msg2 : ARRAY [0..20] OF CHAR;
dummy : BOOLEAN;
BEGIN
Msg0 := "---> END OF ASSEMBLY";
Msg1 := "---> ";
Msg2 := " ASSEMBLY ERROR(S).";
dummy := CardToStr (ErrorCount, CntStr);
(* Messages to console *)
WriteLn;
WriteLn;
WriteString (Msg0); WriteLn;
WriteString (Msg1);
WriteString (CntStr);
WriteString (Msg2);
WriteLn;
(* Messages to listing file *)
Files.Write (f, ASCII.cr);
Files.Write (f, ASCII.lf);
Files.Write (f, ASCII.cr);
Files.Write (f, ASCII.lf);
FileWriteString (f, Msg0);
Files.Write (f, ASCII.cr);
Files.Write (f, ASCII.lf);
FileWriteString (f, Msg1);
FileWriteString (f, CntStr);
FileWriteString (f, Msg2);
Files.Write (f, ASCII.cr);
Files.Write (f, ASCII.lf);
Files.Write (f, ASCII.ff); (* feed up next page *)
END WriteErrorCount;
BEGIN (* MODULE Initialization *)
FirstTime := TRUE;
ErrorCount := 0;
END ErrorX68.
