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