Apple-2gs-SW
/
ORCA-Pascal
mirror of https://github.com/byteworksinc/ORCA-Pascal.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity
ORCA-Pascal/scanner.pas

1106 lines
26 KiB
ObjectPascal
Raw Permalink Blame History

{$optimize 15}
{---------------------------------------------------------------}
{ }
{ Scanner }
{ }
{---------------------------------------------------------------}
unit Scanner;
{$segment 'Pascal2'}
interface
{$libprefix '0/obj/'}
uses PCommon, CGI;
{---------------------------------------------------------------}
var
{misc}
{----}
debugType: (stop,breakPoint,autoGo); {kind of debugging for this line}
doingInterface: boolean; {compiling an interface?}
partiallist: partialptr; {list of partial compile names}
partial: boolean; {is this a partial compile?}
{returned by InSymbol}
{--------------------}
sy: symbol; {last symbol}
op: operator; {classification of last symbol}
val: valu; {value of last constant}
lgth: integer; {length of last string constant}
id: pString; {last identifier}
ch: char; {last character}
eofl: boolean; {end of file flag}
{---------------------------------------------------------------}
procedure InSymbol; extern;
{ read the next token from the source stream }
procedure Match (sym: symbol; ern: integer); extern;
{ insure that the next symbol is the one requested }
{ }
{ parameters: }
{ sym - symbol expected }
{ ern - error number; used if the symbol is not correct }
procedure OpenUses;
{ copies the contents of a uses file }
procedure Scanner_Init; extern;
{ initialize the scanner }
procedure Scanner_Fini;
{ shut down the scanner }
procedure Skip (fsys: setofsys);
{ skip input string until relavent symbol found }
{ }
{ parameters: }
{ fsys - symbol kind to skip to }
{---------------------------------------------------------------}
implementation
type
copyFilePtr = ^copyFileRecord; {copied file chain}
copyFileRecord = record
fnext: copyFilePtr; {next copied file record}
fname: gsosOutString; {file name}
fpos: longint; {disp in file}
fuses: boolean; {doing uses?}
flineCount: integer; {line count}
end;
var
{misc}
{----}
didKeep: boolean; {have we found a $keep directive?}
doingOption: boolean; {compiling an option?}
eofDisable: boolean; {disable end of file error check?}
eol: boolean; {end of line flag}
fHeadGS: copyFilePtr; {copied file chain}
langNum: integer; {language number}
listFixed: boolean; {was the list option specified on the cl?}
lString: pString; {last string}
usesLength: longint; {# bytes in current uses buffer}
usesPtr: ptr; {ptr to next byte in uses buffer}
{- Private subroutines -----------------------------------------}
procedure EndOfLine; extern;
{ Read in the next source line }
procedure FakeInsymbol; extern;
{ install the uses file InSymbol patch }
procedure GetPartialNames;
{ Form a linked list of partial compile names }
function GetName: boolean;
{ Read a name from subsGS }
{ }
{ Returns: false if there are no more names, else true }
var
i: unsigned; {loop/index variable}
pn: partialptr; {new partial compile entry}
pname: pStringPtr; {work string}
function GetCh: char;
{ Get a character }
{ }
{ returns: next character from subsGS }
var
ch: char; {work character}
begin {GetCh}
if subsGS.theString.size = 0 then
GetCh := chr(0)
else begin
ch := subsGS.theString.theString[1];
if ch in ['a'..'z'] then
ch := chr(ord(ch)-ord('a')+ord('A'));
GetCh := ch;
end; {else}
end; {GetCh}
procedure NextCh;
{ Remove the next character from subsGS }
var
i: unsigned; {loop/index variable}
begin {NextCh}
with subsGS.theString do
if size <> 0 then begin
for i := 2 to size do
theString[i-1] := theString[i];
size := size-1;
end; {with}
end; {NextCh}
begin {GetName}
while GetCh = ' ' do
NextCh;
if subsGS.theString.size = 0 then
GetName := false
else begin
GetName := true;
i := 0;
new(pn);
new(pname);
pn^.pname := pname;
while not (GetCh in [' ', chr(0)]) do begin
i := i+1;
pname^[i] := GetCh;
NextCh;
end; {while}
pname^[0] := chr(i);
pn^.next := partialList;
partialList := pn;
end; {else}
end; {GetName}
begin {GetPartialNames}
partialList := nil; {assume no list}
partial := false;
if subsGS.theString.size <> 0 then begin
repeat until not GetName;
partial := true;
end; {if}
end; {GetPartialNames}
procedure InitFile;
{ get the command line and GetLInfo information }
const
{bit masks for GetLInfo flags}
{----------------------------}
flag_d = $10000000; {generate debug code?}
flag_e = $08000000; {abort to editor on terminal error?}
flag_l = $00100000; {list source lines?}
flag_m = $00080000; {memory based compile?}
flag_o = $00020000; {optimize?}
flag_p = $00010000; {print progress info?}
flag_s = $00002000; {list symbol tables?}
flag_t = $00001000; {treat all errors as terminal?}
flag_w = $00000200; {wait when an error is found?}
var
i: unsigned; {loop/index variable}
begin {InitFile}
fNameGS.maxSize := maxPath+4;
fNameGS.theString.size := 0;
for i := 1 to maxPath do
fNameGS.theString.theString[i] := chr(0);
kNameGS := fNameGS;
subsGS := fNameGS;
ldInfoGS := fNameGS;
with liDCBGS do begin
pCount := 11;
sFile := @fNameGS;
dFile := @kNameGS;
namesList := @subsGS;
iString := @ldInfoGS;
end; {with}
GetLInfoGS(liDCBGS);
with liDCBGS do begin
if pFlags & flag_l <> 0 then begin {set up source listing flags}
list := true;
listFixed := true;
end
else if mFlags & flag_l <> 0 then
listFixed := true
else
listFixed := false;
wait := pFlags & flag_w <> 0; {wait when an error is found?}
allTerm := pFlags & flag_t <> 0; {all errors terminal?}
gotoEditor := pFlags & flag_e <> 0; {enter editor on terminal errors?}
debugFlag := pFlags & flag_d <> 0; {generate debug code?}
profileFlag := debugFlag; {generate profile code?}
memoryFlag := pflags & flag_m <> 0; {memory based compile?}
progress := mflags & flag_p = 0; {write progress info?}
printSymbols := pflags & flag_s <> 0; {print the symbol table?}
cLineOptimize := pFlags & flag_o <> 0; {turn optimizations on?}
end; {liDCB}
if list then {we don't need both...}
progress := false;
keepFlag := liDCBGS.kFlag; {set up the code generator}
codeGeneration := keepFlag <> 0;
end; {InitFile}
procedure ListLine; extern;
{ List the current line and any errors found }
procedure NextCh; extern;
{ Fetch the next source character }
procedure OpenGS;
{ Open a source file }
var
ffDCBGS: fastFileDCBGS; {for FastFile load}
erRec: errorDCBGS; {for reporting shell error}
begin {OpenGS}
with ffDCBGS do begin {read the source file}
pCount := 14;
action := 0;
flags := $C000;
pathName := @fNameGS.theString;
option := nil;
end; {with}
FastFileGS(ffDCBGS);
if ToolError <> 0 then begin
erRec.pcount := 1;
erRec.error := ToolError;
ErrorGS(erRec);
TermError(4, nil);
end; {if}
if langNum <> 0 then begin {check the language number}
if ffDCBGS.auxType <> langNum then
TermError(2, nil);
end {if}
else
langNum := long(ffDCBGS.auxType).lsw;
filePtr := ffDCBGS.fileHandle^; {set beginning of file pointer}
chEndPtr := pointer(ord4(filePtr)+ffDCBGS.fileLength);;
chPtr := pointer(ord4(chEndPtr)-1); {make sure the file ends with a CR}
if chPtr^ <> 13 then
TermError(11, nil);
chPtr := filePtr; {set the character pointer}
end; {OpenGS}
procedure OpenUses;
{ Open a file for the uses statement }
var
exRec: ExpandDevicesDCBGS; {ExpandDevices record}
ffRec: FastFileDCBGS; {FastFile record}
i: unsigned; {loop/index variable}
lNameGS: gsosOutString; {work string for forming path name}
separator: char; {separator character}
begin {OpenUses}
if intPrefixGS.theString.size = 0 then begin
lNameGS.theString.theString := concat('13:ORCAPascalDefs:', id, '.int');
lNameGS.theString.size := length(lNameGS.theString.theString);
if GetFileType(lNameGS) = -1 then
lNameGS.theString.theString := concat('8:', id, '.int');
end {if}
else begin
i := 0;
separator := ' ';
while (i < intPrefixGS.theString.size) and (separator = ' ') do begin
if intPrefixGS.theString.theString[i] in [':', '/'] then
separator := intPrefixGS.theString.theString[i];
i := i+1;
end; {while}
if separator = ' ' then
separator := ':';
lNameGS.theString := intPrefixGS.theString;
if intPrefixGS.theString.size < maxPath then
lNameGS.theString.theString[intPrefixGS.theString.size] := chr(0);
if intPrefixGS.theString.theString[intPrefixGS.theString.size-1] <> separator
then
lNameGS.theString.theString :=
concat(lNameGS.theString.theString, separator);
lNameGS.theString.theString := concat(lNameGS.theString.theString, id);
lNameGS.theString.theString := concat(lNameGS.theString.theString, '.int');
end; {else}
lNameGS.theString.size := length(lNameGS.theString.theString);
exRec.pcount := 2; {expand devices}
exRec.inName := @lNameGS.theString;
exRec.outName := @usesFileNameGS;
usesFileNameGS.maxSize := maxPath+4;
ExpandDevicesGS(exRec);
if ToolError <> 0 then
usesFileNameGS := lNameGS;
ffRec.pcount := 14; {read the file}
ffRec.action := 0;
ffRec.flags := $C000;
ffRec.pathName := @usesFileNameGS.theString;
ffRec.option := nil;
FastFileGS(ffRec);
if ToolError <> 0 then
TermError(6, nil);
usesPtr := ffRec.fileHandle^; {save the file pointer}
usesLength := ffRec.fileLength; {save the file length}
if ffRec.fileType = DVU then begin {skip the version number}
usesPtr := pointer(ord4(usesPtr)+1);
usesLength := usesLength-1;
end; {if}
FakeInsymbol; {set up the InSymbol patch}
end; {OpenUses}
procedure SkipComment;
{ Skip to the end of a comment }
begin {SkipComment}
repeat
while not ((ch = '*') or (ch = '}')) and not eofl do
NextCh;
if ch = '*' then
NextCh;
until (ch = ')') or (ch = '}') or eofl;
NextCh;
end; {SkipComment}
function Options: boolean;
{ Compile compiler directives }
{ }
{ Returns: True if the parser should continue to scan for an }
{ end of comment, else false }
const
nameLen = 12; {max length of a directive name}
var
dName: string[nameLen]; {directive name}
function IsAlpha (ch: char): boolean;
{ See if a character is alphabetic }
{ }
{ parameters: }
{ ch - character to check }
{ }
{ Returns: True for an alphabetic character, else false }
begin {IsAlpha}
IsAlpha := ch in ['a'..'z', 'A'..'Z'];
end; {IsAlpha}
procedure SkipBlanks;
{ skip to the next non-blank character }
const
tab = 9; {tab key code}
begin {SkipBlanks}
while (ch in [' ', chr(tab), chr($CA)]) and (not eofl) do
NextCh;
end; {SkipBlanks}
function ToUpper (ch: char): char;
{ Return an uppercase character }
{ }
{ parameters: }
{ ch - character to check }
{ }
{ Returns: Uppercase equivalent of ch }
begin {ToUpper}
if ch in ['a'..'z'] then
ch := chr(ord(ch)-ord('a')+ord('A'));
ToUpper := ch;
end; {ToUpper}
procedure Expand (var name: pString);
{ Expands a name to a full pathname }
{ }
{ parameters: }
{ name - file name to expand }
var
exRec: expandDevicesDCBGS; {expand devices}
begin {Expand}
exRec.pcount := 2;
new(exRec.inName);
exRec.inName^.theString := name;
exRec.inName^.size := length(name);
new(exRec.outName);
exRec.outName^.maxSize := maxPath+4;
ExpandDevicesGS(exRec);
if toolerror = 0 then
with exRec.outName^.theString do begin
if size < maxPath then
theString[size+1] := chr(0);
name := theString;
end; {with}
dispose(exRec.inName);
dispose(exRec.outName);
end; {Expand}
function GetIdent: pStringPtr;
{ Read an identifier }
{ }
{ Returns: pointer to the identifier, or nil }
var
disp: integer; {characters in the string}
sPtr: pStringPtr; {dynamic string pointer}
str: pString; {work buffer}
begin {GetIdent}
SkipBlanks;
sPtr := nil;
disp := 0;
if IsAlpha(ch) then begin
while ch in ['a'..'z', 'A'..'Z', '0'..'9', '_'] do begin
if disp < maxLine then
disp := disp+1;
str[disp] := ch;
NextCh;
end; {while}
str[0] := chr(disp);
sPtr := pStringPtr(Malloc(length(str)+1));
sPtr^ := str;
end; {if}
GetIdent := sPtr;
end; {GetIdent}
function GetInteger: integer;
{ Read an (possibly signed) integer value }
{ }
{ Returns: Value read }
var
sign: boolean; {is the value negative?}
temp: integer; {temp val.ival}
begin {GetInteger}
temp := val.ival;
SkipBlanks;
sign := false;
if ch = '-' then begin
NextCh;
sign := true;
end; {if}
InSymbol;
if sy = longintconst then
if val.valp^.lval >> 16 = 0 then begin
val.ival := ord(val.valp^.lval);
sy := intconst;
end; {if}
if sy <> intconst then
Error(15);
if sign then
val.ival := -val.ival;
GetInteger := val.ival;
val.ival := temp;
end; {GetInteger}
function GetString: boolean;
{ read a string }
{ }
{ Returns: True if a string was found, else false }
{ }
{ Notes: }
{ 1. If a string is found, it is placed in lString }
{ 2. If a string is not found, no error is reported }
begin {GetString}
SkipBlanks;
GetString := ch = '''';
if ch = '''' then
InSymbol
else
Error(6);
end; {GetString}
function SetOption: boolean;
{ Check for a +/- options flag }
{ }
{ Returns: True for +, false for - }
begin {SetOption}
SetOption := true;
if ch in ['+','-'] then begin
SetOption := ch = '+';
NextCh;
end {if}
else
Error(6);
end; {SetOption}
procedure DoAppend;
{ Append }
var
ffRec: FastFileDCBGS; {FastFile record}
begin {DoAppend}
if GetString then begin {get the source name}
EndOfLine; {read the next source line}
PurgeSource; {purge the current source file}
eol := false; {don't reprint the line}
Expand(lString); {set the new path name}
fNameGS.theString.theString := lString;
fNameGS.theString.size := length(lString);
if not eofDisable then begin
OpenGS; {open the file}
lineCount := 1;
end; {if}
end {if}
else begin
eofl := true;
Error(37);
end; {else}
Options := false; {we won't scan for end of comment}
doingOption := false;
end; {DoAppend}
procedure DoCDev;
{ CDev }
begin {DoCDev}
if progFound or isNewDeskAcc or isClassicDeskAcc or isCDev or rtl or isXCMD
or isNBA then
Error(100);
isCDev := true;
openName := GetIdent;
end; {DoCDev}
procedure DoClassicDesk;
{ ClassicDesk }
begin {DoClassicDesk}
if progFound or isNewDeskAcc or isClassicDeskAcc or isCDev or rtl or isXCMD
or isNBA then
Error(100);
isClassicDeskAcc := true;
if GetString then
menuLine := lString
else
Error(131);
openName := GetIdent;
closeName := GetIdent;
end; {DoClassicDesk}
procedure DoCopy;
{ Copy }
var
ffRec: FastFileDCBGS; {FastFile record}
fRec: copyFilePtr; {copy file record}
begin {DoCopy}
new(fRec); {create a copy record}
fRec^.fnext := fHeadGS;
fHeadGS := fRec;
fRec^.fName := fNameGS; {fill in the current file name}
if GetString then begin {get the source name}
SkipComment; {skip to the end of the directive}
{save the file position}
fRec^.fpos := ord4(chPtr) + chCnt - ord4(filePtr);
fRec^.fuses := false; {not doing a uses}
fRec^.flineCount := lineCount+1; {save the new line count}
EndOfLine; {read the next source line}
PurgeSource; {purge the current source file}
eol := false; {don't reprint the line}
Expand(lString); {set the new path name}
fNameGS.theString.theString := lString;
fNameGS.theString.size := length(lString);
OpenGS; {open the file}
lineCount := 1;
end {if}
else begin
eofl := true;
Error(37);
end; {else}
Options := false; {we won't scan for end of comment}
doingOption := false;
end; {DoCopy}
procedure DoDataBank;
{ DataBank }
begin {DoDataBank}
dataBank := SetOption;
end; {DoDataBank}
procedure DoDebug;
{ Debug }
var
val: unsigned; {debug flag word}
begin {DoDebug}
val := GetInteger;
debugFlag := odd(val);
profileFlag := (val & $0002) <> 0;
profileFlag := profileFlag or debugFlag;
debugStrFlag := (val & $8000) <> 0;
end; {DoDebug}
procedure DoEject;
{ Eject }
begin {DoEject}
if printer then
if list then begin
write(chr(12));
lCnt := 0;
if length(title) <> 0 then begin
write(title);
LineFeed;
LineFeed;
end; {if}
end; {if}
end; {DoEject}
procedure DoFloat;
{ Float }
begin {DoFloat}
floatCard := GetInteger;
end; {DoFloat}
procedure DoISO;
{ ISO }
begin {DoISO}
iso := SetOption;
if iso then
debug := true;
end; {DoISO}
procedure DoKeep;
{ Keep }
begin {DoKeep}
if progFound or didKeep then
Error(100)
else if GetString then begin
codeGeneration := true;
Expand(lString);
kNameGS.theString.theString := lString;
kNameGS.theString.size := length(lString);
keepFlag := 1;
didKeep := true;
end; {else if}
end; {DoKeep}
procedure DoLibPrefix;
{ LibPrefix }
var
i: unsigned; {loop/index variable}
len: unsigned; {length(lString)}
separator: char; {path separaotr character}
begin {DoLibPrefix}
if GetString then begin
len := length(lString);
if len = 0 then
intPrefixGS.theString.size := 0
else begin
separator := ' ';
i := 1;
while i < len do
if lString[i] in [':','/'] then begin
separator := lString[i];
i := maxint;
end {if}
else
i := i+1;
if separator = ' ' then
separator := ':';
if lString[len] <> separator then
lString := concat(lString, separator);
intPrefixGS.theString.theString := lString;
intPrefixGS.theString.size := length(lString);
end; {else}
end {if}
else
Error(37);
end; {DoLibPrefix}
procedure DoList;
{ List }
var
llist: boolean; {local list}
begin {DoList}
llist := SetOption;
if not listFixed then
list := llist;
end; {DoList}
procedure DoMemoryModel;
{ MemoryModel }
begin {DoMemoryModel}
if progFound then
Error(100);
smallMemoryModel := GetInteger = 0;
end; {DoMemoryModel}
procedure DoNames;
{ Names }
begin {DoNames}
traceBack := SetOption;
end; {DoNames}
procedure DoNBA;
{ NBA }
begin {DoNBA}
if progFound or isNewDeskAcc or isClassicDeskAcc or isCDev or rtl or isXCMD
or isNBA then
Error(100);
isNBA := true;
openName := GetIdent;
end; {DoNBA}
procedure DoNewDeskAcc;
{ NewDeskAcc }
begin {DoNewDeskAcc}
if progFound or isNewDeskAcc or isClassicDeskAcc or isCDev or rtl or isXCMD
or isNBA then
Error(100);
isNewDeskAcc := true;
openName := GetIdent;
closeName := GetIdent;
actionName := GetIdent;
initName := GetIdent;
refreshPeriod := GetInteger;
eventMask := GetInteger;
if GetString then
menuLine := lString
else
Error(131);
end; {DoNewDeskAcc}
procedure DoOptimize;
{ Optimize }
var
val: unsigned; {optimize flag word}
begin {DoOptimize}
val := GetInteger;
peepHole := odd(val);
nPeepHole := (val & $0002) <> 0;
registers := (val & $0004) <> 0;
commonSubexpression := (val & $0008) <> 0;
loopOptimizations := (val & $0010) <> 0;
jslOptimizations := (val & $0020) <> 0;
end; {DoOptimize}
procedure DoRangeCheck;
{ RangeCheck }
begin {DoRangeCheck}
debug := SetOption;
rangeCheck := debug;
end; {DoRangeCheck}
procedure DoRTL;
{ RTL }
begin {DoRTL}
if isNewDeskAcc or isClassicDeskAcc or isCDev or rtl then
Error(100);
rtl := true;
end; {DoRTL}
procedure DoSegment;
{ Segment }
var
i: unsigned; {loop/index variable}
seg: segNameType; {segment name}
begin {DoSegment}
if GetString then begin
seg := lString;
for i := length(seg)+1 to 10 do
seg[i] := ' ';
DefaultSegName(seg);
isDynamic := false;
end {if}
else
Error(6);
end; {DoSegment}
procedure DoDynamic;
{ Dynamic }
begin {DoDynamic}
DoSegment;
isDynamic := true;
end; {DoDynamic}
procedure DoStackSize;
{ StackSize }
begin {DoStackSize}
if progFound then
Error(100);
stackSize := GetInteger;
end; {DoStackSize}
procedure DoToolParms;
{ ToolParms }
begin {DoToolParms}
toolParms := SetOption;
end; {DoToolParms}
procedure DoTitle;
{ Title }
begin {DoTitle}
if GetString then
title := lString
else
title := '';
end; {DoTitle}
procedure DoXCMD;
{ XCMD }
begin {DoXCMD}
if progFound or isNewDeskAcc or isClassicDeskAcc or isCDev or rtl or isXCMD
or isNBA then
Error(100);
isXCMD := true;
openName := GetIdent;
end; {DoXCMD}
begin {Options}
Options := true; {assume we will scan for end of comment}
doingOption := true; {processing an option}
repeat
NextCh;
if (ch <> '*') and (ch <> '}') then begin
dName[0] := chr(0); {get a directive name}
SkipBlanks;
while IsAlpha(ch) and (ord(dName[0]) < nameLen) do begin
dName[0] := succ(dName[0]);
dName[ord(dName[0])] := ToUpper(ch);
NextCh;
end; {while}
{call the correct handler}
if dName = 'MEMORYMODEL' then DoMemoryModel
else if dName = 'APPEND' then DoAppend
else if dName = 'COPY' then DoCopy
else if dName = 'DEBUG' then DoDebug
else if dName = 'EJECT' then DoEject
else if dName = 'FLOAT' then DoFloat
else if dName = 'ISO' then DoISO
else if dName = 'KEEP' then DoKeep
else if dName = 'LIST' then DoList
else if dName = 'NAMES' then DoNames
else if dName = 'RANGECHECK' then DoRangeCheck
else if dName = 'STACKSIZE' then DoStackSize
else if dName = 'TITLE' then DoTitle
else if dName = 'RTL' then DoRTL
else if dName = 'NEWDESKACC' then DoNewDeskAcc
else if dName = 'OPTIMIZE' then DoOptimize
else if dName = 'SEGMENT' then DoSegment
else if dName = 'DYNAMIC' then DoDynamic
else if dName = 'TOOLPARMS' then DoToolParms
else if dName = 'DATABANK' then DoDataBank
else if dName = 'LIBPREFIX' then DoLibPrefix
else if dName = 'CLASSICDESK' then DoClassicDesk
else if dName = 'CDEV' then DoCDev
else if dName = 'XCMD' then DoXCMD
else if dName = 'NBA' then DoNBA
else doingOption := false;
end {if}
else
doingOption := false;
if doingOption then begin {check for another one}
SkipBlanks;
doingOption := ch = ',';
end; {if}
until not doingOption;
end; {Options}
{- Public subroutines ------------------------------------------}
procedure Scanner_Fini;
{ Shut down the scanner }
var
i: unsigned; {loop/index variable}
tp: partialPtr; {work pointer}
begin {Scanner_Fini}
PurgeSource; {purge the last source file}
fNameGS.theString.size := 0; {handle a trailing append}
eofDisable := true;
InSymbol;
if fNameGS.theString.size <> 0 then begin
liDCBGS.sFile := @fNameGS;
liDCBGS.namesList := @subsGS;
subsGS.theString.size := 0;
while partialList <> nil do begin
tp := partialList;
partialList := tp^.next;
for i := 1 to length(tp^.pname^) do begin
subsGS.theString.size := subsGS.theString.size+1;
subsGS.theString.theString[subsGS.theString.size] := tp^.pname^[i];
end; {for}
dispose(tp);
if partialList <> nil then begin
subsGS.theString.size := subsGS.theString.size+1;
subsGS.theString.theString[subsGS.theString.size] := ' ';
end; {if}
end; {while}
if keepFlag <> 0 then
liDCBGS.kFlag := 3;
end {if}
else begin {no append; the compile is over}
liDCBGS.lOps := liDCBGS.lOps & $FFFE;
if keepFlag <> 0 then
liDCBGS.kFlag := 3
else
liDCBGS.lOps := 0;
liDCBGS.sFile := @kNameGS;
end; {else}
with liDCBGS do begin {pass info back to the shell}
sFile := pointer(ord4(sFile)+2);
dFile := pointer(ord4(dFile)+2);
namesList := pointer(ord4(namesList)+2);
iString := pointer(ord4(iString)+2);
end; {with}
SetLInfoGS(liDCBGS);
StopSpin; {stop the spinner}
ListLine; {finish the listing}
if list or progress then begin
LineFeed;
writeln(errorOutput, numErr:1, ' errors found');
end; {if}
end; {Scanner_Fini}
procedure Skip {fsys: setofsys};
{ skip input string until relavent symbol found }
{ }
{ parameters: }
{ fsys - symbol kind to skip to }
begin {Skip}
if not eofl then begin
while not (sy in fsys) and (not eofl) do
InSymbol;
if not (sy in fsys) then
InSymbol;
end; {if}
end; {Skip}
end.
{$append 'scanner.asm'}
Reference in New Issue View Git Blame Copy Permalink