//D0TYPEIN.BCPL -- alternate keyboard input procedures for converting
// command line to DVec's for memories and registers
// Last edited: 19 October 1981
get "d0.d"
manifest [ get "d0regmem.d" ]
structure [ String↑0,100 byte ]
external [
// OS
Zero
// MIDAS
MidasSwat
// MASM
ResetsCSS; ResetsCS1; @WssCSS; WssCS1; PutsCSS; PutsCS1
PutField; SymbKeyComp; MaskT
// MIOC
SimpleTexttoDVec
// MCMD
ErrorAbort
// D0ASM
stNotInVM
// D0VM
LookUpAA; @VirtualP
// Defined here
InstructionIn; WrdBytIn
]
//Accepts "nnn,,nnn" or "nnnnnn" input forms and evaluates for storage
//into 16-bit DVec.
let WrdBytIn(X,AVec,DVec,TV,Radix) be
[ let TV0,TV1 = vec 80,vec 80
TV0!0,TV1!0 = 0,0
let GotComma1,GotComma2 = false,false
for I = 1 to TV!0 do
[ let C = TV!I
test C ne $,
ifso
[ if GotComma1 then unless GotComma2 do ErrorAbort()
test GotComma2
ifso
[ TV1!0 = TV1!0+1; TV1!(TV1!0) = C
]
ifnot
[ TV0!0 = TV0!0+1; TV0!(TV0!0) = C
]
]
ifnot test GotComma2
ifso ErrorAbort()
ifnot test GotComma1
ifso GotComma2 = true
ifnot GotComma1 = true
]
let V0,V1 = vec 1,vec 1
unless SimpleTexttoDVec(TV0,16,V0,Radix) do ErrorAbort()
test GotComma2
ifso
[ unless SimpleTexttoDVec(TV1,16,V1,Radix) do ErrorAbort()
DVec!0 = (V0!0 lshift 8)+(V1!0 & #377)
]
ifnot DVec!0 = V0!0
]
//AVec is 0 for registers
//This is called for IM, IMX, MIM, and sometimes MDATA (when IMX has been
//tested).
and InstructionIn(X,AVec,DVec,TV,Radix) be
[
//Valid input syntax for field names is "LLL←nnn". FVec is array of
//three-word entries with names in first word, bit1 in 2nd word, nbits
//in 3rd word.
let FVec = table [
//Both kinds of instructions have these fields
0; 2; 4 //RSEL--**kludge for this field which is split**
0; 25; 6 //JA--**kludge for this field which is split**
0; 0; 1 //MEMINST
0; 18; 4 //F2
0; 22; 3 //JC
//Regular instructions have these fields
0; 1; 1 //RMOD
0; 6; 4 //ALUF
0; 10; 2 //BSEL
0; 12; 4 //F1
0; 16; 1 //LR
0; 17; 1 //LT
//Memory instructions have these fields
0; 1; 1 //DF2
0; 6; 4 //TYPE
0; 10; 8 //SRCDEST
]
FVec!0 = "RSEL"
FVec!3 = "JA"
FVec!6 = "MI"
FVec!9 = "F2"
FVec!12 = "JC"
FVec!15 = "RMOD"
FVec!18 = "ALUF"
FVec!21 = "BSEL"
FVec!24 = "F1"
FVec!27 = "LR"
FVec!30 = "LT"
FVec!33 = "DF2"
FVec!36 = "TYPE"
FVec!39 = "SRCDEST"
//Stuff for branch conditions
let BCtab = table [
0; 0; 0 //ALU#0, ALU=0
0; 0; 1 //CARRY, CARRY'
0; 0; 2 //ALU<0, ALU>=0
0; 0; 3 //H2BIT8', H2BIT8
0; 0; 4 //R<0, R>=0
0; 0; 5 //RODD, REVEN
0; 0; 6 //IOATTN', IOATTN
0; 0; 7 //MB,MB'
0; 0; #100000 //INTPENDING,INTPENDING'
0; 0; #100001 //OVF', OVF
0; 0; #100002 //BPCCHK, BPCCHK'
0; 0; #100003 //SPARE, SPARE'
0; 0; #100004 //QW0, QW0'
0; 0; #100005 //TIMEOUT, TIMEOUT'
]
BCtab!0 = "ALU#0"
BCtab!1 = "ALU=0"
BCtab!3 = "CARRY"
BCtab!4 = "CARRY'"
BCtab!6 = "ALU<0"
BCtab!7 = "ALU>=0"
BCtab!9 = "H2BIT8'"
BCtab!10 = "H2BIT8"
BCtab!12 = "R<0"
BCtab!13 = "R>=0"
BCtab!15 = "RODD"
BCtab!16 = "REVEN"
BCtab!18 = "IOATTN'"
BCtab!19 = "IOATTN"
BCtab!21 = "MB"
BCtab!22 = "MB'"
BCtab!24 = "INTPENDING"
BCtab!25 = "INTPENDING'"
BCtab!27 = "OVF'"
BCtab!28 = "OVF"
BCtab!30 = "BPCCHK"
BCtab!31 = "BPCCHK'"
BCtab!33 = "SPARE"
BCtab!34 = "SPARE'"
BCtab!36 = "QW0"
BCtab!37 = "QW0'"
BCtab!39 = "TIMEOUT"
BCtab!40 = "TIMEOUT'"
//Standalone clauses are in OVec (currently only "RETURN").
let OVec = vec 1
OVec!0 = "RETURN"
//Other evaluations are of the form "LLL[nnn]"
let PVec = vec 4
PVec!0 = "GOTO"
PVec!1 = "CALL"
PVec!2 = "GOTOP"
PVec!3 = "CALLP"
//"[" = start with no-op
//"(" = start with old value
switchon TV!1 into
[
//Start with no-op: MI←0, RMOD←0, RSEL←0, ALUF←0, BSEL←2, F1←10,
//F2←12, LR←0, LT←0, JC←4, JA←0
case $[: DVec!0 = #000010; DVec!1 = #025000; DVec!2 = DVec!2 & #7777
//Start with current microinstruction
case $(: endcase
case $?: ResetsCSS(); ResetsCS1()
WssCSS("X←n for X =")
for I = 0 to 39 by 3 do
[ PutsCSS($ ); WssCSS(FVec!I)
]
PutsCSS($,)
for I = 0 to 0 do
[ if I ne 0 then PutsCS1($*S)
WssCS1(OVec!I)
]
WssCS1(", X[va] for X =")
for I = 0 to 3 do
[ PutsCS1($*S); WssCS1(PVec!I)
]
WssCS1(", or X[va,bc] for X = GOTO GOTOP")
ErrorAbort("")
default: ErrorAbort()
]
let P = 2
until P > TV!0 do
[ let SVec = vec 40
//Collect next token in SVec, terminator in Y
let Y = CollectAD(SVec,lv P,TV)
switchon Y into
[
//Invalid string
default: ErrorAbort()
//Separators
case -1:
case $I-100B:
case $]:
case $,:
case $ : if (SVec!0 rshift 8) eq 0 then loop
//Standalone clauses terminated by separators
for I = 0 to 0 do
if SymbKeyComp(SVec,OVec!I) eq 0 do
[ switchon I into
[
case 0: PutField(22,3,DVec,6); endcase
default: MidasSwat(OVecBug)
]
endcase
]
ErrorAbort()
//Field names are terminated by "←"
case $←: for I = 0 to 39 by 3 do
if SymbKeyComp(SVec,FVec!I) eq 0 then
[ let Bit1 = FVec!(I+1); let NBits = FVec!(I+2)
let XNBits = (I ne 0) & (I ne 3) ? NBits,NBits+2
let N = CollectO(XNBits,TV,lv P,Radix)
if N eq -1 then break
test I eq 0
ifso //RSEL kludge
[ PutField(32,2,DVec,N & 3)
N = (N xor #60) rshift 2
]
ifnot if I eq 3 do //JA kludge
[ PutField(34,2,DVec,N rshift 6)
N = N & #77
]
PutField(Bit1,NBits,DVec,N)
endcase
]
ErrorAbort()
case $[: if (SVec!0 rshift 8) eq 0 then loop
for I = 0 to 3 do
if SymbKeyComp(SVec,PVec!I) eq 0 then
[ Y = CollectAD(SVec,lv P,TV)
//Here compute:
// ThisAA = absolute address of this mi needed for on-page checks.
// ThisDot = "." for ".+n" and ".-n" expressions; this will be a VA for
// IM, AA for IMX, or undefined for MIM.
// DotVA = true if ThisDot is virtual, else false.
let ThisAA = selecton X into
[ case IMx: DVec!3 & #7777
case IMXx: AVec!1
case MIMx: DVec!2 & #7777
default: -1 //MDATA
]
let ThisDot = selecton X into
[ case IMx:
case IMXx:
case MIMx: AVec!1
default: -1
]
let DotVA = X eq IMx ? true,false
let OffPageOK = I ge 2
let N =
ConvertToBA(SVec,Radix,ThisAA,ThisDot,DotVA,OffPageOK)
let JC = nil
test (I eq 0) % (I eq 2)
ifso //GOTO or GOTOP
[ test Y eq $,
ifso //Branch condition
[ Y = CollectAD(SVec,lv P,TV)
let Match,Inverted = false,0
if (N & 1) eq 0 then Inverted = 1
N = N & #376
for K = 0 to 39 by 3 do
[ test SymbKeyComp(SVec,BCtab!(K+Inverted)) eq 0
ifso
[ Match = true
let bcstuff = BCtab!(K+2)
if bcstuff < 0 then PutField(18,4,DVec,#10)
JC = (bcstuff rshift 1) & 3
N = N+(bcstuff & 1)
break
]
ifnot if SymbKeyComp(SVec,
BCtab!(K+(Inverted xor 1))) eq 0 then
ErrorAbort("BC inverted for target")
]
if not Match then ErrorAbort("Bad BC")
]
ifnot JC = 4
]
ifnot //Call
[ JC = 5
]
if Y ne $] then break
PutField(22,3,DVec,JC)
PutField(34,2,DVec,(N & #377) rshift 6)
PutField(25,6,DVec,N & #77)
endcase
]
ErrorAbort()
]
]
]
//Collect alphadecimal string ("+", "-", ".", "@", and "$" also string
//constituents) in SVec, return terminator or -1 if terminated by
//end-of-string.
and CollectAD(SVec,lvP,TV) = valof
[ let P = rv lvP
let X,C = 0,-1
while P le TV!0 do //Build the string
[ C = TV!P; P = P+1
if (C < $@ % C > $Z) & (C < $0 % C > $9) &
(C ne $+) & (C ne $-) & (C ne $.) &
(C ne $$) then break
X = X+1; SVec>>String↑X = C
C = -1 //End-of-string char
]
rv lvP = P; SVec!0 = (SVec!0 & #377)+(X lshift 8); resultis C
]
//Collect octal number < NBits in size
and CollectO(NBits,TV,lvP,Radix) = valof
[ let TV1 = vec 80; TV1!0 = 0
let Value,P,X = 0,rv lvP,0
while P le TV!0 do
[ let C = TV!P; P = P+1
if (C eq $,) % (C eq $ ) % (C eq $]) then break
X = X+1; TV1!X = C
]
TV1!0 = X
rv lvP = P
let DVec = vec 4
resultis SimpleTexttoDVec(TV1,16,DVec,Radix) ?
DVec!0 & (MaskT!NBits),-1
]
//Return absolute address of branch target after error-checking.
and ConvertToBA(SVec,Radix,ThisAA,ThisDot,DotVA,OffPageOK) = valof
[ let TV2,N,M = vec 80,0,0
let SB = "Branch target "
for J = 0 to SVec!0 rshift 8 do TV2!J = SVec>>String↑J
//Allow ".+n" and ".-n" args
if (TV2!0 ge 1) & (TV2!1 eq $.) do
[ test ThisDot < 0
ifso ErrorAbort(SB,". not allowed for this memory")
ifnot
[ TV2!1 = TV2!0-1; TV2 = TV2+1; N = ThisDot
]
]
if TV2!0 ge 1 then unless SimpleTexttoDVec(TV2,16,lv M,Radix) do
ErrorAbort(SB,"unevaluable")
N = N+M
if ThisDot ge 0 do
[ if DotVA do
[ N = LookUpAA(N)
if N < 0 then ErrorAbort(SB,stNotInVM)
]
if not OffPageOK then if ((N xor ThisAA) & #177400) ne 0 then
ErrorAbort(SB,"off page")
]
resultis N
]