;	*******************************************************
;	*  REC module containing the REC nucleus and some of  *
;	*  the really indispensable operators and predicates  *
;	*  such as those defining two byte binary numbers and *
;	*  ASCII constant strings.  The model of a pushdown   *
;	*  list is assumed in the expectation that additional *
;	*  operators and predicates will also follow reversed *
;	*  Polish notation. There are additionally many small *
;	*  service routines which may be used externally.     *
;	*						      *
;	*  REC86 was obtained from the previously existing    *
;	*  REC80 by applying SORCIM's TRANS86 translator and  *
;	*  then adjusting the resulting code manually. It is  *
;	*  intended that REC86 will be functionally identical *
;	*  to REC80. All error corrections, additions, or     *
;	*  alterations are made simultaneously to the two     *
;	*  programs, when they are not purely cosmetic.	      *
;	*  Braces, creating a different style of subroutine   *
;	*  definition, were incorporated in REC at the time   *
;	*  the translation to the Intel 8086 was made.	      *
;	*						      *
;	*  This version supports separate code, data (base    *
;	*  page, pointers and PDL), extra (WS) and stack      *
;	*  segments. [G. Cisneros, Feb 1984]		      *
;	*						      *
;	*  REC86 contains the following compiling entries:    *
;	*						      *
;	*	reclp	left parenthesis		      *
;	*	recco	colon				      *
;	*	recsc	semicolon			      *
;	*	recrp	right parenthesis		      *
;	*	recop	operator			      *
;	*	recpr	predicate			      *
;	*	recsq	single quotes			      *
;	*	recdq	double quotes			      *
;	*	reccm	comments			      *
;	*	reco1	operator with one ASCII parameter     *
;	*	recp1	predicate with one ASCII parameter    *
;	*	recms	unary minus sign		      *
;	*	recdd	decimal digit			      *
;	*	recol	operator, with lookahead	      *
;	*	recpl	predicate, with lookahead	      *
;	*						      *
;	*  REC86 contains the following operators and         *
;	*  predicates:					      *
;	*						      *
;	*	'	single quote			      *
;	*	"	double quote			      *
;	*	nu	two byte decimal number		      *
;	*	L	erase argument (lift)		      *
;	*	@	execute subroutine		      *
;	*	{	initiate program segment	      *
;	*	}	discontinue program segment	      *
;	*	?	report detected error		      *
;	*						      *
;	*  The following are initialization programs which    *
;	*  can be called at the outset of a compilation.      *
;	*						      *
;	*	inre	initialize REC temporary registers    *
;	*						      *
;	* * * * * * * * * * * * * * * * * * * * * * * * * * * *
;	*						      *
;	*	 REC86  -  Copyright (C) 1982, 1984	      *
;	*	   Universidad Autonoma de Puebla	      *
;	*		All Rights Reserved		      *
;	*						      *
;	*        [Harold V. McIntosh, 25 April 1982]	      *
;	*	 [Gerardo Cisneros, 8 February 1984]	      *
;	*						      *
;	14 April 1983 - AR recognizes @@		      *
;	14 April 1983 - cosmetic changes: use of <lea>	      *
;	14 April 1983 - suppress TLU and TLV		      *
;	14 January 1984 - 4 explicit jmps's for sorcim.cnv    *
;	8 February 1984 - Individual segments - GCS	      *		
;	10 May 1984 - Floating point - GCS
;	3 July 1984 - @@ takes 1- and 2-byte arguments from   *
;	the PDL; compilation of combinations included - GCS   *
;	15 Aug 1984 - E.P.s for nL, LL and &L - GCS	
;	*******************************************************

;	=======================================================
;	The nucleus of REC is a compiler for control symbols,
;	operators and predicates, some auxiliary subroutines,
;	and an initilazation routine.
;
;	The compiler proper uses only the folowing external
;	references:
;
;		RAM storage		xpd, ypd, zpd
;		I-O routine		read
;		skip instruction	skp
;
;	The RAM storage must be initialized, which may be
;	accomplished by calling inre.
;
;	The location in which the object code is placed is
;	passed along through the register pair (dx), which is
;	continually updated to reflect the next available byte.
;	None of the other registers are either conserved nor
;	significant after the completion of compilation.
;
;	The usage of the registers is the following
;
;		pair (cx) contains the execution pointer
;		pair (dx) contains the object program counter
;		pair (bx) contains the compiling address
;
;	=======================================================

;	Equivalences defining INTEL 8086 instructions and some
;	constants.

CA	equ	0E8H		;call w/16 bit displacement
JU	equ	0E9H		;jump w/16 bit displacement
RN	equ	0C3H		;return w/o change of segment
POBX	equ	05BH		;pop bx
PUBX	equ	053H		;push bx
JUBX	equ	0E3FFH		;jmp bx
PUME	equ	036FFH		;push direct address
POME	equ	0068FH		;pop into memory
INBX	equ	043H		;inc bx
LDME	equ	006C7H		;ld mem,imm
ZE	equ	0000H		;zero
FF	equ	00FFH		;one byte complement of zero


;	Compile a left parenthesis.

RECLP:	pop	bp
	push	ZPD		;save the linkage to semicolon exits
	push	YPD		;save the higher linkage to false jumps
	push	XPD		;save the repeat references
	mov	ax,ZE		;initialze the new chains
	mov	ZPD,ax		;null TRUE exit list
	mov	YPD,ax		;null FALSE jump list
	mov	XPD,dx		;new parenthesis level begins here
	jmp	bp

;	Compile a colon.

RECCO:	mov	bx,XPD		;pick up reference to left parenthesis
	sub	bx,dx
	lea	bx,-3[bx]
	call	RECJU		;and insert a jump to its location
	jmp	RECFY		;fill in any FALSE predicate jumps

;	Compile a semicolon.

RECSC:	mov	bx,ZPD		;pick up link to TRUE exit chain
	call	RECJU		;insert this one on it too
	mov	ZPD,bx		;store it as the new head of the chain
	jmp	RECFY		;fill in any FALSE predicate jumpe

;	Compile an operator.

RECOP:	xchg	bx,dx
	mov	cs:byte ptr [bx],CA	;store the 8086 code for a call
	lea	bx,3[bx]	;advance (dx) to receive next byte
	sub	cx,bx
	mov	cs:(-2)[bx],cx
	xchg	bx,dx
	ret

;	Compile a predicate.

RECPR:	call	RECOP		;call its subroutine, same as operator
RECYJ:	mov	bx,YPD		;linkage to FALSE exits
	call	RECJU		;incorporate a jump if result FALSE
	mov	YPD,bx		;update for new head of chain
	ret

;	Compile a right parenthesis.

RECRP:	pop	bp		;recover xpd, which is hidden
	pop	XPD		;replace it
	cmp	XPD,ZE
	jz	RECFP		;if so, continue with recfp
	pop	bx		;recover wpd
	call	RECJU		;link expr to ypd on its own level
	push	bx		;but save pointer until we finish up
	call	RECFY		;false predicates in last segment
	pop	YPD		;replace ypd for higher level
	mov	bx,ZPD		;now we have destination for semicolons
	call	recfc		;so insert all the correct addresses
	pop	ZPD		;replace old zpd
	jmp	bp

;	Final right parentheses get a different treatment.

RECFP:	mov	bx,dx		;compile pointer in bx
	mov	cs:byte ptr [bx],RN	;store a <ret> for false exit
	inc	bx		;ready for next byte
	push	bx		;save compile pointer
	mov	dx,(offset SKP)		;address of skip - TRUE exit from REC
	call	RECFY		;use it for last segment
	mov	bx,ZPD		;destination of semicolons now known
	call	recfc		;so fill out that chain
	pop	dx		;compile pointer that was saved
	pop	YPD		;restore old ypd
	pop	ZPD		;restore old zpd
	ret			;return one level higher than expected

;	Insert a new element in a chain of jmp's which will
;	eventually have destination addresses.  In the interim
;	each is given the address of its predecessor. On entry
;	(dx) holds the address where the instruction will be
;	stored and (bx) holds the address of its predecessor.
;	On exit, (dx) is incremented by 3 to point to the next
;	free byte, and (bx) has the starting value of (dx).

RECJU:	xchg	bx,dx		;(bx) and (dx) exchanged is better
	mov	cs:byte ptr [bx],JU	;store the jump instruction
	inc	bx
	mov	cs:[bx],dx		;store old link
	lea	dx,2[bx]
	ret

;	When the destination of a linked chain of jumps is
;	finally known, the destination can be substituted into
;	each one of the links.  On entry, (bx) contains the
;	address of the first link unless it is zero signifying
;	a null chain.

recfc:	or	bx,bx		;test for end of chain
	jz	recfx		;if address is zero, chain ends
	mov	ax,dx
	dec	ax
	dec	ax
recfi:	mov	cx,cs:[bx]		;save next link
	mov	cs:[bx],ax		;store destination
	sub	cs:[bx],bx
	mov	bx,cx		;update link
	or	bx,bx
	jnz	recfi		;continue
recfx:	ret

;	Call recfc with the intention of filling the y chain.

RECFY:	mov	bx,YPD
	call	recfc
	mov	YPD,bx
	ret

;	Subroutine which will initialize the temporary
;	registers used by the REC compiler.

INRE:	mov	bx,ZE
	mov	XPD,bx
	mov	YPD,bx
	mov	ZPD,bx
	ret


;	=======================================================
;	The following are specialized compiling subroutines
;	which apply to special structures and depend on the
;	model of a pushdown list with a linked chain structure
;	and special registers px and py delimiting the top
;	segment on the chain.
;	=======================================================

;	-------------------------------------------------------
;	Compilation of quoted expressions.  Single and double
;	quotes may alternate with one another to an arbitrary
;	depth.  Both kinds of quotes are executed in the same
;	way, by loading the quoted expression from the program
;	onto the pushdown list.
;	-------------------------------------------------------

;	Compile single quotes.

RECSQ:	call	RECOP		;record call to qu
	inc	dx		;set aside two bytes
	inc	dx		;to hold length of ASCII chain
	push	dx		;keep beginning for future reference
	push	cs:QUEN		;delay cleanup until ret
SQ:	call	word ptr read		;read the next character
	cmp	al,''''	;test for single quote
	jz	SQ2		;if so go after entire chain
	cmp	al,'"'		;test for double quotes
	jnz	SQ1
	call	DQ1		;if so, read it all
SQ1:	xchg	bx,dx
	mov	cs:[bx],al
	xchg	bx,dx		;otherwise keep on storing
	inc	dx		;and advancing pointer
	jmp	SQ		;go after next character
SQ2:	ret

;	Compile double quotes.

RECDQ:	call	RECOP		;record call to qu
	inc	dx		;set aside two bytes
	inc	dx		;to hold length of chain
	push	dx		;put chain origin away for reference
	push	QUEN		;delay cleanup until ret
DQ:	call	word ptr read		;read the next character
	cmp	al,'"'		;test for double quotes
	jz	DQ2		;if so, chain finished
	cmp	al,''''	;check for single quotes
	jnz	DQ1
	call	SQ1		;if so go after whole chain
DQ1:	xchg	bx,dx
	mov	cs:[bx],al
	xchg	bx,dx		;otherwise keep on storing
	inc	dx		;and advancing pointer
	jmp	DQ		;go after next character
DQ2:	ret

;	Cleanup for both quote compilers.

QUEN	dw	ENQU		;for the direct push
ENQU:	pop	bx		;beginning of chain in (bx)
	mov	cx,dx
	sub	cx,bx
	mov	cs:(-2)[bx],cx	;store length
	ret

;	(') (")   Execute single or double quote.

QU:	pop	bx		;get call location off the 8080 stack
	mov	cx,cs:[bx]		;count
	inc	bx		;
	inc	bx		;
QMOV:	mov	si,bx		;save source origin
	add	bx,cx		;calculate source end = return adress
	push	bx
	call	NARG		;check space, put dest. pointer in (bx)
	mov	di,bx
	jcxz	qu1
	cld
	mov	bp,ds
	mov	es,bp
qu0:	movs	byte [di],cs:[si]
	loop	qu0
qu1:	mov	PY,di
	ret

;	-------------------------------------------------------
;	Comments are enclosed in square brackets, which must be
;	balanced.  Code may be disabled by enclosing it in
;	square brackets, but care must be taken that the
;	expression so isolated does not contain individual
;	brackets, such as arguments of arrobas or quoted
;	brackets, which might disrupt the balance. Since
;	comments are ignored by the compiler they are not
;	executed.
;	-------------------------------------------------------

;	Compile comments by ignoring them.

RECCM:	call	word ptr read		;get next character
	cmp	al,']'		;test for closing ]
	jz	RECCX		;if so we're done
	cmp	al,'['		;test for beginning of new level
	jnz	RECCM		;otherwise keep on reading
	call	RECCM		;if so go after it recursively
	jmp	RECCM
RECCX:	ret

;	-------------------------------------------------------
;	Sometimes, notably in compiling arroba as a call to a
;	subroutine named by a single letter, a parameter will
;	follow a subroutine call as its calling sequence.
;	-------------------------------------------------------

;	Operator with one ASCII parameter.

RECO1:	call	RECOP		;always compile the subroutine call
	call	word ptr read		;read the parameter
	mov	bx,dx
	mov	cs:[bx],al		;store as a 1-byte calling sequence
	inc	dx		;always ready for next byte
	ret

;	Predicate with one ASCII parameter.

RECP1:	call	RECO1		;compile as the analogous operator
	jmp	RECYJ		;then take account of false exit

;	Predicate, with lookahead, to compile often-used
;	combinations like Ez and ED.

RECPL:	call	RECOL		;compile as the analogous operator
	jmps	pl0		;short jump because recol may skip
	call	RECYJ		;call to link into chain
	jmp	skp86		;skip, we have next character
pl0:	jmp	RECYJ		;no skip, just link into chain

;	Operator, with lookahead, to compile often-used
;	combinations like pG and TL into a single call

RECOL:	mov	bl,al		;save first character
ol1:	call	word ptr read	;get the next valid character
	call	svc86
	jmps	ol1
	add	al,' '		;restore to ASCII
	push	ax		;save, in case combination not found
	push	cx		;save exec addr of first letter
	push	dx		;as well as compilation ptr
	mov	bh,al		;both letters in BX
	mov	dx,CMT		;combination table address
	xchg	bx,dx		;switch letters and address
ol2:	mov	cx,[bx]		;get next combination
	jcxz	ol4		;end of table, exit loop
	cmp	cx,dx		;else compare letters
	jz	ol3		;exit loop if found
	add	bx,4		;advance pointer to table
	jmps	ol2		;try next

ol3:	pop	dx		;found, get comp. ptr.
	pop	cx		;get rid of old exec addr
	mov	cx,2[bx]	;get exec. addr. of combination
	pop	ax		;get rid of saved character
	jmp	RECOP		;off to compile call

ol4:	pop	dx		;not found, fetch comp. ptr.
	pop	cx		;and exec. addr. of first letter
	call	RECOP		;compile that
	pop	ax		;retrieve the second character
	jmp	skp86		;and skip, since no read necessary

;	-------------------------------------------------------
;	Decimal numbers are of such frequent occurrence in the
;	form of counters, arguments, or just data that it is
;	convenient to compile them on sight without requiring
;	any special delimiters.  Likewise, negative numbers are
;	easier to designate using a minus sign than using their
;	modular form, but this should not prevent the use of a
;	minus sign as an operator.
;	-------------------------------------------------------

;	Compile a minus sign. This involves determining whether
;	it is followed immediately by a decimal digit, in which
;	case it is compiled as part of a negative number.

RECMS:	mov	FRST,al		;save the minus sign just in case
	call	word ptr read		;read in one byte
	call	MS1		;decide whether it is a digit
	push	ax		;it was not, save it
	call	RECOP		;compile call to binary minus
	pop	ax		;recover the extra character
	jmp	skp86		;skip because we have next character

MS1:	cmp	al,'.'		;period indicates an FP number
	jz	ms2
	call	RND		;return if not digit
	add	al,'0'		;otherwise restore to ascii
ms2:	inc	sp		;erase call to ms1
	inc	sp
	push	dx		;save compilation pointer
	call	RECDS		;read and convert digit string
	mov	cx,cs:GNU	;fake that it was nu, not ms
	jmp	DD1		;continue as though positive number

GNU	dw	NU

;	Execute a number, which means load it on pdl.

NU:	pop	bx		;get beginning of calling sequence
	mov	cl,cs:[bx]	;fetch length from code segment
	mov	ch,0
	inc	bx		;point to low-order byte of number
	jmp	QMOV		;and use code at QU to do the move

;	=======================================================
;	Some simple procedures to compile REC expressions into
;	subroutines, deposit a reference to them in a symbol
;	table, and eventually to recover the space and erase
;	the symbol table reference.
;	=======================================================

;	Table search. The table whose address is stored at fxt
;	is consulted for its pair of addresses at position 4*A.
;	Thus on entry, A holds the table index.  This table
;	alternates the address of a compiling subroutine with
;	the execution address of the same entry.  On exit, (cx)
;	holds the execution address, (dx) is preserved, and a
;	jump is made to the compiling address.

rects:	mov	ah,ZE
	mov	bp,ax		;save the character
	add	ax,ax
	add	ax,ax
	mov	bx,FXT		;load base address of table
	add	bx,ax
	mov	ax,bp		;restore letter to AX
	add	al,' '		;but in original ASCII form
	push	word ptr [bx]		;put the first entry in (cx)
	mov	cx,2[bx]	;table pointer is going
	ret			;then off to the compilation

;	Pick out left delimiters: (, {, or [.

left:	call	word ptr read
	cmp	al,'('
	jz	eft
	cmp	al,'{'
	jz	eft
	cmp	al,'['
	jnz	left
	call	reccm
	jmps	left
eft:	ret

;	A main program to compile characters one by one as
;	they are read in from the console.  Note that the
;	compiling programs invoked by rects can generate skips
;	when they have already read the following character.
;	This occurs most notably when compiling digits. Also
;	note that svc86 normalizes characters when it accepts
;	them.

recre:	call	word ptr read		;read a character from whereever
recrr:	call	svc86		;check for space, control character
	jmps	recre		;not valid, go back for another
	call	rects		;look up in table and compile it
	jmps	recre		;read another character and repeat
	jmps	recrr		;repeat but next character already read

;	A subroutine which will pass over comments, and wait
;	for an opening left parenthesis or brace before compiling
;	a REC expression.

EMCE:	call	UCL		;entry here erases an argument from PDL
EMCX:	call	left 		;get a character from whereever
	mov	dx,C1
	mov	bx,C1
	mov	bp,sp
	xchg	bx,[bp]
	push	bx
	call	recrr		;compiling prgrm one char already read
	cmp	dx,C2
	ja	emc0		;error if above high limit
	cmp	dx,C0
	jb	emc0		;error if below low limit
	mov	C1,dx
	ret
emc0:	mov	bx,'pC'		;type Cp ovfl and quit
	jmp	FERR

EMCU:	pop	dx
	pop	bx
	push	dx
	push	bx
	mov	dx,(offset EMCV)
	push	dx
	jmp	bx
EMCV:	jmp	EMCW
	pop	C1
	jmp	skp86
EMCW:	pop	C1
	ret

;	({) Introduce a series of definitions.

LBR:	xchg	bx,dx
	mov	cs:byte ptr [bx],CA	;insert a call to the executable
	xchg	bx,dx			; subroutine
	inc	dx
	mov	cx,dx		;place to put call address - keep in BC
	inc	dx		;make room
	inc	dx
	call	RECYJ		;link in the FALSE exit
	call	RECJU
	push	bx		;keep this address
	push	XPD
	mov	XPD,ZE		;this is top level for ensuing subroutines
	mov	bx,ZE
LB1:	push	dx		;record entry point to subroutine
	inc	bx		;increment count of subroutines
	push	bx		;keep it next to top on stack
	push	cx		;jump address at entry - keep it on top
	call	left
	call	recrr		;compile at least one subroutine
LB2:	call	word ptr read		;get possible name of subroutine
	cmp	al,'}'		;no name - we execute this one
	jz	LB3
	call	svc86		;convert name into serial number
	jmps	LB2		;punctuation instead of name
	add	al,' '
	mov	ah,ZE
	mov	bx,VRT
	add	ax,ax
	add	bx,ax
	add	bx,ax
	pop	cx		;get this out of the way
	mov	bp,sp
	xchg	bx,[bp]		;store table address, put subr count in bx
	jmp	LB1
LB3:	cld
	mov	ax,cs
	mov	es,ax
	pop	bx		;origin of brace compilation
	mov	di,dx
	lea	ax,2[bx]
	sub	ax,di
	neg	ax
	mov	cs:[bx],ax
	pop	cx		;number of subroutines + 1
	push	cx		;we'll need it again later
	mov	bp,cx		;put it in bp too
	dec	bp
	add	bp,bp
	add	bp,bp
	add	bp,sp
	mov	al,POBX
	stos	byte [di]
	jmp	LB5
LB4:	mov	ax,PUME	;for each defined symbol we insert the
	stos	word [di]
	mov	ax,[bp]
	stos	word [di]
	mov	ax,LDME	;
	stos	word [di]
	mov	ax,[bp]
	stos	word [di]
	mov	ax,2[bp]
	stos	word [di]
	sub	bp,4		;we read the stack backwards
LB5:	loop	LB4
	mov	al,PUBX
	stos	byte [di]
	mov	al,CA
	stos	byte [di]
	pop	cx
	pop	ax
	sub	ax,di
	dec	ax
	dec	ax
	stos	word [di]
	push	cx
	mov	al,JU		;	jmp	$+6
	stos	byte [di]
	push	di		;	inx	h
	inc	di		;	inx	h
	inc	di		;	inx	h
	mov	al,POBX
	stos	byte [di]
	mov	al,INBX
	stos	byte [di]
	stos	byte [di]
	stos	byte [di]
	mov	al,PUBX
	stos	byte [di]
	pop	bx
	lea	ax,2[bx]
	sub	ax,di
	neg	ax
	mov	cs:[bx],ax
	mov	al,POBX
	stos	byte [di]
	pop	cx
	jmp	LB7
LB6:	mov	ax,POME	;after an expression in braces is
	stos	word [di]
	pop	ax
	stos	word [di]
	inc	sp
	inc	sp
LB7:	loop	LB6
	mov	ax,JUBX	;the whole thing is finished off by a return
	stos	word [di]
	mov	dx,di
	pop	XPD
	pop	bx
	cmp	XPD,ZE
	jz	LB8
	lea	ax,2[bx]
	sub	ax,dx
	neg	ax
	mov	cs:[bx],ax
	ret
LB8:	mov	cx,cs:[bx]
	lea	ax,2-(offset SKP)[bx]	;top level true return
	neg	ax
	mov	cs:[bx],ax
	mov	cs:byte ptr (-4)[bx],RN	;top level false return
	inc	sp		;return one level higher than expected
	inc	sp
	ret

;	(@) Subroutine which will transform an ASCII character
;	into a table reference, and then jump to the address
;	so encountered.  This is essentially REC's subroutine
;	call mechanism, necessarily a predicate since it calls
;	a REC expression, which is itself a predicate.

AR:	pop	bx		;entry if name is a parameter
	mov	al,cs:[bx]	;read the calling sequence
	inc	bx		;advance pointer for return
	push	bx		;put it back on 8080 stack
	cmp	al,'@'
	jnz	XAR
	mov	bx,PX		;argument on PDL, compute size
	mov	ax,[bx]		;but fetch two bytes anyway
	mov	cx,PY
	sub	cx,bx
	call	UCL		;lift it before going on
	cmp	cx,2		;is it an address?
	jnz	XAR		;no, assume a letter
	jmp	ax		;yes, jump to it

XAR:	mov	ah,ZE		;clear the high byte
	add	ax,ax		;compute address of table entry
	add	ax,ax
	mov	di,ax
	mov	bx,VRT		;entry when index is in register A
	jmp	word ptr [bx+di]		;then use it as jump address

;	=======================================================
;	Some general service routines.
;	=======================================================

;	Skip on valid character, meaning, not control symbol.
;	If valid, 20H (space) is subtracted, making A = 1, etc.

svc86:	cmp	al,'!'		;reject space, excl is lower limit
	jb	sv
	cmp	al,7FH		;seven bits is upper limit
	jnb	sv
	sub	al,' '		;normalize to begin with (excl) = 1
	pop	bp
	inc	bp
	inc	bp
	jmp	bp
sv:	ret			;don't skip for control or flag bit

;	Second level return on error.

RR2:	pop	bx		;entry to clear two items from PDL
	mov	bp,sp
	xchg	bx,[bp]		;
RR1:	pop	bx		;entry to clear one item from PDL
	mov	bp,sp
	xchg	bx,[bp]		;
RER:	pop	ax		;site where ther error occurred
	cmp	ER,ZE		;only record the first error
	jnz	RRR
	mov	ER,ax
RRR:	ret

;	(?)  Test whether an error has been reported: predicate
;	which is true if er is nonzero, in which case it will
;	reset er.  It will also, if TRUE, place the calling
;	address of the last reported error on the pushdown
;	list.  If false, only a FALSE return is generated. Note
;	the ironic circumstance that, if PDL is exhausted, qm
;	can generate an error trying to report an error - but
;	the TRUE result will still be valid.

QM:	cmp	ER,ZE		;test the error cell
	jz	QQ		;FALSE return if no error
	mov	cx,2		;we want two bytes for error address
	call	NARG		;check space, prepare for new argument
	mov	ax,ER		;fetch error address
	mov	[bx],ax		;transfer it to REC PDL
	inc	bx		;
	inc	bx		;pointer must always advance
	mov	PY,bx		;end of the argument
	mov	ER,ZE		;reset ER
	jmp	SKP		;TRUE return - there was an error
QQ:	ret

;	Generate a skip (skp), whici is often combined with the
;	erasure og an argument on the pushdowo mist (cucl).

CUCL:	call	UCL		;erase the top argument
SKP:	pop	bp
	add	bp,3		;assume the skip will!be over a
	jmp	bp		;thsee-byte insuruction, such as a jump

skp86:	pop	bp
	inc	bp
	inc	bp
	jmp	bp

;	Test PDL space beginning at top argument. On entry (cx)
;	contains the total space required.  On exit, (cx) stays
;	unchanged, (dx) holds pz, while (bx) holds px+(cx).
;	If the space is not available, return is made from the
;	calling program after noting the error.  Otherwise
;	normal return to the calling program occurs. The likely
;	use of oarg is to record a result without having to go
;	through ucl, NARG.

OARG:	mov	dx,PZ		;load limit of PDL
	dec	dx		;keep one byte margin
	mov	bx,PX		;load beginning of current argument
	add	bx,cx
	jc	NRER		;error if PX+(cx) wraps around 64K
	sub	dx,bx
	jb	NRER		;no, note error, quit program
	ret			;yes, continue normally

;	Check space for, and then set up, a new argument. On
;	entry, (cx) should contain the amount of additional
;	space required.  The program will automatically add
;	two more bytes for the pointer which would close the
;	argument and then, if the required space is available,
;	close it, define the new px, and leave its value in
;	(bx).  (dx) will contain the old value of px to be used
;	in case the superseded argument is still interesting.
;	When space is not available, the error return rer is
;	taken.
;
;	The entry RARG can be taken when it is known that
;	sufficient space is available but the pointers still
;	have to be set up.

NARG:	mov	di,cx
	mov	bx,PY		;load end of current argument
	lea	ax,3[bx+di]
	cmp	ax,PZ
	jnb	NRER		;check available space
	cmp	ax,PX
	jb	NRER		;error if ax wraps around 64K
RARG:	mov	dx,PX		;entry if no space check needed
	mov	bx,PY
	mov	[bx],dx		;low byte of closing link
	inc	bx		;on to high byte
	inc	bx		;beginning of new space
	mov	PX,bx		;which is recorded by px
	ret			;and remains in (bx)
NRER:	mov	bx,'DP'
	jmp	FERR		;advise of error and quit


;	(L)  Remove argument from pushdown list. There are no
;	requirements for entry to ucl.  On exit, (cx) remains
;	unchanged, (dx) holds the end of the former argument
;	and (bx) holds the beginning of the former argument -
;	the one that was exposed when the current argument was
;	erased. Erasing non-existent arguments creates an error
;	condition which is noted and ignored.

XLFT:	call	EXCH		;entry point for &L (exchange and lift)
	jmps	UCL

LFTW:	call	UCL		;entry point for LL

UCL:	mov	bx,PX		;pointer to current argument
	dec	bx		;just behind the present
	dec	bx
	mov	dx,[bx]		;argument is the address
	or	dx,dx		;so we always test out of caution
	jz	ULE
	mov	PY,bx		;(bx) now holds end of previous arg.
	mov	PX,dx		;pointer to beginning of prev. arg.
	xchg	bx,dx
	ret
ULE:	call	RER		;record error if pointer was zero

;	Null program for undefined operators.

NOOP:	ret

;	=======================================================
;
;	Some of the service routines, which might be external
;	references in other modules, are:
;
;		oarg	space when reusing an argument
;		NARG	close old argument, space for new
;		rarg	same as NARG when space is assured
;		skp	generic skip
;		rer	return on error
;		rr2	rer after popping two addresses
;		rtn	generic return
;		ucl	lift argument from PDL (L)
;		cucl	lift argument, then skip
;
;	Three entry points can be used according to the variant
;	of the compiling operator C desired.  One of them could
;	also be used by a main program.
;
;		emce	lift pushdown, open block, compile
;		emcx	compile a sequence of subroutines
;
;	=======================================================

	END