// MDinit.bcpl -- process command line
// last edited March 25, 1981  4:01 PM

	get "mddecl.d"
	get "streams.d"
	get "altofilesys.d"
	get "altodefs.d"

external [	// defined here
	Init	// () -> sources
	// Switches and parameters from command line
	DebugFlag
	DebugFirstLoc
	DebugLastLoc
	IgnoreOnPage
	Kludge	// see MDSCAN
	ListAbs
	ListingLevel
	MapChart
	MapIM
	MapRM
	MapOccupied
	ListSymbols
	TraceStorage
	Version
	Xternal
	// Other statics
	VersionString
	StartDTString
	OutputSource
	MBSource
	ScratchSource
	DeleteScratch
]

external [
// OS
	CreateDisplayStream; ShowDisplayStream
	OpenFile
	CreateDiskStream
	Closes; Endofs; Gets; Puts; Resets; Wss
	Allocate; Free; MoveBlock; Zero
	fpComCm; fpSysDir
	dsp
	sysFont; sysZone
// GP
	SetupReadParam; ReadParam; EvalParam
// MDI
	LookupEntries
// TimeIO
	CONVUDT
// Template
	PutTemplate
// MDmain
	Err
	StoreString
	MaxBlock
	@OutputS; @MBS
	@TempZone; @Zone
]


manifest [
	nOutputs = 8
	ldspLines = 6
	ldspLinesSmall = 3
	ldspBits = 5000b
	ldspBitsSmall = 2000b
]


static [
	// Switches and parameters from command line
	DebugFlag = 0
	DebugFirstLoc = 0
	DebugLastLoc = IMsize-1
	IgnoreOnPage = false
	Kludge = false
	LargeProgram = false
	ListAbs = false
	ListingLevel = listFull
	MapChart = false
	MapIM = false
	MapRM = false
	MapOccupied = false
	ListSymbols = false
	TraceStorage = false
	Version = -1
	Xternal = false
	// Other statics
	VersionString
	StartDTString
	OutputSource = 0
	MBSource = 0
	ScratchSource = 0
	DeleteScratch = false
]

let Init() = valof
[	AllocateDisplay(ldspLines, ldspBits, TempZone)

	VersionString = StoreString("*NMicroD 9.14 (OS 16) of March 25, 1981*N", Zone)
	Wss(dsp, VersionString)
	StartDTString = Allocate(Zone, 10)
	CONVUDT(StartDTString, 0)

//Read and parse command line
	let inExt = ".DIB"
	// Following must be kept in order, with scratchExt last
	let lstExt = ".DLS"
	let outExt = ".MB"
	let mapExt = ".csmap"
	let regsExt = ".regs"
	let occExt = "Occupied.mc"
	let chartExt = ".cschart"
	let absExt = ".absDLS"
	let scratchExt = ""

	let scratchName = "SWATEE"

	let ComCmVec = vec 120
	let StrVec,FlagVec = vec 100, vec 16
	let OutVec = vec 100
	@OutVec = 0
	let ScratchVec = vec 100
	@ScratchVec = 0
	let S = OpenFile("Com.Cm",ksTypeReadOnly,charItem,0,fpComCm,0,TempZone)
	let firstSource = 0
	let lastSource = lv firstSource-(offset Source.next/16)
	let NS = 0

//Read and parse global flags
	SetupReadParam(StrVec, FlagVec, S, FlagVec)
	GlobalFlags(FlagVec)

//Now handle names with local flags
	let lastname = nil
	while ReadParam(0, -1, StrVec, FlagVec) ne -1 do
	[ if (StrVec!0 eq 1) & (StrVec!1 eq $~) then	// additional global flags, not a file
	  [ GlobalFlags(FlagVec); loop ]
	  let lflag = ListingLevel
	  let nf = FlagVec!0
	  for i = 1 to nf do
	   switchon FlagVec!i & 137B into
	  [ case $A: lflag = listAbsOnly; endcase
	    case $C: lflag = listConcise; endcase
	    case $D: switchon (i eq nf? $*S, valof [ i = i+1; resultis FlagVec!i & 137B ]) into
		[ case $*S: DebugFlag = EvalParam(StrVec, $B, "Debug: "); endcase
		  case $F: DebugFirstLoc = EvalParam(StrVec, $B, "First loc: "); endcase
		  case $L: DebugLastLoc = EvalParam(StrVec, $B, "Last loc: "); endcase
		  default: Err(NonFatal, "Undefined switch: $US/D$C", StrVec, FlagVec!i)
		]
		goto notsource
	    case $L: lflag = listFull; endcase
	    case $N: lflag = listNotIM; endcase
	    case $O:
	      if nf ne 1 then Err(Fatal, "/O with another switch")
	      EvalParam(StrVec, $P, 0, OutVec)
	      goto notsource
	    case $V:
	      if nf ne 1 then Err(Fatal, "/V with another switch")
	      Version = EvalParam(StrVec, $B, "Version: ")
	      goto notsource
	    case $Z:
	      if nf ne 1 then Err(Fatal, "/Z with another switch")
	      EvalParam(StrVec, $P, 0, ScratchVec)
	      goto notsource
	    default: Err(NonFatal, "Undefined switch: $US/$C", StrVec, FlagVec!i)
	  ]
 	  [ EvalParam(StrVec, $P)
 	    let source = Extend(StrVec, inExt, false)
 	    lastname = source>>Source.pName
	    source>>Source.lflag = lflag
 	    lastSource>>Source.next = source
	    lastSource = source
 	    NS = NS+1
	  ]
notsource:
	]

	if NS eq 0 then Err(Fatal, "No input files")
	if @OutVec eq 0 then MoveBlock(OutVec, lastname, 100)
	if @ScratchVec eq 0 then MoveBlock(ScratchVec, scratchName, 100)
	let nfiles = nOutputs+NS
	let ff = firstSource
	let names = Allocate(TempZone, nfiles)
	let osv = vec nOutputs
	for i = nOutputs-1 by -1 to 0 do
	[ let s = Extend((i eq nOutputs-1? ScratchVec, OutVec), (lv lstExt)!i, true)
	  osv!i = s
	  s>>Source.next = ff
	  ff = s
	]
	let prvec = Allocate(Zone, nfiles*(lFP+1))
	let i = 0
	while ff ne 0 do
	[ names!i = ff>>Source.pName
	  ff>>Source.pFP = prvec+i*(lFP+1)+1
	  i, ff = i+1, ff>>Source.next
	]
	OutputSource = osv!0
	test ListingLevel eq -2  ifso names!1 = 0  ifnot MBSource = osv!1
	test MapIM  ifso MapIM = osv!2  ifnot names!2 = 0
	test MapRM  ifso MapRM = osv!3  ifnot names!3 = 0
	test MapOccupied  ifso MapOccupied = osv!4  ifnot names!4 = 0
	test MapChart  ifso MapChart = osv!5  ifnot names!5 = 0
	test ListAbs  ifso ListAbs = osv!6  ifnot names!6 = 0
	test ListingLevel eq -2  ifso names!7 = 0  ifnot ScratchSource = osv!7
	let DirS = CreateDiskStream(fpSysDir, ksTypeReadOnly, wordItem, 0, 0, TempZone)
	let bufsize = MaxBlock(TempZone)
	let buf = Allocate(TempZone, bufsize)
	LookupEntries(DirS, names, prvec, nfiles, true, buf, bufsize)
	Free(TempZone, buf, bufsize)
	Closes(DirS)
	let s = firstSource
	while s ne 0 do
	[ let pDE = s>>Source.pFP-1
	  if @pDE eq 0 then Err(PassFatal, "Can't open input file $S", s>>Source.pName)
	  s = s>>Source.next
	]
	OutputS = CheckOutput(osv!0, charItem, Zone)
	MBS = (names!1 eq 0? 0, CheckOutput(osv!1, wordItem, Zone))
	for i = 2 to nOutputs-1 do
	 if names!i ne 0 then
	  CheckOutput(osv!i, (i eq nOutputs-1? wordItem, charItem), 0)

	ShowDisplayStream(dsp, DSdelete)
	Free(sysZone, dsp)	// Free the temporary display stream
	test LargeProgram
	 ifso AllocateDisplay(ldspLinesSmall, ldspBitsSmall, Zone)
	 ifnot AllocateDisplay(ldspLines, ldspBits, Zone)
	Wss(dsp, VersionString)
	PutTemplate(OutputS, "$S  at $S*N*N", VersionString, StartDTString)
	Resets(S)
	until Endofs(S) do Puts(OutputS, Gets(S))
	Wss(OutputS, "*N*N")
	resultis firstSource
]

and GlobalFlags(flagVec) be
// A subroutine so that one can add ~/f onto a command line
[	for i = 1 to flagVec!0 do
	 switchon flagVec!i & 137B into
	 [ case $A: ListingLevel = listAbsOnly; endcase	// Absolute only
	   case $C: ListingLevel = listConcise; endcase	// Concise, no octal
	   case $D: DebugFlag = -1; endcase	// Debug MicroD
	   case $E: MapChart = true; endcase	// chart Every location
	   case $H: ListAbs = true; endcase	// abs listing for Hardware debugging
	   case $I: IgnoreOnPage = true; endcase	// Ignore OnPage directives
	   case $K: Kludge = true; endcase
	   case $L: LargeProgram = true; endcase	// large program, small display
	   case $M: MapIM = true; endcase	// Map of IM by page
	   case $N: ListingLevel = listNotIM; endcase	// No IM listing
	   case $O: MapOccupied = true; endcase	// write Occupied location map
	   case $P: ListingLevel = listPrintMB; endcase	// just Print the .MBs
	   case $R: MapRM = true; endcase	// RM map
	   case $S: ListSymbols = true; endcase	// Symbols for all memories
	   case $T: TraceStorage = true; endcase	// Trace calls on allocator
	   case $X: Xternal = true; endcase	// allow eXternal references
	   default: Err(NonFatal, "Undefined global switch /$C", flagVec!i)
	 ]
]


and AllocateDisplay(nl, lbits, zone) be
[	let bits = Allocate(zone, lbits)
	let ds = CreateDisplayStream(nl, bits, lbits, sysFont)
	ShowDisplayStream(ds, DSalone)
	dsp = ds
]

and Extend(name, ext, force) = valof
[	let v = vec 100
	test ext>>BS.length eq 0
	ifso v = name	// scratch name
	ifnot
	[ MoveBlock(v, name, 100)
	  SetExt(v, ext, force)
	]
	let s = Allocate(Zone, lSource)
	s>>Source.pName = StoreString(v, Zone)
	resultis s
]

and SetExt(Str, Ext, force) be
[	let I = Str>>STRING.length
	for J = 1 to I do
	 if Str>>STRING.char^J eq $. then
	[ unless force return
	  I = J-1; break
	]
	for J = 1 to Ext>>STRING.length do
	[ I = I+1; Str>>STRING.char^I = Ext>>STRING.char^J
	]
	Str>>STRING.length = I
]

and CheckOutput(s, item, zone) = valof
[	let name, dv = s>>Source.pName, s>>Source.pFP-1
	if @dv eq 0 then Closes(OpenFile(name, ksTypeWriteOnly, item, verLatestCreate, dv+1, 0, TempZone))
	if zone eq 0 resultis 0
	let st = CreateDiskStream(dv+1, ksTypeWriteOnly, item, 0, 0, zone)
	if st eq 0 then Err(Fatal, "Can't open output file $S", name)
	resultis st
]