// BNCG0.bcpl - BCPL Compiler -- Nova Code Generator, Main program
// Copyright Xerox Corporation 1980
///*DCS* BNCG Symbol Table Compaction

get "bncgx"
external InitToRead

static
 [  PassTwo = false
    LabelDef = false
    Cparameter = 32
    PCparameter = 16
    plabdefvec = nil
    pchainvec = nil
    plabelt = 0
    lchainvec = nil
    llabelt = 0
    elabelvec = nil
    eaddrvec = nil
    elabelt = 0
    vlabelt = 0
    zlabelt = 0
    ctypetable = nil
    cdatatable = nil
    caddrtable = nil
    cnametable = nil
    ctablep = 0
    constcount = 0
    constreflimit = #77777
    casev = nil
    casel = nil
    argvec = nil
    arg1 = nil
    arg2 = nil
    arg3 = nil
    framestack = nil
    framestackp = 0
    Dict = nil
   ///*DCS*
    DictPtr = nil
     VirginSym = 0
    PC = nil
    PCmax = nil
  
  ]

///*DCS*
structure SYMPTR:
   [
   Virgin bit 1 ///* if on, symbol useless 
   link bit 15  ///* => next symbol, no longer needed.
   ]

manifest
  [
  Vsymsize = 64
  ]

let GenerateCode() be
 [  if SWDebug do WriteS("NCG*n")

    Code = Newvec(Codelimit)
    PC, PCmax = 1, Codelimit

    vlabelt = 0
    zlabelt = 0

    plabelt = Nextparam() - 1
    pchainvec = Newvec(plabelt)

    plabdefvec = Newvec(plabelt)
    for i = 0 to plabelt do plabdefvec!i = 0

    llabelt = Nextstatic() - 1
    lchainvec = Newvec(llabelt)

    elabelt = Nextentry() - 1
    elabelvec = Newvec(elabelt)
    eaddrvec = Newvec(elabelt)
    for i = 0 to elabelt do elabelvec!i, eaddrvec!i = 0, 0

    ctypetable = Newvec(ctablesize)
    cdatatable = Newvec(ctablesize)
    caddrtable = Newvec(ctablesize)
    cnametable = Newvec(ctablesize)

    argvec = Newvec(argvecsize)

    framestack = Newvec(framestacksize)

    Reposition(DictStream, 0)
    InitToRead(DictStream)
   ///*DCS*	  Dict = Newvec(DictLength) ///* old code
   ///*	 for i = 0 to DictLength-1 do Readword(DictStream, lv Dict!i)
   ///* Look at each Symbol.  There exist virgin symbols (entered,
   ///* but never referenced) and others.  Virgin symbols have the 
   ///* virgin bit on in the now unused pointer word (word 0).  Read 
   ///* in only non-virgin symbols.  Record their file indices in the
   ///* DictPtr table, for use by binary search.
   Dict = Newvec(RealSymSize) // Size of non-virgin symbols
   DictPtr = Newvec(RealSymCount) // Number of same
   ///* dump first letter dispatch table
   let symptr, symct, onewd = 0, 0, nil
   for i = 0 to ($z-$a+1)*2+1-1 do Readword(DictStream,lv onewd)
   for i = ($z-$a+1)*2+1 to DictLength-1 do
      [readasymbol
      Readword(DictStream, lv onewd) ///* link word, w/virgin bit
      Readword(DictStream, lv Dict!(symptr+1)) ///* 1st word, w/count
      ///* sz is index rel symptr of last word in symbol
      let sz = (((Dict!(symptr+1)) rshift 8)/Bytesperword)+1
      for j=2 to sz do
         Readword(DictStream, lv Dict!(symptr+j))
      unless onewd<<SYMPTR.Virgin do
         [
         DictPtr!symct = symptr
         symct = symct + 1
         Dict!symptr = i+1 ///* the internal rep. of this symbol
         symptr = symptr+sz+1
         if symct eq RealSymCount then break
         ]
      i = i + sz
      ]readasymbol
   ///*DCS* End of Modified Symbol Table Read

    for p = Code to Code + Codelimit do rv p = 0

    Writeword(CodeStream, Version)

    let head = vec #16
    let headpos = Position(CodeStream)
    for i = 0 to #16-1 do [ head!i = 0; Writeword(CodeStream, head!i) ]
    head!2 = BP()

    SWList = SWPassOneList
    SWCode = SWPassOneCode
    PassTwo = false

    ResetStream(OcodeStream, $c)
    InitToRead(OcodeStream)
    let ocodepos = Position(OcodeStream)

 [  for i = 0 to plabelt do pchainvec!i = 0
    for i = 0 to llabelt do lchainvec!i = 0

    for i = 0 to ctablesize do 
	ctypetable!i, cdatatable!i, caddrtable!i, cnametable!i = 0, 0, 0, 0
    ctablep = 0
    constreflimit = #77777
    constcount = 0

    for i = 0 to argvecsize do argvec!i = 0
    SSP = 1
    MaxSSP, MaxVecSSP = SSP, SSP
    Initstack(SSP)
    for i = 0 to framestacksize do framestack!i = 0
    framestackp = 0

    PC, PCmax = 1, Codelimit

    vlabelt = 0
    zlabelt = 0

    ScanImpures()

    ScanPures()

    if PassTwo break
    PassTwo, SWList, SWCode = true, SWPassTwoList, SWPassTwoCode
    Reposition(OcodeStream, ocodepos)

  ] repeat

    CloseTemp(OcodeStream, $c)

    head!4 = BP()
    if PassTwo do WB(elabelt)
    for i = 1 to elabelt do
	 [ if PassTwo do WB(elabelvec!i); if PassTwo do WB(eaddrvec!i) ]

    head!6 = BP()
    if PassTwo do WB(PC)
    Code!0 = PC
    for i = 0 to PC-1 do if PassTwo do WB(Code!i)

    head!#10 = BP()
    if PassTwo do WB(llabelt)
    for i = 1 to llabelt do if PassTwo do WB(lchainvec!i)

    head!#12 = BP()
    if PassTwo do WB(zlabelt)
    let p = lv Code!PCmax
    for i = 1 to zlabelt do if PassTwo do
     [	WB(p!0); WB(p!1); p = p + 2 ]

    head!0 = BP()
    let endpos = Position(CodeStream)
    Reposition(CodeStream, headpos)
    for i = 0 to #16-1 do if PassTwo do WB(head!i)
    Reposition(CodeStream, endpos)
    CloseTemp(DictStream, $d)
]

///*DCS* Binary Search for symbol N
and LookForSym(N) = valof
   [
   let pos = RealSymCount rshift 1
   let inc = pos
   ///* repeat
      [
      let ptr = Dict+(DictPtr!pos)
      let val = @ptr
      if val eq N then resultis ptr+1
      if inc eq 1 then break ///* No more chances
      inc = (inc+1) rshift 1
      test val gr N
         ifso
            [
            pos = pos-inc
            if pos ls 0 then pos = 0
            ]
         ifnot
            [
            pos = pos+inc
            if pos ge RealSymCount then pos = RealSymCount-1
            ]
      ] repeat
   if N eq Dict!0 then resultis Dict+1 ///* Special test for 0
   ///* Referenced but once -- Go get from Complete Dictionary
   resultis SymFromDict(N)
   ]

and SymFromDict(N) = valof
   [
   if VirginSym eq 0 then
      VirginSym = Newvec(Vsymsize)
   Reposition(DictStream, N*Bytesperword)
   Readword(DictStream, lv VirginSym!0)
   for i = 1 to Length(VirginSym)/Bytesperword do 
      Readword(DictStream, lv VirginSym!i)
   resultis VirginSym
   ]
     
and CGreport(n) be
 [  Ostream = ErrorStream
    WW($*n)
    WriteLine(Curline)
    let m = selecton n into
      [	default: 0
	case 0: "TOO MUCH CODE GENERATED"
	case 1: "BAD FRAME REFERENCE -- PROBABLY A COMPILER BUG"
	case 2: "STATEMENT TOO BIG"
      ]
    BCPLreport(n, m)
    if SWHelp do Help("NCG REPORT")
    goto Abort
  ]

and Readop() = valof
 [  let op = nil
    Readch(OcodeStream, lv op)
//WriteS("Readop="); WW(op);WriteO(op);WW($*N)
    resultis op
  ]

and ReadC() = valof
 [  let c = nil
    Readch(OcodeStream, lv c)
//WriteS("ReadC="); WW(c);WriteO(c);WW($*N)
    resultis c
  ]

and ReadL() = valof
 [  let l = nil
    Readaddr(OcodeStream, lv l)
//WriteS("ReadL="); WW(l);WriteO(l);WW($*N)
    resultis l
  ]

and ReadN() = valof
 [  let n = nil
    Readword(OcodeStream, lv n)
//WriteS("ReadN="); WW(n);WriteO(n);WW($*N)
    resultis n
  ]


and WriteOct(n) be
 [  let zsw = true
    for i = 15 to 3 by -3 do
     [	let d = (n rshift i) & #7
	unless zsw & (d eq 0) do
	 [ WW(d+$0); zsw = false ]
      ]
    WW((n & #7)+$0)
  ]

and WB(n) be  Writeword(CodeStream, n) 

and BP()  = Position(CodeStream)/2

and Nval(n) = n

and Bval(n) = n & #377

and Wval(n) = (n & #200) eq 0 ? n, n % #177400

and STRval(u, p) = valof
    [ Packstring(u, p); resultis u!0/2 ]