Модуль MacroGen.

interface

uses

Expr, Strings, SysUtils, Forms, Windows;

const

MAX_MACRO_DESC = 32;

MAX_MACRO_DEF_STR = 1024;

MAX_MARKS = $FF;

MAX_STR_ARRAY_LEN = $FF;

MAX_LOCALS = 32;

MAX_SRC_LEN = 1024;

MAX_OUTPUT_LEN = $FFFF;

MAX_JUMPS = $FF;

MAX_LEVEL = $FF;

MAX_CONFIGS = 4096;

LOCAL_MAX_VAL = 4095;

LOCAL_MIN_VAL = -4096;

NUM_ERR_TYPES = 46;

NUM_ASM_COM = 8;

NUM_MACRO_COM = 8;

NUM_PARAM_SEPARATORS = 10;

BAD_INDEX = -1;

NORM_RESULT = 0;

ERR_END_NOT_FOUND = 1;

ERR_DUP_MDEF_NAME = 2;

ERR_BAD_MDEF_NAME = 3;

ERR_UNCLOSED_MDEF = 4;

ERR_BAD_ACTUAL_PARAMS = 5;

ERR_BAD_FORMAL_PARAMS = 6;

ERR_DUP_MARK_NAME = 7;

ERR_LOCAL_NOT_FOUND = 8;

ERR_MACRO_DEF_NOT_FOUND = 9;

ERR_BAD_ASM_MARK_NAME = 10;

ERR_BAD_PARAM_NAME = 11;

ERR_PARAM_VAL_NOT_SET = 12;

ERR_PARAMS_MISMATCH = 13;

ERR_NOT_ENOUGH_PARAMS = 14;

ERR_OPERANDS_MISMATCH = 15;

ERR_LOCAL_AFTER_COM = 16;

ERR_LOCAL_HAS_MACRO_MARK = 17;

ERR_BAD_SET_SYNTAX = 18;

ERR_ASM_MARK_IN_MACRO = 19;

ERR_INFINITE_LOOP_FOUND = 20;

ERR_ENDW_NOT_EXPECTED = 21;

ERR_COMMON_SYNTAX = 22;

ERR_TOO_DEEP_LEVEL = 23;

ERR_BAD_IF_SYNTAX = 24;

ERR_BAD_WHILE_SYNTAX = 25;

ERR_BAD_AIF_SYNTAX = 26;

ERR_LOCAL_OUT_OF_RANGE = 27;

ERR_BAD_MACRO_MARK_NAME = 28;

ERR_TOO_BIG_PROGRAMM = 29;

ERR_TOO_MANY_MARKS = 30;

ERR_TOO_MANY_PARAMS = 31;

ERR_MACRO_MARK_NOT_FOUND = 32;

ERR_ASM_MARK_NOT_FOUND = 33;

ERR_MEND_NOT_EXPECTED = 34;

ERR_DUP_LOCALS = 35;

ERR_TOO_MANY_JUMPS = 36;

ERR_MACROSTUFF_OUTSIDE = 37;

ERR_TOO_MANY_CONFIGS = 38;

ERR_MACRO_CALL_IN_MACRO = 39;

ERR_ASM_MARK_IN_LOOP = 40;

ERR_DESC: array [0..NUM_ERR_TYPES - 1] of string =

('Директива END не найдена',

'Дублирование имен макросов',

'Неверно задано имя макроса',

'Незавершенное макроопределение',

'Неверно заданы фактические параметры макровызова',

'Неверно заданы формальные параметры макроопределения',

'Дублирование имён меток',

'Локальная переменная не определена',

'Макроопределение не найдено',

'Неверно задано имя ассемблерной метки',

'Неверно задано имя параметра',

'Значение параметра не задано',

'Несоответствие фактических и формальных параметров',

'Недостаточно фактических параметров',

'Неверное количество операндов у оператора',

'Команда LOCAL должна располагаться в начале макроопределения',

'Команда LOCAL не может иметь макрометки',

'Неверный синтаксис оператора SET',

'Обнаружена ассемблерная метка внутри макроса',

'Обнаружен бесконечный цикл',

'Оператор ENDW не является ожидаемым',

'Неверный синтасис команды',

'Превышен предел уровня вложенности управляющих команд',

'Неверный синтаксис в операторе IF',

'Неверный синтаксис в операторе WHILE',

'Неверный синтаксис в операторе AIF',

'Значение локальной переменной вне допустимого диапазона',

'Неверно задано имя макрометки',

'Превышен предел объёма результирующего кода',

'Превышен предел допустимого количества меток',

'Превышен предел допустимого количества параметров макроса',

'Макрометка не найдена',

'Ассемблерная метка не найдена',

'Оператор MEND не является ожидаемым',

'Дублирование имён локальных переменных',

'Слишком много переходов в макроопределении',

'Обнаружена макрокоманда или макрометка вне макроопределения',

'Превышено предельное количество конфигураций',

'Обнаружен макровызов внутри макроса',

'Обнаружена ассемблерная метка внутри цикла',

'Неверный порядок скобок в выражении',

'Количества открывающих и закрывающих скобок не соответствуют друг другу',

'Неверный тип операнда в выражении',

'Пропущен операнд в выражении',

'Неверный тип операции в выражении',

'Значение операнда вне допустимого диапазона');

type

TComType = (tMACRO, tMEND, tLOCAL, tSET, tINC, tDEC, tAIF, tAGO, tMACRO_CALL, tASM_COM, tUNKNOWN);

TMacroCom = record

name,

expectedWord : string;

comType : TComType;

minNumOperands,

maxNumOperands : byte;

end;

TMacroMark = record

name : string;

addr : integer;

end;

TAsmMark = record

name,

newName : string;

isFound : boolean;

end;

TMacroDesc = record

name,

formalParams : string;

startAddr,

endAddr : integer;

end;

TParamPair = record

name, val: string;

end;

TResult = record

code : byte;

additionalInfo : string;

end;

TJump = record

srcAddr,

destAddr : integer;

end;

TJumpStackElem = record

comType : TComType;

jumpIndex : integer;

end;

TParamConfig = record

strN : integer;

vals : array [0..MAX_LOCALS - 1] of integer;

end;

TMacroDefStr = record

str : string;

isDone : boolean;

end;

const

ASM_COM: array [0..NUM_ASM_COM - 1] of string = ('MOV', 'JUMP', 'START', 'ADD', 'BYTE', 'WORD', 'NOP', 'END');

MACRO_COM: array [0..NUM_MACRO_COM - 1] of TMacroCom =

((name: 'MACRO'; expectedWord: ''; comType: tMACRO; minNumOperands: 0; maxNumOperands: 1),

(name: 'MEND'; expectedWord: ''; comType: tMEND; minNumOperands: 0; maxNumOperands: 0),

(name: 'LOCAL'; expectedWord: ''; comType: tLOCAL; minNumOperands: 1; maxNumOperands: 1),

(name: 'SET'; expectedWord: '='; comType: tSET; minNumOperands: 2; maxNumOperands: 2),

(name: 'INC'; expectedWord: ''; comType: tINC; minNumOperands: 1; maxNumOperands: 1),

(name: 'DEC'; expectedWord: ''; comType: tDEC; minNumOperands: 1; maxNumOperands: 1),

(name: 'AIF'; expectedWord: 'AGO'; comType: tAIF; minNumOperands: 2; maxNumOperands: 2),

(name: 'AGO'; expectedWord: ''; comType: tAGO; minNumOperands: 1; maxNumOperands: 1));

COMMON_SEPARATOR = ' ';

OPERAND_SEPARATOR = ' ,()=!<>+-\*';

PARAM_SEPARATOR = ',';

MACRO_DEF_SYMBOL = '$';

MACRO_MARK_SYMBOL = '#';

ASM_MARK_SYMBOL = '@';

UNIQUE_ASM_MARK_SYMBOL = '.';

PARAM_SYMBOL = '&';

MACRO_MARK_FORBIDDEN_SYMBOLS = ' &$,.;"()=!<>+-\*|#@';

ASM_MARK_FORBIDDEN_SYMBOLS = ' &$,.;"()=!<>+-\*|#';

PARAM_FORBIDDEN_SYMBOLS = ' &$,.;"()=!<>+-\*|#@';

DIGITS = '0123456789';

type

TStrArray = array [0..MAX_STR_ARRAY_LEN - 1] of string;

function doFirstStep(code: array of string; numStr: integer): TResult;

function doSecondStep(code: array of string; numStr: integer): TResult;

procedure suspend;

procedure resume;

procedure setSuspendable(isSuspendable: boolean);

procedure breakProcess;

procedure getCurrMacroMarks(var marks: array of TMacroMark; var numMarks: integer);

procedure getCurrLocals(var locals: array of TParamPair; var numLocals: integer);

procedure getCurrOutput(var output: array of string; var numOutputStr: integer);

procedure getCurrMacroDef(var macroDef: array of TMacroDefStr; var numMacroDefStr: integer);

procedure getCurrMacroDesc(var macroDesc: array of TMacroDesc; var numMacroDesc: integer);

function getCurrStrNum: integer;

function inMacroCall: boolean;

function isCorrectName(name: string; startSymbol, forbiddenSymbols: string): boolean;

implementation

var

numMacroDefStr,

numMacroDesc,

numParamConfigs,

numCurrMarks,

numCurrLocals,

numCurrOutputStr,

currStrNum,

markCounter : integer;

isInMacroCall,

isBroken,

isSuspendable,

isSuspended : boolean;

macroDef : array [0..MAX_MACRO_DEF_STR - 1] of TMacroDefStr;

macroDesc : array [0..MAX_MACRO_DESC - 1] of TMacroDesc;

paramConfig : array [0..MAX_CONFIGS - 1] of TParamConfig;

currMarks : array [0..MAX_MARKS - 1] of TMacroMark;

currLocals : array [0..MAX_LOCALS - 1] of TParamPair;

currOutput : array [0..MAX_OUTPUT_LEN - 1] of string;

procedure suspend;

begin

if (isSuspendable) then

begin

isSuspended := true;

while (isSuspended) do

begin

application.ProcessMessages;

end;

end;

end;

procedure resume;

begin

isSuspended := false;

end;

procedure setSuspendable(isSuspendable: boolean);

begin

MacroGen.isSuspendable := isSuspendable;

end;

procedure breakProcess;

begin

resume;

isSuspendable := false;

isBroken := true;

end;

procedure getCurrMacroMarks(var marks: array of TMacroMark; var numMarks: integer);

var

i: integer;

begin

for i := 0 to numCurrMarks - 1 do

begin

marks[i] := currMarks[i];

end;

numMarks := numCurrMarks;

end;

procedure getCurrLocals(var locals: array of TParamPair; var numLocals: integer);

var

i: integer;

begin

for i := 0 to numCurrLocals - 1 do

begin

locals[i] := currLocals[i];

end;

numLocals := numCurrLocals;

end;

procedure getCurrOutput(var output: array of string; var numOutputStr: integer);

var

i: integer;

begin

for i := 0 to numCurrOutputStr - 1 do

begin

output[i] := currOutput[i];

end;

numOutputStr := numCurrOutputStr;

end;

procedure getCurrMacroDef(var macroDef: array of TMacroDefStr; var numMacroDefStr: integer);

var

i: integer;

begin

for i := 0 to MacroGen.numMacroDefStr do

begin

macroDef[i] := MacroGen.macroDef[i];

end;

numMacroDefStr := MacroGen.numMacroDefStr;

end;

procedure getCurrMacroDesc(var macroDesc: array of TMacroDesc; var numMacroDesc: integer);

var

i: integer;

begin

for i := 0 to MacroGen.numMacroDesc do

begin

macroDesc[i] := MacroGen.macroDesc[i];

end;

numMacroDesc := MacroGen.numMacroDesc;

end;

function getCurrStrNum: integer;

begin

result := currStrNum;

end;

function inMacroCall: boolean;

begin

result := isInMacroCall;

end;

procedure updateCurrMarks(marks: array of TMacroMark; numMarks: integer);

var

i: integer;

begin

for i := 0 to numMarks - 1 do

begin

currMarks[i] := marks[i];

end;

numCurrMarks := numMarks;

end;

procedure updateCurrLocals(locals: array of TParamPair; numLocals: integer);

var

i: integer;

begin

for i := 0 to numLocals - 1 do

begin

currLocals[i] := locals[i];

end;

numCurrLocals := numLocals;

end;

procedure updateCurrOutput(output: array of string; numOutputStr: integer);

var

i: integer;

begin

for i := 0 to numOutputStr - 1 do

begin

currOutput[i] := output[i];

end;

numCurrOutputStr := numOutputStr;

end;

procedure initFirstStep;

begin

numMacroDefStr := 0;

numMacroDesc := 0;

markCounter := 0;

isBroken := false;

end;

procedure initMacroCall(var macroMarks: array of TMacroMark;

var locals: array of TParamPair;

var numMacroMarks, numLocals: integer);

begin

numMacroMarks := 0;

numLocals := 0;

end;

function getMDIndex(macroName: string): integer;

var

i: integer;

begin

result := BAD_INDEX;

for i := 0 to numMacroDesc - 1 do

begin

if (macroName = macroDesc[i].name) then

begin

result := i;

exit;

end;

end;

end;

function getMacroMarkIndex(markName: string; marks: array of TMacroMark;

numMarks: integer): integer;

var

i: integer;

begin

result := BAD_INDEX;

for i := 0 to numMarks - 1 do

begin

if (ansiUpperCase(markName) = marks[i].name) then

begin

result := i;

exit;

end;

end;

end;

function getAsmMarkIndex(markName: string; marks: array of TAsmMark;

numMarks: integer): integer;

var

i: integer;

begin

result := BAD_INDEX;

for i := 0 to numMarks - 1 do

begin

if (ansiUpperCase(markName) = ansiUpperCase(marks[i].name)) then

begin

result := i;

exit;

end;

end;

end;

function getLocalIndex(localName: string; locals: array of TParamPair;

numLocals: integer): integer;

var

i: integer;

begin

result := BAD_INDEX;

for i := 0 to numLocals - 1 do

begin

if (locals[i].name = localName) then

begin

result := i;

exit;

end;

end;

end;

function getJumpIndex(jumpSrcAddr: integer; jumps: array of TJump;

numJumps: integer): integer;

var

i: integer;

begin

result := BAD_INDEX;

for i := 0 to numJumps - 1 do

begin

if (jumps[i].srcAddr = jumpSrcAddr) then

begin

result := i;

exit;

end;

end;

end;

function getComType(comName: string): TComType;

var

i: integer;

begin

result := tUNKNOWN;

for i := 0 to NUM_MACRO_COM - 1 do

begin

if (comName = MACRO_COM[i].name) then

begin

result := TComType(i);

exit;

end;

end;

for i := 0 to NUM_ASM_COM - 1 do

begin

if (comName = ASM_COM[i]) then

begin

result := tASM_COM;

exit;

end;

end;

end;

function isAsmCom(comType: TComType): boolean;

begin

result := (comType = tASM_COM);

end;

function isMacroCom(comType: TComType): boolean;

begin

result := (comType < tMACRO_CALL);

end;

function isCorrectName(name: string; startSymbol, forbiddenSymbols: string): boolean;

var

i : integer;

hasForbSymb : boolean;

firstPart,

secondPart : string;

begin

result := true;

if (name <> '') then

begin

firstPart := copy(name, 1, length(startSymbol));

secondPart := copy(name, length(startSymbol) + 1, length(name) - length(startSymbol));

hasForbSymb := false;

for i := 1 to length(secondPart) do

begin

if (pos(secondPart[i], forbiddenSymbols) <> 0) then

begin

hasForbSymb := true;

break;

end;

end;

if ((isAsmCom(getComType(name))) or (isMacroCom(getComType(name))) or

(pos(name[1], DIGITS) <> 0) or

((startSymbol <> '') and (firstPart <> startSymbol)) or

(hasForbSymb)) then

begin

result := false;

exit;

end;

end;

end;

function substituteLocals(var str: string; locals: array of TParamPair;

numLocals: integer): TResult;

var

i, charPos: integer;

begin

result.code := NORM_RESULT;

if (str = '') then

exit;

for i := 0 to numLocals - 1 do

begin

replaceLexems(str, locals[i].Name, locals[i].Val, OPERAND_SEPARATOR);

end;

charPos := pos(PARAM_SYMBOL, str);

if (charPos <> 0) then

begin

result.code := ERR_LOCAL_NOT_FOUND;

result.additionalInfo := getNextLexem(str, charPos, OPERAND_SEPARATOR);

end;

end;

function getParamPair(const paramStr: string; var paramPair: TParamPair): TResult;

var

charPos: integer;

begin

result.code := NORM_RESULT;

charPos := 1;

paramPair.name := trim(ansiUpperCase(getNextLexem(paramStr, charPos, '=')));

inc(charPos);

paramPair.val := trim(ansiUpperCase(getNextLexem(paramStr, charPos, '')));

if (not isCorrectName(paramPair.name, PARAM_SYMBOL, PARAM_FORBIDDEN_SYMBOLS)) then

begin

result.code := ERR_BAD_PARAM_NAME;

result.additionalInfo := paramPair.name;

exit;

end;

end;

procedure extractCommand(srcStr: string; var macroMarkName, macroCallName, asmMarkName: string; var comType: TComType;

var operand1, operand2: string);

var

firstComType,

secondComType,

thirdComType : TComType;

firstLexem,

secondLexem,

thirdLexem,

currLexem : string;

i,

comPos,

charPos,

prevCharPos : integer;

operands : array [0..1] of string;

begin

macroMarkName := '';

macroCallName := '';

asmMarkName := '';

operand1 := '';

operand2 := '';

comType := tUNKNOWN;

charPos := 1;

firstLexem := getNextLexem(srcStr, charPos, COMMON_SEPARATOR);

firstComType := getComType(AnsiUpperCase(firstLexem));

secondLexem := getNextLexem(srcStr, charPos, COMMON_SEPARATOR);

secondComType := getComType(AnsiUpperCase(secondLexem));

thirdLexem := getNextLexem(srcStr, charPos, COMMON_SEPARATOR);

thirdComType := getComType(AnsiUpperCase(thirdLexem));

comPos := -1;

if (firstComType <> tUNKNOWN) then

begin

comPos := 0;

comType := firstComType;

end else

if (secondComType <> tUNKNOWN) then

begin

comPos := 1;

comType := secondComType;

end else

if (thirdComType <> tUNKNOWN) then

begin

comPos := 2;

comType := thirdComType;

end;

if (comPos >= 0) then

begin

case comPos of

0: ;

1: begin

if (firstLexem[1] = MACRO_MARK_SYMBOL) then

macroMarkName := firstLexem

else

if (firstLexem[1] = MACRO_DEF_SYMBOL) then

macroMarkName := firstLexem

else

if (firstLexem[1] = ASM_MARK_SYMBOL) then

asmMarkName := firstLexem

else

comType := tUNKNOWN;

end;

2: begin

macroMarkName := firstLexem;

asmMarkName := secondLexem;

end;

end;

end else

begin

comType := tMACRO_CALL;

if ((secondLexem <> '') and (isCorrectName(secondLexem, MACRO_DEF_SYMBOL, MACRO_MARK_FORBIDDEN_SYMBOLS))) then

begin

macroMarkName := firstLexem;

macroCallName := secondLexem;

end else

if (isCorrectName(firstLexem, MACRO_DEF_SYMBOL, MACRO_MARK_FORBIDDEN_SYMBOLS)) then

macroCallName := firstLexem

else begin

if (isCorrectName(firstLexem, ASM_MARK_SYMBOL, ASM_MARK_FORBIDDEN_SYMBOLS)) then

begin

if (secondLexem = '') then // an empty asm command (only asm mark)

begin

asmMarkName := firstLexem;

comType := tASM_COM;

end else

comType := tUNKNOWN; // an asm mark cannot be before unknown command,

// so the entire string is unrecognized

end else

comType := tUNKNOWN;

end;

end;

// start to skip mark's and comand's lexems, because operands are located after it

charPos := 1;

if (macroMarkName <> '') then

getNextLexem(srcStr, charPos, COMMON_SEPARATOR); // skip a macro mark

if (asmMarkName <> '') then

getNextLexem(srcStr, charPos, COMMON_SEPARATOR); // skip an asm mark

if (macroCallName <> '') then

getNextLexem(srcStr, charPos, COMMON_SEPARATOR); // etc.

if (comType <> tMACRO_CALL) then

getNextLexem(srcStr, charPos, COMMON_SEPARATOR);

if (comType < tASM_COM) then

begin

operands[0] := '';

operands[1] := '';

for i := 0 to 1 do

begin

if (i = 0) then

prevCharPos := pos(ansiUpperCase(MACRO_COM[ord(comType)].expectedWord), ansiUpperCase(srcStr));

if ((i > 0) or (prevCharPos = 0)) then

begin

operands[i] := ansiUpperCase(getNextLexem(srcStr, charPos, ''));

break;

end else

begin

operands[i] := copy(srcStr, charPos, prevCharPos - charPos);

charPos := prevCharPos + length(MACRO_COM[ord(comType)].expectedWord);

end;

end;

operand1 := trim(ansiUpperCase(operands[0]));

operand2 := trim(ansiUpperCase(operands[1]));

end else

operand1 := ansiUpperCase(getNextLexem(srcStr, charPos, ''));

end;

function checkValBounds(val: integer): TResult;

begin

if ((val >= LOCAL_MIN_VAL) and (val <= LOCAL_MAX_VAL)) then

result.code := NORM_RESULT

else begin

result.code := ERR_LOCAL_OUT_OF_RANGE;

result.additionalInfo := result.additionalInfo + '; допустимый диапазон значений: '

+ intToStr(LOCAL_MIN_VAL) + '..' + intToStr(LOCAL_MAX_VAL);

end;

end;

function getParams(paramStr: string; var err: TResult; var numParams: byte;

locals: array of TParamPair; numLocals: integer): TStrArray;

var

currParamPair : TParamPair;

exprErr : byte;

i,

charPos,

paramVal : integer;

currLexem,

currStr,

errSubStr : string;

begin

err.code := NORM_RESULT;

err.additionalInfo := paramStr;

numParams := 0;

charPos := 1;

while (charPos <= length(paramStr)) do

begin

if (numParams = MAX_LOCALS) then

begin

err.code := ERR_TOO_MANY_PARAMS;

err.additionalInfo := paramStr;

exit;

end;

currLexem := trim(getNextLexem(paramStr, charPos, PARAM_SEPARATOR));

result[numParams] := currLexem;

inc(numParams);

end;

for i := 0 to numParams - 1 do

begin

currStr := result[i];

err := getParamPair(currStr, currParamPair);

if (err.code <> NORM_RESULT) then

exit;

err := substituteLocals(currParamPair.val, locals, numLocals);

if (err.code <> NORM_RESULT) then

exit;

result[i] := currParamPair.name;

if (currParamPair.val <> '') then

begin

paramVal := tryEvalExpr(currParamPair.val, exprErr, errSubStr);

if (exprErr <> NORM_EXPR) then

begin

err.code := exprErr;

err.additionalInfo := errSubStr;

exit;

end;

err := checkValBounds(paramVal);

if (err.code <> NORM_RESULT) then

exit;

result[i] := result[i] + '=' + intToStr(paramVal);

end;

end;

end;

function checkCommonSyntax(macroMarkName, macroCallName, asmMarkName: string; comType: TComType; operand1, operand2: string): TResult;

var

charPos : integer;

currLexem : string;

numFoundOperands,

macroComIndex : byte;

begin

result.code := NORM_RESULT;

if ((comType = tUNKNOWN) or ((comType < tASM_COM) and (asmMarkName <> ''))) then

begin

result.code := ERR_COMMON_SYNTAX;

result.additionalInfo := 'нераспознанная команда';

exit;

end;

if ((macroMarkName <> '') and

(macroMarkName[1] = MACRO_MARK_SYMBOL) and

(not isCorrectName(macroMarkName, MACRO_MARK_SYMBOL, MACRO_MARK_FORBIDDEN_SYMBOLS))) then

begin

result.code := ERR_BAD_MACRO_MARK_NAME;

result.additionalInfo := macroMarkName;

exit;

end;

if (not isCorrectName(macroCallName, MACRO_DEF_SYMBOL, MACRO_MARK_FORBIDDEN_SYMBOLS)) then

begin

result.code := ERR_BAD_MDEF_NAME;

result.additionalInfo := macroMarkName;

exit;

end;

if (not isCorrectName(asmMarkName, ASM_MARK_SYMBOL, ASM_MARK_FORBIDDEN_SYMBOLS)) then

begin

result.code := ERR_BAD_ASM_MARK_NAME;

result.additionalInfo := asmMarkName;

exit;

end;

numFoundOperands := 0;

if ((comType < tASM_COM) and (comType <> tMACRO_CALL)) then

begin

macroComIndex := ord(comType);

if (operand1 <> '') then

inc(numFoundOperands);

if (operand2 <> '') then

inc(numFoundOperands);

if ((numFoundOperands < MACRO_COM[macroComIndex].minNumOperands) or

(numFoundOperands > MACRO_COM[macroComIndex].maxNumOperands)) then

begin

result.code := ERR_OPERANDS_MISMATCH;

result.additionalInfo := MACRO_COM[macroComIndex].name + ' ожидается минимум ' + intToStr(MACRO_COM[macroComIndex].minNumOperands) +

' параметров и максимум ' + intToStr(MACRO_COM[macroComIndex].maxNumOperands) + ' параметров';

end;

end else

if (comType = tASM_COM) then

begin

// no macro marks and macro commands after an asm command

charPos := 1;

currLexem := '';

repeat

currLexem := getNextLexem(operand1, charPos, COMMON_SEPARATOR);

if (currLexem = '') then

break;

if (isMacroCom(getComType(currLexem))) then

begin

result.code := ERR_COMMON_SYNTAX;

result.additionalInfo := 'обнаружена макрокоманда "' + currLexem + '" после команды ассемблера';

exit;

end;

if (isCorrectName(currLexem, MACRO_MARK_SYMBOL, MACRO_MARK_FORBIDDEN_SYMBOLS)) then

begin

result.code := ERR_COMMON_SYNTAX;

result.additionalInfo := 'обнаружена макрометка "' + currLexem + '" после команды ассемблера';

exit;

end;

until (currLexem = '');

end;

end;

function processMacroDefs(code: array of string; startAddr, endAddr: integer;

var isEndFound: boolean): TResult;

var

MDefProcess : boolean;

comType : TComType;

i, level,

markIndex : integer;

currStr,

macroMarkName,

macroCallName,

asmMarkName,

operand1,

operand2 : string;

begin

result.code := NORM_RESULT;

MDefProcess := false;

isEndFound := false;

level := 0;

for i := startAddr to endAddr do

begin

currStr := trim(code[i]);

result.additionalInfo := currStr;

if (currStr = '') then

continue;

currStrNum := i;

suspend;

if (isBroken) then

exit;

extractCommand(currStr, macroMarkName, macroCallName, asmMarkName, comType, operand1, operand2);

if (comType = tMACRO) then

begin

inc(level);

markIndex := getMDIndex(macroMarkName);

if (markIndex = BAD_INDEX) then

begin

if (level = 1) then

begin

if (not isCorrectName(macroMarkName, MACRO_DEF_SYMBOL, MACRO_MARK_FORBIDDEN_SYMBOLS)) then

begin

result.code := ERR_BAD_MDEF_NAME;

result.additionalInfo := macroMarkName;

exit;

end;

macroDesc[numMacroDesc].name := macroMarkName;

macroDesc[numMacroDesc].formalParams := operand1;

macroDesc[numMacroDesc].startAddr := numMacroDefStr;

mDefProcess := true;

inc(numMacroDesc);

end;

macroDef[numMacroDefStr].str := currStr;

inc(numMacroDefStr);

end else

begin

result.code := ERR_DUP_MDEF_NAME;

result.additionalInfo := macroMarkName;

exit;

end;

end else

if (comType = tMEND) then

begin

dec(level);

if (level < 0) then

begin

result.code := ERR_MEND_NOT_EXPECTED;

exit;

end;

if (MDefProcess) then

begin

if (level = 0) then

begin

macroDesc[numMacroDesc - 1].EndAddr := numMacroDefStr;

MDefProcess := false;

end;

macroDef[numMacroDefStr].str := currStr;

inc(numMacroDefStr);

end;

end else

if ((comType = tASM_COM) and (ansiUpperCase(currStr) = 'END')) then

begin

isEndFound := true;

if (MDefProcess) then

begin

result.code := ERR_UNCLOSED_MDEF;

exit;

end else

begin

result.code := NORM_RESULT;

exit;

end;

end else

begin

if (MDefProcess) then

begin

macroDef[numMacroDefStr].str := currStr;

inc(numMacroDefStr);

end;

end;

end;

if (level <> 0) then

result.code := ERR_UNCLOSED_MDEF;

end;

function doFirstStep(code: array of string; numStr: integer): TResult;

var

isEndFound: boolean;

begin

result.code := NORM_RESULT;

initFirstStep;

result := processMacroDefs(code, 0, numStr - 1, isEndFound);

if (result.code <> NORM_RESULT) then

exit;

if (not isEndFound) then

result.code := ERR_END_NOT_FOUND;

end;

function checkParamsByKey(MDIndex: integer; actualParams: TStrArray; var locals: array of TParamPair;

numActualParams: byte; var numLocals: integer): TResult;

var

i, j : integer;

formalParams : TStrArray;

paramIsFound,

hasDefaultVal : boolean;

actualParamPair,

formalParamPair : TParamPair;

numFormalParams,

numUsedActualParams : byte;

begin

result.code := NORM_RESULT;

formalParams := getParams(macroDesc[MDIndex].formalParams, result, numFormalParams, locals, numLocals);

if (result.code <> NORM_RESULT) then

exit;

numUsedActualParams := 0;

// main checking

for i := 0 to numFormalParams - 1 do

begin

result := getParamPair(formalParams[i], formalParamPair);

if (result.code <> NORM_RESULT) then

exit;

if (formalParamPair.name = '') then

begin

result.code := ERR_BAD_FORMAL_PARAMS;

result.additionalInfo := '"' + macroDesc[MDIndex].name + ' ' + formalParams[i] + '"';

exit;

end;

if (getLocalIndex(formalParamPair.name, locals, numLocals) <> BAD_INDEX) then

begin

result.code := ERR_DUP_LOCALS;

result.additionalInfo := formalParamPair.name;

exit;

end;

locals[numLocals].name := formalParamPair.name;

if (formalParamPair.val <> '') then

begin

locals[numLocals].val := formalParamPair.val; // default value

hasDefaultVal := true;

end else

hasDefaultVal := false;

paramIsFound := false;

for j := 0 to numActualParams - 1 do

begin

result := getParamPair(actualParams[j], actualParamPair);

if (result.code <> NORM_RESULT) then

exit;

if ((actualParamPair.name = '') xor (actualParamPair.val = '')) then

begin

result.code := ERR_BAD_ACTUAL_PARAMS;

result.additionalInfo := actualParams[j];

exit;

end;

if (formalParamPair.name = actualParamPair.name) then

begin

if ((formalParamPair.val = '') and (actualParamPair.val = '')) then

begin

result.code := ERR_PARAM_VAL_NOT_SET;

result.additionalInfo := formalParamPair.name;

exit;

end;

if (actualParamPair.val <> '') then

begin

locals[numLocals].val := actualParamPair.val; // actual value

inc(numUsedActualParams);

end;

paramIsFound := true;

break;

end;

end;

if (not paramIsFound and not hasDefaultVal) then

begin

result.code := ERR_NOT_ENOUGH_PARAMS;

result.additionalInfo := 'в макроопределении "' + macroDesc[MDIndex].name + ' ' + macroDesc[MDIndex].formalParams +

'" параметр "' + formalParamPair.name + '" не имеет значения по умолчанию';

exit;

end;

inc(numLocals);

end;

if (numUsedActualParams < numActualParams) then

begin

result.code := ERR_PARAMS_MISMATCH;

result.additionalInfo := 'в макровызове "' + macroDesc[MDIndex].name + ' ' + macroDesc[MDIndex].formalParams +

'" фактических параметров больше, чем необходимо';

end;

end;

function processMarks(MDIndex: integer; var macroMarks: array of TMacroMark; var asmMarks: array of TAsmMark;

var numMacroMarks: integer; var numAsmMarks: integer): TResult;

var

comType : TComType;

i,

macroDefLevel : integer;

currStr,

macroMarkName,

macroCallName,

asmMarkName,

unusedStr : string;

begin

result.code := NORM_RESULT;

macroDefLevel := 0;

for i := macroDesc[MDIndex].StartAddr + 1 to macroDesc[MDIndex].EndAddr do

begin

currStr := macroDef[i].str;

extractCommand(currStr, macroMarkName, macroCallName, asmMarkName, comType, unusedStr, unusedStr);

// Marks from inner macroses have to be invisible in outer one

// so skip it

if (comTYpe = tMACRO) then

inc(macroDefLevel)

else

if (comType = tMEND) then

dec(macroDefLevel);

if (macroDefLevel > 0) then

continue;

if (macroMarkName <> '') then

begin

if ((getMacroMarkIndex(macroMarkName, macroMarks, numMacroMarks) <> BAD_INDEX) or

(getMDIndex(macroMarkName) <> BAD_INDEX)) then

begin

result.code := ERR_DUP_MARK_NAME;

result.additionalInfo := macroMarkName;

exit;

end;

if (numMacroMarks = MAX_MARKS) then

begin

result.code := ERR_TOO_MANY_MARKS;

exit;

end;

if (not isCorrectName(macroMarkName, MACRO_MARK_SYMBOL, MACRO_MARK_FORBIDDEN_SYMBOLS)) then

begin

result.code := ERR_BAD_MACRO_MARK_NAME;

result.additionalInfo := macroMarkName;

exit;

end;

macroMarks[numMacroMarks].Name := macroMarkName;

macroMarks[numMacroMarks].Addr := i;

inc(numMacroMarks);

end;

if (asmMarkName <> '') then

begin

if (getAsmMarkIndex(asmMarkName, asmMarks, numAsmMarks) <> BAD_INDEX) then

begin

result.code := ERR_DUP_MARK_NAME;

result.additionalInfo := asmMarkName;

exit;

end;

if (not isCorrectName(asmMarkName, ASM_MARK_SYMBOL, ASM_MARK_FORBIDDEN_SYMBOLS)) then

begin

result.code := ERR_BAD_ASM_MARK_NAME;

result.additionalInfo := asmMarkName;

exit;

end;

if (numAsmMarks = MAX_MARKS) then

begin

result.code := ERR_TOO_MANY_MARKS;

exit;

end;

asmMarks[numAsmMarks].Name := asmMarkName;

asmMarks[numAsmMarks].newName := asmMarkName + UNIQUE_ASM_MARK_SYMBOL + intToStr(markCounter);

asmMarks[numAsmMarks].isFound := false;

inc(markCounter);

inc(numAsmMarks);

end;

end; // of [for i ...]

end;

function makeParamConfig(strN: integer; locals: array of TParamPair; numLocals: integer): TResult;

var

i: integer;

begin

result.code := NORM_RESULT;

if (numParamConfigs = MAX_CONFIGS) then

begin

result.code := ERR_TOO_MANY_CONFIGS;

exit;

end;

paramConfig[numParamConfigs].strN := strN;

for i := 0 to numLocals - 1 do

begin

paramConfig[numParamConfigs].vals[i] := strToInt(locals[i].val);

end;

inc(numParamConfigs);

end;

function isConfigFound(strN: integer; locals: array of TParamPair; numLocals: integer): boolean;

var

i, j: integer;

begin

for i := 0 to numParamConfigs - 1 do

begin

if (paramConfig[i].strN = strN) then

begin

if (numLocals = 0) then

begin

result := true;

exit;

end;

for j := 0 to numLocals - 1 do

begin

result := true;

if (paramConfig[i].vals[j] <> strToInt(locals[j].val)) then

begin

result := false;

break;

end;

end;

end;

if (result) then

exit;

end;

end;

function processMacroCall(MDIndex: integer; const actualParams: TStrArray; numActualParams: byte;

var output: array of string; var numOutputStr: integer): TResult;

var

localParamPair : TParamPair;

unusedBool : boolean;

comType,

prevComType : TComType;

exprErr : byte;

currStr,

currLexem,

errSubExpr,

macroMarkName,

macroCallName,

asmMarkName,

targetMarkName,

operand1,

operand2 : string;

i, j,

macroDefLevel,

numMacroMarks,

numAsmMarks,

numLocals,

localIndex,

markIndex,

exprResult,

localVal,

charPos,

lastMDefAddr : integer;

macroMarks : array [0..MAX_MARKS - 1] of TMacroMark;

asmMarks : array [0..MAX_MARKS - 1] of TAsmMark;

locals : array [0..MAX_LOCALS - 1] of TParamPair;

code : array [0..MAX_SRC_LEN - 1] of string;

begin

initMacroCall(macroMarks, locals, numMacroMarks, numLocals);

result := checkParamsByKey(MDIndex, actualParams, locals, numActualParams, numLocals);

if (result.code <> NORM_RESULT) then

exit;

result := processMarks(MDIndex, macroMarks, asmMarks, numMacroMarks, numAsmMarks);

if (result.code <> NORM_RESULT) then

exit;

if (isSuspendable) then

begin

updateCurrLocals(locals, numLocals);

updateCurrMarks(macroMarks, numMacroMarks);

end;

macroDefLevel := 0;

lastMDefAddr := 0;

prevComType := tUNKNOWN;

i := macroDesc[MDIndex].StartAddr + 1;

while (i <= macroDesc[MDIndex].EndAddr) do

begin

currStr := macroDef[i].str;

result.additionalInfo := currStr;

currStrNum := i;

suspend;

if (isBroken) then

exit;

extractCommand(currStr, macroMarkName, macroCallName, asmMarkName, comType, operand1, operand2);

/////////////////// proccess submacro definitions //////////////////////

if (comType = tMACRO) then

begin

if (macroDefLevel = 0) then

lastMDefAddr := i;

inc(macroDefLevel);

end else

if (comType = tMEND) then

begin

dec(macroDefLevel);

if ((macroDefLevel = 0) and (not macroDef[i].isDone)) then

begin

for j := lastMDefAddr to i do

begin

code[j] := macroDef[j].str;

end;

result := processMacroDefs(code, lastMDefAddr, i, unusedBool);

if (result.code <> NORM_RESULT) then

exit;

macroDef[i].isDone := true;

inc(i);

continue;

end;

end;

////////////////////////////////////////////////////////////////////////

if (macroDefLevel > 0) then

begin

inc(i);

continue;

end;

/////////////////////// substitute locals //////////////////////////////

if (comType <> tASM_COM) then

begin

if ((comType <> tMACRO_CALL) and (comType <> tSET) and (comType <> tLOCAL) and

(comType <> tINC) and (comType <> tDEC)) then

begin

result := substituteLocals(operand1, locals, numLocals);

end;

result := substituteLocals(operand2, locals, numLocals);

if (result.code <> NORM_RESULT) then

exit;

end else

begin

if (asmMarkName <> '') then

begin

markIndex := getAsmMarkIndex(asmMarkName, asmMarks, numAsmMarks);

if (markIndex <> BAD_INDEX) then

begin

if (asmMarks[markIndex].isFound) then

begin

result.code := ERR_ASM_MARK_IN_LOOP;

exit;

end else

asmMarks[markIndex].isFound := true;

end;

end;

end;

////////////////////////////////////////////////////////////////////////

if (comType = tMEND) then

begin

////////

end else

if ((comType = tAIF) or (comType = tAGO)) then

begin

if (comType = tAGO) then

begin

targetMarkName := operand1;

exprResult := ord(true);

end else

begin

targetMarkName := operand2;

exprResult := tryEvalExpr(operand1, exprErr, errSubExpr);

if (exprErr <> NORM_EXPR) then

begin

result.code := ERR_BAD_AIF_SYNTAX;

result.additionalInfo := errSubExpr;

exit;

end;

end;

markIndex := getMacroMarkIndex(targetMarkName, macroMarks, numMacroMarks);

if (markIndex = BAD_INDEX) then

begin

result.code := ERR_MACRO_MARK_NOT_FOUND;

result.additionalInfo := operand2;

exit;

end;

if (macroDef[i].isDone) then

begin

if (isConfigFound(i, locals, numLocals)) then

begin

result.code := ERR_INFINITE_LOOP_FOUND;

updateCurrOutput(output, numOutputStr);

exit;

end;

end;

macroDef[i].isDone := true;

result := makeParamConfig(i, locals, numLocals);

if (result.code <> NORM_RESULT) then

exit;

if (boolean(exprResult) = true) then

begin

macroDef[i].isDone := true;

i := macroMarks[markIndex].addr;

continue;

end;

end else

if (comType = tLOCAL) then

begin

if ((prevComType <> tUNKNOWN) and (prevComType <> tLOCAL)) then

begin

result.code := ERR_LOCAL_AFTER_COM;

exit;

end;

if (macroMarkName <> '') then

begin

result.code := ERR_LOCAL_HAS_MACRO_MARK;

exit;

end;

result := getParamPair(operand1, localParamPair);

if (result.code <> NORM_RESULT) then

exit;

if (getLocalIndex(localParamPair.name, locals, numLocals) <> BAD_INDEX) then

begin

result.code := ERR_DUP_LOCALS;

result.additionalInfo := localParamPair.name;

exit;

end;

localVal := tryEvalExpr(localParamPair.val, exprErr, errSubExpr);

if (exprErr <> NORM_EXPR) then

begin

result.code := exprErr;

result.additionalInfo := errSubExpr;

exit;

end;

result := checkValBounds(localVal);

if (result.code <> NORM_RESULT) then

exit;

locals[numLocals].name := localParamPair.name;

locals[numLocals].val := intToStr(localVal);

inc(numLocals);

if (isSuspendable) then

updateCurrLocals(locals, numLocals);

end else

if (comType = tSET) then

begin

localVal := tryEvalExpr(operand2, exprErr, errSubExpr);

if (exprErr <> NORM_EXPR) then

begin

result.code := ERR_BAD_SET_SYNTAX;

result.additionalInfo := errSubExpr;

exit;

end;

localIndex := getLocalIndex(operand1, locals, numLocals);

if (localIndex = BAD_INDEX) then

begin

result.code := ERR_LOCAL_NOT_FOUND;

result.additionalInfo := localParamPair.name;

exit;

end;

result := checkValBounds(localVal);

if (result.code <> NORM_RESULT) then

exit;

locals[localindex].val := intToStr(localVal);

if (isSuspendable) then

updateCurrLocals(locals, numLocals);

end else

if ((comType = tINC) or (comType = tDEC)) then

begin

localIndex := getLocalIndex(operand1, locals, numLocals);

if (localIndex = BAD_INDEX) then

begin

result.code := ERR_LOCAL_NOT_FOUND;

result.additionalInfo := localParamPair.name;

exit;

end;

if (comType = tINC) then

locals[localIndex].val := intToStr(strToInt(locals[localIndex].val) + 1)

else

locals[localIndex].val := intToStr(strToInt(locals[localIndex].val) - 1);

result := checkValBounds(strToInt(locals[localIndex].val));

if (result.code <> NORM_RESULT) then

exit;

if (isSuspendable) then

updateCurrLocals(locals, numLocals);

end else

if (comType = tMACRO_CALL) then

begin

result.code := ERR_MACRO_CALL_IN_MACRO;

result.additionalInfo := macroCallName;

exit;

end else

if (comType = tASM_COM) then

begin

if (numOutputStr = MAX_OUTPUT_LEN) then

begin

result.code := ERR_TOO_BIG_PROGRAMM;

exit;

end;

result := substituteLocals(currStr, locals, numLocals);

if (result.code <> NORM_RESULT) then

exit;

currStr := trim(stringReplace(currStr, macroMarkName, '', []));

for j := 0 to numAsmMarks - 1 do

begin

replaceLexems(currStr, asmMarks[j].Name, asmMarks[j].newName, COMMON_SEPARATOR);

end;

charPos := 1;

while (charPos <= length(currStr)) do

begin

currLexem := getNextLexem(currStr, charPos, COMMON_SEPARATOR);

if ((currLexem <> '') and (currLexem[1] = ASM_MARK_SYMBOL)) then

begin

if (isCorrectName(currLexem, ASM_MARK_SYMBOL, ASM_MARK_FORBIDDEN_SYMBOLS)) then

begin

result.code := ERR_ASM_MARK_NOT_FOUND;

result.additionalInfo := currLexem;

exit;

end;

end;

end;

output[numOutputStr] := currStr;

inc(numOutputStr);

if (isSuspendable) then

updateCurrOutput(output, numOutputStr);

end else

begin

result.code := ERR_COMMON_SYNTAX;

result.additionalInfo := 'команда "' + currStr + '" не распознана';

exit;

end;

prevComType := comType;

macroDef[i].isDone := true;

inc(i);

end; // of while

for i := macroDesc[MDIndex].StartAddr + 1 to macroDesc[MDIndex].EndAddr do

begin

macroDef[i].isDone := false;

end;

end;

function doSecondStep(code: array of string; numStr: integer): TResult;

var

actualParams : TStrArray;

numActualParams : byte;

comType : TComType;

i,

level,

numOutputStr,

MDIndex : integer;

currStr,

macroMarkName,

macroCallName,

asmMarkName,

operand1,

operand2 : string;

fakeLocals : array [0..0] of TParamPair;

output : array [0..MAX_OUTPUT_LEN] of string;

begin

result.code := NORM_RESULT;

numOutputStr := 0;

level := 0;

for i := 0 to MAX_MACRO_DEF_STR - 1 do

begin

macroDef[i].isDone := false;

end;

for i := 0 to numStr - 1 do

begin

currStr := trim(code[i]);

result.additionalInfo := currStr;

if (currStr = '') then

continue;

currStrNum := i;

suspend;

if (isBroken) then

exit;

extractCommand(currStr, macroMarkName, macroCallName, asmMarkName, comType, operand1, operand2);

result := checkCommonSyntax(macroMarkName, macroCallName, asmMarkName, comType, operand1, operand2);

if (result.code <> NORM_RESULT) then

begin

result.additionalInfo := result.additionalInfo + ' : ' + currStr;

exit;

end;

if ((macroMarkName <> '') and (comType <> tMACRO) and (level = 0)) then

begin

result.code := ERR_MACROSTUFF_OUTSIDE;

result.additionalInfo := '"' + currStr + '" ; ожидается, что метка "' + macroMarkName + '" будет являться макрометкой';

exit;

end;

if (comType = tMACRO) then

begin

inc(level);

continue;

end else

if (comType = tMEND) then

begin

if (level = 0) then

begin

result.code := ERR_MEND_NOT_EXPECTED;

exit;

end;

dec(level);

continue;

end;

if (level > 0) then

continue;

if (isMacroCom(comType)) then

begin

result.code := ERR_MACROSTUFF_OUTSIDE;

result.additionalInfo := currStr;

exit;

end else

if (comType = tMACRO_CALL) then

begin

MDIndex := getMDIndex(macroCallName);

if (MDIndex <> BAD_INDEX) then

begin

actualParams := getParams(operand1, result, numActualParams, fakeLocals, 0);

if (result.code <> NORM_RESULT) then

exit;

isInMacroCall := true;

numParamConfigs := 0;

result := processMacroCall(MDIndex, actualParams, numActualParams, output, numOutputStr);

if (result.code <> NORM_RESULT) then

exit;

isInMacroCall := false;

end else

begin

result.code := ERR_MACRO_DEF_NOT_FOUND;

result.additionalInfo := macroCallName;

exit;

end;

end else

if (comType = tASM_COM) then

begin

if (numOutputStr = MAX_OUTPUT_LEN) then

begin

result.code := ERR_TOO_BIG_PROGRAMM;

exit;

end;

output[numOutputStr] := currStr;

inc(numOutputStr);

if (isSuspendable) then

updateCurrOutput(output, numOutputStr);

if (ansiUpperCase(currStr) = 'END') then

break;

end else

begin

result.code := ERR_COMMON_SYNTAX;

result.additionalInfo := 'команда не распознана';

exit;

end;

end; // of [for i ...]

updateCurrOutput(output, numOutputStr);

end;

end.