//		A L T O   E X E C U T I V E
//	Internal Exec Commands (1) - Type.bcpl
// Copyright Xerox Corporation 1979, 1980

//	E. McCreight
//	last edited by R. Johnsson May 22, 1980  8:26 AM


get "sysdefs.d"
get "altofilesys.d"
get "disks.d"
get "streams.d"
get "COMSTRUCT.bcpl"

external
	[ TYPE
	DELETE
	RELEASE
	UserBootFrom
	EBoot
	Ftp
	Chat
	Scavenger
	NetExec
	Install
	Resume
	BootKeys
	StandardRam
	MesaBanks
	]


let RELEASE(ISTREAM, DSTREAM) be

	[ WRITE(ExecRelease)
	WRITE(ReleaseString)
	]


and TYPE(ISTREAM, DSTREAM) be

	[ let FN = vec 200
	let T = nil

	SetupReadParam(FN, 0, ISTREAM, FN)

	while ReadParam($P, -1, FN) ne -1 do

		[ T = 0

		let FILE = MyOpenFile(FN, ksTypeReadOnly,
					charItem)

		test FILE eq 0

		ifnot	[ let DPLen = vec 2
			let FL = vec 20

			FileLength(FILE, DPLen)

			test DPLen!0 ne 0

			ifnot FORMAT(FL, "<OCT>", DPLen!1)

			ifso FORMAT(FL, "<OCT><OCT 5 $0>",
				((DPLen!0 lshift 1)+
					(((DPLen!1 & #100000) eq 0)?
						0, 1)),
				DPLen!1 & #77777)

			PagedWrite(
			FORMATN("*300Contents of file <S>*301: (Length = <S> (octal) bytes)*N*N",
				FN, FL), true, lv T)

			Resets(FILE)
			until Endofs(FILE) do

				[ T = PagedWrite(Gets(FILE), true, lv T)
				if T ne 0 then break
				]

			PagedWrite($*N, true, lv T)
			Closes(FILE)
			]

		ifso	[ PagedWrite("File ", true, lv T)
			PagedWrite(FN, true, lv T)
			PagedWrite(" doesn't exist.*N", true, lv T)
			]

		if T eq CONTROLC then break
		]

	return
	]


and PagedWrite(C, PageBreaks, ResultOfPageBreak) be

	[ let T = WRITE(C, PageBreaks)
	if @ResultOfPageBreak eq 0 then
		@ResultOfPageBreak = T
	]


and DELETE(ISTREAM, DSTREAM) be

	[ let FN = vec 200

	let SWVEC = vec 200

	SetupReadParam(FN, SWVEC, ISTREAM, SWVEC)

	let PAUSESW = false
	let WipeIt = false

	for I=1 to SWVEC!0 do
		switchon SWVEC!I into
			[ case $P:
			case $p:
				PAUSESW = true
				endcase

			default:
				endcase
			]

	let T = 0
	while (T eq 0) & (ReadParam($P, -1, FN) ne -1) & not Cancel() do

		[ MAKETIMELINE()

		unless PAUSESW do RESETPAGE()

		let did = DeleteFile(FN)
		T = WRITE(FORMATN(
				(did?
					"File <S> deleted.*N",
					"File <S> doesn't exist.*N"),
					FN
				)
			)
		if did then WipeIt = true
		]

	if WipeIt then WIPEDIRBLK()
	return
	]


and CheckEther() = valof

	[
	if (StartIO(0)&#377) eq #377 then
	    [
	    WRITE("This Alto has no Ethernet!*n")
	    resultis false
	    ]
	WriteDiskDescriptor()
	resultis true
	]


and EBoot(IStream, DStream) be

	[ if not CheckEther() then return
	let FN = vec 200
	let SWVEC = vec 200
	SetupReadParam(FN, SWVEC, IStream, SWVEC)

	FN!0 = 0
	ReadParam($P, -1, FN)
	let v = 0
	for i = 1 to FN>>STRING.length do
		[
		let c = FN>>STRING.char^i
		if c ge $0 & c le $7 then v = v * 8 + (c-$0)
		]
	if CheckEther() then EtherBoot(v)
	]


and Ftp(IStream, DStream) be

	[
	if CheckEther() then EtherBoot(2)
	]


and Chat(IStream, DStream) be

	[
	if CheckEther() then EtherBoot(7)
	]


and Scavenger(IStream, DStream) be

	[
	if CheckEther() then EtherBoot(3)
	]


and NetExec(IStream, DStream) be

	[
	if CheckEther() then EtherBoot(#10)
	]


and DIAGNOSE(IStream, DStream) be

	[ let FP = vec lFP

	let FoundIt = BootFP(0, "DMT.BOOT", FP)

	WriteDiskDescriptor()
	test FoundIt
	ifso BootFrom(FP)
	ifnot EtherBoot(0)
	]


and UserBootFrom(IStream, DStream) be

	[ let FP = vec lFP

	let FoundIt = BootFP(IStream, "SYS.BOOT", FP)

	WriteDiskDescriptor()
	if FoundIt then BootFrom(FP)
	]


and Install(IStream, DStream) be

	[ let FP = vec lFP

	let FoundIt = BootFP(IStream, "SYS.BOOT", FP)

	let V = vec lInLdMessage

	V>>EVM.type = eventInstall
	V>>EVM.length = 1

	V!1 = 0			// last event

	WriteDiskDescriptor()

	if FoundIt then InLd(FP, V)
	]


and Resume(IStream, DStream) be

	[ let FP = vec lFP
	let CFA = vec size CFA/16

	let FoundIt = BootFP(IStream, "SWATEE", FP, CFA)

	if FoundIt then
		[
		WriteDiskDescriptor()
		PatchForSwat(lv (CFA>>CFA.fp))
		InLd(FP)
		]
	]



//Before resuming a file, it is considered polite to patch in the
// file pointers for the Swat and Swatee on the disk we are running
// with -- it may happen that the file we are about to resume was
// copied from another disk.  So we flail around a bit and do that.

and PatchForSwat(fp) be
	[

structure SCM: [
	blank		word	// For entry point jmp
	Location	word	// address of this spot (to find it!)
	Version		word	// Version number
	Why		word	// Why (0 = break, 1 = interrupt)
	Swatee		word 5	// Fid for Swatee
	Swat		word 5	// Fid for Swat
	CallSwat		word	// = #77400 - break here
	CallArgs		word	// Here is where you plant the #args
	CallReturn	word	// =#77400 - patch subr calls to return here
//	CodeVector	word CodeVectorLength
	]

// The following procedure positions a file for addressing word w
// in an OutLd-format file:

	let SPW(s, w) be
		[ let pn = (w rshift 8)
		if pn eq 0 then pn = 255
		if pn eq 1 then pn = 254
		PositionPage(s, pn)
		PositionPtr(s, (w&#377) lshift 1) // New style only!!!
		]

	let s = OpenFile(0,ksTypeReadOnly,0,0,fp)
	if s then
		[ SPW(s, #567)	// Trap vector entry
		let tb = Gets(s)
		if tb then
			[ tb = tb+(offset SCM.Swatee)/16
			let scbase = @#567+(offset SCM.Swatee)/16 // Ours!
			SPW(s, tb)
			if valof
			    [
			    for i=0 to lFP*2-1 do
				if Gets(s) ne scbase!i then resultis true
			    resultis false
			    ] then
			    [
			    Closes(s)
			    s = OpenFileFromFp(fp)
			    SPW(s, tb)
			    for i=0 to lFP*2-1 do Puts(s, scbase!i) // 2 FP's
			    ]
			]

		Closes(s)
		]
	]


and BootKeys(IStream, DStream) be

	[ let FP = vec lFP

	let FoundIt = BootFP(IStream, "SYS.BOOT", FP)

	unless FoundIt do return

	let DiskAddress = FP>>FP.leaderVirtualDa

	WRITE(FORMATN(
		"Boot disk address is #<OCT>, or the following keys:*N",
		DiskAddress))

	test DiskAddress eq 0

	ifso WRITE("All keys up!*N")

	ifnot	[ let MaskBit = #100000
		for BitNo=0 to 15 do
			[ let MaskBit = #100000 rshift BitNo
			if (DiskAddress&MaskBit) ne 0 then
				if WRITE(FORMATN("<S> ",
				selecton BitNo into
				[ case 0: "5"
				case 1: "4"
				case 2: "6"
				case 3: "E"
				case 4: "7"
				case 5: "D"
				case 6: "U"
				case 7: "V"
				case 8: "zero"
				case 9: "K"
				case 10: "minus"
				case 11: "P"
				case 12: "/"
				case 13: "\"
				case 14: "lf"
				case 15: "bs"
				]), true) ne 0 then break
			]
		WRITE("*N")
		]
	]


and BootFP(ComCm, DefaultFileName, FP, CFA; numargs na) = valof

	[ let S = vec 200
	let FN = vec 200

	let IsFileName = false
	if ComCm ne 0 then
		[ SetupReadParam(S, 0, ComCm, S)
		IsFileName = (ReadParam("P", -1, FN) ne -1)
		]

	unless IsFileName do
		FN = DefaultFileName

	let File = MyOpenFile(FN, ksTypeReadOnly, wordItem)

	if File eq 0 then

		[ WRITE(FORMATN("File *"<S>*" couldn't be found.*N", FN))
		resultis false
		]

	WRITE(FORMATN("File is <S>...*N", FN))

	let LocalCFA = vec size CFA/16

	if na ls 4 then CFA = LocalCFA

	Resets(File)
	GetCompleteFa(File, CFA)

	for i=0 to (size FP/16)-1 do
		FP!i = (lv CFA>>CFA.fp)!i

	RealDiskDA(sysDisk, CFA>>CFA.fa.da,
				lv (FP>>FP.leaderVirtualDa))

	Closes(File)

	resultis true
	]


// Load Ram to send all traps to the Rom

and StandardRam() be

	[ // These two instructions for very ancient microcode

	writeram(#637, 0, #102640)		// trapx: SWMODE
	writeram(#640, #10, #102637)	// :trapx;

	// These two instructions for Altocode 14

	writeram(#645, 0, #102646)		// trapx: SWMODE;
	writeram(#646, #10, #102645)	// :trapx;

	// These two instructions for Altocode 20 and above

	writeram(#37, 0, #102036)		// trap1: SWMODE;
	writeram(#36, #10, #102037)	// :trap1;
	]


and writeram(addr, hi, lo) be

	( table[
		#55001		// STA 3 1,2
		#35003		// LDA 3 3,2
		#61012		// WRTRAM
		#35001		// LDA 3 1,2
		#1401		// JMP 1,3
		]) (hi, addr, lo)


and WriteSortedDirectory(IStream, DStream; numargs na) be

	[ 
	// SYSTEMDIR is readonly
	let d = vec 1
	let len = FileLength(SYSTEMDIR,d)/2 //positions to end
	if d!0 ne 0 % d!1 ls 0 then return
	let dir = OpenFileFromFp(fpSysDir)
//	let dir = OpenFile("NewDir")
	if dir eq 0 then return
	let t, elen = nil, nil
	t<<DV.type = dvTypeFile
	let count, used = 0, 0
	@lvAbortFlag = @lvAbortFlag + 1
	for i = 1 to DIRHDBLK!0 do
	  [
	  let de = DIRHDBLK!i
	  if de>>MYDE.TYPE ne ISFILE then loop
	  elen = lDV + de>>MYDE.S.length/2+1
	  t<<DV.length = elen
	  Puts(dir,t)
	  WriteBlock(dir,lv de>>MYDE.FP,elen-1)
	  count = count + 1
	  used = used + elen
	  len = len - elen
	  ]
	t<<DV.type = dvTypeFree
	let free = len
	while len ne 0 do
	  [
	  let pos = FilePos(dir)
	  elen = len ls 100? len, 100
	  t<<DV.length = elen
	  Puts(dir,t)
	  SetFilePos(dir,0,pos+(elen*2))
	  len = len - elen
	  ]
	Closes(dir)
	@lvAbortFlag = @lvAbortFlag - 1
	Resets(SYSTEMDIR) //reposition to beginning to validate buffer
	if na ls 2 then DStream = 0
	unless DStream eq 0 do
	  WRITE(FORMATN("<D> entries; <D> words used; <D> words free*n",
	    count, used, free))
  	return
	]


and MesaBanks(IStream, DStream) be

	[ let arg = vec 200
	let sw = vec 200
	let mask = 177777b
	let setMask = false
	SetupReadParam(arg, sw, IStream)
	ReadParam(0,-1)
	while arg!0 ne 0 do
	   [ setMask = true
	   test sw!0 ne 0 & (sw!1 eq $x % sw!1 eq $X) ifso
	      [ let n = EvalParam(arg,$D,-1)
	      mask = mask & (not (100000b rshift n))
	      ]
	   ifnot mask = EvalParam(arg,$B,-1)
	   ReadParam(0,-1)
	   ]
	if mask eq 0 then mask = 177777b
	mask = mask % 100000b	// bank 0 required
	if setMask then
	   [ mesaBankMask = mask; RememberData(lv mesaBankMask) ]
	Wss(DStream, FORMATN("Mesa bank mask <S> <B>B.*n",
	   (setMask? "set to", "is"), mesaBankMask))
	]