SECTION "CGA"

GET "b.CgHeader"

STATIC {
/* Version of 07 Mar 86 21:29:00
*/
   dummy = VersionMark
   version = 1*256+8 }

/* 1.5	01 Nov 85 15:44:44
      bug fix: return to do right sort of LDM if link size is 3
      also improvement to use RTS directly if appropriate in this
      case.
   1.6	06 Feb 86 16:34:42
      Incorporation of floating point
   1.7	20 Feb 86 13:17:07
      Bug fix: ABS should must flush pending instructions
   1.8	07 Mar 86 21:27:53
      DSTR operation supported.  Also changes to use k.static mostly
      in place of k.lab
*/

LET IgnoreNames() BE {
   LET i = ReadN();
   FOR j = 1 TO i DO
      DiscardN(ReadN()+2) }

AND DiscardN(count) BE
   FOR i = 1 TO count DO ReadN()

AND ReadNames(block, l) BE RETURN

AND WriteNames() BE RETURN

AND GenStore(t, n) BE {
   LET s, type = Null, k.reg;
   LET storeNeeded = TRUE;
   LET wastos = ?;

   IF t=k.loc THEN s := RegisterDedicatedToLoc(n);
   IF t=k.lab THEN {
      LET k = OffsetOfStatic(n);
      IF k~=Null THEN t, n := k.static, k };
   TEST s=Null THEN
      TEST h1!arg1=k.freg THEN
	 s, type := MoveToAnyFR(arg1), k.freg
      ELSE {
	 s := LookForSloc(NotAddr, t, n);
	 TEST s~=Null & ~Locked(s, k.reg) & ~IsInARegister(arg1)
	    THEN MoveToRSomeTime(s, arg1)
	    ELSE s := MoveToAnyCRSomeTime(arg1) }
   ELSE {
      MoveToRSomeTime(s, arg1);
      storeNeeded := FALSE };

   TEST type=k.freg THEN {
      TEST t=k.lab THEN {
	 CheckRLLoaded();
	 GenCPDT(f.st, s, r.l, n, 0) }
      ELSE {
	 LET b = r.g;
	 LET offset = n;
	 TEST t=k.static
	    THEN b := CheckRLLoaded()
	 ELSE IF t=k.loc THEN {
	    b := r.ts;
	    TEST usesFrame THEN
	       IF ~linkageNotStored THEN b := r.p
	    ELSE
	       offset := offset-saveSpaceSize;
	    offset := (nextStackWord/BytesPerWord)*offset }

	 GenCPDT(f.st, s, b, 0, offset) };
      StoreR(k.freg, s, t, n) }
   ELSE {
      wastos := StoreR(k.reg, s, t, n);
      IF storeNeeded THEN
	 TEST t=k.lab THEN {
	    FlushPendingLoadsForReg(s);
	    CheckRLLoaded();
	    GenF2(f.str, s, r.l, n, 0) }
	 ELSE {
	    IF t=k.static THEN CheckRLLoaded();
	    AddToPendingStores(s, t, n, wastos, 0) } };

   Stack(ssp-1) }

AND CGDebug() BE {
   WriteS("Debug*n");
   PrintSimulatedStack();
   PrintRegList();
   WriteS("PendingLoads*n");
   PrintPendingList(pendingLoads);
   WriteS("PendingStores*n");
   PrintPendingList(pendingStores);
   NewLine() }

AND Scan() BE {
   LET l, blockStart = blockLabel, 0;
   IF naming THEN {
      blockLabel := NextLabel();
      blockStart := NextLabel();
      SetLabel(blockStart) };

   {s
      IF (CGDebugMode&db.tracescan)~=0 THEN
	 writef("op = %n ssp = %n*n", op, ssp);

      SWITCHON op INTO
      {  DEFAULT:
	    CGError(FALSE, "compiler error: op = %n", op);
	    ENDCASE

	 CASE s.debug:
	    CGDebug();
	    ENDCASE

	 CASE s.lineCount:
	    lineCount := ReadN();
	    IF Assoc(linecount, 1, lineCounts)=Null THEN
	       lineCounts := FillBlk(3, lineCounts, lineCount, locCtr);
	    ENDCASE

	 CASE s.argno:	argumentNumber := ReadN(); ENDCASE

	 CASE s.fconst: {  LET mantissa = ReadN();
			   LET exponent = ReadN();
			   LET sign = 1;
			   IF mantissa<0 THEN sign, mantissa := -1, -mantissa;
			   Load(k.number, PackFPNum(mantissa, exponent, sign));
			   ENDCASE }
	 CASE s.lg:	Load(k.glob, ReadGN()); ENDCASE
	 CASE s.lp:	Load(k.loc, ReadN()); ENDCASE
	 CASE s.ll:	LoadLabelOrStatic(k.lab); ENDCASE
	 CASE s.ln:	Load(k.number, ReadN()); ENDCASE
	 CASE s.true:	Load(k.number, TRUE); ENDCASE
	 CASE s.false:	Load(k.number, FALSE); ENDCASE
	 CASE s.nil:	Load(k.reg, r.nil); ENDCASE
	 CASE s.stnil:	MovetoR(r.nil, arg1);
			SetRtoRplusK(r.nilbase, r.nil, 4096);
			MaskOutTagBits(r.nilbase);
			Lock(r.nil, k.reg);
			Stack(ssp-1);
			ENDCASE

	 CASE s.llp:	Load(k.lvloc, ReadN()); ENDCASE
	 CASE s.llg:	Load(k.lvglob, ReadGN()); ENDCASE
	 CASE s.lll:	LoadLabelOrStatic(k.lvlab); ENDCASE

	 CASE s.lstr:	CGString(ReadN(), 0); ENDCASE

	 CASE s.sl:	GenStore(k.lab, ReadL()); ENDCASE
	 CASE s.sg:	GenStore(k.glob, ReadGN()); ENDCASE
	 CASE s.sp:	GenStore(k.loc, ReadN()); ENDCASE

	 CASE s.getbyte:
	 CASE s.putbyte:CGByteAp(op); ENDCASE

	 CASE s.stvcar: CGStCar(0, TRUE); ENDCASE
	 CASE s.stvcdr: CGStCar(4, TRUE); ENDCASE
	 CASE s.stcar:	CGStCar(0, FALSE); ENDCASE
	 CASE s.stcdr:	CGStCar(4, FALSE); ENDCASE
	 CASE s.stind:	CGStind(); ENDCASE
	 CASE s.mod:	CGAssop(); ENDCASE
	 CASE s.modslct:CGError(FALSE, "field op:= not implemented yet");
			ReadN();
			Stack(ssp-2);
			ENDCASE

	 CASE s.mult:	CGMult(); ENDCASE
	 CASE s.plus:	CGPlus(); ENDCASE
	 CASE s.div:	CGDiv(); ENDCASE
	 CASE s.rem:	CGRem(); ENDCASE
	 CASE s.minus:	CGMinus(); ENDCASE

	 CASE s.fmult:
	 CASE s.fplus:
	 CASE s.fdiv:
	 CASE s.fminus: CGFop(op); ENDCASE

	 CASE s.fneg:
	 CASE s.fabs:	CGFUnOp(op); ENDCASE
	 CASE s.fix:	CGFix(); ENDCASE
	 CASE s.float:	CGFloat(); ENDCASE

	 CASE s.lls: CASE s.lgr: CASE s.lle: CASE s.lge:
	 CASE s.eq:  CASE s.ne:  CASE s.ls:
	 CASE s.gr:  CASE s.le:  CASE s.ge:
	 CASE s.feq: CASE s.fne: CASE s.fls:
	 CASE s.fgr: CASE s.fle: CASE s.fge:
			CGRelop(op, ReadOp()); LOOP

	 CASE s.lshift: CGShift(sh.asl); ENDCASE
	 CASE s.rshift: CGShift(sh.lsr); ENDCASE

	 CASE s.logand:
	 CASE s.logor:
	 CASE s.eqv:
	 CASE s.neqv:	CGLogop(op, TRUE); LOOP

	 CASE s.not:
	    TEST IsConst(arg1) THEN
	       h3!arg1 := ~(h3!arg1)
	    ELSE {
	       LET n = MoveToAnyR(arg1);
	       GenRR(f.mvn, n, 0, n);
	       DiscardReg(n, k.reg) };
	    ENDCASE

	 CASE s.neg:
	    TEST IsConst(arg1) THEN
	       h3!arg1 := -(h3!arg1)
	    ELSE {
	       LET n = MoveToAnyR(arg1);
	       GenF1K(f.rsb, n, n, 0);
	       DiscardReg(n, k.reg) };
	    ENDCASE

	 CASE s.abs:
	 {  LET n = MoveToAnyR(arg1);
	    FlushPendingInsts(Null, FALSE);
	    GenF1K(f.cmps, 0, n, 0);
	    F1Inst(f.rsb, n, n, Null, 0, Null, 0, m.lt);
	    DiscardReg(n, k.reg)
	    ENDCASE };

	 CASE s.slctap:
	    IF h2!arg1>=0 | h1!arg1=k.shreg THEN
	       MoveToAnyR(arg1);
	    {  LET size = ReadN();
	       LET shift = ReadN();
	       h4!arg1 := h4!arg1+ReadN();
	       h2!arg1 := 32*size + shift
	       ENDCASE };

	 CASE s.slctst:
	    CGSlctst();
	    ENDCASE

	 CASE s.vcar:
	 CASE s.vcdr:
	    FlushPendingStores();
	    IF h2!arg1>=0 | h1!arg1=k.shreg THEN
	       MoveToAnyR(arg1);
	    IF op=s.vcdr THEN h4!arg1 := h4!arg1 + 4;
	    h2!arg1 := VACarMark;
	    ENDCASE

	 CASE s.car:
	 CASE s.cdr:
	    FlushPendingStores();
	    IF h2!arg1>=0 | h1!arg1=k.shreg THEN
	       MoveToAnyR(arg1);
	    IF op=s.cdr THEN h4!arg1 := h4!arg1 + 4;
	    h2!arg1 := CarMark;
	    ENDCASE

	 CASE s.rv:
	    IF h2!arg1>=0 | h1!arg1=k.shreg THEN
	       MoveToAnyR(arg1);
	    h2!arg1 := 0;
	    ENDCASE

	 CASE s.res:
	    loadRegFromFRegOK := TRUE;
	    MoveToR(ArgumentRegister(1), arg1);
	    loadRegFromFRegOK := FALSE;
	    Stack(ssp-1);

	 CASE s.jump:
	 {  LET lab = ReadL();
	    IF TransferredLabel(lab)~=0 THEN {
	       Store(0, ssp);
	       FlushPendingStores();
	       Jump(lab);
	       deadCode := Dead;
	       ENDCASE };
	    GOTO DoRtrn }

	 CASE s.jt:
	 CASE s.jf:
	    Load(k.number, 0);
	    CGRelop(s.ne, op);
	    LOOP

	 CASE s.goto:
	    Store(0, ssp-2);
	    FlushPendingStores();
	    {  LET n = LabelInStatic(arg1);
	       TEST IsSimpleStoreLoc(arg1) THEN
		  TEST n~=Null THEN
		     Jump(n)
		  ELSE
		     MoveToR(r.pc, arg1)
	       ELSE
		  GenRR(f.mov, r.pc, 0, MoveToAnyR(arg1)) };
	    InitStack(ssp-1);
	    deadCode := Dead;
	    ENDCASE

	 CASE s.lab:
	 {  LET m = ReadL();
	    LET s = ?;
	    LET d = deadCode;
	    IF Assoc(m, 1, transferLabs)~=Null THEN {
	       TEST TransferredLabel(m)=pendingJump
		  THEN IF m=pendingJump THEN pendingJump := 0
		  ELSE CheckDelayedJump();
	       ENDCASE };

	    FlushPendingLoads();
	    FlushPendingStores();
	    Store(0, ssp);
	    s := FindSavedState(m);
	    IF (CGDebugMode&db.srs)~=0 THEN
	       TEST s=Null THEN {
		  LET p = savedStates;
		  WriteF("no saved state for %n:*n", m);
		  WHILE p~=0 DO {
		     PrintRegisterState(p);
		     p := !p } }
	       ELSE {
		  WriteF("Found saved state for %n:", m);
		  PrintRegisterState(s) };

	    TEST s=Null THEN {
	       DiscardRegs();
	       TOSoffset := Null }
	    ELSE {
	       IF deadCode~=Dead THEN {
		  LET p = SaveRegisterState();
		  s := IntersectionOfRegisterStates(p, s) };
	       DiscardRegs();
	       RestoreRegisterState(s) };

	    R0Offset := Null;
	    InitStack(ssp);
	    deadCode := Alive;
	    IF pendingJump~=0 THEN
	       TEST m=pendingJump THEN
		  pendingJump := 0
	       ELSE
		  CheckDelayedJump();

	    TEST pendingLab=Null THEN
	       SetLabel(m)
	    ELSE TEST pendingLab=m THEN {
	       FlushPendingInsts(pendingMask, TRUE)
	       IF ~d |
		  ~LabelFlagged(m, lab.onlyonejump) |
		   LabelFlagged(m, lab.jumpedto)
		  THEN SetLabel(m) }
	    ELSE {
	       FlushPendingInsts(Null, TRUE);
	       SetLabel(m) } };
	    CountFlag := counting;
	    ENDCASE

	 CASE s.query:	 Stack(ssp+1); ENDCASE
	 CASE s.stack:	 Stack(ReadN()); ENDCASE
	 CASE s.store:	 Store(0, ssp);
			 InitStack(ssp);
			 ENDCASE
	 CASE s.save:	 CGSave(ReadN()); ENDCASE

	 CASE s.entry:
	 {  LET n = ReadN();
	    LET m = ReadL();
	    deadCode := Alive;
	    CheckDelayedJump();
	    IF pendingLab~=Null THEN FlushPendingInsts(Null, FALSE)
	    TOSoffset := Null;
	    R0Offset := Null;
	    CGEntry(n, m);
	    ENDCASE }

	 CASE s.fnap:
	 CASE s.rtap:
	    CGApply(op, ReadN());
	    R0Offset := Null;
	    LOOP

	 CASE s.fnrn:
	    DelLocsAbove(0, TRUE);
	    loadRegFromFRegOK := TRUE;
	    MovetoR(ArgumentRegister(1), arg1);
	    loadRegFromFRegOK := FALSE;
	    ssp := ssp-1;

	 DoRtrn:
	 CASE s.rtrn:
	    DelLocsAbove(0, TRUE);
	    IF deadCode~=Dead THEN {
	       FlushPendingStores();
	       TEST usesFrame & ~linkageNotStored THEN
		  TEST compactCode THEN
		     CondJump(m.always, ExitLab)
		  ELSE {
		     LET ldmtype = reversedStack | saveSpaceSize=3 ->
					     upStack,
					     upStack+f.pre;
		     LET base = r.p;
		     TEST TOSOffset=3 THEN {
			base := r.ts;
			ldmtype := f.wb+(reversedStack -> f.preup,
							  f.predown) }
		     ELSE
			GenRR(f.mov, r.ts, 0, r.p);
		     F4Inst(f.ldm, base, f4.plpc, ldmtype+f.pc) }
	       ELSE
		  GenRR(f.movs, r.pc, 0, r.14) };
	    InitStack(ssp);
	    deadCode := Dead;
	    ENDCASE

	 CASE s.endfor:
	    FlushPendingStores();
	    CondJump(Condition(s.le, TRUE), ReadL());
	    ENDCASE

	 CASE s.endblock:
	    TEST naming THEN {
	       ReadNames(blockStart, l);
	       blockLabel := l;
	       RETURN }
	    ELSE
	       IgnoreNames();
	    ENDCASE

	 CASE s.endproc:
	    CheckDelayedJump();
	    FlushPendingInsts(Null, TRUE);
	    IF ~usesRL THEN {
	       FlagLabel(localConstLab, lab.endproclab);
	       SetLabel(localConstLab);
	       GenData(localConstants);
	       WHILE !localConstants~=0 DO {
		  LET p = localConstants;
		  localConstants := !localConstants;
		  !p := freeDataBlocks;
		  freeDataBlocks := p };
	       EndOfDataInBlock!localConstants := DataBlockItems-1;
	       localConstLab := NextLabel();
	       localConstP := localConstants;
	       localFaddr := 0 };

	    ClearAssignedRegisters();
	    base := base-3;
	    baseLab, baseAddr := base!0, base!1;
	    {  LET f = base!2;
	       localsSafe := (f&1)~=0;
	       usesFrame := (f&2)~=0;
	       containsCalls := (f&4)~=0;
	       usesRL := (f&8)~=0;
	       f := f&48;
	       linkageNotStored := f=0	-> FALSE,
				   f=16 -> r.b,
					   TRUE };
	    TEST naming THEN {
	       ReadNames(blockStart, l);
	       WriteNames();
	       RETURN }
	    ELSE {
	       IgnoreNames();
	       ENDCASE }

	 CASE s.rstack:
	    Stack(ReadN());
	    Load(k.reg, ArgumentRegister(1));
	    ENDCASE

	 CASE s.finish:
	    FlushPendingStores();
	    SetRtoRplusK(r.pc, r.gb, sr.fin);
	    deadCode := Dead;
	    ENDCASE

	 CASE s.switchon:
	    FlushPendingStores();
	    CGSwitch(ReadN());
	    ENDCASE

	 CASE s.global:   CGGlobal(ReadN()); RETURN

	 CASE s.dstr:
	 {  LET label = ReadL();
	    CGString(ReadN(), label);
	    ENDCASE }

	 CASE s.defext:
	 {  LET lab = ReadL();
	    AddXSymbol(ReadString(ReadN()), 3, lab);
	    ENDCASE }

	 CASE s.refext:
	 // already handled
	    ReadL();
	    FOR i = 1 TO ReadN() DO ReadN();
	    ENDCASE

	 CASE s.dtab:
	 CASE s.datalab:
	    dataLabel := ReadL();
	    Data(s.datalab, dataLabel);
	    staticLabels :=
	       FillBlk(4, staticLabels, dataLabel, Null, staticOffset);
	    IF op=s.dtab THEN ReadN();	// discard the table length
	    ENDCASE

	 CASE s.itemn:
	    dataLabel := Null;
	    Data(s.itemn, ReadN());
	    staticOffset := staticOffset+4;
	    ENDCASE

	 CASE s.iteml:
	 {  LET lab = ReadL();
	    LET p = Assoc(lab, 1, transferLabs);
	    IF p~=Null THEN 1!p := -1;
	    IF dataLabel~=Null THEN {
	       LET p = FindLabelEntry(lab);
	       LET q = Assoc(dataLabel, 1, staticLabels);
	       !p := !p & ~(lab.forwardjump+lab.onlyonejump);
	       2!q := lab };
	    dataLabel := Null;
	    staticOffset := staticOffset+4;
	    Data(s.iteml, lab); ENDCASE }
      };

      op := ReadOp() }s REPEAT
}

AND LabelInStatic(x) = VALOF {
   LET p, t, n = ?, h1!x, h3!x;
   IF ~IsSimpleStoreLoc(x) THEN RESULTIS Null;

   TEST t=k.lab THEN
      p := Assoc(n, 1, staticLabels)
   ELSE TEST t=k.static THEN {
      p := Assoc(n*4, 3, staticLabels);
      IF p~=Null THEN n := 1!p }
   ELSE RESULTIS Null;

   IF p=Null |
      LabelFlagged(n, lab.stored+lab.lvtaken) THEN
      RESULTIS Null;

   RESULTIS p!2 }

AND XSymInStatic(x) = VALOF {
   LET p, t, n = ?, h1!x, h3!x;
   IF ~IsSimpleStoreLoc(x) THEN RESULTIS Null;
   TEST t=k.lab THEN
      p := Assoc(n, 1, staticLabels)
   ELSE TEST t=k.static THEN {
      p := Assoc(n*4, 3, staticLabels);
      IF p~=Null THEN n := 1!p }
   ELSE RESULTIS Null;

   IF p=Null |
      LabelFlagged(n, lab.stored+lab.lvtaken) |
      2!p~=Null THEN
      RESULTIS Null;

   p := Assoc(n, 1, xrefSyms);
   IF p=Null THEN RESULTIS Null;
   RESULTIS p!2 }

AND OffsetOfStatic(lab) = VALOF {
   LET p = Assoc(lab, 1, staticLabels);
   RESULTIS p=Null -> Null,
		      (p!3)/4 }

AND LoadLabelOrStatic(op) BE {
   LET n = ReadL();
   LET k = OffsetOfStatic(n);
   TEST k=Null THEN
      Load(op, n)
   ELSE
      Load(op+k.static-k.lab, k) }
