// BLDR.BCPL
// Copyright Xerox Corporation 1979, 1981
//  Taft, November 13, 1981  3:05 PM
//  Swinehart, June 20, 1977  8:44 AM, accept $H switch

get "bldr.decl"

// System Initialization

let Bldr(blv, upe, cfa) be
  [
  VERSION = (2 lshift 8) + 8
  BeforeJuntaInit(blv)
  ]

and Main() be
  [
  AfterJuntaInit()
  IncreaseStorage() // toss out initialization code
// Main loading loop -- process eventList

let event = @eventList
let eventCount = 0
while event do
    [
    let cmd = event>>RFile.cmd
    switchon cmd into
	[
	case $S: INITSAVEFILE(event); endcase
	case $A: case $B: INITBINFILE(event, cmd); endcase
	case $R: case $I: READRELFILE(event, cmd); endcase
	case $H: case $J: case $K: READJKFILE(event,cmd); endcase
	case $P: case $Q: case $X: case $Y: ProcessPC(event, cmd); endcase
	default: ERROR("Invalid internal structure")
	]
    event = @event
    eventCount = eventCount+1
    DisplayInCursor(eventCount)
    ]

FinishBldr()
finish
]

and ProcessPC(event, cmd) be
    [
    let letterVbl = event>>PCsave.letterVbl
    let newVal = CODELOC
    let P, oldVal = nil, nil
    if letterVbl ge $A then
    	[ P = lv PARAMLIST!(letterVbl-$A); oldVal = @P ]
    switchon cmd into
    	[
    	case $P:
    	  [
    	  unless letterVbl eq $$ do newVal = 0
    	  test letterVbl < $A then [ // not a letter, so it's 0 or $$
		oldVal = newVal + event>>PCmod.newValue
    		if BFILE eq SFILE & Usc(oldVal, SFILE>>BFile.codeLoc)<0 then ERROR(
		   "$UO/P: Can't load below Codestart -- change it with /O", oldVal)
		]
	   or if oldVal eq -1 then ERROR("/P: $C value not initialized",letterVbl)
	  CODELOC = oldVal
	  endcase
	  ]
	case $X: if Usc(oldVal, newVal) > 0 then newVal = oldVal; docase $Q
	case $Y: if Usc(oldVal, newVal) < 0 then newVal = oldVal; // docase $Q
	case $Q: @P = oldVal eq -1? CODELOC, newVal; endcase
	default: ERROR("Internal structure damaged")
	]
    ]

and INITSAVEFILE(event) be
   [
   Ws(SFILENAME)
   if TFILENUM ne -1 do [ Ws(" , "); Ws(fileNameVec!TFILENUM) ]
   Puts(dsp,$*N)
   
   if COMMONSTART eq -1 then COMMONSTART=#50
   COMMONMAX=#300
   DEBGSTARTADDR=-1
   if STATICMAX eq -1 do STATICMAX = ISTATICMAX
   if STATICSTART eq -1 then STATICSTART = USERBOTTOM
   if CODESTART eq -1 then CODESTART = STATICSTART+ STATICMAX
   STATICSPACESIZE=STATICMAX
   STATICMAX = STATICSTART + STATICSPACESIZE
   COMMONLOC = COMMONSTART
   STATICLOC = STATICSTART
   CODELOC = CODESTART
   STARTCODEIMAGE=STARTMEMIMAGE+STATICSPACESIZE

   if INITSWAPSW eq 1 then
	[ // make "external SwappedOut" be first symbol
	let sym, symstring = vec lSYm, "SwappedOut"
	sym>>SYm.rFile = @eventList // .RUN file descriptor
	sym>>SYm.flags = 0; sym>>SYm.staticAddress = -1
	sym>>SYm.dictEntry = DICTENTRY(symstring)
	SWAPPEDOUTSYM = NEWSYMENTRY(sym) ]

   if (LISTSW % TFILESW) do
 	[ LSTREAM = Openfile(TFILENUM,ksTypeWriteOnly,charItem)
 	if TFILESW do TSTREAM = LSTREAM ]
   SSTREAM = Openfile(SFILENUM, ksTypeWriteOnly,wordItem)
   INITBINFILE(event, 0)
   SFILE = BFILE
   
   if Usc(STATICSTART , USERBOTTOM) ls 0 do
 	WARNING("statics start below USERBOTTOM")
   if Usc(STATICMAX , COREMAX) gr 0 do
 	WARNING("static area overlaps OS")
   
   PutTemplate(LSTREAM,"   COMMON*T*T*T$6UO*T$6UO*N",
 	COMMONSTART, COMMONMAX-1)
   unless DEBGSTARTADDR eq -1 do
 	PutTemplate(LSTREAM,"   DEBUG *T*T*T$6UO*N", DEBGSTARTADDR)
   PutTemplate(LSTREAM,"   STATICS*T*T*T$6UO*T$6UO*N",
 	STATICSTART, STATICMAX-1)
   ]

and INITBINFILE(event, kind) be
   [
   if SFILE then ENDBINFILE() // suspend .RUN file or end .BB overlay

   BFILE = event
   BFILENUM = BFILE>>BFile.fileNum
   BFILEMODE = kind eq $B? 1, 0
   RELPAIRSW = BFILEMODE eq 1

   bFileCount = bFileCount+1
   BFILE>>BFile.bFileId = bFileCount
   BFILE>>BFile.codeLoc = -1
   BFILE>>BFile.maxCodeLoc = -1
   
   Wss(LSTREAM,fileNameVec!BFILENUM);
   if BBINSAVESW & BFILENUM ne SFILENUM then
   	PutTemplate(LSTREAM," (IN $S)",SFILENAME)
   Puts(LSTREAM,$*N)
   
   LABLIST!0 = 0; LABLISTBASE = 0
   
   test BFILENUM eq SFILENUM	//IF SO, THIS IS THE SAVE FILE
   	then BSTREAM = SSTREAM
   	or   [ test BBINSAVESW
   		   ifso	[ // pad last page of save file & append
   			BSTREAM = SSTREAM
   			let N = CURBOPOS(BSTREAM) & #377
   			if N then WriteBlock(BSTREAM, CODE, 256-N)
   			]
   		  ifnot BSTREAM = Openfile(BFILENUM, ksTypeWriteOnly, wordItem)
		GetCurrentFa(BSTREAM,startOverlayFa)
   		Zero(BHEAD,BHEADLENGTH)
		WriteBlock(BSTREAM,BHEAD,BHEADLENGTH)
   		BHEAD>>BBHeader.overlayPage = CURBOPAGE(BSTREAM)
   		]
   ]
and STOPSAVEFILE() be
	[
	SFILE>>BFile.rFileCodeLoc = CODELOC
	SETBOPOS(SSTREAM, SFILE>>BFile.maxCodeLoc-CODESTART+STARTCODEIMAGE-1)
	if LABLISTBASE then
	   SRELPAIRLOC = WRITERELPAIRS(0)+CODESTART-STARTCODEIMAGE+1
	let SAVEENDPAGE = CURBOPAGE(SSTREAM)
	GetCurrentFa(SSTREAM, staticLinksFa)
	if BBINSAVESW then // **** leave room for static links (too much)
		WriteBlock(SSTREAM, CODE, STATICSPACESIZE) 
	SFILE>>BFile.pageLength = 
	  (CURBOPOS(SSTREAM, SAVEENDPAGE)+255) rshift 8 +  SAVEENDPAGE
	if INITSWAPSW eq 1 then
	  test SWAPPEDOUTSYM>>SYm.type > 1 then INITSWAPSW = 2
		or [
		Wss(LSTREAM,"*N/I switch requires SwappedOut procedure*N*N")
		ERRORCOUNT = ERRORCOUNT + 1; INITSWAPSW = 3 ]
	]

and ENDBINFILE() be
	[
	if BFILE eq SFILE then [ STOPSAVEFILE(); return ]
	BHEAD>>BBHeader.codeLoc = BFILE>>BFile.codeLoc
	BHEAD>>BBHeader.codeLength = BFILE>>BFile.maxCodeLoc - BFILE>>BFile.codeLoc
	BHEAD>>BBHeader.type = BFILEMODE
	let oPage = BHEAD>>BBHeader.overlayPage
	BHEAD>>BBHeader.relPairTable = CURBOPOS(BSTREAM, oPage)
	if BFILEMODE eq 1 % LABLISTBASE do WRITERELPAIRS(oPage)
	BHEAD>>BBHeader.fileLength = CURBOPOS(BSTREAM, oPage)
	let endFa = vec lFA
	GetCurrentFa(BSTREAM, endFa)
	JumpToFa(BSTREAM,startOverlayFa)
	WriteBlock(BSTREAM,BHEAD,BHEADLENGTH)
	JumpToFa(BSTREAM,endFa)
	unless BBINSAVESW do Closes(BSTREAM)
	]

// ENDSAVEFILE logically goes here

and WRITERELPAIRS(PAGEOFFSET) = valof // ***
	[
	let P = CURBOPOS(BSTREAM, PAGEOFFSET)
	let nRelPairs = LABLIST!0 - LABLISTBASE/2
	BFILE>>BFile.nRelPairs = nRelPairs // keep for SYMS file
	Puts(BSTREAM,nRelPairs)
	WriteBlock(BSTREAM,lv LABLIST!(LABLISTBASE+1),nRelPairs lshift 1)
	if BFILENUM eq SFILENUM then
	  [
	  SFILE>>BFile.maxCodeLoc=
	    SFILE>>BFile.maxCodeLoc + LABLIST!0*2 - LABLISTBASE + 1
	  SFILE>>BFile.rFileCodeLoc=SFILE>>BFile.maxCodeLoc
	  ]
	resultis P
	]