//D1TYPEIN.BCPL -- alternate keyboard input procedures for converting
//		command line to DVec's for memories and registers
//	Last edited: 17 December 1979

get "d1.d"
manifest [ get "d1regmem.d" ]
manifest [ get "d1instrs.d" ]

structure [ String↑0,100	byte ]

external [
// OS
	Zero

// MASM
	PutField; SymbKeyComp; MaskT
	ResetsCSS; ResetsCS1; @WssCSS; WssCS1; PutsCSS; PutsCS1

// MIOC
	SimpleTexttoDVec

// MCMD
	ErrorAbort

// D1ASM
	stNotInVM

// D1MEM
	MGetMemData

// D1VM
	LookUpAA; @VirtualP

// Defined here
	WrdBytIn; InstructionIn
]


//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>>rh)
	]
	ifnot DVec!0 = V0!0
]

//X is IMXx, IMx, MIRx, IMBDx, LDRx, or sometimes MDATAx
//AVec is 0 for registers
and InstructionIn(X,AVec,DVec,TV,Radix) be
[	let ThisAddr = selecton X into
	[ case IMx:	DVec!3 & #7777
	  case IMXx:
	  case IMBDx: AVec!1
	  default:	-1
	]
//Last entry in Bit1Tab is used only for NBits computation
	let Bit1Tab = table [ 0; 4; 8; 11; 14; 17; 18;
		26; 34; 35; 36; 50; 51; 52; 64 ]
//Valid input syntax for field names is "LLL←nnn".  FVec is array of
//field names.  Standalone clauses are in OVec (currently only "RETURN").
//Other evaluations are of the form "LLL[nnn]"
	let FVec,OVec,PVec = vec 14,vec 1,vec 7
	FVec!0 = "RSTK"
	FVec!1 = "ALUF"
	FVec!2 = "BSEL"
	FVec!3 = "LC"
	FVec!4 = "ASEL"
	FVec!5 = "BLOCK"
	FVec!6 = "FF"
	FVec!7 = "JCN"
	FVec!8 = "PE020"
	FVec!9 = "PE2141"
//Next four only allowed on X eq IMx
	FVec!10 = "z"
	FVec!11 = "EMUL"
//Made these two illegal
//	FVec!12 = "UNDEF"
//	FVec!13 = "AT"

	OVec!0 = "RETURN"

//For IM, IMX, and IMBD, ThisAddr is known so automatic determination
//of global, local, or long forms, and "GOTO", "CALL", and "BRANCH"
//are translatable; for others ThisAddr unknown, so only "LONGGO",
//"GO", and "GCALL" forms are translatable.
	PVec!0 = "LONGGO"
	PVec!1 = "GO"
	PVec!2 = "GCALL"
	PVec!3 = "IFUJUMP"
	PVec!4 = "GOTO"
	PVec!5 = "CALL"
	PVec!6 = "BRANCH"
	switchon TV!1 into
	[
case $[:	MGetMemData(LDRx,DVec,table [ 0; NOOP/4 ] )
						//"[" = start with NOOP
case $(:	endcase				//"(" = start with old val
case $?:	ResetsCSS(); ResetsCS1()
		WssCSS("X←n for X =")
		for I = 0 to 9 do
		[ PutsCSS($ ); WssCSS(FVec!I)
		]
		if X eq IMx then for I = 10 to 11 do
		[ WssCS1(FVec!I); PutsCSS($ )
		]
		WssCS1("or")
		for I = 0 to 0 do
		[ PutsCS1($ ); WssCS1(OVec!I)
		]
		WssCS1(" or X[va] for X =")
		for I = 0 to 2 do
		[ PutsCS1($ ); WssCS1(PVec!I)
		]
		if ThisAddr > 0 then for I = 4 to 6 do
		[ PutsCS1($ ); WssCS1(PVec!I)
		]
		WssCS1(" or IFUJUMP[n]")
		ErrorAbort("")
default:	ErrorAbort()
	]
	let P = 2
	until P > TV!0 do
	[ let SVec = vec 40
	  let Y = CollectAD(SVec,lv P,TV)
	  let N = nil
	  switchon Y into
	  [
//Invalid string
default:	ErrorAbort()
//Separators
case $I-100B:
case $]:
case $,:
case $ :	if SVec>>lh 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(26,8,DVec,107B); endcase
		    ]
		    endcase
		  ]
		ErrorAbort()
//Field names are terminated by "←"
case $←:	for I = 0 to (X eq IMx ? 11,9) do
		  if SymbKeyComp(SVec,FVec!I) eq 0 then
		  [ let Bit1 = Bit1Tab!I; let NBits = Bit1Tab!(I+1)-Bit1
		    N = CollectO(NBits,TV,lv P,Radix)
		    if N eq -1 then break
		    PutField(Bit1,NBits,DVec,N); endcase
		  ]
		ErrorAbort()
case $[:	if SVec>>lh eq 0 then loop
		for I = 0 to 6 do
		  if SymbKeyComp(SVec,PVec!I) eq 0 then
		  [ if (I > 3) & (ThisAddr < 0) then
		      ErrorAbort(SVec,
			" illegal because instruction address unknown")
		    Y = CollectAD(SVec,lv P,TV)
//***Should handle "," and branch conditions here***
		    if Y ne $] then break
		    let IFJump = I eq 3
		    N = ConvertToBA(SVec,Radix,ThisAddr,IFJump)
		    switchon I into
		    [
	//Long
	case 0:		PutField(18,8,DVec,N rshift 4)
			PutField(26,8,DVec,N & 17B); endcase
	//Local
	case 1:		if ThisAddr ne -1 do
			[ if ((N xor ThisAddr) & 37700B) ne 0 then
			    ErrorAbort("target not on page")
			]
			PutField(26,8,DVec,(N & 77B)+200B); endcase
	//Global
	case 2:		if (N & 77B) ne 0 then
			  ErrorAbort("target not global")
			PutField(26,8,DVec,(N rshift 6)+300B)
			endcase
	//IFUJump
	case 3:		if (N & #177774) ne 0 then
			  ErrorAbort("IFUJUMP arg > 3")
			PutField(26,8,DVec,(N lshift 3)+47B)
			endcase
	//GOTO
	case 4:		if (N & #17) eq 0 then
			  ErrorAbort("GOTO arg at call location")
			docase(6)
	//CALL
	case 5:		if (N & #17) ne 0 then
			  ErrorAbort("CALL arg at goto location")
	//BRANCH
	case 6:		test (N & #77) eq 0
			ifso docase(2)
			ifnot test ((N xor ThisAddr) & #37700) eq 0
			  ifso docase(1)
			  ifnot docase(0)
		    ]
		    endcase
		  ]
		ErrorAbort()
	  ]
	]
	return
]


//Collect alphadecimal string in SVec, return terminator
//("+" and "-" also string constituents)
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
	]
	rv lvP = P; SVec>>lh = X; 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
	if SimpleTexttoDVec(TV1,16,DVec,Radix) then
		resultis DVec!0 & (MaskT!NBits)
	resultis -1
]


//Convert the text in SVec to an absolute branch address
and ConvertToBA(SVec,Radix,ThisAddr,IFJump) = valof
[	let TV2,N,M = vec 80,0,0
	let SB = "branch target "
	for J = 0 to SVec>>lh do TV2!J = SVec>>String↑J
//Allow ".+n" and ".-n" args
	if (ThisAddr ge 0) & (TV2!0 ge 1) & (TV2!1 eq $.) do
	[ TV2!1 = TV2!0-1; TV2 = TV2+1; N = ThisAddr
	]
	if TV2!0 ge 1 then unless SimpleTexttoDVec(TV2,16,lv M,Radix) do
		ErrorAbort(SB,"unevaluable")
	N = N+M
	if (ThisAddr ge 0) & not IFJump do
	[ if VirtualP do
	  [ N = LookUpAA(N)
	    if N < 0 then ErrorAbort(SB,stNotInVM)
	  ]
	]
	resultis N
]