<> <> <> DIRECTORY Basics USING [LowHalf, LowByte], IO USING [STREAM], Rope USING [ROPE]; PasPrivate: CEDAR DEFINITIONS IMPORTS Basics = BEGIN <> ROPE: TYPE = Rope.ROPE; --short names for Cedar things STREAM: TYPE = IO.STREAM; PascalInteger: TYPE = INT; PascalReal: TYPE = REAL; PascalMaxSetSize: NAT = 256; PascalIdentLength: NAT = 8; <> <> Standards: TYPE = -- Pascal standard files/procedures/functions/constants { Input, Output, Tty, ExtraFile1, ExtraFile2, Halt, Get, Put, Reset, Rewrite, Read, ReadLn, Write, WriteLn, Break, Pack, Unpack, New, Dispose, Page, Release, Assign, Concat, PutChar, GetFileName, Date, Time, ExtraProc1, ExtraProc2, ExtraProc3, ExtraProc4, ExtraProc5, Clock, Abs, Sqr, Sin, Cos, Exp, Ln, Sqrt, Arctan, Odd, Ord, Chr, Pred, Succ, EOF, EOLn, EOPage, Card, LowerBound, UpperBound, Min, Max, First, Last, Round, Trunc, Length, GetChar, ExtraFn1, ExtraFn2, ExtraFn3, ExtraFn4, ExtraFn5, MaxInteger, False, True, Nil, ExtraConst1, ExtraConst2}; StandardFiles: TYPE = Standards [Input..ExtraFile2]; StandardProcedures: TYPE = Standards [Halt..ExtraProc5]; StandardFunctions: TYPE = Standards [Clock..ExtraFn5]; StandardConstants: TYPE = Standards [False..ExtraConst2]; PascalStandardFileNames: ARRAY StandardFiles OF ROPE; PascalStandardProcedureNames: ARRAY StandardProcedures OF ROPE; PascalStandardFunctionNames: ARRAY StandardFunctions OF ROPE; Symbol: TYPE = -- scanner tokens { identSy, intConstSy, realConstSy, stringConstSy, notSy, mulOpSy, addOpSy, relOpSy, lParentSy, rParentSy, lBrackSy, rBrackSy, commaSy, semiColonSy, periodSy, arrowSy, colonSy, becomesSy, labelSy, constSy, typeSy, varSy, functionSy, procedureSy, packedSy, setSy, arraySy, recordSy, fileSy, forwardSy, beginSy, ifSy, caseSy, repeatSy, whileSy, forSy, withSy, loopSy, gotoSy, exitSy, endSy, elseSy, untilSy, ofSy, doSy, toSy, downToSy, externSy, programSy, thenSy, otherSy, othersSy, eofSy, CRSy}; Operator: TYPE = -- Pascal operators { noOp, plusOp, minusOp, mulOp, rDivOp, iDivOp, modOp, andOp, orOp, ltOp, gtOp, leOp, geOp, neOp, eqOp, inOp, notOp}; Errors: TYPE = -- various error types { MalformedProgram, MalformedBlock, MalformedStatement, MalformedAssignment, MalformedParameterList, MalformedProcedureCall, MultipleTypeDefinition, ShouldBeRecord, CantComputeConstant, MalformedVariable, MalformedArrayAccess, MalformedRecordAccess, MalformedExpression, MalformedSimpleExpression, MalformedTerm, MalformedFactor, MalformedConstant, MalformedSetConstructor, IllegalOperation, IncompatibleOperands, IllegalOperand, UnknownType, IllegalValue, IncompatibleTypes, CantExpressString, NotASet, Undefined, MultipleDefinition, MalformedInstr, MalformedStandard, MalformedNewDispose, ImproperType, MalformedPack, BadArgumentCount, MalformedIdList, MalformedSimpleType, MalformedRangeType, MalformedType, MalformedScalar, UnexpectedType, NotFiniteType, SetTooLarge, UndefinedType, MultiplyDefinedLabel, MalformedNonLocalGoTo, MalformedProcArrayDeclaration, MalformedComputedSeqArrayDeclaration, MalformedComputedSeqArrayAccess, MalformedProcArrayAccess, IdentifierMismatch, MalformedExternalProc, Confusion}; Name: TYPE = ROPE; LexLevel: TYPE = CARDINAL [0..31]; Position: TYPE = {outer, inner}; -- for generating the interfaces TypeFlavor: TYPE = {unknown, scalar, subRange, pointer, power, array, procArray, computedSeqArray, record, file, procedure}; Type: TYPE = RECORD [ SELECT form: TypeFlavor FROM unknown => NULL, scalar => -- integer, real, char, and boolean are instances of this [ firstId: ConstantIdentifierPtr, -- for boolean or user-defined type size: CARDINAL -- for boolean, char, and user-defined type ], subRange => [ hostType: GeneralTypePtr, -- host type: non-real scalar lower, upper: PascalInteger], pointer => [elType: GeneralTypePtr], -- pointed-to element type: any power => [baseType: GeneralTypePtr], <> array => [ aIsPacked: BOOLEAN _ FALSE, aIsDynamic: BOOLEAN _ FALSE, -- represented as pointer aElType: GeneralTypePtr, -- element type: any type aIxType: GeneralTypePtr <> ], procArray => [ aElType: GeneralTypePtr, -- any type indices: IdentifierSetPtr], computedSeqArray => [ aElType: GeneralTypePtr], -- any type record => [recIsPacked: BOOLEAN _ FALSE, fieldList: FieldListPtr], file => [ fileIsPacked: BOOLEAN _ FALSE, textFile: BOOLEAN _ FALSE, fileType: GeneralTypePtr -- file element type: any type ], procedure => [ result: GeneralTypePtr, -- = nilGeneralTypePtr if non-function formals: IdentifierSetPtr], ENDCASE] _ [unknown[]]; -- Type TypePtr: TYPE = REF Type; ScalarTypePtr: TYPE = REF scalar Type; SubRangeTypePtr: TYPE = REF subRange Type; PointerTypePtr: TYPE = REF pointer Type; PowerTypePtr: TYPE = REF power Type; ArrayTypePtr: TYPE = REF array Type; ProcArrayTypePtr: TYPE = REF procArray Type; ComputedSeqArrayTypePtr: TYPE = REF computedSeqArray Type; RecordTypePtr: TYPE = REF record Type; FileTypePtr: TYPE = REF file Type; ProcedureTypePtr: TYPE = REF procedure Type; FieldList: TYPE = RECORD [ fieldSet: IdentifierSetPtr, -- set of fields firstVariant: VariantPtr _ NIL, -- NIL if no variants tagSpecific: SELECT tagStatus: * FROM identified => [tagId: VariableIdentifierPtr], <> unidentified => [tagType: GeneralTypePtr], <> <> ENDCASE] _ nilFieldList; nilFieldList: FieldList = [fieldSet: NIL, firstVariant: NIL, tagSpecific: unidentified[tagType: nilGeneralTypePtr]]; FieldListPtr: TYPE = REF FieldList; Variant: TYPE = RECORD [ nextVariant: VariantPtr, -- to next variant in this record tagValue: PascalInteger, -- that activates this variant fieldList: FieldListPtr]; VariantPtr: TYPE = REF Variant; IdentifierFlavor: TYPE = --possible tag fields for Identifier variant record {unknown, type, constant, realConstant, charArrayConstant, variable, procedure, label, config, defsModule, implModule, outerItem, compileDifferently, programSegment}; Identifier: TYPE = RECORD [ name: Name, -- the actual name hash: INTEGER _ , -- a hash code, to make searching lists of identifiers faster type: GeneralTypePtr, -- the type descriptor class: IdentifierTailPtr]; IdentifierTail: TYPE = RECORD [ t: SELECT idClass: IdentifierFlavor FROM unknown, type => NULL, constant => [scalarLink: ConstantIdentifierPtr, value: PascalInteger], realConstant => NULL, charArrayConstant => NULL, variable => [kind: {normal, var} _ normal], procedure => [ source: SELECT declKind: * FROM standard => [key: Standards], <> parameter => NULL, declared => [ forward: BOOLEAN _ FALSE, defining: BOOLEAN _ FALSE, -- now within definition inline: BOOLEAN _ FALSE, -- translate as an INLINE headerQ: OutputQueuePtr -- translation of header ], ENDCASE], label => [ nonLocal: BOOL _ FALSE, -- NonLocal goto's are implemented with Signals. <> forwardTarget: BOOL _ FALSE, backwardTarget: BOOL _ FALSE, alreadyDefined: BOOL _ FALSE ], defsModule => [ openees: IdentifierSetPtr, -- these go into the directory and open clause of this defs importees: IdentifierSetPtr, -- these go into the imports clause compileMe: BOOL _ TRUE, -- false for either a trash or an external defs exportMe: BOOL _ TRUE, --false for a trash defs q: OutputQueuePtr ], implModule => [ openedDefs: IdentifierSetPtr, -- these go into the directory and open clause of this impl importedDefs: IdentifierSetPtr, -- these go into the imports clause openedAndImportedImpls: IdentifierSetPtr, -- these too, in case of importing pointer to frame exportees: IdentifierSetPtr, -- and these are the exports compileMe: BOOL _ TRUE, -- false for either a trash or an external impl bindMe: BOOL _ TRUE, -- false for a trash impl q: OutputQueuePtr ], compileDifferently => [ arrayHow: ArrayDifferentlyMethod _ notAtAll, procHow: ProcDifferentlyMethod _ notAtAll ], programSegment => -- constructed from command file [ mentionedProcedures: IdentifierSetPtr, -- consisting of programSegments mentionedVariables: IdentifierSetPtr -- consisting of compileDifferently's ], config => -- constructed from command files that ask for modularization [ mentionedIdents: IdentifierSetPtr -- consisting of outerItem's ], outerItem => -- something in the outer block [ dest: DestinationPtr -- says where the item should go ], ENDCASE _ unknown[]]; -- Identifier ArrayDifferentlyMethod: TYPE = {notAtAll, specialArray, procArray, computedSeqArray}; <> <> <> <> <> <> <> ProcDifferentlyMethod: TYPE = {notAtAll, inlineProc}; <> IdentifierPtr: TYPE = REF Identifier; IdentifierTailPtr: TYPE = REF IdentifierTail; <> <> ConstantIdentifierPtr: TYPE = IdentifierPtr; VariableIdentifierPtr: TYPE = IdentifierPtr; ProcedureIdentifierPtr: TYPE = IdentifierPtr; DeclaredProcedureIdentifierPtr: TYPE = IdentifierPtr; SegmentIdentifierPtr: TYPE = IdentifierPtr; <> ConstantIdentifierTailPtr: TYPE = REF constant IdentifierTail; VariableIdentifierTailPtr: TYPE = REF variable IdentifierTail; ProcedureIdentifierTailPtr: TYPE = REF procedure IdentifierTail; DeclaredProcedureIdentifierTailPtr: TYPE = REF declared procedure IdentifierTail; SegmentIdentifierTailPtr: TYPE = REF programSegment IdentifierTail; <> <> <> IdentifierSet: TYPE = LIST OF IdentifierPtr _ NIL; -- default is empty IdentifierSetPtr: TYPE = REF IdentifierSet; <> Destination: TYPE = RECORD [ defsModule: IdentifierPtr, implModule: IdentifierPtr]; DestinationPtr: TYPE = REF Destination; GeneralTypePtr: TYPE = REF ANY; <> <> <> nilGeneralTypePtr: GeneralTypePtr = NIL; Value: TYPE = RECORD [ type: GeneralTypePtr, value: ValueTailPtr]; ValueTail: TYPE = RECORD [ SELECT binding: * FROM unknown => NULL, variable, nonConstant, otherConstant => [ translation: OutputQueuePtr _ NIL], scalarConstant => [v: ScalarConstant], stringConstant => [v: ROPE], -- turns into otherConstant on translation setConstructor => [v: SetIntervalPtr], -- a chain of SetIntervals ENDCASE] _ [unknown[]]; ValuePtr: TYPE = REF Value; ValueTailPtr: TYPE = REF ValueTail; ScalarConstantValueTailPtr: TYPE = REF scalarConstant ValueTail; -- can be checked ScalarConstantValuePtr: TYPE = REF Value; -- but this one just indicates our intentions ScalarConstant: TYPE = RECORD [ value: PascalInteger _ 0, -- used only for non-real scalars, or subranges translation: OutputQueuePtr _ NIL]; SetInterval: TYPE = RECORD [ next: SetIntervalPtr, lower: ValuePtr, rest: SELECT case: * FROM singleton => NULL, interval => [upper: ValuePtr], ENDCASE]; SetIntervalPtr: TYPE = REF SetInterval; DisplayEntry: TYPE = RECORD [ locals: IdentifierSetPtr, formals: SELECT formalSource: * FROM call => [ programSegment: SegmentIdentifierPtr _ NIL, isp: IdentifierSetPtr], with => [flp: FieldListPtr], ENDCASE] _ [locals: NIL, formals: call[isp: NIL]]; DisplayEntryPtr: TYPE = REF DisplayEntry; OutputQueue: TYPE = RECORD [ contents: ROPE _ NIL, fileName: ROPE _ NIL -- NIL means that this Queue is purely temporary ]; OutputQueuePtr: TYPE = REF OutputQueue; SourceFileSeqPtr: TYPE = REF SourceFileSeq; SourceFileSeq: TYPE = RECORD [ next: SourceFileSeqPtr, name: ROPE ]; TargetLanguage: TYPE = {mesa, longMesa, cedar}; ItemType: TYPE = {globalLabel, type, const, var, proc, main}; <

> <<** Implemented in PasBlock>> TranslateProgram: PROCEDURE; TranslateBlock: PROCEDURE [position: Position]; <<** Implemented in PasDecl>> TranslateConstantDeclaration: PROCEDURE [position: Position] RETURNS [saySemiColon: BOOL _ TRUE]; TranslateTypeDeclaration: PROCEDURE [position: Position] RETURNS [saySemiColon: BOOL _ TRUE]; TranslateVariableDeclaration: PROCEDURE [position: Position] RETURNS [saySemiColon: BOOL _ TRUE]; TranslateProcedureDeclaration: PROCEDURE [position: Position, isFunction: BOOL]; TranslateProcedureCall: PROCEDURE [id: IdentifierPtr] RETURNS [ValuePtr]; ExtractResultType: PROCEDURE [id: IdentifierPtr] RETURNS [GeneralTypePtr]; <<** Implemented in PasErrs>> Error: PROCEDURE [reason: Errors]; Warning: PROCEDURE [reason: Errors, extraInfo: ROPE _ NIL]; PasMesaError: ERROR [reason: ROPE]; <<** Implemented in PasExpr>> TranslateVariable: PROCEDURE [isLHS: BOOL _ FALSE] RETURNS [ValuePtr]; ParseVariable: PROCEDURE [isLHS: BOOL _ FALSE] RETURNS [ValuePtr]; <> <> TranslateExpression: PROCEDURE [st: GeneralTypePtr _ nilGeneralTypePtr] RETURNS [ValuePtr]; ParseExpression: PROCEDURE [st: GeneralTypePtr _ nilGeneralTypePtr] RETURNS [ValuePtr]; ParseConstant: PROCEDURE RETURNS [ValuePtr]; ParseConstantExpression: PROCEDURE RETURNS [ValuePtr]; ParseCountableConstant: PROCEDURE RETURNS [ScalarConstantValuePtr]; ParseFiniteConstant: PROCEDURE RETURNS [ScalarConstantValuePtr]; CoerceToReal: PROCEDURE [vp: ValuePtr]; CoerceToLong: PROCEDURE [vp: ValuePtr]; ExpressStringConstant: PROCEDURE [v: ValuePtr, st: GeneralTypePtr]; ExtractTranslation: PROCEDURE [ v: ValuePtr, st: GeneralTypePtr _ nilGeneralTypePtr] RETURNS [OutputQueuePtr]; SayTranslation: PROCEDURE [v: ValuePtr, st: GeneralTypePtr _ nilGeneralTypePtr]; <<** Implemented in PasIdent>> CreateIdentifierSet: PROCEDURE RETURNS [pset: IdentifierSetPtr]; InitIdentifierSet: PROCEDURE [pset: IdentifierSetPtr]; DisposeIdentifierSet: PROCEDURE [pset: IdentifierSetPtr]; EmptyIdentifierSet: PROCEDURE [pset: IdentifierSetPtr] RETURNS [BOOL]; EnumerateIdentifierSet: PROCEDURE [ pset: IdentifierSetPtr, p: PROCEDURE [IdentifierPtr]]; -- in insertion order MergeIdentifierSets: PROCEDURE [ into: IdentifierSetPtr _ NIL, from: IdentifierSetPtr]; <> AssignTypeToIdSet: PROCEDURE [pset: IdentifierSetPtr, type: GeneralTypePtr]; <> NewIdent: PROCEDURE [ name: Name _ NIL, pset: IdentifierSetPtr _ NIL] RETURNS [IdentifierPtr]; <> InsertOldIdent: PROCEDURE [ id: IdentifierPtr, pset: IdentifierSetPtr]; <> IdentLookup: PROCEDURE [ name: Name _ NIL, pset: IdentifierSetPtr _ NIL, pfl: FieldListPtr _ NIL, couldFail: BOOLEAN _ FALSE] RETURNS [IdentifierPtr]; <> <<** Implemented in PasInit>> InitializeStandards: PROCEDURE; InitializeModules: PROCEDURE; FinishModules: PROCEDURE; <<** Implemented in PasOut>> CharToQueue: PROCEDURE [c: CHARACTER, q: OutputQueuePtr _ NIL]; CharToQueueStart: PROCEDURE [c: CHARACTER, q: OutputQueuePtr _ NIL]; StringToQueue: PROCEDURE [s: ROPE, q: OutputQueuePtr _ NIL]; StringToQueueStart: PROCEDURE [s: ROPE, q: OutputQueuePtr _ NIL]; MergeQueue: PROCEDURE [from: OutputQueuePtr, to: OutputQueuePtr _ NIL]; MergeQueueStart: PROCEDURE [from: OutputQueuePtr, to: OutputQueuePtr _ NIL]; CopyQueue: PROCEDURE [from: OutputQueuePtr, to: OutputQueuePtr _ NIL]; ClearQueue: PROCEDURE [q: OutputQueuePtr _ NIL]; BalanceQueue: PROCEDURE [q: OutputQueuePtr _ NIL]; PushOut: PROCEDURE [q: OutputQueuePtr _ NIL]; PopOut: PROCEDURE; CopyAndPopOut: PROCEDURE RETURNS [OutputQueuePtr]; <<** Implemented in PasScanner>> SourceFromStream: PROCEDURE [stream: STREAM, name: ROPE]; SourceFromNextStream: PROCEDURE; -- uses sourceFileSeq InSymbol: PROCEDURE [stopAtCR: BOOLEAN _ FALSE]; <> StringToPascalInteger: PROCEDURE [s: ROPE] RETURNS [PascalInteger]; SayPascalInteger: PROCEDURE [i: PascalInteger]; NarrowPascalInteger: PROCEDURE [i: PascalInteger] RETURNS [NAT] = INLINE {RETURN[i]}; PascalIntegerToCh: PROCEDURE [i: PascalInteger] RETURNS [CHARACTER] = INLINE { RETURN[LOOPHOLE[Basics.LowByte[ Basics.LowHalf[LOOPHOLE[i,LONG CARDINAL]]], CHARACTER]]}; CouldBe: PROCEDURE [testSy: Symbol, string: ROPE _ NIL] RETURNS [BOOLEAN]; MustBe: PROCEDURE [testSy: Symbol, string: ROPE _ NIL, e: Errors]; SequenceOf: PROCEDURE [ p: PROCEDURE, separatorSy: Symbol _ semiColonSy, separatorString: ROPE _ NIL]; RespondCh: PROCEDURE [c: CHARACTER] = INLINE {SayCh[c]; InSymbol[]}; SayCh: PROCEDURE [c: CHARACTER] = INLINE {CharToQueue[c]}; <> Respond: PROCEDURE [s: ROPE] = INLINE {Say[s]; InSymbol[]}; Say: PROCEDURE [s: ROPE] = INLINE {StringToQueue[s]}; <> SayIdent: PROCEDURE [s: ROPE _ NIL]; <> RopeSayIdent: PROCEDURE [s: ROPE _ NIL] RETURNS [r: ROPE]; <> SayLine: PROCEDURE [s: ROPE _ NIL] = INLINE {Say[s]; SayCh['\n]}; <> <<** Implemented in PasStd>> TranslateStandardProcedure: PROCEDURE [key: Standards]; TranslateStandardFunction: PROCEDURE [key: Standards] RETURNS [ValuePtr]; <<** Implemented in PasType>> SayScalar: PROCEDURE [t: GeneralTypePtr, i: PascalInteger]; SayScalarAsInteger: PROCEDURE [t: GeneralTypePtr, i: PascalInteger]; SayType: PROCEDURE [gtp: GeneralTypePtr]; -- elaborates a type translation SaySetType: PROCEDURE [t: TypePtr]; SaySetOriginOffset: PROCEDURE [baseType: GeneralTypePtr]; IsScalarType: PROCEDURE [gtp: GeneralTypePtr] RETURNS [BOOLEAN]; IsCountableType: PROCEDURE [gtp: GeneralTypePtr] RETURNS [BOOLEAN]; IsCountableHostType: PROCEDURE [gtp: GeneralTypePtr] RETURNS [BOOLEAN]; IsFiniteType: PROCEDURE [gtp: GeneralTypePtr] RETURNS [BOOLEAN]; GenScalarType: PROCEDURE [gtp: GeneralTypePtr] RETURNS [GeneralTypePtr]; GenCountableType: PROCEDURE [gtp: GeneralTypePtr] RETURNS [GeneralTypePtr]; GenCountableHostType: PROCEDURE [gtp: GeneralTypePtr] RETURNS [GeneralTypePtr]; GenFiniteType: PROCEDURE [gtp: GeneralTypePtr] RETURNS [t: GeneralTypePtr, lower, upper: PascalInteger]; GetConcreteType: PROCEDURE [gtp: GeneralTypePtr] RETURNS [TypePtr]; GetScalarType: PROCEDURE [gtp: GeneralTypePtr] RETURNS [TypePtr] = INLINE { RETURN[GetConcreteType[GenScalarType[gtp]]]}; GetCountableType: PROCEDURE [gtp: GeneralTypePtr] RETURNS [TypePtr] = INLINE { RETURN[GetConcreteType[GenCountableType[gtp]]]}; GetCountableHostType: PROCEDURE [gtp: GeneralTypePtr] RETURNS [TypePtr] = INLINE {RETURN[GetConcreteType[GenCountableHostType[gtp]]]}; GetFiniteType: PROCEDURE [gtp: GeneralTypePtr] RETURNS [t: TypePtr, lower, upper: PascalInteger] = INLINE { g: GeneralTypePtr; [g, lower, upper] _ GenFiniteType[gtp]; t _ GetConcreteType[g]}; GetConcreteTypeOfValue: PROCEDURE [v: ValuePtr] RETURNS [TypePtr] = INLINE { RETURN[GetConcreteType[gtp: v.type]]}; ConcreteValue: PROCEDURE [ t: TypePtr, translation: OutputQueuePtr _ NIL] RETURNS [ValuePtr] = INLINE { RETURN[NEW[Value_[type: t, value: NEW[ValueTail _[nonConstant[translation: translation]]]]]]}; LikeValue: PROCEDURE [ id: IdentifierPtr, translation: OutputQueuePtr _ NIL] RETURNS [ValuePtr] = INLINE { RETURN[NEW[Value_[type: id, value: NEW[ValueTail _[nonConstant[translation: translation]]]]]]}; CheckForPascalString: PROCEDURE [t: GeneralTypePtr] RETURNS [is: BOOLEAN, length: PascalInteger]; PowerSetOf: PROCEDURE [t: GeneralTypePtr] RETURNS [GeneralTypePtr]; IsTextFile: PROCEDURE [t: GeneralTypePtr] RETURNS [BOOLEAN]; TranslateIdList: PROCEDURE [pset: IdentifierSetPtr _ NIL]; TranslateVariableList: PROCEDURE [ pset: IdentifierSetPtr _ NIL, fwdOK: BOOLEAN _ FALSE]; TranslateType: PROCEDURE [id: IdentifierPtr _ NIL, fwdOK: BOOLEAN _ FALSE, packArrays: BOOLEAN _ FALSE, outerArrayIsFunny: ArrayDifferentlyMethod _ notAtAll] RETURNS [GeneralTypePtr]; DisposeType: PROCEDURE [gtp: GeneralTypePtr]; END. -- Pas