DIRECTORY
Ascii USING [Letter, Upper],
Basics USING [BITAND, BITSHIFT, LowByte, ShortNumber],
FS USING [ComponentPositions, Error, ExpandName, StreamOpen],
IO,
Rope,
VM USING [AddressForPageNumber, SimpleAllocate, WordsForPages],
MicroDefs,
MicroGlobalVars,
MicroOps;
MicroInputImpl:
CEDAR
PROGRAM
IMPORTS
Ascii, Basics, FS, IO, Rope, VM,
MicroGlobalVars, MicroOps
= BEGIN OPEN MicroDefs, MicroGlobalVars;
InputFile: TYPE = REF InputFileRec;
InputFileRec:
TYPE =
RECORD[
chain: InputFile, -- previous
labelSymIndex: INTEGER ← 0,
labelLineCount: INTEGER ← 0,
lineCount: INTEGER ← 0,
strm: STREAM,
fullName: ROPE];
fileChain: InputFile ← NIL; -- input stack for INSERT statements
currentFile: InputFile ← NIL;
stmtCharCount: INTEGER ← 0; -- backup char. count for current statement
minpt: CHAR = '\041; -- lowest printing character
maxpt: CHAR = '\176; -- highest printing character
eofChar: CHAR = IO.DEL; -- dummy character for eof
trailerChar: CHAR = '\032; -- Bravo trailer character
brktStkSize: CARDINAL = 30; -- Bracket/paren stack size
brktStack: ARRAY [0 .. brktStkSize) OF CHAR ← ALL[eofChar];
stmtBufferBottom: NAT;
stmtBufferEnd: NAT;
lastSym: NAT;
convertAllToUpper: BOOL ← FALSE;
InitIn:
PUBLIC
PROC = {
Initialize input variables
numPages: INT = 2;
IF stmtBuffer =
NIL
THEN {
buf: LONG POINTER ← VM.AddressForPageNumber[VM.SimpleAllocate[numPages].page];
stmtBuffer ← LOOPHOLE[buf, LONG POINTER TO WORD];
stmtBufferEnd ← VM.WordsForPages[numPages];
};
stmtBufferTop ← 0;
[] ← PushStmtChar[endc];
stmtBufferBottom ← stmtBufferTop;
fileChain ← NIL;
labelSymIndex ← 0;
labelLineCount ← 0;
lineCount ← 0;
};
InPush:
PUBLIC PROC[srcFile: MicroDefs.SrcFile]
RETURNS[fileOK:
BOOL] = {
Push down the input stack and open the indicated file; Return false if bad file
strm: STREAM;
fullName: ROPE ← ExpandNameWithExt[srcFile.fullName, ".mc"];
IF currentFile #
NIL
THEN {
currentFile.labelSymIndex ← labelSymIndex;
currentFile.labelLineCount ← labelLineCount;
currentFile.lineCount ← lineCount;
};
strm ← FS.StreamOpen[fullName ! FS.Error => { strm ← NIL; CONTINUE} ];
IF strm = NIL THEN RETURN[FALSE];
currentFile ← NEW[InputFileRec ← [chain: currentFile, fullName: fullName] ];
IF fileChain = NIL THEN fileChain ← currentFile;
currentFile.strm ← strm;
labelSymIndex ← 0;
labelLineCount ← lineCount ← 1;
reportStrm.PutF["* File: %g\n", IO.rope[fullName]];
RETURN[TRUE];
};
InPop:
PUBLIC
PROC
RETURNS[stackEmpty:
BOOL] = {
Pop input stack. Return true if stack empty
IF currentFile #
NIL
THEN {
currentFile.strm.Close[ ! IO.Error => CONTINUE];
currentFile ← currentFile.chain;
};
IF currentFile = NIL THEN RETURN[TRUE];
labelSymIndex ← currentFile.labelSymIndex;
labelLineCount ← currentFile.labelLineCount;
lineCount ← currentFile.lineCount;
MicroOps.ListingReport["* Return to: ", currentFile.fullName];
RETURN[FALSE];
};
InitReadStmt:
PUBLIC
PROC[raiseFlag:
BOOL] = {
convertAllToUpper ← raiseFlag;
stmtTailTop ← stmtTailBottom ← stmtBufferEnd - 1;
};
ReadStmt:
PUBLIC
PROC
RETURNS[stmtOK:
BOOL] = {
Read a statement, return false on eof
brktPtr: NAT ← 0;
stmtLineCount ← lineCount;
stmtCharCount ← 0;
stmtBufferTop ← stmtBufferBottom; -- (stmtBuffer+0)^ contains endc
lastSym ← stmtBufferTop;
DO
char: CHAR ← GetInputChar[];
stmtCharCount ← stmtCharCount + 1;
SELECT char
FROM
trailerChar => FlushInput['\n, IO.SP]; -- bravo trailer
'\n => {
lineCount ← lineCount + 1;
IF stmtBufferTop = stmtBufferBottom
THEN
{ stmtLineCount ← lineCount; stmtCharCount ← 0 };
};
eofChar => {
-- end of file
IF stmtBufferTop # stmtBufferBottom
THEN {
MicroOps.ReportError["\n*** File ends with incomplete statement\n", FALSE];
stmtBufferTop ← stmtBufferBottom;
};
IF InPop[] THEN RETURN[FALSE]; --end of top-level file
stmtLineCount ← lineCount;
stmtCharCount ← 0;
};
'% => {
-- multi-line comment
FlushInput['%, IO.NUL];
IF stmtBufferTop = stmtBufferBottom
THEN
{ stmtLineCount ← lineCount; stmtCharCount ← 0 };
};
'* => {
nextChar: CHAR ← GetInputChar[];
EofError:
PROC = {
MicroOps.ReportError["\n*** End of file inside comment\n", FALSE];
};
IF nextChar = eofChar
THEN { EofError[];
RETURN[
FALSE] }
ELSE {
IF nextChar # commentChar THEN FlushInput['\n, nextChar]
ELSE {
-- Look for sequence *commentChar
FlushInput['*, nextChar];
nextChar ← GetInputChar[];
IF nextChar = eofChar
THEN
{ EofError[]; RETURN[FALSE] };
IF nextChar = commentChar
THEN
{ FlushInput['\n, IO.NUL]; EXIT };
};
};
IF stmtBufferTop = stmtBufferBottom
THEN
{ stmtLineCount ← lineCount; stmtCharCount ← 0 };
};
'(, '[ => {
IF brktPtr = brktStkSize
THEN
{ BrktStkError["Too much nesting of () and []"]; EXIT };
brktPtr ← brktPtr + 1;
brktStack[brktPtr] ← char;
IF ~DoDelimiter[char] THEN EXIT;
};
') => {
IF brktStack[brktPtr] # '(
THEN
{ BrktStkError["Unmatched )\n"]; EXIT };
brktPtr ← brktPtr - 1;
IF ~DoDelimiter[char] THEN EXIT;
};
'] => {
IF brktStack[brktPtr] # '[
THEN
{ BrktStkError["Unmatched ]\n"]; EXIT };
brktPtr ← brktPtr - 1;
IF ~DoDelimiter[char] THEN EXIT;
};
'#, '← => {
-- Suppress symbol lookup
lastSym ← stmtBufferTop;
IF ~PushStmtChar[char] THEN EXIT;
};
':, ', => IF ~DoDelimiter[char] THEN EXIT;
'; => {
-- end of statement
IF brktStack[brktPtr] # eofChar THEN BrktStkError[ "Unmatched ( or [\n" ];
EXIT
};
IN ['a .. 'z] => {
IF convertAllToUpper THEN char ← Ascii.Upper[char];
IF ~PushStmtChar[char] THEN EXIT;
};
IN ['A ..'Z] => IF ~PushStmtChar[char] THEN EXIT;
IN ['0 ..'9] => IF ~PushStmtChar[char] THEN EXIT;
< minpt => NULL; -- Non-printing control character
ENDCASE => IF ~PushStmtChar[char] THEN EXIT; -- punctuation character
ENDLOOP;
stmtTailTop ← stmtTailBottom ← stmtBufferEnd;
RETURN[TRUE];
};
GetStmtChar:
PUBLIC
PROC[offset:
NAT]
RETURNS[ch:
CHAR] =
TRUSTED {
byte: BYTE ← Basics.LowByte[(stmtBuffer+offset)^];
RETURN[LOOPHOLE[byte, CHAR] ];
};
PutStmtChar:
PUBLIC
PROC[offset:
NAT, ch:
CHAR] = {
sn: Basics.ShortNumber;
sn.hi ← 0;
sn.lo ← LOOPHOLE[ch, BYTE];
TRUSTED { (stmtBuffer+offset)^ ← LOOPHOLE[sn, WORD] };
};
GetStmtInteger:
PUBLIC
PROC[offset:
NAT]
RETURNS[val:
INTEGER] =
TRUSTED { RETURN[LOOPHOLE[(stmtBuffer+offset)^, INTEGER]] };
PutStmtInteger:
PUBLIC
PROC[offset:
NAT, val:
INTEGER] =
TRUSTED { (stmtBuffer+offset)^ ← LOOPHOLE[val, WORD] };
GetStmtValue:
PUBLIC
PROC[offset:
NAT]
RETURNS[val:
WORD] =
TRUSTED { RETURN[(stmtBuffer+offset)^]};
PutStmtValue:
PUBLIC
PROC[offset:
NAT, val:
WORD] =
TRUSTED { (stmtBuffer+offset)^ ← val };
PushStmtChar:
PUBLIC
PROC[ch:
CHAR]
RETURNS[pushOK:
BOOL] = {
sn: Basics.ShortNumber;
sn.hi ← 0;
sn.lo ← LOOPHOLE[ch, BYTE];
RETURN[PushStmtValue[LOOPHOLE[sn, WORD]] ];
};
PushStmtInteger:
PUBLIC
PROC[val:
INTEGER]
RETURNS [
BOOL] =
{ RETURN[PushStmtValue[LOOPHOLE[val, WORD]] ] };
PushStmtValue:
PUBLIC
PROC[val:
WORD]
RETURNS[pushOK:
BOOL] =
TRUSTED {
IF stmtBufferTop >= stmtBufferEnd THEN RETURN[FALSE];
(stmtBuffer + stmtBufferTop)^ ← val;
stmtBufferTop ← stmtBufferTop + 1;
RETURN[TRUE];
};
MoveValueInStmtBuffer:
PUBLIC
PROC[to, from:
NAT] =
TRUSTED {
(stmtBuffer + to)^ ← (stmtBuffer + from)^;
};
LookupBufferSymbol:
PUBLIC
PROC[offset:
NAT, len:
INTEGER]
RETURNS[symIndex: INTEGER, symb: ATOM] = TRUSTED {
[symIndex, symb] ← MicroOps.LookupSymbol[stmtBuffer+offset, len];
};
Internal procedures
DoDelimiter:
PROC[char:
CHAR]
RETURNS[delimOK:
BOOL] = {
nChars: NAT = stmtBufferTop - lastSym;
firstChar: CHAR = GetStmtChar[lastSym];
IF (nChars >= 1)
AND Ascii.Letter[firstChar]
THEN {
symbolPtr: INTEGER;
TRUSTED {symbolPtr ← MicroOps.LookupSymbol[stmtBuffer+lastSym, nChars].symIndex};
IF symbolPtr # 0
THEN {
stmtBufferTop ← lastSym;
[] ← PushStmtInteger[symbolPtr];
[] ← PushStmtChar[symc];
lastSym ← stmtBufferTop + 1;
RETURN[PushStmtChar[char]];
};
}
ELSE {
-- might this be an octal number?
IF firstChar <= '7 AND (nChars IN [1 .. 6]) AND
(firstChar >= (
IF nChars = 1
THEN '0
ELSE '1) )
THEN {
-- whew
isNum: BOOL;
val: CARDINAL;
[isNum, val] ← CheckForOctalNum[nChars];
IF isNum
THEN {
stmtBufferTop ← lastSym;
[] ← PushStmtValue[LOOPHOLE[val]];
[] ← PushStmtChar[numc];
lastSym ← stmtBufferTop + 1;
RETURN[PushStmtChar[char]];
};
};
};
lastSym ← stmtBufferTop + 1;
RETURN[PushStmtChar[char]];
};
CheckForOctalNum:
PROC[nChars:
NAT]
RETURNS[
BOOL,
CARDINAL] = {
valW: WORD ← 0;
FOR p:
NAT
IN [lastSym .. lastSym+nChars)
DO
charN: NAT ← GetStmtChar[p] - '0;
this: WORD ← charN;
IF ~( this IN [0 .. 7]) THEN RETURN[FALSE, 0];
IF Basics.BITAND[valW, 160000B] # 0 THEN RETURN[FALSE, 0]; -- would overflow
valW ← Basics.BITSHIFT[valW, 3] + this;
ENDLOOP;
RETURN[TRUE, LOOPHOLE[valW, CARDINAL] ];
};
GetInputChar:
PROC
RETURNS[ch:
CHAR] =
{ ch ← currentFile.strm.GetChar[ ! IO.EndOfStream => {ch ← eofChar; CONTINUE} ] };
FlushInput:
PROC[marker, fChar:
CHAR] = {
Flush input stream until marker is detected.
Increment stmtCharCount for each character skipped
DO
IF fChar < minpt
THEN {
IF fChar = trailerChar THEN { FlushInput['\n, IO.SP]; fChar ← '\n };
IF fChar = '\n THEN lineCount ← lineCount + 1;
};
IF fChar = eofChar
THEN {
MicroOps.ReportError["\nEnd of File inside Comment\n", FALSE];
RETURN
};
IF fChar = marker THEN RETURN;
fChar ← GetInputChar[];
stmtCharCount ← stmtCharCount + 1;
ENDLOOP;
};
BrktStkError:
PROC[msg:
ROPE] = {
MicroOps.ReportError[msg, FALSE];
FlushInput[';, IO.NUL];
stmtBufferTop ← 1;
};
PrintStatement:
PUBLIC PROC[out:
STREAM] = {
Print the last statement read, by backing up the input stream by stmtCharCount characters
Remove Bravo trailers
pos: INT;
lastChar: CHAR;
inTrailer: BOOL ← FALSE;
IF currentFile = NIL OR currentFile.strm = NIL THEN RETURN;
pos ← currentFile.strm.GetIndex[];
currentFile.strm.SetIndex[pos - stmtCharCount];
FOR i:
INT
IN [1 .. stmtCharCount)
DO
lastChar ← GetInputChar[];
IF lastChar = trailerChar THEN { inTrailer ← TRUE; LOOP };
IF lastChar = '\n THEN inTrailer ← FALSE;
IF ~inTrailer THEN out.PutChar[lastChar];
ENDLOOP;
IF lastChar # '\n THEN out.PutChar['\n];
};
ExpandNameWithExt:
PUBLIC PROC[fileName, ext:
ROPE]
RETURNS[fullName:
ROPE] = {
cp: FS.ComponentPositions;
[fullName, cp, ] ← FS.ExpandName[fileName];
IF cp.ext.length = 0 THEN fullName ← fullName.Concat[ext];
};
for debugging
StrmIndex:
PROC
RETURNS[
INT] = {
IF currentFile = NIL THEN RETURN[-1];
IF currentFile.strm = NIL THEN RETURN[-1];
RETURN[currentFile.strm.GetIndex[]];
};
END.