SECTION "CGF"

GET "b.CGheader"

STATIC {
  // Version of 23 Nov 86 16:04:04
   dummy = VersionMark;
   version = 1*256+7 };

/*
*/

STATIC {
   staticDataLoc = 0;
   relocatedLocs = 0;
   relocateReferences = FALSE;
   xRelocatedLocs = 0;
   xSymbols = 0;
   xSymNo = 0;
   currentArea = 0;
   caRec = 0; daRec = 0;
   dataArea = 0 };

MANIFEST {
   CodeArea = 0 };

MANIFEST {
   sll.loc = 1; sll.reg = 2; sll.offset = 3;
   sll.size = 4 };

MANIFEST {
   a.locC=0; a.reloc=1; a.xreloc=2; a.sbv=3;
   a.size=4 };

MANIFEST {
   sym.next = 0;
   sym.str = 1;
   sym.attr = 2;
   sym.no = 3
   sym.id = 4;
   sym.val = 5;
   sym.size = 6 };

LET PutWord(word) BE
{  IF (CGDebugMode&db.tracepw)~=0 THEN
      WriteF("pw %x4 %x8*n", locCtr, word);
   WriteWord(locCtr, word);
   locCtr := locCtr+4 }

AND PutString(s, maxlen) BE
{  LET w = 0;
   LET l = s%0;
   LET wp = 0;
   FOR i = 1 TO maxlen DO {
      IF i<=l THEN (@w)%wp := s%i;
      TEST wp=3 THEN {
	 PutWord(w); w, wp := 0, 0 }
      ELSE
	 wp := wp+1 } }

AND AddressInCode(label, offset) BE
{  LET labelValue = ?;
   label := TransferredLabel(label);
   IF label=0 THEN label := exitLab;
   labelValue := ValueOfLabel(label);
   TEST labelValue=Null THEN {
      AddRef(locCtr, 0, label);
      PutWord(-offset) }
   ELSE
      PutWord(labelValue-offset) }

AND ReadWord(loc) = VALOF
{  LET o = ?;
   LET b = FindStoreBlock(loc, @o);
   RESULTIS b!o }

AND WriteWord(loc, word) BE
{  LET o = ?;
   LET b = FindStoreBlock(loc, @o);
   b!o := word }


AND FindStoreBlock(loc, lv.o) = VALOF
{  LET b = loc>>StoreBlockShift;
   LET v = ?;

   !lv.o := (loc & StoreBlockMask)>>2;

   IF b>=StoreBlockVSize THEN
      CGError(TRUE, "program too large (exceeds %N bytes)",
		StoreBlockVSize * StoreBlockSize * bytesperword);

   v := StoreBlockV!b;

   IF v=0 THEN {
      v := GetVector(StoreBlockSize);
      StoreBlockV!b := v };

   RESULTIS v }

AND FlagLabel(lab, flag) BE
{  LET p = FindLabelEntry(lab);
   !p := !p | flag }

AND LabelFlagged(lab, flag) = VALOF
{  LET p = FindLabelEntry(lab);
   RESULTIS ((!p) & flag)~=0 }

AND FindLabelEntry(lab) = VALOF
{  LET b = lab>>LabelBlockShift
   LET o = lab&LabelBlockMask
   LET v = ?

   IF b>=LabelBlockVSize THEN
     CGError(TRUE, "label too large (exceeds %N)",
		   last.label.number)

   v := LabelBlockV!b
   IF v=0 THEN {
      v := GetVector(LabelBlocksize);
      LabelBlockV!b := v;
      FOR j = 0 TO LabelBlockSize-1 DO v!j := 0 }

   RESULTIS v+o }

AND ValueOfLabel(lab) = VALOF
{  LET pointerToLabel = FindLabelEntry(lab);
   LET val = !pointerToLabel;
   RESULTIS (val&lab.set)~=0 -> val & (lab.value-lab.area),
				Null }

AND AreaOfLabel(lab) = VALOF
{  LET pointerToLabel = FindLabelEntry(lab);
   LET val = !pointerToLabel;
   RESULTIS (val&lab.set)~=0 -> val & lab.area,
				Null }

AND LabelWithValue(n, lab) = VALOF
{  IF n=0 THEN RESULTIS Null;

   WHILE lab<=last.label.number DO {
      LET v = labelBlockV!(lab>>LabelBlockShift);
      LET o = lab&LabelBlockMask

      TEST v=0
	 THEN lab := lab+LabelBlockSize
      ELSE TEST ((v!o)&lab.set)~=0 & ((v!o)&lab.value)=n
	 THEN RESULTIS lab
	 ELSE lab := lab+1 };
   RESULTIS Null }

AND RelocationForLoc(n) = Assoc(n, 1, XRelocatedLocs)

AND SymbolOfReloc(n) = VALOF {
   LET p = Assoc((2!n)&#xffff, sym.no, XSymbols);
   IF p=Null THEN RESULTIS Null;
   RESULTIS sym.id!p }

AND RealSetLabel(lab) BE
{  LET pointerToLabel = FindLabelEntry(lab);
   LET oldval = !pointerToLabel;
   LET val = locCtr;

   !pointerToLabel := ((oldval & ~lab.value)+val) | lab.set | currentArea;
   TEST (oldval&lab.set)~=0 THEN
      CGError(FALSE, "Label %n set twice, at %x6, old value %x6",
		     lab, val, oldval&lab.value)
   ELSE IF (oldval&lab.value)~=0 THEN {
      oldval := oldval & lab.value;
      WHILE oldval~=0 DO {
	 LET o = ?;
	 LET loc = oldval!RefLoc;
	 LET a = currentArea;
	 LET xx = SetArea(loc&lab.area);
	 LET block = FindStoreBlock(loc, @o);
	 LET word = block!o;
	 LET base = (word>>16)&15;

	 SWITCHON oldval!reftype INTO {
	    CASE 0:
	       block!o := word+val;
	       IF relocateReferences
		  THEN AddRelocatedLoc(loc, lab);
	       ENDCASE

	    CASE 1:
	    {  LET offset = RotateRight(word&255, (word>>7)&30);
	       LET n = base=r.pc ->	  loc+8,
		       staticDataLoc=0 -> ValueOfLabel(SLab)+4*SAddr,
					  staticDataLoc;
	       LET shiftit = FALSE;
	       offset := offset+val-n;
	       IF offset<0 THEN
		  word, offset := word+f.sub-f.add, -offset;
	       IF (base=r.pc | ~aofOut) & ~EightBitsOrFewer(offset) THEN {
		  LET r = word&#xf000;
		  LET m = word&#xf0000000;
		  LET x = m+f.mov+r+(r>>12)+sh.lsr+256;
		  LET next = ReadWord(loc+4);
		  IF next=x THEN {
		     block!o := m+f.mov+r+base+sh.lsr+256;
		     loc := loc+4;
		     block := FindStoreBlock(loc, @o)
		     offset := offset-4;
		     word := (word&#xfff0ffff)+(r<<4);
		     shiftit := TRUE };
		  WHILE ~EightBitsOrFewer(offset) DO {
		     next := ReadWord(loc+4);
		     IF BranchInst(next) |
			(next&#xf0000000)~=m |
			UsesOrUpdatesReg(next, r) THEN BREAK;
		     loc := loc+4;
		     offset := offset-4;
		     block!o := next;
		     block := FindStoreBlock(loc, @o) } };
	       TEST ~EightBitsOrFewer(offset) THEN
		  CGError(FALSE, "%x6: F1 offset %x8 out of range",
			  loc, offset)
	       ELSE {
		  IF shiftit THEN offset := offset>>2;
		  word := (word&#xfffff000)+PackUp(offset) }
	       block!o := word;
	       ENDCASE }

	    CASE 2:
	    {  LET n = base=r.pc -> loc+8,
		 staticDataLoc=0 -> ValueOfLabel(SLab)+4*SAddr,
				    staticDataLoc;
	       n := (word&#xfff)+val-n;
	       IF n<0 THEN {
		  n := -n;
		  word := word NEQV f.up };
	       IF ~(0<=n<=f2.max.offset) THEN {
		  CGError(FALSE, "Resolve reference: offset %x6 at %x6",
				 n, oldVal!RefLoc);
		  n := 0 };
	       block!o := (word&#xfffff000)+(n&#xfff);
	       ENDCASE }

	    CASE 6:
	    {  LET n = base=r.pc -> loc+8,
		 staticDataLoc=0 -> ValueOfLabel(SLab)+4*SAddr,
				    staticDataLoc;
	       n := (word&#xff)*BytesPerWord+val-n;
	       IF n<0 THEN {
		  n := -n;
		  word := word NEQV f.up };
	       n := n/BytesPerWord;
	       IF ~(0<=n<=255) THEN {
		  CGError(FALSE, "Resolve reference: offset %x6 at %x6",
				 n, oldVal!RefLoc);
		  n := 0 };
	       block!o := (word&#xffffff00)+(n&#xff);
	       ENDCASE }

	    CASE 5:
	       block!o := (word&#xff000000)+
			  ((word+(val>>2))&#xffffff);
	       ENDCASE

	    DEFAULT:
	       CGError(FALSE, "Bad reference type %N",
			      oldval!RefType) };
	 SetArea(a);
	 oldval := FreeBlk(oldval, RefSize) } } }

AND BranchInst(i) =
   (i&#x0f000000)=#x0f000000 -> TRUE,	 // SWI
   (i&#x0e000000)=#x0a000000 -> TRUE,	 // BR, BL
   (i&#x0e000000)=#x08000000 &
   ((i&#x00108000)=#x00108000) -> TRUE,  // LDM loading pc
   (i&#x0c10f000)=#x0410f000 -> TRUE,	 // LDR pc, ...
   (i&#x0c00f000)=#x0000f000 -> TRUE,	 // f1, dest pc
				FALSE

AND UsesOrUpdatesReg(i, r) = VALOF
{  LET ix = i & #x0e000000;
   TEST (i>>16)=r THEN
      RESULTIS TRUE
   ELSE TEST ix=#x08000000 THEN
      TEST (i&(1<<r))~=0 THEN
	 RESULTIS TRUE
      ELSE
	 RESULTIS FALSE
   ELSE TEST (i>>12)=r THEN
      RESULTIS TRUE
   ELSE TEST (ix=0 | ix=#x06000000) & (i&15)=r THEN
      RESULTIS TRUE
   ELSE
      RESULTIS FALSE }

AND AddRef(loc, type, lab) BE
{  LET pointerToLabel = FindLabelEntry(lab);
   LET val = !pointerToLabel;
   TEST (val&lab.set)~=0 THEN
      CGError(FALSE, "adding reference to set label %n (value %n)",
	       lab, val)
   ELSE {
      LET refp = FillBlk(RefSize, val & lab.value, type, loc+currentArea);
      !pointerToLabel := (val & ~lab.value) + refp } }

AND GetArea() = VALOF {
   LET a = GetVector(a.size);
   LET v = GetVector(StoreBlockVSize);
   FOR i = 0 TO StoreBlockVSize-1 DO v!i := 0;
   a!a.locC, a!a.reloc, a!a.xreloc := 0, 0, 0;
   a!a.sbv := v;
   RESULTIS a }

AND SetArea(a) BE IF a~=currentArea THEN {
   LET old, new = ?, ?;
   TEST a=CodeArea THEN
      old, new := daRec, caRec
   ELSE
      old, new := caRec, daRec;
   old!a.locC, old!a.reloc, old!a.xreloc :=
      locCtr, relocatedLocs, xRelocatedLocs;
   locCtr, relocatedLocs, xRelocatedLocs :=
      new!a.locC, new!a.reloc, new!a.xreloc;
   storeBlockV := new!a.sbv;
   currentArea := a }


AND InitDataLists() BE
{  freeDataBlocks := 0;
   FdataList := GetDataBlock(); Fdatap, Faddr := FdataList, 0;
   SdataList, Saddr := 0, 0;
   DataList := GetDataBlock(); Datap := DataList;
   relocatedLocs := 0; relocateReferences := FALSE;
   staticDataLoc := 0;
   pendingLoads, pendingStores := 0, 0;
   savedStates := 0;
   dedicatedRegisters := 0;
   localConstants := GetDataBlock();
   localConstP := localConstants;
   localFAddr := 0;
   RLLoadList := 0;
   xSymbols := 0;
   xRelocatedLocs := 0;
   xSymNo := 4;
   currentArea := 0;
   dataArea := 0;
   caRec := GetArea();
   IF aofOut THEN {
      dataArea := 1;
      daRec := GetArea() };
   storeBlockV := caRec!a.sbv }

AND GetDataBlock() = VALOF
{  LET v = ?;
   TEST freeDataBlocks=0 THEN
      v := GetVector(DataBlockSize)
   ELSE {
      v := freeDataBlocks;
      freeDataBlocks := !freeDataBlocks };
   v!NextBlock, v!EndOfDataInBlock := 0, DataBlockItems-1
   RESULTIS v }

AND AddData(lvdp, n, d1, d2, d3) BE
{  LET p = !lvdp;
   LET i = p!EndOfDataInBlock;
   LET dp = @n;
   IF (i+n)>=DataBlockSize THEN {
      LET newp = GetDataBlock();
      !lvdp, p!NextBlock := newp, newp;
      i := DataBlockItems-1;
      p := newp };
   FOR j = 1 TO n DO {
      i := i+1;
      p!i := dp!j };
   p!EndOfDataInBlock := i }

AND FData(n) = VALOF
{  LET i, p, q = 0, ?, ?;
   TEST usesRL
      THEN p, q := FdataList, @FDataP
      ELSE p, q := localConstants, @localConstP;

   WHILE p~=0 DO {
      FOR j = DataBlockItems TO p!EndOfDataInBlock DO {
	 IF n=p!j THEN RESULTIS i;
	 i := i+4 };
      p := p!NextBlock };
   AddData(q, 1, n);
   {  LET n = ?;
      TEST usesRL THEN {
	 n := Faddr;
	 Faddr := Faddr+4 }
      ELSE {
	 n := localFaddr;
	 localFaddr := localFaddr+4 };
      RESULTIS n } }

AND Sdata(n) BE
   TEST usesRL THEN
      CGError(FALSE, "SData should not be callable")
   ELSE
      AddData(@localConstP, 1, n)

AND Data(n1, n2) BE AddData(@DataP, 2, n1, n2)

AND CGString(n, label) BE
{  LET v = VEC 256/BytesPerWord;
   LET i = 1;
   LET size = n/4;
   v%0 := n;
   FOR i = 1 TO n DO v%i := ReadN();
   FOR i = n+1 TO n+3 DO v%i := 0;

   TEST usesRL | label~=0 THEN {
      LET b = GetBlk(DataBlockItems+size+1);
      !b := SDataList;
      SDataList := b;
      b!EndOfDataInBlock := size+DataBlockItems;
      FOR i = 0 TO size DO b!(i+DataBlockItems) := v!i;
      SAddr := SAddr+size+1;
      TEST label=0 THEN
	 Load(k.lvstatic, -SAddr)
      ELSE
	 staticLabels :=
	    FillBlk(4, staticLabels, label, Null, -4*SAddr) }
   ELSE {
      Load(k.lvlab, localConstLab);
      h4!arg1 := localFaddr/4;
      FOR i = 0 TO size DO {
	 SData(v!i);
	 localFaddr := localFaddr+4 } } }

AND GenData(d) BE
   WHILE d~=0 DO {
      FOR p = DataBlockItems TO d!EndOfDataInBlock DO
	 PutWord(d!p);
      d := d!NextBlock }

AND AddRelocatedLoc(loc, lab) BE
   relocatedLocs := FillBlk(RefSize, relocatedLocs, loc, lab)

AND AddXRelocatedLoc(loc, xsym, reftype) BE
   xrelocatedLocs := FillBlk(RefSize, xRelocatedLocs, loc, xsym!sym.no+reftype)

AND AddXSymbol(id, type, value) = VALOF
{  LET p = xSymbols;
   LET q = @xSymbols;
   WHILE p~=0 DO {
      IF CompString(id, sym.id!p)=0 THEN {
	 IF type~=0 THEN sym.attr!p, sym.val!p := type, value;
	 RESULTIS p };
      q := p;
      p := !p };
   !q := FillBlk(sym.size, 0, 0, type, xSymNo, InternString(id), value);
   xSymNo := xSymNo+1;
   RESULTIS !q }

AND InternString(string) = VALOF
{  LET n = (string%0+1)/BytesPerWord;
   LET s = GetBlk(n+1);
   FOR i = 0 TO n DO s!i := string!i;
   RESULTIS s }

AND GenXSym(name, label) BE {
   LET w = VEC 256/BytesPerWord;
   LET k = sectionName%0;
   LET k1 = name%0;
   FOR i = 1 TO k DO w%i := sectionName%i;
   k := k+1;
   w%k := '.';
   FOR i = 1 TO k1 DO w%(k+i) := name%i;
   w%0 := k+k1;
   SetLabel(label);
   AddXSymbol(w, 1, label) }

AND CGGlobal(n) BE
{  LET ldmtype = reversedStack | saveSpaceSize=3 -> upStack,
						    upStack+f.pre;
   deadCode := Alive;
   IF (![FindLabelEntry(callLab)] & lab.value)~=0 THEN {
      GenXSym("_Call", callLab);
      GenRR(f.mov, r.pc, 0, r.b) };

   IF (![FindLabelEntry(exitCallLab)] & lab.value)~=0 THEN {
      GenXSym("_ExitCall", exitCallLab);
      GenRR(f.mov, r.ts, 0, r.p);
      F4Inst(f.ldm, r.ts, f4.pl14, ldmtype);
      GenRR(f.mov, r.pc, 0, r.b) };

   IF (![FindLabelEntry(exitLab)] & lab.value)~=0 THEN {
      GenXSym("_Exit", exitLab);
      GenRR(f.mov, r.ts, 0, r.p);
      F4Inst(f.ldm, r.ts, f4.plpc, ldmtype+f.pc) };

   IF (![FindLabelEntry(multLab)] & lab.value)~=0 THEN {
      GenXSym("_Multiply", multLab);
      SetRtoRplusK(r.pc, r.gb, sr.multiply) };

   IF (![FindLabelEntry(quotLab)] & lab.value)~=0 THEN {
      GenXSym("_QuotRem", quotLab);
      SetRtoRplusK(r.pc, r.gb, sr.quotrem) };

   deadCode := Dead;
   SetArea(dataArea);
   SetLabel(SLab);
   GenData(SDataList);
   relocateReferences := TRUE;
   SetLabel(staticDataLab);
   relocateReferences := FALSE;
   staticDataLoc := locCtr;
   {  LET d = DataList;
      WHILE d~=0 DO {
	 FOR p = DataBlockItems TO d!EndOfDataInBlock BY 2 DO {
	    LET n = d!(p+1);
	    SWITCHON d!p INTO {
	       CASE s.datalab:
		  SetLabel(n); ENDCASE

	       CASE s.itemn:
		  PutWord(n); ENDCASE

	       CASE s.iteml:
		  AddRelocatedLoc(locCtr, n);
		  AddressInCode(n, 0);
		  ENDCASE

	       CASE s.itemx:
		  AddXRelocatedLoc(locCtr, AddXSymbol(n, 0, 0), RelWord+RelSymbol);
		  PutWord(0) } };
	 d := d!NextBlock } };
   SetLabel(FLab);
   GenData(FDataList);

   SetArea(CodeArea);
   SetLabel(endSectLabel);
   FOR i = 1 TO n DO {
      LET l = ?;
      PutWord(ReadGN());
      l := ReadL();
      AddRelocatedLoc(locCtr, l);
      AddressInCode(l, 0) };
   PutWord(MaxGn);
   PutWord(0);
   IF ~aofOut THEN
   {  LET setToPCplus = m.always+f.add+#x2000000+(r.pc<<16);
      WHILE RLLoadList~=0 DO {
	 LET loc = 1!RLLoadList;
	 LET offset = staticDataLoc-loc-8;
	 LET rl = ReadWord(loc)&#xf000;
	 TEST EightBitsOrFewer(offset) THEN
	    WriteWord(loc, setToPCplus+rl+PackUp(offset))
	 ELSE IF EightBitsOrFewer(offset+4) THEN {
	    LET w = ReadWord(loc-4);
	    WriteWord(loc-4, setToPCplus+rl+PackUp(offset+4));
	    WriteWord(loc, w) };
	 RLLoadList := FreeBlk(RLLoadList, 2) } } }

AND PrintingCharacter(n) = #x20<=n<#x7f

AND PrintHexAndChars(loc, n, fnname) BE
{  WriteF(" & &%x8", n);
   StartComment();
   WriteF("%x4  ", loc);
   IF ~fnname & (n&#xff000000)~=#xff000000
      THEN FOR i = 0 TO 3 DO {
	 LET c = [n>>(i*8)] & 255;
	 WrCh(c<32 | c>=127 -> '.', c) };
   NewLine() }

AND PrintSizes(sofar) = VALOF {
   TEST aofOut THEN {
      WriteF("s %n+%n", carec!a.locC, darec!a.locC);
      sofar := sofar+carec!a.locC+darec!a.locC }
   ELSE {
      WriteF(" %n", locctr);
      sofar := sofar+LocCtr }
   WriteS(" bytes");
   RESULTIS sofar }

AND PrintWords(end, lines, thisArea) BE {
   LET fnname = FALSE;
   LET notInst = FALSE;
   FOR loc = 0 TO locCtr-4 BY 4 DO {
      LET n = ReadWord(loc);
      LET x = n&#xffff0000;
      LET lab = 0;
      LET line = Assoc(loc, 2, lineCounts);
      IF line~=Null & lines THEN WriteF("; -- Line %n --*n", 1!line);
      {  lab := LabelWithValue(loc+thisArea, lab+1);
	 IF lab=Null THEN BREAK;
	 WriteF("L%n*n", lab);
	 {  LET p = Assoc(lab, 5, xSymbols);
	    IF p~=Null THEN WriteF("|%s|*n", p!4) };
	 notInst := LabelFlagged(lab, lab.endproclab) } REPEAT;

      TEST loc<40 | loc>=end | x=0 | x=#xffff0000 | fnname THEN {
	 LET p = Assoc(loc, 1, relocatedLocs);
	 TEST p~=Null THEN {
	    WriteF(" & L%n", TransferredLabel(2!p));
	    StartComment();
	    WriteF("%x4  %x8*n", loc, n) }
	 ELSE {
	    p := Assoc(loc, 1, XRelocatedLocs);
	    TEST p~=Null THEN {
	       WriteS(" & ");
	       IF n~=0 THEN WriteF("%n+", n);
	       WriteF("|%s|", SymbolOfReloc(p));
	       StartComment();
	       WriteF("%x4*n", loc) }
	    ELSE
	       PrintHexAndChars(loc, n, fnname) };

	 fnname := FALSE }

      ELSE TEST (@n)%0=7 & PrintingCharacter((@n)%1) &
			   PrintingCharacter((@n)%2) &
			   PrintingCharacter((@n)%3) THEN {
	 LET v = VEC 1;
	 v!0 := n;
	 v!1 := ReadWord(loc+4);
	 fnname := TRUE;
	 WriteF(" & &%x8    ; %s", n, v);
	 StartComment();
	 WriteF("%x4*n", loc);
	 notInst := FALSE }

      ELSE TEST notInst THEN
	 PrintHexAndChars(loc, n, FALSE)
      ELSE
	 PrintInstruction(loc, n) } }

AND CGEnd() BE
{  IF ListStream~=0 THEN {
      LET o = Output();

      SelectOutput(listStream);
      InitialiseDisassembler(TRUE);
      TEST aofOut THEN {
	 SetArea(codeArea);
	 WriteS(" AREA |BCPL$$Code|, CODE, READONLY*n*n");
	 PrintWords(ValueOfLabel(endSectlabel), TRUE, CodeArea)
	 WriteS("*n AREA |BCPL$$Data|*n*n");
	 SetArea(dataArea);
	 PrintWords(0, FALSE, dataArea) }
      ELSE
	 PrintWords(ValueOfLabel(slab), TRUE, 0);

      WriteS(" END*N");
      TerminateDisassembler();
      SelectOutput(o) };

   OutputSection() }

AND WriteTable(t) BE
{  LET i = 0;
   {  LET w = t!i;
      IF w=-1 THEN RETURN
      BinWord(t!i);
      i := i+1 } REPEAT }

AND WriteObjString(s) = VALOF
{  LET n = s%0;
   LET nn = (n+4)&-4;
   FOR i = 1 TO n DO OutByte(s%i);
   FOR i = n+1 TO nn DO OutByte(0);
   RESULTIS nn }

AND OutputSection() BE IF moduleStream~=0 THEN
{  LET o = output();
   SelectOutput(moduleStream);
   TEST AOFout THEN {
      MANIFEST {  // description of chunk file header
	 AreaChunkPosn = 11;
	 StringTablePosn = 15;
	 SymbolTablePosn = 19;

	 ChunkStart = 2;
	 ChunkLength = 3;

	 // description of header chunk
	 HCnSym = 3;
	 AreaPosn = 6;
	 AreaLength = 2;
	 AreaRelocs = 3;

	 AAAbs = #x100;
	 AACode = #x200;
	 AACommon = #x400;
	 AANoInit = #x1000;
	 AAReadOnly = #x2000;
	 AAPositionIndependent = #x4000;

	 SymName = 0;
	 SymAttributes = 1;
	 SymValue = 2;
	 SymArea = 3;
	 SymSize = 4 };

      LET RoundUp(n) = (n+4) & -4

      LET objFileHeader = TABLE
	 #xc3cbc6c5,	// "I am a chunk file"
	 7,		// max number of chunks
	 5,		// number used

	 'O'+('B'<<8)+('J'<<16)+('_'<<24),
	 'H'+('E'<<8)+('A'<<16)+('D'<<24),
	 #x7C,		// file position
	 24+2*20,	// length

	 'O'+('B'<<8)+('J'<<16)+('_'<<24),
	 'I'+('D'<<8)+('F'<<16)+('N'<<24),
	 #x7C+24+2*20,
	 20,

	 'O'+('B'<<8)+('J'<<16)+('_'<<24),
	 'A'+('R'<<8)+('E'<<16)+('A'<<24),
	 #x7C+24+2*20+20,
	 0,

	 'O'+('B'<<8)+('J'<<16)+('_'<<24),
	 'S'+('T'<<8)+('R'<<16)+('T'<<24),
	 #x7C+24+2*20+20,
	 0,

	 'O'+('B'<<8)+('J'<<16)+('_'<<24),
	 'S'+('Y'<<8)+('M'<<16)+('T'<<24),
	 #x7C+24+2*20+20,
	 0,

	 0,0,0,0,
	 0,0,0,0,

	 -1;

      LET headerChunk = TABLE
	 #xC5E2D080,	// magic 'I am a module' marker
	 110,		// version of object format
	 2,		// area count
	 0,		// number of symbols
	 0,		// entry area
	 0,		// entry offset

	 0,		// code area name
	 AACode+AAReadOnly+2,	   // code : word aligned
	 0,		// length: locCtr
	 0,		// relocations: LengthOfList(relocatedLocs)
	 0,		// base

	 12,		// data area name
	 2,		// data: word aligned
	 0,		// length: locCtr
	 0,		// relocations: LengthOfList(relocatedLocs)
	 0,		// base

	 -1;

      LET standardSyms = TABLE
	 0, SADefined+SAGlobal, 0, 0,
	 1, SADefined+SAGlobal+SAAbs, 0, 0,
	 2, SADefined+SAGlobal, 0, 12,
	 3, SADefined+SAGlobal+SAAbs, 0, 0,
	 -1;

      LET areaSyms = TABLE 0, 12;

      LET cLocCtr = locCtr;
      LET nRelocs = LengthOfList(relocatedLocs)+LengthOfList(xRelocatedLocs);
      LET codeAreaLength = locCtr+nRelocs*8;
      LET dLocCtr = daRec!a.locC;
      LET ndRelocs = LengthOfList(daRec!a.reloc)+LengthOfList(daRec!a.xreloc);
      LET dataAreaLength = dLocCtr+8*ndRelocs;
      LET filepos = objFileHeader!(AreaChunkPosn+ChunkStart)
      LET strTabLen = 24;   // for the area names
      strTabLen := strTabLen+2*RoundUp(sectionName%0+3)+2*RoundUp(sectionName%0+4);
      {  LET p = xSymbols;
	 WHILE p~=0 DO {
	    strTabLen := strTabLen+RoundUp((sym.id!p)%0);
	    p := !p } };
      objFileHeader!(AreaChunkPosn+ChunkLength) := codeAreaLength+dataAreaLength;
      filepos := filepos+codeAreaLength+dataAreaLength;
      objFileHeader!(StringTablePosn+ChunkStart) := filepos;
      objFileHeader!(StringTablePosn+ChunkLength) := strTabLen;
      objFileHeader!(SymbolTablePosn+ChunkStart) := filepos+strTabLen;
      objFileHeader!(SymbolTablePosn+ChunkLength) := xSymNo*(4*SymSize);

      headerChunk!(AreaPosn+AreaLength) := locCtr;
      headerChunk!(AreaPosn+AreaRelocs) := nRelocs;
      headerChunk!(AreaPosn+5+AreaLength) := dLocCtr;
      headerChunk!(AreaPosn+5+AreaRelocs) := ndRelocs;
      headerChunk!HCnSym := xSymNo;

      WriteTable(objFileHeader);
      WriteTable(headerChunk);
      WriteObjString(StringF("BCPL version %n.%n", CGMajorVersion, CGMinorVersion));

      OutArea(codeArea);
      OutArea(dataArea);

      {  // The string table
	 LET stPos = WriteObjString("BCPL$$Code");
	 stPos := stPos+WriteObjString("BCPL$$Data");
	 standardSyms!(SymName+0*SymSize) := stPos;
	 stPos := stPos+WriteObjString(StringF("%s.C$", sectionName));
	 standardSyms!(SymName+1*SymSize) := stPos;
	 stPos := stPos+WriteObjString(StringF("%s.CS$", sectionName));
	 standardSyms!(SymName+2*SymSize) := stPos;
	 stPos := stPos+WriteObjString(StringF("%s.D$", sectionName));
	 standardSyms!(SymName+3*SymSize) := stPos;
	 stPos := stPos+WriteObjString(StringF("%s.DS$", sectionName));
	 {  LET p = xSymbols;
	    WHILE p~=0 DO {
	       sym.str!p := stPos;
	       stPos := stPos+WriteObjString(sym.id!p);
	       p := !p } };

	 // The symbol table
	 standardSyms!(SymValue+1*SymSize) := cLocCtr;
	 standardSyms!(SymValue+3*SymSize) := dLocCtr;
	 WriteTable(standardSyms)
	 {  LET p = xSymbols;
	    WHILE p~=0 DO {
	       BinWord(sym.str!p);
	       BinWord(sym.attr!p);
	       TEST (sym.attr!p&SADefined)~=0 THEN {
		  BinWord(ValueOfLabel(sym.val!p));
		  BinWord(AreaSyms![AreaOfLabel(sym.val!p)]) }
	       ELSE {
		  BinWord(0); BinWord(0) };
	       p := !p } } } }

   ELSE {
      FOR loc = 0 TO locCtr-4 BY 4
	 DO BinWord(ReadWord(loc));
      BinWord(#x12345678);
      {  LET r = relocatedLocs;
	 WHILE r~=0 DO {
	    BinWord(1!r);
	    r := !r } };
      BinWord(#x87654321) };

   SelectOutput(o) }

AND OutArea(area) BE {
   SetArea(area);
   FOR loc = 0 TO locCtr-4 BY 4
      DO BinWord(ReadWord(loc));

   {  LET r = relocatedLocs;
      WHILE r~=0 DO {
	 BinWord(1!r);
	 TEST AreaOfLabel(2!r)=area THEN
	    BinWord(RelWord)  // additive, internal, word
	 ELSE
	    BinWord(RelWord+RelSymbol+(area=0 -> 2,0));
	 r := !r };
      r := xRelocatedLocs;
      WHILE r~=0 DO {
	 BinWord(1!r);
	 BinWord(2!r);
	 r := !r } } }


AND OutByte(byte) BE BinWrCh(byte)

AND BinWord(word) BE
   FOR i = 0 TO 24 BY 8
      DO OutByte((word>>i) & 255)
