MODULE; IMPORT BuiltInSlots, JunoAST, JunoCompileRep, JunoScope, JunoASTUtils AS Utils; IMPORT JunoByteCode AS BC, JunoRT, JunoRTError, JunoValue, WriteVal; IMPORT IntSeq; TYPE IntList = REF RECORD val: INTEGER; next: IntList END; LabelData = RECORD loc: INTEGER; (* location (index) of label in "code" *) refs: IntList; (* list of references (jumps) to this label *) END; VAR mu := NEW(MUTEX); loc: CARDINAL; (* current code location *) code := NEW(JunoRT.ByteStream, 1000); (* result bytestream buffer *) labelSeq := NEW(IntSeq.T).init(sizeHint := 100); TYPE Z3 = ARRAY [0..3] OF INTEGER; CONST NoLabel = 0; (* the number of an invalid label *) PROCEDURE JunoAssemble Cmd ( res: JunoCompileRep.Result; scp: JunoScope.T; temp_cnt: CARDINAL; type: CmdType): JunoRT.ByteStream = PROCEDURE Pred( pred: JunoAST.Formula; t, f: CARDINAL; tBranch: BOOLEAN) = (* Generate code for "pred" at the current location in the code stream. Generate a branch to label "t" if "pred" evaluates true, and to label "f" if "pred" evaluates false. Only generate a branch to "t" at the *end* of the stream if "tBranch" is "TRUE". The code generated to evaluate a predicate must restore the stack to its original state before branching to "t" or "f". NOTE: We do not need to handle the "JunoAST" cases "False", "And", "Or", "Not", "Exists", or "Differs", since those are eliminated by the compilation procedure "JunoCompile.Cmd.C2q". *) PROCEDURE UnaryPred(p: JunoAST.BIUPred; bc: JunoRT.ByteCode) = BEGIN Expr(p.e, f); PushByte(bc); FBranch(f); IF tBranch THEN Branch(t) END END UnaryPred; PROCEDURE Relation(p: JunoAST.Relation; bc: JunoRT.ByteCode) = BEGIN Expr(p.e1, f); IF Utils.AlwaysDefined(p.e2) THEN Expr(p.e2, f); PushByte(bc); FBranch(f); IF tBranch THEN Branch(t) END ELSE VAR popFirst := NewLabel(); BEGIN Expr(p.e2, popFirst); PushByte(bc); FBranch(f); Branch(t); SetLabelLoc(popFirst); PushByte(BC.DECSP); PushByte(1); Branch(f) END END END Relation; (* Pred *) BEGIN pred.start := loc; TYPECASE pred OF <* NOWARN *> JunoAST.True => IF tBranch THEN Branch(t) END | JunoAST.GroupedExpr (p) => Pred(p.expr, t, f, tBranch) | JunoAST.IsReal (p) => UnaryPred(p, BC.IS_REAL) | JunoAST.IsText (p) => UnaryPred(p, BC.IS_TEXT) | JunoAST.IsPair (p) => UnaryPred(p, BC.IS_PAIR) | JunoAST.IsInt (p) => UnaryPred(p, BC.IS_INT) | JunoAST.Equals (p) => Relation(p, BC.EQUAL) | JunoAST.Less (p) => Relation(p, BC.LESS) | JunoAST.AtMost (p) => Relation(p, BC.AT_MOST) | JunoAST.Cong (p) => Relation(p, BC.CONG) | JunoAST.Para (p) => Relation(p, BC.PARA) | JunoAST.Hor (p) => Relation(p, BC.HOR) | JunoAST.Ver (p) => Relation(p, BC.VER) | JunoAST.Greater (p) => Relation(NEW(JunoAST.Relation, e1 := p.e2, e2 := p.e1), BC.LESS) | JunoAST.AtLeast (p) => Relation(NEW(JunoAST.Relation, e1 := p.e2, e2 := p.e1), BC.AT_MOST) | JunoAST.Call (c) => (* Push IN's *) ExprList(c.ins, f); (* Generate CALL instruction *) PushByte(BC.CALL); PushULong(c.name.index); (* Skip past IN's *) Repeat(BC.DECSP, c.ins.size); (* Branch appropriately *) FBranch(f); IF tBranch THEN Branch(t) END END; pred.end := loc END Pred; PROCEDURE OutInout(outCnt: CARDINAL; inouts: JunoAST.ExprList) = BEGIN Repeat(BC.INCSP, outCnt); (* Leave space for OUT's *) QIdList(inouts); (* Push INOUT's *) END OutInout; PROCEDURE AfterCall(inCnt: CARDINAL; inouts: JunoAST.ExprList; uJump: BOOLEAN; label: INTEGER := NoLabel) = (* Lay down the instructions after a "JunoAST.Call" node has been assembled. Namely, write instructions to skip the SP down past the "inCnt" IN parameters and to pop the INOUT parameters into "inouts". Then, if "uJump" is TRUE, write a "UJUMP" instruction to the offset "label". On return from a user-defined function, functional procedure, or functional external procedure, the internal condition bit is set as the function was defined or not. The UBRANCH instruction tests if the condition bit was set. If it was, the instruction is a no-op; otherwise, it decrements SP past the single OUT parameter, sets the internal "undefined term" address, and branches to its argument "label". *) BEGIN Repeat(BC.DECSP, inCnt); PopQIds(inouts.head, scp); IF uJump THEN PushByte(BC.UJUMP); AddReference(label) END END AfterCall; PROCEDURE AfterProcCall(inCnt: CARDINAL; inouts, outs: JunoAST.ExprList) = BEGIN Repeat(BC.DECSP, inCnt); PopQIds(inouts.head, scp); PopQIds(outs.head, scp) END AfterProcCall; PROCEDURE Apply(outCnt, inoutCnt: CARDINAL; ins: JunoAST.ExprList; u: CARDINAL) = (* Assuming space has already been left for the OUT parameters and the INOUT parameters have been pushed on the stack, write code to assemble an "APPLY" expression with "outCnt" OUT parameters, "inoutCnt" INOUT parameters, and with IN parameters in "ins". The generated code branches to "u" in the event that the APPLY bytecode instruction is undefined or if any of the expressions in "ins" is undefined. *) BEGIN ins.start := loc; (* Push APPLY arguments except the first *) ExprListTail(ins.head.next, u, level := outCnt + inoutCnt); (* Push 1st APPLY (closure) argument *) VAR expr := ins.head.expr; BEGIN IF Utils.AlwaysDefined(expr) THEN Expr(expr, u := NoLabel) ELSE VAR def, pop := NewLabel(); BEGIN Expr(expr, pop); Branch(def); SetLabelLoc(pop); Repeat(BC.DECSP, outCnt + inoutCnt + ins.size - 1); Branch(u); SetLabelLoc(def) END END END; ins.end := loc; (* Generate APPLY instruction *) PushByte(BC.APPLY); PushUShort(outCnt); PushUShort(inoutCnt); PushUShort(ins.size - 1); AddReference(u); (* On return from "APPLY", adjust the stack pointer to account for the IN parameters in the run-time closure. *) PushByte(BC.CLDECSP) END Apply; PROCEDURE Expr(expr: JunoAST.Expr; u: CARDINAL) = (* Generate code at the current location in the code stream to place the value of "expr" on the top of the stack. Generate a branch to label "u" if any portion of the evaluation is undefined; in that case, the code must restore the stack to its original state before executing the instruction to branch to "u". *) PROCEDURE UnaryFunc(f: JunoAST.BIUFunc; bc: JunoRT.ByteCode) = BEGIN Expr(f.e, u); PushByte(bc); IF u # NoLabel THEN AddReference(u) ELSE (* this case can arise because the negation of a literal number is always defined *) StuffShort(loc, u); INC(loc, 2); END END UnaryFunc; PROCEDURE BinaryFunc( f: JunoAST.BIBFunc; bc: JunoRT.ByteCode; uArg := TRUE) = BEGIN Expr(f.e1, u); IF Utils.AlwaysDefined(f.e2) THEN Expr(f.e2, u := NoLabel); PushByte(bc); IF uArg THEN AddReference(u) END ELSE VAR popFirst, defined := NewLabel(); BEGIN Expr(f.e2, popFirst); Branch(defined); SetLabelLoc(popFirst); PushByte(BC.DECSP); PushByte(1); Branch(u); SetLabelLoc(defined); PushByte(bc); IF uArg THEN AddReference(u) END; END END END BinaryFunc; (* Expr *) BEGIN expr.start := loc; TYPECASE expr OF <* NOWARN *> | JunoAST.Number (e) => PushByte(BC.PUSHNUM); PushReal(e.val) | JunoAST.Nil => PushByte(BC.PUSHNIL) | JunoAST.Text (e) => PushByte(BC.PUSHG); PushULong(e.index) | JunoAST.QId (e) => <* ASSERT e.index # 0 *> CASE e.type OF <* NOWARN *> | JunoAST.IdType.Local => PushByte(BC.PUSHL); PushShort(e.index) | JunoAST.IdType.Const, JunoAST.IdType.Var => PushByte(BC.PUSHG); PushULong(e.index) | JunoAST.IdType.Proc => PushByte(BC.NEWCL); PushULong(e.index) | JunoAST.IdType.ExtProc => PushByte(BC.NEWEXTCL); PushULong(e.index) END | JunoAST.GroupedExpr (e) => Expr(e.expr, u) | JunoAST.UMinus (e) => UnaryFunc(e, BC.NEGATE) | JunoAST.Floor (e) => UnaryFunc(e, BC.FLOOR_) | JunoAST.Ceiling (e) => UnaryFunc(e, BC.CEILING_) | JunoAST.Round (e) => UnaryFunc(e, BC.ROUND_) | JunoAST.Abs (e) => UnaryFunc(e, BC.ABS_) | JunoAST.Sin (e) => UnaryFunc(e, BC.SIN) | JunoAST.Cos (e) => UnaryFunc(e, BC.COS) | JunoAST.Exp (e) => UnaryFunc(e, BC.EXP) | JunoAST.Ln (e) => UnaryFunc(e, BC.LN) | JunoAST.Car (e) => UnaryFunc(e, BC.CAR) | JunoAST.Cdr (e) => UnaryFunc(e, BC.CDR) | JunoAST.Plus (e) => BinaryFunc(e, BC.ADD) | JunoAST.Minus (e) => BinaryFunc(e, BC.SUBTRACT) | JunoAST.Concat (e) => BinaryFunc(e, BC.CONCAT) | JunoAST.Times (e) => BinaryFunc(e, BC.MULTIPLY) | JunoAST.Divide (e) => BinaryFunc(e, BC.DIVIDE) | JunoAST.Div (e) => BinaryFunc(e, BC.DIV_) | JunoAST.Mod (e) => BinaryFunc(e, BC.MOD_) | JunoAST.Rel (e) => BinaryFunc(e, BC.REL) | JunoAST.Max (e) => BinaryFunc(e, BC.MAX_) | JunoAST.Min (e) => BinaryFunc(e, BC.MIN_) | JunoAST.Atan (e) => BinaryFunc(e, BC.ATAN) | JunoAST.Pair (e) => BinaryFunc(e, BC.CONS, uArg := FALSE) | JunoAST.List (e) => ExprList(e.elts, u); PushByte(BC.LIST); PushUShort(e.elts.size) | JunoAST.Call (c) => IF BuiltInSlots.IsCloseProc(c.name) THEN (* CLOSE(...) *) ExprList(c.ins, u); PushByte(BC.CLOSE); PushUShort(c.ins.size - 1); AddReference(u); ELSIF BuiltInSlots.IsApplyProc(c.name) THEN (* APPLY(...) *) OutInout(1, c.inouts); Apply(1, c.inouts.size, c.ins, u); (* After the call to APPLY, the condition bit is irrelevant, since calls to user-defined procedures never fail, and since the "APPLY" bytecode automatically signals a run-time error in the event that a call to an external procedure fails. *) AfterCall(c.ins.size - 1, c.inouts, uJump := FALSE) ELSE (* User-defined function, functional procedure, or functional external procedure *) OutInout(1, c.inouts); ExprList(c.ins, u, level := 1 + c.inouts.size); (* Generate CALL instruction *) VAR uJump: BOOLEAN; BEGIN CASE c.name.type OF <* NOWARN *> | JunoAST.IdType.Func => PushByte(BC.CALL); uJump := TRUE | JunoAST.IdType.Proc => PushByte(BC.CALL); uJump := FALSE | JunoAST.IdType.ExtProc => PushByte(BC.CALLEXT); uJump := FALSE END; PushULong(c.name.index); AfterCall(c.ins.size, c.inouts, uJump := uJump, label := u) END END END; expr.end := loc END Expr; PROCEDURE QIdList(l: JunoAST.ExprList) = (* Generates code to push the qualified identifiers in "l" onto the stack. Since the evaluation of a QId is never undefined, we need not generate code to restore the stack in the event of an undefined term. It is an unchecked runtime error for "l" to contain an expression "e" such that "NOT Utils.AlwaysDefined(e)". *) VAR curr := l.head; BEGIN l.start := loc; WHILE curr # NIL DO Expr(curr.expr, u := NoLabel); curr := curr.next END; l.end := loc END QIdList; PROCEDURE ExprList(l: JunoAST.ExprList; u: CARDINAL; level: CARDINAL := 0) = (* Generate code to push the expressions in the list "l" onto the stack, branching to label "u" if any of them are undefined. In this case, the stack is restored to its original state (before the first expression of "l" was evaluated) and an additional "level" elements are then popped off the stack before branching to "u". *) BEGIN l.start := loc; ExprListTail(l.head, u, level); l.end := loc END ExprList; PROCEDURE ExprListTail( l: JunoAST.ExprLink; u: CARDINAL; level: CARDINAL) = (* Generate code to push the expressions in the list "l" onto the stack, branching to label "u" if any are undefined. However, in this case, the stack is restored to its original state, and an additional "level" elements are popped from the stack before branching to "u". We use the global "labelsSeq" as a stack of labels. We push a new label value for each expression so we know afterward how much to decrement the stack pointer for each expression. This procedure preserves the size of "labelsSeq"; we could add code to assert that here, but instead, we simply assert at the end of "JunoAssemble.Cmd" the the size of the sequence is 0. *) VAR newLabels := FALSE; pop: INTEGER; stackSz := 0; BEGIN (* Push expressions *) WHILE l # NIL DO IF Utils.AlwaysDefined(l.expr) THEN pop := NoLabel ELSIF level + stackSz = 0 THEN pop := u ELSE pop := NewLabel(); newLabels := TRUE END; labelSeq.addhi(pop); INC(stackSz); Expr(l.expr, pop); l := l.next END; (* Generate code to pop (if necessary) *) IF newLabels THEN (* write branches for each new label *) VAR end := NewLabel(); BEGIN Branch(end); WHILE stackSz > 0 DO pop := labelSeq.remhi(); DEC(stackSz); IF pop # NoLabel AND pop # u THEN SetLabelLoc(pop); Repeat(BC.DECSP, level + stackSz); Branch(u) END END; SetLabelLoc(end) END ELSE (* pop "stackSz" elements from "labelSeq" stack *) WHILE stackSz > 0 DO pop := labelSeq.remhi(); DEC(stackSz) END END END ExprListTail; PROCEDURE Cmd0( cmd: JunoAST.Cmd; h, g, u: CARDINAL; hBranch: BOOLEAN) = (* Generate code for "cmd" at the current location in the code stream. Generate a branch to label "h" on successful termination, to label "g" on a guard failure, and to label "u" on an "undefined term" run-time error. Only generate a branch to "h" at the end of the stream if "hBranch" is "TRUE". *) BEGIN cmd.start := loc; TYPECASE cmd OF <* NOWARN *> JunoAST.Skip => IF hBranch THEN Branch(h) END | JunoAST.Abort => PushByte(BC.ERROR); PushByte(ORD(JunoRTError.Code.Abort)); IF hBranch THEN Branch(h) END | JunoAST.Halt => PushByte(BC.ERROR); PushByte(ORD(JunoRTError.Code.Halt)); IF hBranch THEN Branch(h) END | JunoAST.Fail => Branch(g) | JunoAST.Assign (c) => ExprList(c.exprs, u); PopQIds(c.vars.head, scp); IF hBranch THEN Branch(h) END | JunoAST.If (c) => VAR l := NewLabel(); BEGIN Cmd0(c.body, h, l, u, hBranch := TRUE); SetLabelLoc(l); PushByte(BC.ERROR); PushByte(ORD(JunoRTError.Code.IfFailure)) END | JunoAST.Do (c) => VAR l := NewLabel(); BEGIN SetLabelLoc(l); Cmd0(c.body, l, h, u, hBranch := TRUE) END | JunoAST.Seq (c) => Cmd0Seq(c, h, g, u, hBranch) | JunoAST.Else (c) => VAR l := NewLabel(); BEGIN Cmd0(c.c1, h, l, u, hBranch := TRUE); SetLabelLoc(l); Cmd0(c.c2, h, g, u, hBranch) END | JunoAST.GroupedCmd (c) => Cmd0(c.body, h, g, u, hBranch) | JunoAST.Flip (c) => Cmd0(c.body, g, h, u, hBranch := TRUE) | JunoAST.Safe (c) => Cmd0(c.body, h, g, g, hBranch) | JunoAST.ProcCall (c) => IF BuiltInSlots.IsApplyProc(c.name) THEN (* APPLY(...) *) OutInout(c.outs.size, c.inouts); Apply(c.outs.size, c.inouts.size, c.ins, u); AfterProcCall(c.ins.size - 1, c.inouts, c.outs) ELSE (* procedure or external procedure command *) OutInout(c.outs.size, c.inouts); ExprList(c.ins, u, level := c.outs.size + c.inouts.size); (* Generate CALL instruction *) CASE c.name.type OF <* NOWARN *> | JunoAST.IdType.Proc => PushByte(BC.CALL) | JunoAST.IdType.ExtProc => PushByte(BC.CALLEXT) END; PushULong(c.name.index); AfterProcCall(c.ins.size, c.inouts, c.outs) END; IF hBranch THEN Branch(h) END | JunoAST.Query (q) => <* ASSERT q.vars.size = 0 *> (* Query of form: P?() *) Pred(q.f, h, g, tBranch := hBranch) | JunoAST.ConjQuery (q) => (* Query of form: P?(v1,...,vn) (represented by arrays) *) IF NUMBER(q.conj^) > 0 THEN (* skip "(TRUE)?(v1,...,vn)" *) PushConjVars(q.var^); PushConstraints(q.var^, q.conj^); VAR l := NewLabel(); BEGIN TBranch(l); (* Skip over OUT vars if solve failed *) Repeat(BC.DECSP, NUMBER(q.var^)); Branch(g); SetLabelLoc(l); (* Update INOUT's in "q.vars" *) PopConjVars(q.var^) END END; IF hBranch THEN Branch(h) END END; (* TYPECASE *) cmd.end := loc END Cmd0; PROCEDURE Cmd0Seq( seq: JunoAST.Seq; h, g, u: CARDINAL; hBranch: BOOLEAN) = (* Equivalent to: | | VAR l := NewLabel(); BEGIN | Cmd0(c.c1, l, g, u, hBranch := FALSE); | SetLabelLoc(l) | END; | Cmd0(c.c2, h, g, u, hBranch) | except that fewer frames are used on the stack if "seq" is a long list of semi-colon-separated commands. *) VAR curr := seq; BEGIN (* Loop down list to generate code *) LOOP VAR l := NewLabel(); BEGIN Cmd0(curr.c1, l, g, u, hBranch := FALSE); SetLabelLoc(l); END; TYPECASE curr.c2 OF JunoAST.Seq (next) => next.start := loc; curr := next ELSE EXIT END END; Cmd0(curr.c2, h, g, u, hBranch); (* Now, loop a second time to set "end" locations *) curr := seq; LOOP TYPECASE curr.c2 OF JunoAST.Seq (next) => next.end := loc; curr := next ELSE EXIT END END END Cmd0Seq; (* Cmd *) BEGIN LOCK mu DO loc := 0; InitLabelTable(); Repeat(BC.PUSHM3NIL, temp_cnt); VAR h := NewLabel(); err := NewLabel(); BEGIN CASE type OF CmdType.Pred, CmdType.Func => (* When the bodies of predicates and functions are compiled as commands, they become queries that either halt or fail. The procedure for a predicate must set the condition bit as the command halted or failed, to indicate if the predicate was true or not. The procedure for a function must also set the condition bit as the command halted or failed, to indicate if the function was defined or not. *) Cmd0(res.cmd, h, err, NoLabel, hBranch := FALSE); SetLabelLoc(h); PushByte(BC.C_ON); PushByte(BC.RET); SetLabelLoc(err); PushByte(BC.C_OFF); PushByte(BC.RET); | CmdType.Proc => (* User-defined procedures are total: they never fail. Hence, we don't need to set the condition bit at the end of the procedure. *) Cmd0(res.cmd, h, NoLabel, err, hBranch := FALSE); SetLabelLoc(h); PushByte(BC.RET); SetLabelLoc(err); PushByte(BC.ERROR); PushByte(ORD(JunoRTError.Code.UndefTerm)) END END; res.cmd.end := loc; BackPatchReferences(); <* ASSERT labelSeq.size() = 0 *> RETURN CodeCopy(); END END Cmd; PROCEDUREPushConjVars (READONLY v: JunoAST.Vars) =
Push thefrozen
variables inv
to the stack; pushunfrozen
variables inv
asNIL
. To decrease the size of the output code, do run-length encoding on thePUSHM3NIL
's.
VAR i := FIRST(v); nilCnt := 0; BEGIN WHILE i <= LAST(v) DO IF v[i].frozen THEN IF nilCnt > 0 THEN Repeat(BC.PUSHM3NIL, nilCnt); nilCnt := 0 END; PushByte(BC.PUSHL); PushShort(v[i].index) ELSE INC(nilCnt) END; INC(i) END; IF nilCnt > 0 THEN Repeat(BC.PUSHM3NIL, nilCnt) END END PushConjVars; PROCEDUREPopConjVars (READONLY v: JunoAST.Vars) =
Pop the non-temporary variables invars
in reverse order; discard temporary variables. To decrease the size of the output code, do run-length encoding on theDECSP
's.
VAR i := LAST(v); tempCnt := 0; BEGIN WHILE i >= FIRST(v) DO IF v[i].evar THEN INC(tempCnt) ELSE IF tempCnt > 0 THEN Repeat(BC.DECSP, tempCnt); tempCnt := 0 END; <* ASSERT v[i].index # 0 *> PushByte(BC.POPL); PushShort(v[i].index) END; DEC(i) END; IF tempCnt > 0 THEN Repeat(BC.DECSP, tempCnt) END END PopConjVars; PROCEDUREPushConstraints ( READONLY v: JunoAST.Vars; READONLY c: JunoAST.Formulas) = VAR index := NUMBER(v); argNum := NEW(REF ARRAY OF Z3, NUMBER(c)); BEGIN FOR i := FIRST(argNum^) TO LAST(argNum^) DO ProcessLeaf1(c[i], argNum[i], v, index) END; PushByte(BC.SOLVE); PushUShort(NUMBER(v)); (* # of variables (INOUTS) *) PushUShort(index - NUMBER(v)); (* # of constants (INS) *) PushUShort(NUMBER(c)); (* # of constraints *) FOR i := FIRST(argNum^) TO LAST(argNum^) DO ProcessLeaf2(c[i], argNum[i]) END END PushConstraints; PROCEDUREProcessLeaf1 ( f: JunoAST.Formula; VAR (* OUT *) z3: Z3; READONLY inouts: JunoAST.Vars; VAR (* INOUT *) index: CARDINAL) =
Setz3
to the canonicalized form off
. Incrementindex
by the number of knowns inf
, where anid
is known if it does not appear ininouts
. For each such known, generate code to push its value.
VAR j: CARDINAL := 0; PROCEDURE Atom(e: JunoAST.AtomicExpr) = BEGIN TYPECASE e OF <* NOWARN *> JunoAST.LitValue (lit) => z3[j] := index; INC(index); TYPECASE lit OF <* NOWARN *> JunoAST.Text (t) => PushByte(BC.PUSHG); PushULong(t.index) | JunoAST.Number (n) => PushByte(BC.PUSHNUM); PushReal(n.val) | JunoAST.Nil => PushByte(BC.PUSHNIL) END | JunoAST.QId (qid) => CASE qid.type OF <* NOWARN *> JunoAST.IdType.Local => VAR k := Utils.MemVars(qid, inouts); BEGIN IF k # -1 THEN (* INOUT *) z3[j] := k ELSE (* IN Local var *) z3[j] := index; INC(index); PushByte(BC.PUSHL); PushShort(qid.index) END END | JunoAST.IdType.Var, JunoAST.IdType.Const => z3[j] := index; INC(index); PushByte(BC.PUSHG); PushULong(qid.index) END END; INC(j) END Atom; BEGIN TYPECASE f OF <* NOWARN *> JunoAST.Equals (eq) => Atom(eq.e1); TYPECASE eq.e2 OF <* NOWARN *> JunoAST.AtomicExpr => Atom(eq.e2) | JunoAST.BIUFunc (e) => Atom(e.e) | JunoAST.BIBFunc (e) => Atom(e.e1); Atom(e.e2) END | JunoAST.BIUPred (e) => Atom(e.e) END END ProcessLeaf1; PROCEDUREProcessLeaf2 (f: JunoAST.Formula; READONLY z3: Z3) = BEGIN TYPECASE f OF <* NOWARN *> JunoAST.Equals (eq) => TYPECASE eq.e2 OF <* NOWARN *> | JunoAST.Pair => PushByte(BC.CONS_C); PushUShort(z3[0]); PushUShort(z3[1]); PushUShort(z3[2]); | JunoAST.Plus => PushByte(BC.SUM_C); PushUShort(z3[0]); PushUShort(z3[1]); PushUShort(z3[2]); | JunoAST.Times => PushByte(BC.PROD_C); PushUShort(z3[0]); PushUShort(z3[1]); PushUShort(z3[2]); | JunoAST.Atan => PushByte(BC.ATAN_C); PushUShort(z3[0]); PushUShort(z3[1]); PushUShort(z3[2]); | JunoAST.AtomicExpr => PushByte(BC.EQUAL_C); PushUShort(z3[0]); PushUShort(z3[1]); | JunoAST.Sin => PushByte(BC.SIN_C); PushUShort(z3[0]); PushUShort(z3[1]); | JunoAST.Cos => PushByte(BC.COS_C); PushUShort(z3[0]); PushUShort(z3[1]); | JunoAST.Exp => PushByte(BC.EXP_C); PushUShort(z3[0]); PushUShort(z3[1]); END | JunoAST.IsReal => PushByte(BC.REAL_C); PushUShort(z3[0]); | JunoAST.IsText => PushByte(BC.TEXT_C); PushUShort(z3[0]); END END ProcessLeaf2; PROCEDUREPopIds (id: JunoAST.IdLink) =
Generate code to pop the locals indexed in ids
in reverse order.
BEGIN IF id # NIL THEN PopIds(id.next); <* ASSERT id.index # 0 *> PushByte(BC.POPL); PushShort(id.index) END END PopIds; PROCEDUREPopQIds (v: JunoAST.ExprLink; scp: JunoScope.T) =
The listv
is a list of QId's. Generate code to pop the values on the stack into the locations designated by these QId's in reverse order. It is a checked run-time error for the type of any QId inv
not to be a local or global variable.
BEGIN IF v # NIL THEN PopQIds(v.next, scp); VAR qid: JunoAST.QId := v.expr; BEGIN <* ASSERT qid.index # 0 *> CASE qid.type OF <* NOWARN *> | JunoAST.IdType.Local => PushByte(BC.POPL); PushShort(qid.index) | JunoAST.IdType.Var => PushByte(BC.POPG); PushULong(qid.index) END END END END PopQIds; PROCEDUREBranch (lbl: CARDINAL) = BEGIN PushByte(BC.JUMP); AddReference(lbl); END Branch; PROCEDURETBranch (lbl: CARDINAL) = BEGIN PushByte(BC.TJUMP); AddReference(lbl); END TBranch; PROCEDUREFBranch (lbl: CARDINAL) = BEGIN PushByte(BC.FJUMP); AddReference(lbl); END FBranch; PROCEDUREPushByte (byte: JunoRT.ByteCode) = BEGIN IF loc > LAST(code^) THEN VAR new := NEW(JunoRT.ByteStream, 2 * NUMBER(code^)); BEGIN SUBARRAY(new^, 0, NUMBER(code^)) := code^; code := new END END; code[loc] := byte; INC(loc) END PushByte; <* INLINE *> PROCEDUREPushUShort (i: CARDINAL) = BEGIN WriteVal.UShort(code, loc, i) END PushUShort; <* INLINE *> PROCEDUREPushShort (i: INTEGER) = BEGIN WriteVal.Short(code, loc, i) END PushShort; <* INLINE *> PROCEDUREPushULong (i: CARDINAL) = BEGIN WriteVal.ULong(code, loc, i) END PushULong; <* INLINE *> PROCEDUREPushReal (r: JunoValue.Real) = BEGIN WriteVal.Real(code, loc, r) END PushReal; PROCEDURERepeat (instruction: JunoRT.ByteCode; cnt: CARDINAL) = BEGIN WHILE cnt > 0 DO PushByte(instruction); WITH num = MIN(cnt, 255) DO PushByte(num); DEC(cnt, num) END END END Repeat; <* INLINE *> PROCEDUREStuffShort (at: CARDINAL; val: INTEGER) =
Stuffs the 2-byte valueval
at locationscode[at..at+1]
.
BEGIN WriteVal.Short(code, at, val) END StuffShort;Label Procedures -------------------------------------------------------
CONST FirstLabel = 1; (* the number of the first valid label *) VAR last_label: INTEGER; (* the most-recently granted valid label *) labels := NEW(REF ARRAY OF LabelData, 500); <* INLINE *> PROCEDUREInitLabelTable () =
Clears the label table and resets the last label number.
BEGIN last_label := FirstLabel - 1 END InitLabelTable; PROCEDURENewLabel (): CARDINAL =
Returns a new, unused label. A new label has a loc
of -1 and an empty
references list. All valid label numbers are strictly positive.
BEGIN INC(last_label); IF last_label >= NUMBER(labels^) THEN VAR newLabels := NEW(REF ARRAY OF LabelData, 2 * NUMBER(labels^)); BEGIN SUBARRAY(newLabels^, 0, NUMBER(labels^)) := labels^; labels := newLabels END END; labels[last_label].loc := -1; labels[last_label].refs := NIL; RETURN last_label END NewLabel; <* INLINE *> PROCEDURESetLabelLoc (lbl: CARDINAL) =
Assert that labellbl
should be associated with indexloc
in the outputcode
. It is either a checked or an unchecked run-time error to set the label location of a label that was not obtained by a call to NewLabel().
BEGIN <* ASSERT lbl >= FirstLabel *> labels[lbl].loc := loc; END SetLabelLoc; <* INLINE *> PROCEDUREAddReference (lbl: CARDINAL) =
Assert that the bytes at locationscode[loc..loc+1]
should eventually be back-patched to be relative offsets to labellbl
, and incrementloc
past these bytes.
BEGIN <* ASSERT lbl >= FirstLabel *> WITH data = labels[lbl] DO data.refs := NEW(IntList, val := loc, next := data.refs) END; INC(loc, 2); END AddReference; PROCEDUREBackPatchReferences () =
Backpatch the 2-bytes incode
whose indices are stored in the listslabels[FirstLabel..last_label].refs
to contain relative offsets to the corresponding label locationslabels[FirstLabel..last_label].loc
.
BEGIN FOR lbl := FirstLabel TO last_label DO VAR p := labels[lbl].refs; BEGIN WHILE p # NIL DO StuffShort(p.val, labels[lbl].loc - (p.val + 2)); p := p.next END END END END BackPatchReferences; PROCEDURECodeCopy (): JunoRT.ByteStream =
Return a copy of code[0..loc-1]
.
VAR res := NEW(JunoRT.ByteStream, loc); BEGIN res^ := SUBARRAY(code^, 0, loc); RETURN res END CodeCopy; BEGIN END JunoAssemble.