<> <> <> <> 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 EXPORTS 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 = { <> 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] = { <> 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] = { <> 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] = { <> 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]; }; <> 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] = { <> <> 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] = { <> <> 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]; }; <> <<>> StrmIndex: PROC RETURNS[INT] = { IF currentFile = NIL THEN RETURN[-1]; IF currentFile.strm = NIL THEN RETURN[-1]; RETURN[currentFile.strm.GetIndex[]]; }; END.