//MDload -- load the Micro binaries into memory
// last edited July 5, 1980 10:08 AM
get "mddecl.d"
get "streams.d"
get "altofilesys.d"
external [ // defined here
Load // (sources, outs, tempzone, zone, loader(...))
SkipMicroString // (sp) -> p
@Symbols; @SymLength
fixTab
// for MDload1
AllocInbuf // (zone, len)
OpenSource // (source) -> s
LoadFile // (strm, tempzone, dataproc, symproc, memproc, fixproc, xfixproc)
dataIM0; dataIM1; dataIM2
dataRM; dataIFUM; dataALUFM
dataDISP; dataIMLOCK; dataIMMASK
dataOther; dataSkip
@mData
@mWidths
@mNames
@mSymMax
]
external [
// OS
CreateDiskStream; Endofs; Closes
ReadBlock
MoveBlock; SetBlock; Usc; Zero
Allocate; Free
Noop
// GetSetBits
SetBits
// MDmain
@IP
ScratchZone
@DMachine
@IM; @IMlocked; @NInstructions; @IMMASK
@RM; @RMbits
@IFUM; @IFUMbits; @NIFUM
@ALUFM; @ALUFMbits
// MDerr
Err
PutAddress
// MDasm
Get1Bit; Set1Bit
]
manifest
[ lLoadSpace = lKS+400b
]
//Memories expected by MicroD are as follows:
// For D0:
// 1 IM 6 words (84 bits)
// 2 RM 1 word
// - DISP 1 word
// - IMLOCK 1 word (1 bit)
// - VERSION 1 word
// - IMMASK 2 words (20 bits)
// For Dorado:
// 1 IM 5 or 6 words (80 or 96 bits)
// 2 RM 1 word
// 3 IFUM 2 words
// 4 ALUFM 1 word (8 bits)
// - DISP 1 word
// - IMLOCK 1 word (1 bit)
// - RVREL 0 words
// - VERSION 1 word
// - IMMASK 2 words (20 bits)
static [
@mData
@mWidths
@mNames
@mSymMax
fixTab = 0
@inbuf; @lInbuf; @einbuf
@Symbols
@SymLength = 301b // See hash algorithm in AddSym
loadSpace
]
let AllocInbuf(zone, len) be
[ lInbuf = len
inbuf = Allocate(zone, len)
einbuf = inbuf+lInbuf
]
and Load(Sources, OutS, tempzone, zone, loader) be
[ NInstructions, NIFUM, IMMASK = 0, 0, 0
loadSpace = Allocate(tempzone, lLoadSpace)
let source = Sources
while source ne 0 do
[ loader(source, OutS, tempzone, zone)
source = source>>Source.next
]
if DMachine eq 2 then // shuffle bits for Dorado model 1
for i = 0 to NInstructions-1 do
[ let ip = IP(i)
let w0, w1, w2 = ip>>IM.iw0, ip>>IM.iw1, ip>>IM.iw2
ip>>IM.iw0 = (w0 lshift 1) + (w1 rshift 15)
ip>>IM.iw1 = (w1 lshift 1) + (w2 rshift 15)
ip>>IM.iw2 = (w0 & 100000b) + (w2 & 77777b)
]
Free(tempzone, loadSpace, lLoadSpace)
]
and OpenSource(source) = valof
[ let S = CreateDiskStream(source>>Source.pFP, ksTypeReadOnly, wordItem, 0, 0, ScratchZone(loadSpace, lLoadSpace))
if S eq 0 then Err(Fatal, "Can't open $S", source>>Source.pName)
resultis S
]
and LoadFile(S, tempzone, zone, dataproc, symproc, memproc, fixproc, xfixproc) be
// Main code -- load one file
[ let MemX,Addr = -1,nil
let dwords = nil
let Ibase = NInstructions
let BP = einbuf
let end, endstop = einbuf, einbuf-maxMBblock
let ddisp, adr, ip, idata = mData!0, nil, nil, nil // to avoid making a block out of MBdata
// begin main loop
[ let more, blockdisp = nil, vec 8 // faster than switchon
SetBlock(blockdisp, blockError, 8)
blockdisp!MBend = blockEnd
blockdisp!MBdata = blockData
blockdisp!MBaddress = blockAddress
blockdisp!MBfixup = blockFixup
blockdisp!MBmemory = blockMemory
blockdisp!MBsymbol = blockSymbol
blockdisp!MBexternalfixup = blockExternalfixup
more = labelMore // for faster looping
labelMore:
if BP gr endstop then
[ if end eq einbuf then
[ MoveBlock(inbuf, BP, end-BP)
end = inbuf+end-BP
BP = inbuf
let nw = einbuf-end
nw = ReadBlock(S, end, nw)
end = end+nw
endstop = end-maxMBblock // reset end test
]
if BP ge end then
Err(Fatal, "Unexpected end of input file")
]
if (@BP & -8) ne 0 then goto blockError
goto blockdisp!@BP
// Block types created by Micro
blockEnd: // terminating block
break
blockData: // data word
adr = Addr; Addr = Addr+1
goto ddisp
dataOther:
dataproc(BP, MemX, adr, dwords)
// falls through
dataSkip:
BP = BP+dwords
goto more
dataIM0: // D0 -- iw2 at end
ip = IP(adr)
idata = BP+1 // iw2 missing
ip>>IM.iw2 = BP!7
goto dataIMall
dataIM1: // Dorado model 0 -- no iw2
ip = IP(adr)
idata = BP+1 // iw2 missing
goto dataIMall
dataIM2: // Dorado model 1 -- iw2 follows iw1
ip = IP(adr)
idata = BP+2
ip>>IM.iw2 = idata!2
// falls through
dataIMall: [ // common IM code
ip>>IM.iw0, ip>>IM.iw1 = BP!2, BP!3
ip!3, ip!4, ip!5 = idata!3, idata!4, idata!5
// Adjust W1 and W2
let w = ip>>IM.W1word
ip>>IM.W1word = ((w&(IMsize-1)) eq WNull? adr+(1-WNull), Ibase)+w
w = ip>>IM.W2word
ip>>IM.W2word = ((w&(IMsize-1)) eq WNull? adr+(1-WNull), Ibase)+w
if NInstructions ne adr then
Err(PassFatal, "$P....Imaginary addresses not consecutive ($O follows $O)", PutAddress, NInstructions, adr, NInstructions-1)
NInstructions = adr+1
if NInstructions gr NImax then IMfull()
BP = BP+dwords
goto more ]
dataRM: [ // RM
let RP = RM+adr
if (Get1Bit(RMbits, adr) ne 0) & (@RP ne BP!2) then
Err(NonFatal, "Attempt to load RM[$O] twice", adr)
@RP = BP!2
Set1Bit(RMbits, adr, 1)
BP = BP+3
goto more ]
dataIFUM: [ // IFUM
let dp = BP+2
let ifad = dp>>IFUM.IFAD
if ifad ne WNull then dp>>IFUM.IFAD = ifad+Ibase // relocate entry address
if adr ge NIFUM then NIFUM = adr+1
let ip = IFUM+adr*lIFUM
test Get1Bit(IFUMbits, adr) ne 0
ifso Err(PassFatal, "Attempt to load IFUM[$O] twice", adr)
ifnot
[ ip!0, ip!1 = BP!2, BP!3
Set1Bit(IFUMbits, adr, 1)
]
BP = BP+4
goto more ]
dataALUFM: [ // ALUFM
ALUFM!adr = BP!2
Set1Bit(ALUFMbits, adr, 1)
BP = BP+3
goto more ]
dataDISP: [ // DISP -- not defined yet
BP = BP+3
goto more ]
dataIMLOCK: [ // IMLOCK
Set1Bit(IMlocked, adr, BP!2 rshift 15) // allow both set and reset
BP = BP+3
goto more ]
dataIMMASK: [ // IMMASK
let m = Allocate(zone, lIMMASK)
m>>IMMASK.next = IMMASK
m>>IMMASK.addr = adr+Ibase // address in IM, must be relocated
m>>IMMASK.mask = BP!2
m>>IMMASK.nseq = BP!3 rshift 12
IMMASK = m
BP = BP+4
goto more ]
blockAddress: [ // set current memory and address
MemX, Addr = BP!1, BP!2
ddisp = mData!MemX
dwords = 2+((mWidths!MemX+15) rshift 4)
if MemX eq IMmemx then
[ Addr = Addr+Ibase
if Addr gr NImax then IMfull()
]
BP = BP+3
goto more ]
blockFixup: [ // fix up (forward ref)
let addr, field, value = BP!2, BP!3, BP!4
let fixp = selecton BP!1 into
[
case IMmemx: valof // adjust bit #
[ field = fixIMfield(field)
if (field eq W1field) % (field eq W2field) then
value = value+Ibase
resultis IP(addr+Ibase)
]
case IFUMmemx: valof // check pass
[ if field eq IFADfield then value = value+Ibase
resultis IFUM+addr*lIFUM
]
case ALUFMmemx: ALUFM+addr
case RMmemx: RM+addr
default: valof
[ fixproc(BP)
goto noset
]
]
// Actually do the fixup
[ let firstbit = field<<lh
let nbits = field<<rh-firstbit+1
SetBits(fixp, firstbit, nbits, value)
]
noset:
BP = BP+5
goto more ]
blockMemory: [ // memory def
let mdp = BP
BP = SkipMicroString(BP+3)
memproc(mdp, BP, zone)
goto more ]
blockSymbol: [ // symbol def
let ap = BP
BP = BP+3 // Open code SkipMicroString (see below)
while (@BP)<<rh ne 0 do BP = BP+1
if BP-ap ge 53 then Err(Fatal, "Symbol longer than 99 chars")
BP = BP+1
if ap!1 eq IMmemx then ap!2 = ap!2+Ibase
symproc(ap, BP, zone)
goto more ]
blockExternalfixup: [ // external fixup
let ap = BP
BP = SkipMicroString(BP+4)
if ap!1 eq IMmemx then
[ ap!2 = ap!2+Ibase
ap!3 = fixIMfield(ap!3)
]
xfixproc(ap, BP, zone)
goto more ]
blockError: Err(Fatal, "Unknown block type $UO", @BP)
] repeat // end main loop
]
and SkipMicroString(sp) = valof
[ let p = sp
while (@p)<<rh ne 0 do p = p+1
if p-sp ge 50 then Err(Fatal, "Symbol longer than 99 chars")
resultis p+1
]
and fixIMfield(field) =
((field ls 32*400b) % (DMachine eq 2)? field, // iw0, iw1, or OK
field ls 80*400b? field+16*401b, // not iw2
field-48*401b) // iw2
and IMfull() be
Err(Fatal, "More than $Ob microinstructions", NImax)