// 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)Ź) 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Ź) 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))
]