# Op-Code Decoding (as*op)
#=========================
# Last Revision 1_Nov_84
#
#
# General Description
#--------------------
#
#		This module contains all of the routines specific to
#	decoding operation codes.
#
#----------------------------------------------------------------------
# Included in this module
#------------------------
#
#	Decode an Op-Code
#		subroutine dcdopc (type,value,key)
#	Get a Label
#		subroutine getlbl
#	Get Argument
#		subroutine getarg (type,value,key,opaode,opcarg,leng)
#	Get the addressing mode
#		logical function getmod (modbuf,opcode,leng)
#
#----------------------------------------------------------------------
# Preprocesser definition section
#--------------------------------
#
	include as13df

#.pa
#----------------------------------------------------------------------
# Decode an Op-Code (1_Nov_84)
#-----------------------------
#
#		This routine decode one op-code. If the op-code is an
#	immediate addressing mode instruction then its code is equal to
#	the value retrieved from the symbol table. The length is set to
#	one.
#		If the op-code has the relative addressing mode then
#	its value is that retrieved from the symbol table. The argument
#	is computed from the expression that follows the op-code and
#	from the current value of the program counter. The target
#	address calculation is only done on pass 2. If it fails an
#	error message is printed and the target forced to 'self' (0).
#	The length of a relative op-code is always two.
#		If the op-code is in the class of 'other' then the
#	subroutine getarg is involked. That routine returns a valid
#	op-code and length. Any errors made in the subroutine getarg
#	are reported there and cause an JMP 0 instruction to be
#	substituted for the original.

	subroutine dcdopc (type,value,key)

	logical eval, def, genprn, temp
	integer*1 modbuf(4), modind
	integer*1 type, st, pass, leng, argf(2), opcf(2)
	integer opcode, opctyp, opcarg
	integer value, key, sv, sk, pc, result
	common /comprm/ pass, pc, st, sv, sk, genprn
	equivalence (opcode, opcf(1)), (opcarg, argf(1))

	opctyp = type
	opcode = value
	# sk is not zero then there is a label
	if (sk .ne. 0)
		{
		call getlbl
		}
	if (type .eq. IMPL)
		{
		leng = 1
		}
	else if (type .eq. REL)
		{
		temp= eval(type,value,key,result,def)
		opcarg = result - (pc + 2)
		leng = 2
		if (pass .eq. 2)
			{
			if (temp .eq. .false.)
				{
				call error(NOARG)
				}
			else if (def .eq. .false.)
				{
				call error(NODEF)
				}
			else if (opcarg .gt. x'00FF')
				{
				call error(BRNCH)
				}
			}
		}
	else # Type is _Other
		{
		call getarg (type,value,key,opcode,opcarg,leng)
		}
	if (pass .eq. 2)
		{
		call putobj (opcf(1),SAVE)
		if (leng .ge. 2)
			{
			call putobj (argf(1),SAVE)
			if (leng .ge. 3)
				{
				call putobj (argf(2),SAVE)
				}
			}
		}
	pc = pc + leng
	return

	end
#.pa
#----------------------------------------------------------------------
# Get Argument (1_Nov_84)
#------------------------
#
#		This routine gets the argument (if any) for an op-code.
#	First the addressing mode symbols that preface the symbol are
#	collected in modbuf. Then the experession is evaluated. Finally
#	any additional addressing mode symbols are collected in modbuf

	subroutine getarg (type,value,key,opcode,opcarg,leng)

	logical eval, def, getmod, genprn
	integer*1 modbuf(4), mi, ngett
	integer*1 type, st, pass, leng
	integer opcode, opcarg
	integer value, key, sv, sk, pc, result
	common /comprm/ pass, pc, st, sv, sk, genprn

	type = ngett(type,value,key)
	for (mi=1; (type.ge.ACCM).and.(type.le.CLSPRN); mi=mi+1)
		{
		modbuf(mi) = type
		type = ngett(type,value,key)
		}
	if (modbuf(1) .ne. ACCM)
		{
		call putbt(type,value,key)
		if (eval(type,value,key,opcarg,def) .eq. .false.)
			{
			if (pass .eq. 1)
				{
				call error(NOARG)
		  		}
			}
		else if ( (pass .eq. 2) .and. (def .eq. .false.) )
			{
			call error(NODEF)
			}
		}
	for (; mi.le.MAXMOD; mi=mi+1)
		{
		if ( (type.ge.ACCM) .and. (type.le.CLSPRN) )
			{
			modbuf(mi) = type
			type = ngett(type,value,key)
			}
		else
			{
			modbuf(mi) = 0
			}
		}
	iæ (getmod(modbuf,opcode,leng,opcarg© .eq® .false.)
		{
		opcarg = 0
		}

	return

	end
#.pa
#----------------------------------------------------------------------
# Get the addressing mode (1_Nov_84)
#-----------------------------------
#
#		This routine gets the modbuf, containing the addressing mode
#	characters that were found around the argument, and the opcode, which
#	at this point contains an index into the codprm table. This index
#	points to the base of the 11 integer*1 locations reserved for it.
#		This routine is expected to put a valid op-code in the
#	parameter opcode and fill in the length in parameter leng.
#		The processing is done in the following manner. The major index
#	into codprm (opcode) is saved. Then a loop is entered which searches
#	modprm for a match to the string of addressing mode characters
#	recieved in modbuf.
#		If no match is made Then a jump to location 0 is
#	substituted and the error is printed on the console.
#		If there was a match then a check is made to see if page 0
#	mode should be forced (this is done by incrementing the minor index).
#	The addressing mode index (the minor index into codprm) is retrieved
#	from codprm as well as the length. The actual op-code is retrieved
#	form codprm. If the code is equal to zero then a jump to location
#	zero is	forced and an error message is printed out on the console.
#
	logical function getmod (modbuf,opcode,leng,opcarg)

	integer*1 modbuf(4), leng
	integer*1 modprm(7,11), codprm(11,23), opcf(2)
	integer opcode, mode, code, opcarg
	data modprm /	IMMED,	0,	0,	0,	1,	2,	0,
			0,	0,	0,	0,	2,	3,	1,
			PZERO,	0,	0,	0,	3,	2,	0,
			ACCM,	0,	0,	0,	4,	1,	0,
			OPNPRN,	XREG,	CLSPRN,	0,	5,	2,	0,
			OPNPRN,	CLSPRN,	YREG,	0,	6,	2,	0,
			XREG,	0,	0,	0,	7,	3,	1,
			PZERO,	XREG,	0,	0,	8,	2,	0,
			YREG,	0,	0,	0,	9,	3,	1,
			PZERO,	YREG,	0,	0,	10,	2,	0,
			OPNPRN,	CLSPRN,	0,	0,	11,	3,	0/
	data codprm / x'69',
	      x'6D',x'65',x'00',x'61',x'71',x'7D',x'75',x'79',x'00',x'00',
	x'29',x'2D',x'25',x'00',x'21',x'31',x'3D',x'35',x'39',x'00',x'00',
	x'00',x'0E',x'06',x'0A',x'00',x'00',x'1E',x'16',x'00',x'00',x'00',
	x'00',x'2C',x'24',x'00',x'00',x'00',x'00',x'00',x'00',x'00',x'00',
	x'C9',x'CD',x'C5',x'00',x'C1',x'D1',x'DD',x'D5',x'D9',x'00',x'00',
	x'E0',x'EC',x'E4',x'00',x'00',x'00',x'00',x'00',x'00',x'00',x'00',
	x'C0',x'CC',x'C4',x'00',x'00',x'00',x'00',x'00',x'00',x'00',x'00',
	x'00',x'CE',x'C6',x'00',x'00',x'00',x'DE',x'D6',x'00',x'00',x'00',
	x'49',x'4D',x'45',x'00',x'41',x'51',x'5D',x'55',x'59',x'00',x'00',
	x'00',x'EE',x'E6',x'00',x'00',x'00',x'FE',x'F6',x'00',x'00',x'00',
	x'00',x'4C',x'00',x'00',x'00',x'00',x'00',x'00',x'00',x'00',x'6C',
	x'00',x'20',x'00',x'00',x'00',x'00',x'00',x'00',x'00',x'00',x'00',
	x'A9',x'AD',x'A5',x'00',x'A1',x'B1',x'BD',x'B5',x'B9',x'00',x'00',
	x'A2',x'AE',x'A6',x'00',x'00',x'00',x'00',x'00',x'BE',x'B6',x'00',
	x'A0',x'AC',x'A4',x'00',x'00',x'00',x'BC',x'B4',x'00',x'00',x'00',
	x'00',x'4E',x'46',x'4A',x'00',x'00',x'5E',x'56',x'00',x'00',x'00',
	x'09',x'0D',x'05',x'00',x'01',x'11',x'1D',x'15',x'19',x'00',x'00',
	x'00',x'2E',x'26',x'2A',x'00',x'00',x'3E',x'36',x'00',x'00',x'00',
	x'00',x'6E',x'66',x'6A',x'00',x'00',x'7E',x'76',x'00',x'00',x'00',
	x'E9',x'ED',x'E5',x'00',x'E1',x'F1',x'FD',x'F5',x'F9',x'00',x'00',
	x'00',x'8D',x'85',x'00',x'81',x'91',x'9D',x'95',x'99',x'00',x'00',
	x'00',x'8E',x'86',x'00',x'00',x'00',x'00',x'00',x'00',x'96',x'00',
	x'00',x'8C',x'84',x'00',x'00',x'00',x'00',x'94',x'00',x'00',x'00'/

	code = opcode
	for (i=1; i.le.11; i=i+1)
		{
		for (j=1; modbuf(j).eq.modprm(j,i); j=j+1)
			{
			if (j .ge. 4)
				{
				mode = modprm(7,i)
				if ((mode .ne. 0) .and. (opcarg .le. x'00FF'))
					{
					i = i + 1 # force page 0 mode
					}
				mode = modprm(5,i)
				leng = modprm(6,i)
				opcode = codprm(mode,code)
				if (opcode .eq. 00)
					{
					if (pass .eq. 1)
						{
						call error(BADCOD)
						}
					opcode = x'004C' # JMP instruction
					leng = 3
					getmod = .false.
					}
				getmod = .true.
				return
				}
			}
		}
	leng = 3
	opcode = x'004C'
	call error(BADMOD)
	getmod = .false.
	return

	end