SECTION "CG2"
GET "CGHDR"
// INITIALISE THE SIMULATED STACK (SS)
LET INITSTACK(N) BE
$( ARG2, ARG1 := TEMPV, TEMPV+3
SSP := N
PENDINGOP := S.NONE
H1!ARG2, H2!ARG2, H3!ARG2 := K.LOC, SSP-2, SSP-2
H1!ARG1, H2!ARG1, H3!ARG1 := K.LOC, SSP-1, SSP-1
IF MAXSSP<SSP DO MAXSSP := SSP $)
// MOVE SIMULATED STACK (SS) POINTER TO N
AND STACK(N) BE
$(1 IF MAXSSP<N DO MAXSSP := N
IF N>SSP+SAVESPACESIZE DO // I wonder how this works
$( STORE(0,SSP-1)
INITSTACK(N)
RETURN $)
WHILE N>SSP DO LOADT(K.LOC, SSP)
UNTIL N=SSP DO
$( IF ARG2=TEMPV DO
$( TEST N=SSP-1
THEN $( SSP := N
H1!ARG1,H2!ARG1 := H1!ARG2,H2!ARG2
H3!ARG1 := SSP-1
H1!ARG2,H2!ARG2 := K.LOC,SSP-2
H3!ARG2 := SSP-2 $)
ELSE INITSTACK(N)
RETURN $)
ARG1, ARG2 := ARG1-3, ARG2-3
SSP := SSP-1 $)
$)1
// STORE ALL SS ITEMS FROM A TO B IN THEIR TRUE
// LOCATIONS ON THE STACK
AND STORE(A,B) BE FOR P = TEMPV TO ARG1 BY 3 DO
$( LET S = H3!P
IF S>B RETURN
IF S>=A DO STORET(P) $)
//*<3032
// THE LINE BELOW WILL BE REMOVED FOR THE TRIPOS VERSION
AND TESTFLAGS(N) = FALSE
/*3032>*/
AND SCAN() BE
$(1 IF TESTFLAGS(1) DO CGERROR("BREAK", TRUE)
SWITCHON OP INTO
$(SW DEFAULT: CGERROR("BAD OP %N", FALSE, OP)
ENDCASE
CASE 0: RETURN
//*<3032
CASE S.DEBUG:DEBUGGING := NOT DEBUGGING
ENDCASE
/*3032>*/
CASE S.LP: LOADT(K.LOC, RDN()); ENDCASE
CASE S.LG: LOADT(K.GLOB, RDGN()); ENDCASE
CASE S.LL: LOADT(K.LAB, RDL()); ENDCASE
CASE S.LN: LOADT(K.NUMB, RDN()); ENDCASE
CASE S.LSTR: CGSTRING(RDN()); ENDCASE
CASE S.TRUE: LOADT(K.NUMB, -1); ENDCASE
CASE S.FALSE:LOADT(K.NUMB, 0); ENDCASE
CASE S.LLP: LOADT(K.LVLOC, RDN()); ENDCASE
CASE S.LLG: LOADT(K.LVGLOB, RDGN()); ENDCASE
CASE S.LLL: LOADT(K.LVLAB, RDL()); ENDCASE
CASE S.SP: STOREIN(K.LOC, RDN()); ENDCASE
CASE S.SG: STOREIN(K.GLOB, RDGN()); ENDCASE
CASE S.SL: STOREIN(K.LAB, RDL()); ENDCASE
CASE S.STIND:CGSTIND(); ENDCASE
CASE S.RV: CGRV(); ENDCASE
CASE S.MULT:CASE S.DIV:CASE S.REM:
CASE S.PLUS:CASE S.MINUS:
CASE S.EQ: CASE S.NE:
CASE S.LS:CASE S.GR:CASE S.LE:CASE S.GE:
CASE S.LSHIFT:CASE S.RSHIFT:
CASE S.LOGAND:CASE S.LOGOR:CASE S.EQV:CASE S.NEQV:
CASE S.NOT:CASE S.NEG:CASE S.ABS:
CGPENDINGOP(REGSET(OP))
PENDINGOP := OP
ENDCASE
CASE S.JUMP: CGPENDINGOP(V.XX)
STORE(0, SSP-1)
GENBRANCH(F.JMP, RDL())
ENDCASE
CASE S.ENDFOR:
CGPENDINGOP(V.XX)
PENDINGOP := S.LE
CASE S.JT: CGJUMP(TRUE, RDL())
ENDCASE
CASE S.JF: CGJUMP(FALSE, RDL())
ENDCASE
CASE S.GOTO: CGPENDINGOP(V.XX)
STORE(0, SSP-2)
GETVALUE(ARG1)
IF H1!ARG1=K.NUMB THEN
H2!ARG1 := H2!ARG1 * 2
MOVETOINDEXR(ARG1)
// CS same as now so can do JI (instead of JIS)
GENJ(F.JI,H2!ARG1=R.BX->K.XBX, K.XSI, 0)
STACK(SSP-1)
ENDCASE
CASE S.LAB: CGPENDINGOP(V.XX)
STORE(0, SSP-1)
CGLAB(RDL())
ENDCASE
CASE S.QUERY:CGPENDINGOP(V.XX)
STACK(SSP+1)
ENDCASE
CASE S.STACK:CGPENDINGOP(V.XX)
STACK(RDN())
ENDCASE
CASE S.STORE:CGPENDINGOP(V.XX)
STORE(0, SSP-1)
ENDCASE
CASE S.ENTRY:
CGENTRY(RDN(), RDL())
ENDCASE
CASE S.SAVE: CGSAVE(RDN())
IF STKCHKING DO
$( IF PROCSTKP>=20 DO
CGERROR("PROC STACK OVF", TRUE)
PROCSTK!PROCSTKP := MAXSSP
GENINT(I.STKCHECK)
PROCSTK!(PROCSTKP+1) := STVP
//*<3032
LISTAT(S.ITEMN, 0)
/*3032>*/
CODE(0,0) // MAXSSP OF CALLED ROUTINE IS PLACED HERE
MAXSSP := SSP $)
PROCSTKP := PROCSTKP+2
ENDCASE
CASE S.FNAP:
CASE S.RTAP: CGAPPLY(OP, RDN())
ENDCASE
CASE S.RTRN:
CASE S.FNRN: CGRETURN(OP)
ENDCASE
CASE S.ENDPROC:
RDN()
PROCSTKP := PROCSTKP-2
IF STKCHKING DO
$( PWABO(STV, PROCSTK!(PROCSTKP+1), MAXSSP)
MAXSSP := PROCSTK!PROCSTKP $)
ENDCASE
CASE S.RES: CGPENDINGOP(V.R0)
STORE(0, SSP-2)
MOVETOR(ARG1,R0)
GENBRANCH(F.JMP, RDL())
STACK(SSP-1)
ENDCASE
CASE S.RSTACK:
INITSTACK(RDN())
LOADT(K.REG, R0)
ENDCASE
CASE S.FINISH:
LOADT(K.NUMB, 0)
LOADT(K.NUMB, 0)
CGGLOBCALL(GN.STOP)
ENDCASE
CASE S.SWITCHON:
CGSWITCH(RDN())
ENDCASE
CASE S.GETBYTE:
CASE S.PUTBYTE:
CGBYTEAP(OP)
ENDCASE
CASE S.GLOBAL:
CGGLOBAL(RDN())
RETURN
CASE S.DATALAB:
CASE S.ITEML:CGDATA(OP, RDL()); ENDCASE
CASE S.ITEMN:CGDATA(OP, RDN()); ENDCASE
$)SW
//*<3032
IF DEBUGGING DO DBOUTPUT()
/*3032>*/
OP := RDN()
$)1 REPEAT
.