;	=======================================================
;
;	REC module for the operators and predicates pertaining
;	to the pushdown list, other than the most important
;	ones already contained in the REC nucleus.  These
;	comprise:
;
;		comparison
;
;			=	equality
;
;		modification of arguments
;
;			H	hex ASCII string to binary
;			[exclm]	binary to hex ASCII string
;			&	exchange top arguments
;			|	concatinate top arguments
;
;		block movements
;
;			G	fetch a block from memory
;			g	address fetch
;			r	replace address by contents
;			u	incrementing byte fetch
;			y	incrementing word fetch
;			P	put buffer block in memory
;			S	store block in memory
;			s	store into buffer
;			v	incrementing byte store
;			m	move arg to end of PDL space
;			n	recover arg from end of PDL
;			h	store/restore machine state
;
;		generate pointers
;
;			c	reserve block, generate pointer
;			p	put px, py-px on PDL
;			l	put pz on PDL
;			$	form addr of variable cell
;
;	-------------------------------------------------------
;	Version of REC released during the summer school, 1980
;	-------------------------------------------------------
;	8086 version with separate segments for code, PDL, WS.
;	-------------------------------------------------------
;
;	      PDL86  -  Copyright (C) 1982, 1984
;		Universidad Autonoma de Puebla
;		     All Rights Reserved
;
;	     [Harold V. McIntosh, 25 April 1982]
;	     [Gerardo Cisneros, 8 February 1984]
;
;	May 29, 1983 - & exchanges arbitrary arguments
;	May 29, 1983 - ~ discontinued; use m&n instead
;	May 29, 1983 - ~ Complement or Negate top element
;	May 29, 1983 - N for Numerical comparison on PDL
;	July 7, 1983 - $ with char arg gets subroutine addr
;	January 23, 1984 - at comp:, <cmp ax,> is <cmp cx,>
;	February 8, 1984 - separate segments (GCS)
;	May 9, 1984 - h stores/restores machine state (GCS)
;	May 22, 1984 - arithmetic operators moved to ATH and FLT (GCS)
;	May 23, 1984 - H and exclm handle any length (GCS)
;	May 31, 1984 - PDL becomes 1st module of REC86F.CMD -GCS
;	18 June 1984 - n quits on empty PDL complement - GCS
;	3 July 1984 - entry points for pG, $S and $r - GCS
;	15 Aug 1984 - E.P.s for nL and &S - GCS
;	=======================================================

;	=============
	org	0000H
;	=============


	jmp	MAIN	;<===============================<<<


;	=======================================================
;	A collection of subroutines for two-byte arithmetic,
;	including loading and storage of the 8080 registers
;	from the pushdown list.
;	=======================================================

;	-------------------------------------------------------
;	Load and store subroutines for 2-byte arithmetic.
;	-------------------------------------------------------

;	Push a two-byte value onto the PDL.  The value to be
;	pushed should be placed on the 8080's stack before
;	calling PUTW.

PUTW:	mov	cx,2		;two bytes are required
	call	NARG		;close old variable, reserve space
	mov	bp,sp
	mov	ax,2[bp]
	mov	[bx],ax		;store low order byte
	inc	bx		;on to high order destination
	inc	bx		;always leave pointer in good condition
	mov	PY,bx		;close top argument
	ret	2

;	(&) Exchange top two arguments, assumed two-byte.

EXCH:	mov	ax,PY
	mov	bx,PX		;org1
	sub	ax,bx		;siz1
	mov	dx,-2[bx]	;org2
	lea	cx,-2[bx]
	sub	cx,dx		;siz2
	cmp	ax,cx
	jnz	XTNE
	jcxz	XTRE
XTEQ:	mov	al,[bx]
	xchg	bx,dx
	mov	ah,[bx]
	mov	[bx],al
	xchg	bx,dx
	mov	[bx],ah
	inc	bx
	inc	dx
	loop	XTEQ
XTRE:	ret
XTNE:	push	cx
	push	dx
	push	bx
	push	ax
	push	dx
	call	NARG
	mov	ax,ds
	mov	es,ax
	cld
	mov	di,bx
	pop	si
	repnz	movs	byte [di],[si]
	pop	cx
	pop	si
	pop	di
	push	di
	repnz	movs	byte [di],[si]
	pop	word ptr [di]
	lea	di,2[di]
	mov	si,PX
	mov	PX,di
	pop	cx
	repnz	movs	byte [di],[si]
	mov	PY,di
	ret

;	Load top two arguments into the machine's stack.  In
;	reality so many permutations exist for places to put
;	the arguments as they are taken off the REC stack that
;	they are simply transferred to the 8080 stack, to be
;	popped into the desired registers on return from the
;	corresponding call.  It is assumed that all quantities
;	involved in these transactions are of two bytes.  A
;	sequence of entry points is provided so as to pop off
;	one or two arguments.

TWOL:	mov	bx,PX
	pop	bp		;entry for two args
	push	word ptr [bx]
	push	bp
	call	UCL		;pop argument, put px in (bx)
ONEL:	pop	bp		;continue, or entry for one argument
	push	word ptr [bx]
	push	bp
	jmp	UCL		;pop the last argument, quit

;	-------------------------------------------------------
;	Conversion between binary and hexadecimal ASCII strings
;	-------------------------------------------------------

;	Return if not hexadecimal. A unchanged if not hex, else
;	reduced to binary.

RNH:	cmp	al,'G'		;no hex characters beyond F
	jnb	RH2
	cmp	al,'A'		;hex letters equal A or beyond
	jb	RH1
	sub	al,'7'		;compensate the gap between 9 and A
	ret
RH1:	jmp	RND
RH2:	inc	sp
	inc	sp
	ret

;	(H) Convert a hex ASCII string on the PDL into binary.
;	If the length of the string is n, the result will have
;	int((n+1)/2) bytes, stored in Intel form: the least
;	significant byte in the lowest addressed location.

HE:	mov	cx,PY		;compute length of string
	mov	si,PX		;while saving pointers
	sub	cx,si
	jz	H4		;leave null strings alone
	mov	bp,cx		;save byte count
	cld
H0:	lods	byte ptr [si]	;check that all characters
	call	RNH		;are hex digits, return false if not
	loop	H0
	mov	cx,bp
	inc	cx		;compute length of final number
	shr	cx,1
	mov	si,PX		;reload PX to process the hex string
	mov	bp,si		;copy of PX to be used later
	mov	bx,si		;another copy as pointer for result
	mov	di,cx		;copy of byte count to be used later
	mov	dl,0
	jnc	H2		;start in the middle if length odd
H1:	lods	byte ptr [si]
	call	RNH		;reduce to binary
	shl	al,1		;multiply by 16
	shl	al,1
	shl	al,1
	shl	al,1
	mov	dl,al		;save it while getting next nibble
H2:	lods	byte ptr [si]
	call	RNH
	or	al,dl		;put nibbles together
	mov	[bx],al		;and store on PDL
	inc	bx		;keep pointing to the next byte
	loop	H1
	mov	PY,bx		;update PY
	call	HXC		;turn the string around
H4:	jmp	SKP		;return TRUE

;	Turn around string of (DI) bytes starting at (BP) and
;	ending at (BX)-1

HXC:	dec	bx		;highest byte
	mov	cx,di		;total byte count
	shr	cx,1		;half of number of bytes
	jcxz	H5
H3:	mov	al,[bx]
	xchg	ds:[bp],al
	mov	[bx],al
	dec	bx
	inc	bp
	loop	H3
H5:	ret

;	([exclm])  Convert an n-byte binary number into an ASCII
;	string of length 2n.  The high order byte is assumed to be
;	in the highest-addressed location.

HX:	mov	cx,PY		;compute lenght of number
	mov	si,cx
	mov	bp,PX		;while saving pointers in other
	sub	cx,bp		;registers
	jnz	HX0
	ret			;leave null strings alone
HX0:	mov	di,cx
	shl	cx,1		;twice as many bytes will be made
	call	OARG		;verify availability of space
	mov	PY,bx		;update PY right away
	mov	cx,di		;restore old count
	std			;conversion proceeds backwards
	dec	si		;last byte is one below original PY
HX1:	lods	byte ptr [si]	;get the byte
	mov	ah,al		;make a copy
	call	HSA		;produce digit from high nibble
	mov	al,ah		;back to AL
	call	HSB		;produce digit from low nibble
	loop	HX1
	shl	di,1		;prepare to turn string around
	mov	bx,PY
	jmps	HXC

HSA:	ror	al,1		;shift byte right four bits
	ror	al,1		;
	ror	al,1		;
	ror	al,1		;
HSB:	and	al,0FH		;mask in right nibble
	add	al,90H		;prepare for some carries from <daa>
	daa			;create gap if nibble beyond 10
	adc	al,40H		;code for @ if we have a letter
	daa			;decide 3 for digit, 4 for letter
	dec	bx		;get pointer ready for deposit
	mov	[bx],al		;record the ASCII digit
	ret

;	-------------------------------------------------------
;	Fetch and store bytes, addresses, and blocks to and fro
;	between the PDL and the memory.  The following chart
;	shows the relation between all the different operators
;	which are available.
;
;				byte	word	block
;				----	----	-----
;
;	replace			-	r	G
;	fetch, nonincrement	g	-	-
;	fetch, increment	u	y	-
;
;	store			-	-	S
;	store, increment	-	-	v
;	store w.r.t. limit	-	-	s
;	store into buffer	-	-	P
;
;	variable head cell	-	$	-
;
;	The main operators for saving and fetching variables
;	are G and S.  The remainder were especially chosen
;	on the one hand to scrutinize the memory under REC
;	control, and on the other to give the widest possible
;	latitude in defining variables in applications of REC.
;
;	The following chart shows how to employ variables:
;
;	    'data' [var#] $ S		define 2-byte variable
;	     [var#] $ r			fetch 2-byte variable
;	    'data' ml [var#] $ S	save fixed variable
;	     [var#] $ ryG		fetch fixed variable
;	    'data' [var#] $rs		redefine existing fixed var
;	     kc Lml [var#] $ S		create k-byte buffered variable
;	     kc [var#] $ S		alternative k-byte buffered var
;	    'data' [var#] $r P		redefine buffered variable
;	     [var#] $ ryLyG		fetch buffered variable
;
;	Memory can be examined bytewise with the following
;	combinations:
;
;	    org g		fetch a byte, keep origin
;	    org u		autoincrementing byte fetch
;	    org v		autoincrementing byte store
;	    org (g  ... v:;)	read, modify, store, ready next
;	    o1 o2 (u~...v&:;)	move from o1 to o2
;
;	-------------------------------------------------------

;	(g) (u)  Fetch a byte from memory and leave on PDL. The
;	sequence <org, g> leaves <org, (org)[1 byte]> on PDL.
;	The sequence <org, u> leaves <org+1, (org)[1 byte]> on
;	PDL.

GB:	mov	bx,PX		;/g/ pointer to top argument
	push	word ptr [bx]		;fetch low byte of origin
	jmp	GBJ		;if the origin is not to be incremented
GBI:	mov	bx,PX		;/u/ pointer to arg, which is org
	push	word ptr [bx]		;fetch low byte of origin
	inc	word ptr [bx]
GBJ:	call	ESLD		;get segment address
	mov	cx,1		;require space for one byte
	call	NARG		;close old arg, check space, open new
	pop	dx		;here's the origin we saved
	xchg	bx,dx
	mov	al,es:[bx]
	xchg	bx,dx		;fetch the byte there
	mov	[bx],al		;store on the PDL
	inc	bx		;pointer always ready for next byte
	mov	PY,bx		;right deliniter of argument
	ret

;	(y)  Fetch two bytes from memory and leave on PDL.
;	The sequence <org, y> leaves <org+2, (org)[2 bytes]>
;	on PDL.

GW:	mov	bx,PX		;/ / pointer to the argument
	push	word ptr [bx]		;low byte of origin
	jmp	GWJ		;common continuation of gw, gwi
GWI:	mov	bx,PX		;/y/ pointer to the argument
	push	word ptr [bx]		;place low byte in A
	add	word ptr [bx],2		;origin to be incremented by 2
GWJ:	call	ESLD		;get segment address
	mov	cx,2		;require space for two bytes
	call	NARG		;close old arg, check space, open new
	pop	dx		;now we're ready for that origin
	xchg	bx,dx
	mov	ax,es:[bx]
	xchg	bx,dx		;fetch the byte sitting there
	mov	[bx],ax		;and store it on PDL
	inc	bx
	inc	bx		;keep the pointer moving along
	mov	PY,bx		;value's finished, store its end
	ret

;	(G)  Fetch a block from memory, leave on PDL.
;	<org,siz, G> leaves (org, ...) on PDL.

GA:	call	CXLD		;load siz into (cx)
	call	OARG		;reuse the argument, but with siz bytes
	call	ESLD		;get segment base
	mov	si,[bx]		;pick up source address too
	cld
	mov	di,bx
	mov	bp,ds
	mov	ax,es
	mov	ds,ax
	mov	es,bp
	repnz	movs	byte [di],[si]
	mov	ds,bp		;restore data segment
	mov	PY,di		;(bx) holds the destination terminator
	ret

;	(pG)  Make a copy of the last argument, a combination
;	which is compiled as a single operator

DUP:	mov	cx,PY	;compute size of current top
	sub	cx,PX
	call	NARG	;check availability of space
	mov	ax,ds
	mov	es,ax	;prepare for move
	cld
	mov	si,dx	;old PX is in DX
	mov	di,bx	;new PX is in BX
	repnz	movs	byte [di],[si]	;count still in  CX
	mov	PY,di	;note new argument end
	ret

;	(S)  Store a block forward from the designated memory
;	location.  <'data' org S> stores 'data' starting at
;	org; leaves no residue on the PDL.

XSTO:	call	EXCH		;entry point for &S
	jmps	SA

VSTO:	call	VBLE		;entry pt for combination $S

SA:	call	CXLD		;fetch destination origin
	mov	di,cx		;save it for a while
	mov	si,PX
	mov	cx,PY
	sub	cx,si
	cld
	repnz	movs	byte [di],[si]
	jmp	UCL		;pop the second argument too

;	(v)  Store a block, leaving incremented address.
;	<org,'data' v> leaves org+size['data'] on PDL, stores
;	'data' starting from org.

SAI:	mov	si,PX
	mov	cx,PY
	sub	cx,si		;determine length of data
	call	UCL		;pop top argument, exposing second
	call	ESLD		;get segment address
	mov	di,[bx]		;(bx) has px, which is destn address
	mov	ax,si
	add	ax,cx
	cmp	di,ax
	jb	LVB
	cld
	repnz	movs	byte [di],[si]
	mov	[bx],di
	ret
LVB:	std
	add	si,cx
	add	di,cx
	mov	[bx],di
	dec	si
	dec	di
	repnz	movs	byte [di],[si]
	ret

;	(s)  Store into an area of limited size. The sequence
;	<'data' org s> will store 'data' beginning at org+2,
;	supposing that siz('data') is less than or equal to
;	(org, org+1).  In either event no residue is left, but
;	an error notation is generated if the data doesn't fit.
;	No data at all is stored if all will not fit.  If it
;	matters to know how much of the space was used, the
;	operator P should probably be used instead.

LCS:	call	CXLD		;fetch destination origin
	mov	bx,cx		;save it while calling psiz
	mov	si,PX
	mov	cx,PY
	sub	cx,si		;determine length of data
	mov	ax,es:[bx]		;low byte of capacity
	cmp	ax,cx
	jnb	LST
	call	UCL
	call	RER		;note error, return if it won't fit
LST:	cld
	inc	bx
	inc	bx
	mov	di,bx
	repnz	movs	byte [di],[si]
	jmp	UCL		;pop second argument

;	(P)  Store into a buffer and note length.  Used to
;	store data of variable length into an area whose
;	maximum length is fixed.  The buffer has the form
;
;	   /available/used/data/data/.../data/.../end/
;
;	The sequence <'data' org P> will store the data
;	in the buffer beginning at org. (org, org+1) holds
;	the maximum length of data that may be stored in the
;	buffer, (org+2, org+3) is siz('data'), and 'data' is
;	stored from org+4 onward if it will fit.  If it will
;	not, P is a noop and error is set.

UCP:	call	CXLD		;pointer to destination
	mov	bx,cx		;save destination while calling psiz
	mov	si,PX
	mov	cx,PY
	sub	cx,si		;load (cx) with length of data
	inc	cx		;data has to appear two bytes larger
	inc	cx		;to include cell showing its size
	mov	ax,es:[bx]		;low byte of destination capacity
	inc	bx		;
	inc	bx		;
	cmp	ax,cx
	jnb	UP1
	call	RER		;capacity exceeded: mark error, return
UP1:	dec	cx		;we want to store the true size
	dec	cx		;subtract out the two byte margin
	mov	es:[bx],cx		;low byte into usage cell
	inc	bx		;just keep moving along
	inc	bx		;ready to start moving data
	cld
	mov	di,bx
	mov	ax,ds
	mov	es,ax
	repnz	movs	byte [di],[si]
	jmp	UCL		;lift second argument, leave nothing

;	(r)  Replace address on top of pdl by its contents.

VREP:	call	VBLE		;entry point for combination $r
IND:	call	ESLD		;get segment address
	mov	dx,[bx]		;load word
	xchg	bx,dx		;(bx) now has top argument
	mov	ax,es:[bx]		;indirect address
	xchg	bx,dx		;address of top argument again
	mov	[bx],ax		;store low indirect byte
	add	bx,2		;set PY in case old arg had 4 bytes
	mov	PY,bx
	ret

;	($)  Generate the address of the nth cell in the array
;	of variables, which is a block of four-byte addresses.
;	These cells may be used to store data directly - for
;	example counters or addresses - or indirectly through
;	pointers to the actual location of the data.  By giving
;	a one-byte character argument, <'x'$>, the location where
;	the address of subroutine x is stored may be obtained.

VBLE:	mov	bx,PX		;pointer to argument
	mov	cx,PY
	sub	cx,bx
	cmp	cx,2
	jz	VBLF
	mov	cx,2
	call	OARG		;reuse old arg with size 2
	mov	bx,PX
	mov	al,[bx]
	mov	ah,0
	jmp	VBLG
VBLF:	mov	ax,[bx]
VBLG:	add	ax,ax
	add	ax,ax
	add	ax,VRT
	mov	[bx],ax
	add	bx,2
	mov	PY,bx
	ret

;	(l)  Load pz onto PDL.

LCL:	push	PZ		;putw requires arg on 8080 stack
	call	PUTW		;record two-byte argument
	ret			;can't use simply <jmp putw>

;	(m)  Set aside top argument on PDL.  It is moved to the
;	other end of the array reserved for the PDL, which can
;	be used as a temporary storage stack without name.  The
;	mechanism by which pz is moved and the block size is
;	recorded makes this an attractive mechanism to create
;	storage space for REC variables.

LCM:	mov	si,PY
	mov	cx,si
	sub	cx,PX		;get length of top argument
	push	cx
	call	UCL		;pop top argument
	mov	di,PZ		;load destination origin
	std
	dec	si
	dec	di
	mov	ax,ds
	mov	es,ax
	repnz	movs	byte [di],[si]
	lea	bx,-1[di]
	mov	PZ,bx
	pop	word ptr [bx]		;recover length
	ret

;	(n)  Recover segment which was set aside.

LCN:	mov	cx,ZE		;there won't be any net length change
	call	NARG		;close old argument, ready for new
	mov	di,bx		;place destination origin in (dx)
	mov	PY,di		;leave null string in case of error
	mov	bx,PZ		;place source origin in (bx)
	mov	cx,[bx]		;place length in cx
	cmp	cx,0FFFFH	;see whether PDL complement is empty
	jnz	lcn1
	call	RER		;it is, quit after recording error
lcn1:	lea	si,2[bx]
	cld
	mov	ax,ds
	mov	es,ax
	repnz	movs	byte [di],[si]
	mov	PY,di		;end of destination is end of argument
	mov	PZ,si		;update pz
	ret

;	(nL)  Lift from PDL complement

ENLF:	mov	bx,PZ		;place source origin in (bx)
	mov	cx,[bx]		;place length in cx
	cmp	cx,0FFFFH	;check for top of PDL flag
	jnz	enlf1
	call	RER		;quit if PDL complement empty
enlf1:	add	bx,cx		;compute start of next compl. arg.
	inc	bx
	inc	bx
	mov	PZ,bx		;store new upper limit of PDL
	ret

;	(|)  Concatinate the top arguments on the PDL.

CONC:	mov	si,PX
	mov	cx,PY
	sub	cx,si		;get length of top argument
	call	UCL		;pop top argument, set up pntrs to next
	mov	di,dx		;new py is destination
	cld
	mov	ax,ds
	mov	es,ax
	repnz	movs	byte [di],[si]
	mov	PY,di		;record new terminal address
	ret

;	(p)  Put px and siz on the pushdown list.

GXS:	mov	dx,PX
	mov	bx,PY
	mov	cx,bx
	sub	cx,dx		;calculate length of top argument
	push	cx		;put length on 8080 stack
	push	dx		;put origin on 8080 stack
	call	PUTW		;put top of 8080 stack on REC PDL
	call	PUTW		;put the next item there too
	ret			;can't combine <call, ret> into <jmp>

;	(c) Reserve a block on the pushdown list. <n,c> creates
;	a block of length n, and puts n-2 at the front of the
;	block as a size indicator.  Then, if n .ge. 2, it will
;	be there as a length indicator for a buffer. <=====maybe change this?

BLOK:	mov	bx,PX		;pointer to argument
	mov	cx,[bx]		;fetch the argument
	mov	[bx],cx		;store header
	sub	word ptr [bx],2
	call	OARG		;is there enough space to reuse arg?
	mov	PY,bx		;increment in (bx), it goes into py
	push	PX		;px has origin of block just formed
	call	PUTW		;record block origin as new argument
	ret			;can't replace <call putw, ret> by jmp

;	(h) Save the state of the machine and leave the SP value on
;	the PDL, if arg is null; otherwise restore the state of the
;	machine from values at the stack pointed to by the address
;	on the PDL.

MST:	pop	rtaddr		;put return address aside
	pushf			;Flags to the stack
	push	ax		;Accumulator to stack
	push	bx		;BX to stack
	push	cx		;CX to stack
	push	dx		;DX to stack
	push	bp		;Base pointer to stack
	push	si		;Source index to stack
	push	di		;Destination index to stack
	push	ds		;Data segment to stack
	push	es		;Extra segment to stack
	mov	ax,PY		;compute argument length
	sub	ax,PX		;and lift top
	call	UCL		;before pushing pointers
;	push	PX		;PDL pointers
;	push	PY
;	push	PZ
;	push	P0		;WS pointers
;	push	P1
;	push	P2
;	push	P3
;	push	P4
;	push	WSEG
	test	ax,ax
	jnz	mrst		;restore if arg nonnull
	mov	cx,4		;need 4 bytes for SS and SP
	call	NARG		;A ROYAL MESS WILL ENSUE IF NARG FAILS
	mov	[bx],ss		;record stack segment value
	mov	2[bx],sp	;record stack pointer value
	add	bx,cx		;compute new PY
	mov	PY,bx		;and update it
	jmps	mrst2

mrst:	xchg	bx,dx		;get previous PY back in BX
	cmp	al,2		;see if top arg has size 2
	jnz	mrst1
	call	UCL		;yes, clean up stack
	xchg	dx,bx		;get PY back into BX
	mov	ss,2[bx]	;restoring pointers should be below
	mov	sp,4[bx]	;the 2-byte argument
	add	sp,20		;get rid of stored stuff (10 regs)
;	add	sp,38		;get rid of stored stuff (10 regs + 9 ptrs)
	jmps	mrst2

mrst1:	mov	ss,2[bx]	;fetch SS from the PDL
	mov	sp,4[bx]	;SP too, now it points to previous store
;	pop	WSEG		;so we can pop everything
;	pop	P4		;we pushed in reverse
;	pop	P3
;	pop	P2
;	pop	P1
;	pop	P0
;	pop	PZ
;	pop	PY
;	pop	PX
	pop	es
	pop	ds
	pop	di
	pop	si
	pop	bp
	pop	dx
	pop	cx
	pop	bx
	pop	ax
	popf
mrst2:	push	rtaddr		;restore return address
	ret			;and exit

;	Load a single variable into (cx) from the pushdown
;	list.  No register is sure to be preserved.

CXLD:	mov	bx,PX		;pointer to argument
	mov	cx,[bx]		;fetch low order byte
	call	ESLD		;get segment address
	jmp	UCL		;erase argument [(cx) is unchanged]

;	Load register pair (dx) from the pushdown list.
;	(cx) will be preserved, (bx) not.

DXLD:	mov	bx,PX		;pointer to argument
	push	word ptr [bx]		;fetch word
	call	UCL		;erase argument
	pop	dx		;restore (dx) since UCL modified it
	ret

;	(=)  Test the two top arguments on the pushdown list
;	for equality.  The arguments may be of any length, but
;	will be equal only when of the same length and composed
;	of the same sequence of bytes. The top argument will be
;	popped whatever the outcome, but when equality is true
;	both will be popped.

EQL:	mov	di,PX		;under argument
	mov	cx,PY
	sub	cx,di		;obtain length of top argument
	call	UCL		;lift top argument
	mov	si,PX
	mov	bx,PY
	sub	bx,si
	cmp	bx,cx		;compare lengths
	jnz	EQF
	cld
	mov	ax,ds
	mov	es,ax
	repz	cmps	byte [di],[si]
	jnz	EQF
	jmp	CUCL		;both agree, erase second arg, TRUE
EQF:	ret			;disagree so FALSE

;	Load (es) with (ds) if PDL argument length is 2 bytes
;	Load!(es) from upper two bytes if length is 4 bytes

ESLD:	mov	ax,PY
	mov	bx,PX
	sub	ax,bx
	cmp	ax,2
	jnz	esl1
	mov	ax,ds		;two-byte argument
	mov	es,ax
	ret
esl1:	cmp	ax,4
	jnz	esl2
	mov	ax,2[bx]	;four-byte argument
	mov	es,ax
	ret
esl2:	call	RR1		;error record with one lift

;	-------------------------------------------------------
;
;	Some of the service routines which are likely to be
;	external references in other modules are:
;
;		puon	push one byte on PDL
;		putw	push address on PDL
;		thrl	load  three arguments onto 8080 stack
;		twol	load two arguments onto 8080 stack
;		onel	load one argument onto 8080 stack
;		bcld	load (cx) from PDL, pop PDL
;		deld	load (dx) from PDL, pop PDL
;
;	-------------------------------------------------------

	END