// Main Program for MICRO
// last edited December 26, 1979  8:33 AM
// Copyright Xerox Corporation 1979

	get "micdecl.d"
	get "streams.d"
	get "altofilesys.d"
	get "sysdefs.d"

external
[		// O.S.
	CreateDisplayStream; ShowDisplayStream
	ReadCalendar
	FilePos
	OpenFile; Puts; Closes
	TruncateDiskStream
	CounterJunta
	MoveBlock
	Noop
	sysFont
	dsp
		// EasyJunta
	EasyJunta
		// LoadOverlay
	LoadOverlay
]


manifest [
	StackSize = 5000b
	ldspData = 5000b
	nKS = 7	// in, out, lst, er, fix, +2 for OpenFile
	lSysZone = nKS*(lKS+400b+10)+40	// don't know why the extra is needed, but it is
	lvCodeTop = 335b
   ]

static
[	saveDsp
	stime
	ttime
	nullout
]


let micro(blv, params, cfa) be
[	saveDsp = dsp
	EasyJunta(levDisplay, micro1, cfa, lCFA, lSysZone)
]

and micro1(cfa) be
  [	let dspData = vec ldspData
	let ds = CreateDisplayStream(6, dspData, ldspData, sysFont)
	ShowDisplayStream(ds, DSalone)
	dsp = ds
	let femb = "MB"
	let StartTime = vec 1
	ReadCalendar(StartTime)
	stime = StartTime!1
	let mbfile = vec filenamelength
	freestoretop(0)
	let top = fstop
	let sources = micinit(mbfile)
	@lvCodeTop = micinit	// Flush initialization code
	freestoretop(fstop+fsbot)	// Expand free area
	test inchan eq 0
	ifso	// Create symtab
	  [	initsym(131, 200b)
		defbi(table[ $B;$U;$I;$L;$T;$I;$N], 7, biBUILTIN)
		defbi(table[ $I;$N;$S;$E;$R;$T], 6, biINSERT)
	   ]
	ifnot	// Restore save file
	  [	srecover(inchan)
		close(inchan)
		initsym()
		recsym()
	   ]
	ofbot = fsbot
	@lvCodeTop = top+1	// set stack limit
	// Initialize fake outchan
	let os = vec lST
	os>>ST.par1 = mbfile
	os>>ST.puts = firstput
	fakeoutchan = os
	outchan = os
	let no = vec lST
	no>>ST.puts = Noop
	no>>ST.close = Noop
	no>>ST.type = not stTypeDisk	// for close
	nullout = no
	initacc()
	initin()
	initmac()
	initmac1()
	initout(femb)
	initscan()
	lchan = lstchan
	while sources ne 0 do
	  [	initreadstat(ucflag % sources!1)
		let arg = sources+(2+lFP)
		if not inpush(arg, sources+2) then
		   errx("SOURCE FILE @L DOES NOT EXIST",true,arg)
		while readstat() do
		  test @stbuf eq $:
		   ifso [ @stbuf = endc; assem() ]	// ignore :, always process
		   ifnot unless ignore do assem()	// don't process if ignoring
		sources = sources!0
	   ]
	if symchan ne 0 then
	 [ dumpsym()
	   sdump(symchan)
	   close(symchan)
	   recsym()
	 ]
	let limit = fstop+fsbot
	fsfix(LoadOverlay(cfa, initin, limit), limit)	// release main program, load end code
	endout()
	endlist(xlistflag)
	endmic()
   ]

and defbi(ap, l, i) be
// Predefine a BUILTIN
[	lookup(ap, l)
	putin(bitype)!bsno = i
]

and endmic() be
[	let EndTime = vec 1
	ReadCalendar(EndTime)
	ttime = EndTime!1-stime
	summary(ettchan)
	closeall()
	ShowDisplayStream(dsp, DSdelete)
	CounterJunta(micro2)
]

and micro2() be
[	dsp = saveDsp
	summary(dsp)
	finish
]

and summary(strm) be
[	lchan = strm
	llstr("*NTime: ")
	ldec(ttime)
	llstr(" seconds; ")
	if errcnt ne 0 then
	[ ldec(errcnt)
	  llstr(" error(s), ")
	]
	if warncnt ne 0 then
	[ ldec(warncnt)
	  llstr(" warning(s), ")
	]
	ldec(fsgap)
	llstr(" words free*N")
]

and firstput(os, wd) be
// Called on first Puts(outchan, --).  Really opens outchan.
[	unless binflag do	// No output
	  [ outchan = nullout; return ]
	if os eq outchan then	// otherwise, old outchan was copied somewhere
	  [	filext(os>>ST.par1, nil, mbext+fstop)
		outchan = OpenFile(os>>ST.par1, ksTypeWriteOnly, wordItem, verLatestCreate)
	   ]
	Puts(outchan, wd)
]

and putboth(st, ch) be
// This is Puts for a splitter stream
[	Puts(st>>ST.par1, ch)
	Puts(st>>ST.par2, ch)
]

and filext(res,org,ext) = valof
// If res is empty, copy org into res forcing the extension to ext
// If res is not empty, add ext as its extension if it has none
  [	let empty = @res eq 0
	if empty then copyfile(res, org)
	let len = length(res)
	let i = 1
	while i le len do
	 [ if res>>BS.char^i eq $. break
	   i = i+1
	 ]
	if empty % (i gr len) then
	 [ res>>BS.char^i = $.
	   for j = 1 to length(ext) do
	      res>>BS.char^(i+j) = ext>>BS.char^j
	   res>>BS.length = i+length(ext)
	 ]
	resultis res
   ]

and copyfile(tofile,fromfile) be
// Copies a bcpl string.
MoveBlock(tofile,fromfile,(length(fromfile)+2) rshift 1)

and freestoretop(fst) be
// Set top of free storage
[	if fst eq 0 then fst = (lv fst)-StackSize
	fsfix(@lvCodeTop, fst)
	fstop = fst
	// Initialize allocator variables
	fsbot = -1
	fstop!-1 = 0
	slfl = 0
	srover = 0
]

and fsfix(bot, top) be
[	if (top-bot) le 0 then	// more than 32K, arithmetic fails
	  bot = top-77777b
	fslim = bot
]

and close(str) be
  [	if (str eq 0) % (str>>ST.type ne stTypeDisk) return
	let pos = vec 1
	FilePos(str,pos)
	if (pos!0 eq 0) & (pos!1 eq 0) then TruncateDiskStream(str)
	Closes(str)
   ]

and closeall() be
  [	close(lstchan)
	close(erlchan)
	close(outchan)
   ]