Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

; UPD ID= 1810 on 4/4/79 at 4:16 PM by N:<NIXON>
TITLE	STRGEN FOR COBOL V12
SUBTTL	CODE GENERATORS FOR STRING & UNSTRING		C.MCCOMAS



;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1974, 1979 BY DIGITAL EQUIPMENT CORPORATION


	SEARCH	P
	%%P==:%%P

;EDITS
;V12*****************
;NAME	DATE		COMMENTS
;DAW	1-MAR-79	[646] FIX ERROR MESSAGE ALWAYS POINTS TO LINE 371 IF
;			 ERROR WAS IN SUBSCRIPTED "COUNT" ITEM IN UNSTRING.
;DMN	29-NOV-78	[604] PUT OUT CORRECT ERROR MESSAGE ON STRING OF NON-NUMERIC TO NUMERIC.

;V10*****************
;NAME	DATE		COMMENTS
;EHM	12-DEC-77	[524] FIX UNSTRING INTO RECEIVING FIELD WITH  DECIMAL PLACES.
;EHM	8-FEB-77	FIX STRING ERROR "RECEIVING ITEM MAY NOT BE EDITED
;			 OR JUSTIFIED" WHICH COMES OUT AT WRONG PLACE.
;ACK	2-JUN-75	FIX RANDOM ERROR MESSAGES THAT COME OUT SOMETIMES.
;ACK	3-JUN-75	COMP-3/EBCDIC FOR STRING.
;********************

TWOSEG
SALL
RELOC	400000

ENTRY	STRGEN		;STRING
ENTRY	UNSGEN		;UNSTRING

EXTERN	STASHI,STASHL

SUBTTL	GENERATE A "STRING"

COMMENT	\

	GENFIL FOR A STRING LOOKS LIKE:


	SENDING ITEM 1.1
	SENDING ITEM 1.2
	...
	SENDING ITEM 1.I
	DELIMITER 1 (NOT PRESENT IF DELIMITED BY SIZE)
	SDELIM OPERATOR (WITH FLAG 9 ON IF DELIMITED BY SIZE)
	SENDING ITEM 2.1
	SENDING ITEM 2.2
	...
	SENDING ITEM 2.J
	DELIMETER 2 (NOT ...)
	SDELIM OPERATOR (WITH ...)
	...
	SENDING ITEM K.1
	SENDING ITEM K.2
	...
	SENDING ITEM K.L
	DELIMITER K (NOT ...)
	SDELIM OPERATOR (WITH ...)
	RECEIVING ITEM
	POINTER ITEM (OPTIONAL)
	STRNG OPERATOR (WITH FLAG 10 ON IF THE POINTER ITEM IS PRESENT)

\

;ARRIVE HERE ON AN SDELIM OPERATOR
;	FOLLOWED (OPTIONALLY) BY OTHER SDELIM'S WHICH MUST BE FORCIBLY READ
;	AND THEN A STRNG OPERATOR WHICH ALSO MUST BE FORCIBLY READ


STRGEN:	MOVE	W2,W1		;STORE [-1 + W1] IN EOPTAB
	SETO	W1,		;  JUST AFTER OPERANDS FOR THIS SDELIM
	PUSHJ	PP,PUSH12##
	HRRZ	TB,EOPNXT##	;SAVE PTR TO NEXT LOC ON EOPTAB
	ADDI	TB,1
	MOVEM	TB,ARGSTR##	;USE THIS AS TEMP STORE
	PUSHJ	PP,READEM##	;READ NEXT OPERANDS+OPERATOR SET
	CAIN	W2,SDELIM	;ANOTHER SDELIM? OR A STRNG?
	JRST	STRGEN		;SDELIM

	CAIE	W2,	STRNG		;WAS IT REALLY A STRING.
	POPJ	PP,			;NO, FORGET THE WHOLE THING, THE
					; ERROR MESSAGE SHOULD HAVE BEEN
					; GENERATED BY THE SYNTAX SCAN.

	LDB	TB,[POINT 1,W1,10]	;IS THERE A POINTER-ITEM?
	JUMPN	TB,STRG1	;YES
	PUSH	PP,W1		;SAVE STRNG OPERATOR
	MOVNI	W1,2		;STORE [-2 + 0] ON EOPTAB
	PUSHJ	PP,PUSH%T
	POP	PP,W1		;RESTORE STRNG OPERATOR

COMMENT	\

	ALL OPERANDS AND OPERATORS FOR THE STRING HAVE BEEN READ IN.
	EOPTAB NOW LOOKS LIKE:

	SENDING ITEM 1.1
	SENDING ITEM 1.2
	...
	SENDING ITEM 1.I
	DELIMITER 1 (NOT PRESENT IF DELIMITED BY SIZE)
	[-1 + W1]
	SENDING ITEM 2.1
	SENDING ITEM 2.2
	...
	SENDING ITEM 2.J
	DELIMITER 2 (NOT ...)
	[-1 + W1]
	...
	SENDING ITEM K.1
	SENDING ITEM K.2
	...
	SENDING ITEM K.L
	DELIMITER K (NOT ...)
	[-1 + W1]
	RECEIVING ITEM
	POINTER ITEM (OR [-2 + 0] IF THERE WAS NO POINTER ITEM)

\

;BUILD POINTER TO RECEIVING ITEM AND POINTER.

STRG1:	SETZM		M.STR##		;CLEAR SPECIAL SUBSRCIPT FLAG.

	JSP	W2,	SETLST		;GO REMEMBER THE ADDRESS OF THE
					; RECEIVING ITEM.
	PUSHJ	PP,	BLDPTR		;GO BUILD POINTER TO RECEIVING ITEM.
	TSWF	FANUM;			;IF IT'S NUMERIC,
	JRST		STRE1		; IT'S AN ERROR.
	JSP	W2,	SETFST		;GO SET IT UP AS THE B OPERAND
					; AND DO SOME MORE CHECKING.
	HRRZ	TA,	ETABLA##	;GET THE ITEM'S TABLE LINK.
	PUSHJ	PP,	LNKSET##	;MAKE IT AN ADDRESS.
	LDB	TC,	DA.JST##	;IF THE ITEM IS JUSTIFIED
	JUMPN	TC,	STRE5
	LDB	TC,	DA.EDT##	; OR EDITED,
	JUMPN	TC,	STRE5		; COMPLAIN.

	PUSHJ	PP,	BLDPTR		;GO BUILD POINTER TO POINTER ITEM.
	JSP	W2,	CHKPTR		;GO CHECK IT OUT.
	EXP		PTRSIZ		;ADDRESS OF ROUTINE TO CHECK
					; IT'S SIZE.

STRG2:	SETZM	ARGCTR##	;COUNT ARGUMENTS FOR CALL TO STRING ROUTINE
	MOVE	TB,EACC		;FAKE OUT SETUP
	PUSHJ	PP,SETUP##	;AIM AT TOP OF EOPTAB


;BUILD POINTERS TO SOURCES AND DELIMITERS.

	SETOM	M.STR##		;SPECIAL SUBSCRIPTING FOR SRC & DELIM
	HRRZ	TC,CUREOP##	;SET UP PTRS TO ALL SOURCE & DELIM ITEMS

STRG3:	PUSHJ	PP,MAKREL
	CAMN	TA,ARGSTR##	;ARE WE AT RECEIVING-ITEM YET?
	JRST	STRG5		;YES
STRG3A:	AOS	ARGCTR		;COUNT THIS EOP ENTRY
	SETO	TB,		;LOOKING AT AN SDELIM OPERATOR?
	CAMN	TB,(TC)
	JRST	STRG4		;YES
	PUSHJ	PP,	BLDPTR		;GO BUILD THE POINTER AND ARG.
	JRST		STRG3A		;GO DO THE NEXT SOURCE.

STRG4:	MOVE	TB,1(TC)	;GET SDELIM OPERATOR
	TLNE	TB,(1B9)	;IS IT DELIMITED BY SIZE?
	AOS	ARGCTR		;YES
	PUSHJ	PP,	NXTEOP		;BUMP OVER THE SDELIM.
	JRST	STRG3

COMMENT	\
	ALL OF THE ARGS HAVE BEEN BUILT AND ARE IN EOPTAB, WHICH
	LOOKS LIKE:

	ARG FOR SENDING ITEM 1.1
	ARG FOR SENDING ITEM 1.2
	...
	ARG FOR SENDING ITEM 1.I
	ARG FOR DELIMITER 1 (NOT PRESENT IF DELIMITED BY SIZE)
	[-1 + W1]
	ARG FOR SENDING ITEM 2.1
	ARG FOR SENDING ITEM 2.2
	...
	ARG FOR SENDING ITEM 2.J
	ARG FOR DELIMITER 2 (NOT ...)
	[-1 + W1]
	...
	ARG FOR SENDING ITEM K.1
	ARG FOR SENDING ITEM K.2
	...
	ARG FOR SENDING ITEM K.L
	ARG FOR DELIMITER K (NOT ...)
	[-1 + W1]
	ARG FOR RECEIVING ITEM
	ARG FOR POINTER ITEM (OR [-2 + 0] IF THERE IS NO POINTER ITEM)


NOW WE WRITE ALL OF THIS JUNK OUT IN THE FOLLOWING FORMAT:

	MOVEI	16,	%LITNN+M
	PUSHJ	17,	STR./STR.O
	...
	XWD	-P,0	;P IS THE NUMBER OF ARGS IN THE FOLLOWING LIST.
%LITNN+M:	ARG FOR RECEIVING ITEM
	ARG FOR POINTER ITEM (OR XWD 0,0 IF THERE WAS NO POINTER ITEM)
	ARG FOR DELIMITER 1 (OR XWD 0,0 IF IT IS DELIMITED BY SIZE)
	XWD	0,I
	ARG FOR SOURCE 1.1
	ARG FOR SOURCE 1.2
	...
	ARG FOR SOURCE 1.I
	ARG FOR DELIMITER 2 (OR XWD 0,0 IF ...)
	XWD	0,J
	ARG FOR SOURCE 2.1
	ARG FOR SOURCE 2.2
	...
	ARG FOR SOURCE 2.J
	...
	ARG FOR DELIMITER K (OR XWD 0,0 IF ...)
	XWD	0,L
	ARG FOR SOURCE K.1
	ARG FOR SOURCE K.2
	...
	ARG FOR SOURCE K.L	\

STRG5:	MOVN	TB,ARGCTR	;OUTPUT ARG-COUNT
	HRLZI	TB,-2(TB)
	PUSHJ	PP,WRDGEN##
	HRRZ	TB,ELITPC##	;SAVE ADDR OF ARG-LIST
	MOVEM	TB,LITNN##
	MOVEI	TA,STR.##	;OUTPUT MOVEI+PUSHJ
	TLNE	W1,(GWFL9)	;STRING HAVE OVERFLOW CLAUSE?
	MOVEI	TA,STR.O##	;YES
	PUSHJ	PP,CSEQGN##

	PUSHJ	PP,	BLDARG		;TRANSFER THE RECEIVING ARG
					; FROM EOPTAB TO LITAB.

	PUSHJ	PP,	BLDARG		;TRANSFER THE POINTER ARG FROM
					; EOPTAB TO LITAB.

	MOVE	TB,EACC		;FAKE OUT SETUP
	PUSHJ	PP,SETUP

STRG6:	HRRZ	TC,CUREOP##	;ARE WE BACK TO RECEIVING-ITEM YET?
	PUSHJ	PP,MAKREL
	CAMN	TA,ARGSTR##
	JRST	LEAVE		;YES

	MOVEM	TC,M.ARG4##	;SAVE CURRENT POSITION IN OPERAND LIST
	SETZM	ARGCTR		;INIT COUNT OF SOURCE-ITEMS PER DELIMITER
STRG6A:	SETO	TB,		;ARE WE UP TO THE SDELIM?
	CAMN	TB,(TC)
	JRST	STRG7		;YES
	SKIPN		(TC)		;LOOKING AT A NULL ENTRY?
	SKIPE		1(TC)
	AOS	ARGCTR		;NO, COUNT IT
	PUSHJ	PP,	NXTEOP		;MOVE UP TO NEXT OPERAND.
	JRST	STRG6A

STRG7:	MOVE	TB,1(TC)	;GET SDELIM OPERATOR
	TLNN	TB,(1B9)	;IS SIZE FLAG ON?
	JRST	STRG7A		;NO
	SETZM	XWDRH##		;YES, PUT XWD 0,0 IN ARG-LIST
	SETZ	TB,
	PUSHJ	PP,XWDGEN##
	JRST	STRG7C

STRG7A:	SOS	ARGCTR		;DON'T COUNT DELIMITER
STRG7B:	SUBI	TC,2		;AIM AT DELIMITER
	MOVE	TB,(TC)		;LOOKING AT A NULL ENTRY?
	IOR	TB,1(TC)
	JUMPE	TB,STRG7B	;YES, BACK UP SOME MORE
	MOVEM	TC,	CUREOP##	;SET UP FOR BLDARG CALL.
	PUSHJ	PP,	BLDARG		;TRANSFER THE DELIMITER ARG FROM
					; EOPTAB TO LITAB.

STRG7C:	MOVE	TB,ARGCTR	;PUT SOURCE-ITEM COUNT IN ARG-LIST
	MOVEM	TB,XWDRH##
	SETZ	TB,		;ARG-TYPE = 0
	PUSHJ	PP,XWDGEN##

	MOVE	TC,M.ARG4	;RESET TO TOP OF THIS SOURCE-ITEM GROUP
	MOVEM	TC,	CUREOP##
STRG8:	SOSGE	ARGCTR		;ANY MORE SOURCES IN THIS GROUP?
	JRST	STRG9		;NO

STRG8B:	PUSHJ	PP,	BLDARG		;TRANSFER THE SOURCE ITEM ARG
					; FROM EOPTAB TO LITAB.
	JRST	STRG8

STRG9:	ADDI	TC,2		;BUMP OVER SDELIM
	MOVNI	TB,1		;BE SURE IT WAS THE SDELIM
	CAME	TB,-2(TC)
	JRST	STRG9		;NO, MUST HAVE BEEN THE DELIMITER
	MOVEM	TC,CUREOP##	;DO NEXT SOURCE-ITEM GROUP
	JRST	STRG6

SUBTTL	GENERATE AN "UNSTRING"

COMMENT	\

	GENFIL FOR AN UNSTRING LOOKS LIKE:


	DELIMITER ITEM 1 (OPTIONAL)
	UDELIM OPERATOR (OPTIONAL - NOT PRESENT IF DELIMITER ITEM 1 ISN'T)
	DELIMITER ITEM 2 (OPTIONAL)
	UDELIM OPERATOR (OPTIONAL - NOT ...)
	...
	DELIMITER ITEM I (OPTIONAL)
	UDELIM OPERATOR (OPTIONAL - NOT ...)
	RECEIVING ITEM 1
	RECEIVING ITEM 1 DELIMITER (OPTIONAL)
	COUNT ITEM 1 (OPTIONAL)
	UNSDES OPERATOR (WITH FLAG 9 ON IF RECEIVING ITEM 1 DELIMITER IS
		PRESENT AND FLAG 10 ON IF COUNT ITEM 1 IS PRESENT)
	RECEIVING ITEM 2
	RECEIVING ITEM 2 DELIMITER (OPTIONAL)
	COUNT ITEM 2 (OPTIONAL)
	UNSDES OPERATOR (WITH ...)
	...
	RECEIVING ITEM J
	RECEIVING ITEM J DELIMITER (OPTIONAL)
	COUNT ITEM J (OPTIONAL)
	UNSDES OPERATOR (WITH ...)
	SENDING ITEM
	POINTER ITEM (OPTIONAL)
	TALLYING ITEM (OPTIONAL)
	UNSTR OPERATOR (WITH FLAG 10 ON IF POINTER ITEM IS PRESENT AND
		FLAG 11 ON IF TALLYING ITEM  IS PRESENT)

\

;ARRIVE HERE ON A UDELIM OPERATOR OR AN UNSDES OPERATOR
;ADDITIONAL FOLLOWING OPERATORS MUST BE FORCIBLY READ IN
;THE SEQUENCE IS: [UDELIM]...UNSDES[UNSDES]...UNSTR

UNSGEN:	SETZM	ARGCTR		;INIT DELIMITER COUNT
	HRRZ	TB,EOPNXT	;SAVE ADDR OF NEXT EOPTAB ENTRY
	ADDI	TB,1		;  IN CASE UNSDES OPERATOR
	MOVEM	TB,ARGSTR##

;******************************
;THIS IS A TEMPORY PATCH UNTIL I FIGURE OUT WHAT FIXOPS REALLY DOES
; IN THE CASE OF THE FIRST OPTIONAL OPERAND MISSING
; THE CODE DOES NOTHING USEFUL IN ALL CASES I'VE LOOKED AT
; THIS PATCH CLEARS JUNK FROM EOPTAB SO THAT THE LOOKAHEAD AT
; FIXOPS+12 TO FIND SUBSCRIPTS (? WHY ?) DOES NOT PICK UP JUNK

	HLRE	TA,EOPNXT	;GET WHATS LEFT IN EOPTAB
	MOVM	TA,TA
	CAIGE	TA,2		;MAKE SURE THERE IS SOME FREE
	JRST	UNSGZ		;NO, GIVE UP
	ADDI	TB,1		;GET FIRST FREE
	HRLI	TB,1(TB)
	MOVS	TB,TB		;BLT POINTER
	ADD	TA,EOPNXT	;FIND END OF EOPTAB
	SETZM	(TB)		;ZERO FIRST FREE
	BLT	TB,(TA)		;CLEAR OUT JUNK
UNSGZ:

;******************************

	CAIN	W2,UNSDES	;NO UDELIM'S?
	JRST	UNSG1		;NONE
UNSG0:	MOVE	W2,W1		;STORE [-1 + W1] ON EOPTAB
	SETO	W1,		;  TO MARK UDELIM OPERATOR
	PUSHJ	PP,PUSH12
	AOS	ARGCTR		;COUNT THIS DELIMITER
	HRRZ	TB,EOPNXT	;SAVE ADDR OF NEXT EOPTAB ENTRY
	ADDI	TB,1		;  IN CASE UNSDES OPERATOR
	MOVEM	TB,ARGSTR##
	PUSHJ	PP,READEM	;READ NEXT OPERAND+OPERATOR SET
	CAIN	W2,UDELIM	;ANOTHER UDELIM? OR UNSDES?
	JRST	UNSG0		;UDELIM

UNSG1:	CAIE	W2,	UNSDES		;WAS IT REALLY A UNSDES?
	POPJ	PP,			;NO, FORGET THE WHOLE THING, THE
					; ERROR MESSAGE SHOULD HAVE BEEN
					; GENERATED BY THE SYNTAX SCAN.

	HRLZS	ARGCTR		;MOVE DELIM CT TO LH, INIT DEST CT IN RH
UNSG2:	LDB	TB,[POINT 2,W1,10]	;GET DEL-STORE & COUNTER-ITEM FLAGS
	PUSHJ	PP,FIXOPS	;IF NOT BOTH PRESENT, STORE %TEMP PTRS
	MOVE	W2,W1		;STORE [-1 + W1] ON EOPTAB
	SETOI	W1,		;  TO MARK UNSDES OPERATOR
	PUSHJ	PP,PUSH12
	AOS	ARGCTR		;COUNT THIS DESTINATION, DEL-STORE & COUNTER
	HRRZ	TB,EOPNXT	;SAVE ADDR OF NEXT EOPTAB ENTRY
	ADDI	TB,1		;  IN CASE UNSTR OPERATOR
	MOVEM	TB,ARGSTR##
	PUSHJ	PP,READEM	;READ NEXT OPERAND+OPERATOR SET
	CAIN	W2,UNSDES	;ANOTHER UNSDES? OR UNSTR?
	JRST	UNSG2		;UNSDES

	CAIE	W2,	UNSTR		;WAS IT REALLY AN UNSTR?
	POPJ	PP,			;NO, FORGET THE WHOLE THING, THE
					; ERROR MESSAGE SHOULD HAVE BEEN
					; GENERATED BY THE SYNTAX SCAN.

	LDB	TB,[POINT 2,W1,11]	;GET POINTER & TALLY-ITEM FLAGS
	PUSHJ	PP,FIXOPS	;IF NOT BOTH, STORE %TEMP PTRS

COMMENT	\

	ALL OF THE OPERANDS AND OPERATORS FOR THE UNSTRING HAVE BEEN READ IN.
	EOPTAB NOW LOOKS LIKE:

	DELIMITER ITEM 1 (OPTIONAL)
	[-1 + W1] (OPTIONAL - NOT PRESENT IF DELIMITER ITEM 1 ISN'T)
	DELIMITER ITEM 2 (OPTIONAL)
	[-1 + W1] (OPTIONAL - NOT ...)
	...
	DELIMITER ITEM I (OPTIONAL)
	[-1 + W1] (OPTIONAL - NOT ...)
	RECEIVING ITEM 1
	RECEIVING ITEM 1 DELIMITER (OR [-2 + 0] IF THERE WAS NO
				RECEIVING ITEM 1 DELIMITER)
	COUNT ITEM 1 (OR [-2 + 0] IF THERE WAS NO COUNT ITEM 1)
	[-1 + W1]
	RECEIVING ITEM 2
	RECEIVING ITEM 2 DELIMITER (OR [-2 + 0] IF ...)
	COUNT ITEM 2 (OR [-2 + 0] IF ...)
	[-1 + W1]
	...
	RECEIVING ITEM J
	RECEIVING ITEM J DELIMITER (OR [-2 + 0] IF ...)
	COUNT ITEM J (OR [-2 + 0] IF ...)
	[-1 + W1]
	SENDING ITEM
	POINTER ITEM (OR [-2 + 0] IF THERE WAS NO POINTER ITEM.)
	TALLYING ITEM (OR [-2 + 0] IF THERE WAS NO TALLYING ITEM)

\

;BUILD POINTER TO SENDING ITEM AND POINTER.

	SETZM		M.STR##		;CLEAR SPECIAL SUBSCRIPT FLAG.

	JSP	W2,	SETLST		;GO REMEMBER THE ADDRESS OF THIS ITEM.
	SETOM		NODPPF##	;TELL BLDPTR ROUTINE TO DISALLOW DECIMAL
					; PLACES
	PUSHJ	PP,	BLDPTR		;GO BUILD POINTER TO SENDING ITEM.
	JSP	W2,	SETFST		;GO SET THIS ITEM UP AS THE B OPERAND
					; AND DO SOME MORE CHECKING.
	MOVE	TB,	ESIZEB##	;GET THE ITEM'S SIZE.
	MOVEM	TB,	M.ARG3##	;SAVE IT FOR CHECKING COUNT ITEMS.

	PUSHJ	PP,	BLDPTR		;GO BUILD POINTER TO POINTER-ITEM.
	JSP	W2,	CHKPTR		;GO CHECK IT OUT.
	EXP		PTRSIZ		;ADDRESS OF ROUTINE TO CHECK ITS SIZE.

	PUSHJ	PP,	BLDPTR		;GO BUILD POINTER TO TALLY ITEM.
	JSP	W2,	CHKPTR		;GO CHECK IT OUT.
	EXP		TLYSIZ		;ADDRESS OF ROUTINE TO CHECK ITS SIZE.

;BUILD POINTERS TO DELIMITERS, DESTINATIONS, DELIMITER STORES AND COUNTS.

UNSG3:	MOVE	TB,EACC		;FAKE OUT SETUP
	PUSHJ	PP,SETUP	;AIM AT TOP OF EOPTAB

	SETOM	M.STR		;SPECIAL SUBSCRIPTING FOR DELIMITERS,
				; DESTINATIONS, ...
	HRRZ	TC,CUREOP	;SET UP PTRS TO DEST, DEL-ST & COUNT ITMS

;BUILD POINTERS TO DELIMITERS.

	HLRZ	TB,	ARGCTR##	;GET # OF DELIMITERS.
	JUMPE	TB,	UNSG4		;IF THERE AREN'T ANY, GO ON.
	MOVEM	TB,	M.ARG5##	;SAVE DELIMITER COUNT.

UNSG3N:	PUSHJ	PP,	BLDPTR		;GO BUILD THE POINTER TO THE DELIMITER.

	PUSHJ	PP,	NXTEOP		;SKIP OVER THE UDELIM OPERATOR.

	SOSLE		M.ARG5##	;IF THERE ARE MORE DELIMITERS,
	JRST		UNSG3N		; GO GENERATE THEIR POINTERS.

;BUILD POINTERS TO THE DESTINATIONS, DELIMITER STORES AND COUNT ITEMS.

UNSG4:	HRRZ	TB,	ARGCTR##	;GET # OF DESTINATIONS.
	MOVEM	TB,	M.ARG5##	;SAVE IT (MUST BE AT LEAST 1).
	MOVE	TB,	M.ARG3##	;GET THE SIZE OF THE SOURCE.
	MOVEM	TB,	ESIZEB##	;PUT IT WHERE PTRSIZ CAN FIND IT.

UNSG4N:	PUSHJ	PP,	BLDPTR		;GO BUILD POINTER TO DESTINATION.

	PUSHJ	PP,	BLDPTR		;GO BUILD POINTER TO DELIMITER-STORE.
	TRNA				;WE RETURN TO CALL+2 IF THERE IS
	JFCL				; NO DELIMITER-STORE.

	PUSHJ	PP,	BLDPTR		;GO BUILD POINTER TO COUNT ITEM.
	JSP	W2,	CHKPTR		;GO CHECK IT OUT.
	EXP		PTRSIZ+1	;ADDRESS OF ROUTINE TO CHECK ITS SIZE.

	PUSHJ	PP,	NXTEOP		;SKIP OVER UNSDES.

	SOSLE		M.ARG5##	;IF THERE ARE MORE DESTINATIONS,
	JRST		UNSG4N		; GO GENERATE THEIR POINTERS.

COMMENT	\

	ALL OF THE ARGS HAVE BEEN BUILT AND ARE IN EOPTAB, WHICH LOOKS LIKE:

	ARG FOR DELIMITER ITEM 1 (OPTIONAL)
	[-1 + W1] (OPTIONAL - NOT PRESENT IF DELIMITER ITEM 1 ISN'T)
	ARG FOR DELIMITER ITEM 2 (OPTIONAL)
	[-1 + W1] (OPTIONAL - NOT ...)
	...
	ARG FOR DELIMITER ITEM I (OPTIONAL)
	[-1 + W1] (OPTIONAL - NOT ...)
	ARG FOR RECEIVING ITEM 1
	ARG FOR RECEIVING ITEM 1 DELIMITER (OR [-2 + 0] IF THERE WAS NO
				DELIMITER FOR RECEIVING ITEM 1)
	ARG FOR COUNT ITEM 1 (OR [-2 + 0] IF THERE WAS NO COUNT ITEM 1)
	[-1 + W1]
	ARG FOR RECEIVING ITEM 2
	ARG FOR RECEIVING ITEM 2 (OR [-2 + 0] IF ...)
	ARG FOR COUNT ITEM 2 (OR [-2 + 0] IF ...)
	[-1 + W1]
	...
	ARG FOR RECEIVING ITEM J
	ARG FOR RECEIVING ITEM J DELIMITER (OR [-2 + 0] IF ...)
	ARG FOR COUNT ITEM J (OR [-2 + 0] IF ...)
	[-1 + W1]
	ARG FOR SENDING ITEM
	ARG FOR POINTER ITEM (OR [-2 + 0] IF THERE WAS NO POINTER ITEM)
	ARG FOR TALLYING ITEM (OR [-2 + 0] IF THERE WAS NO TALLYING ITEM)

NOW WE WRITE ALL OF THIS JUNK OUT IN THE FOLLOWING FORMAT:

	MOVEI	16,	%LITNN+M
	PUSHJ	17,	UNS./UNS.O
	...
	XWD	-P,0		;P IS THE NUMBER OF ARGS IN THE FOLLOWING LIST.
%LITNN+M:	ARG FOR SENDING ITEM
	ARG FOR POINTER ITEM (OR XWD 0,0 IF THERE IS NO POINTER ITEM)
	ARG FOR TALLYING ITEM (OR XWD 0,0 IF THERE IS NO TALLYING ITEM)
	XWD	0,2*I
	ARG FOR DELIMITER 1
	ALL FLAG FOR DELIMITER 1
	ARG FOR DELIMITER 2
	ALL FLAG FOR DELIMITER 2
	...
	ARG FOR DELIMITER I
	ALL FLAG FOR DELIMITER I
	ARG FOR RECEIVING ITEM 1
	ARG FOR RECEIVING ITEM 1 DELIMITER (OR XWD 0,0 IF THERE IS NO
			RECEIVING ITEM 1 DELIMITER)
	ARG FOR COUNT ITEM 1 (OR XWD 0,0 IF THERE IS NO COUNT ITEM 1)
	ARG FOR RECEIVING ITEM 2
	ARG FOR RECEIVING ITEM 2 DELIMITER (OR XWD 0,0 IF ...)
	ARG FOR COUNT ITEM 2 (OR XWD 0,0 IF ...)
	...
	ARG FOR RECEIVING ITEM J
	ARG FOR RECEIVING ITEM J DELIMITER (OR XWD 0,0 IF ...)
	ARG FOR COUNT ITEM J (OR XWD 0,0 IF ...)

\

UNSG5:	HLRZ	TB,ARGCTR	;GET # OF DELIMITERS
	ASH	TB,1		;COUNT "ALL FLAG" ARGS
	HRRZ	TA,ARGCTR	;GET # OF DEST, ETC, ARGS
	IMULI	TA,3
	ADDI	TB,4(TA)	;TOTAL PLUS SRC, PTR, TALLY & DEL-COUNT
	MOVNI	TB,(TB)
	HRLZI	TB,(TB)		;OUTPUT WORD COUNT FOR ARG-LIST
	PUSHJ	PP,WRDGEN##
	HRRZ	TB,ELITPC	;SAVE ADDR OF ARG-LIST
	MOVEM	TB,LITNN
	MOVEI	TA,UNS.##	;OUTPUT MOVEI+PUSHJ
	TLNE	W1,(GWFL9)	;UNSTRING HAVE OVERFLOW CLAUSE?
	MOVEI	TA,UNS.O##	;YES
	PUSHJ	PP,CSEQGN

	HRRZ	TC,CUREOP	;AIM AT SOURCE ITEM
	PUSHJ	PP,	BLDARG		;GENERATE IT'S ARG.

	PUSHJ	PP,	BLDARG		;GENERATE THE POINTER'S ARG.

	PUSHJ	PP,	BLDARG		;GENERATE THE TALLY'S ARG.

	MOVE	TB,EACC		;FAKE OUT SETUP
	PUSHJ	PP,SETUP

	HLRZ	TB,ARGCTR	;OUTPUT "XWD 0,2*<# OF DELIMITERS>"
	ASH	TB,	1
	MOVEM	TB,XWDRH##
	SETZ	TB,
	PUSHJ	PP,XWDGEN##

	HLRZ	TB,ARGCTR	;INIT CTR FOR DELIMITERS
	JUMPE	TB,UNSG7	;THERE AREN'T ANY DELIMITERS
	MOVEM	TB,M.ARG5##
	HRRZ	TC,CUREOP
UNSG6:	PUSHJ	PP,	BLDARG		;PUT OUT ARG FOR DELIMITER.
	MOVE	TA,1(TC)	;GET UDELIM OPERATOR
	SETZB	TB,XWDRH##	;ASSUME NO 'ALL FLAG'
	TLNE	TA,(GWFL9)	;IS 'ALL FLAG' ON?
	AOS	XWDRH##		;YES
	SETZ	TB,		;OUTPUT "XWD 0,ALL-FLAG"
	PUSHJ	PP,XWDGEN##
	PUSHJ	PP,NXTEOP	;BUMP TO NEXT OPERAND
	SOSLE	M.ARG5		;MORE UDELIM'S?
	JRST	UNSG6		;YES

UNSG7:	HRRZ	TB,ARGCTR	;INIT CTR FOR DESTINATIONS
	MOVEM	TB,M.ARG5

UNSG8:	PUSHJ	PP,	BLDARG		;GENERATE THE DESTINATION ARG.

	PUSHJ	PP,	BLDARG		;GENERATE THE DEST-DELIM ARG.

	PUSHJ	PP,	BLDARG		;GENERATE COUNT ARG.
	PUSHJ	PP,NXTEOP	;SKIP UNSDES OPERATOR

	SOSLE	M.ARG5		;ANY MORE DESTINATIONS?
	JRST	UNSG8

LEAVE:	SETZM	M.STR		;FINISHED WITH SPECIAL SUBSCRIPT MODE
	POPJ	PP,

	SUBTTL	ERROR ROUTINES.

STRE1:	MOVEI	DW,E.373	;[604] ?IMPROPER USAGE
	JRST	FATAL##
STRE2:	MOVEI	DW,E.264	;?NOT AN INTEGER DATA ITEM
	JRST	FATAL##
STRE3:	MOVEI	DW,E.464	;?CANNOT BE AN EDITED ITEM
	JRST	FATAL##
STRE4:	MOVEI	DW,E.465	;?PTR/CTR TOO SMALL
	JRST	FATAL##
STRE5:	MOVEI	DW,E.577	;?RECEIVING ITEM MAY NOT BE EDITED OR JUSTIFIED.
	LDB	LN,W1LN##	;[463]GET LINE NUMBER
	LDB	CP,W1CP##	;[463] GET CHARACTER POSITION.
	JRST	FATAL##

SUBTTL	SUBROUTINES

;ASSUME TC=CUREOP(RH)
;THEN CONVERT IT TO RELATIVE AND SAVE IN M.ARG1

MAKREL:	HRRZI	TA,(TC)
	HRRZ	TB,EOPLOC##
	SUBI	TA,(TB)
	MOVEM	TA,M.ARG1##
	POPJ	PP,

;SKIP OVER NULLS TO NEXT EOPTAB ENTRY
;RETURNS WITH NEW ADDR IN CUREOP (COULD BE END OF EOPTAB)

NXTEOP:	HRRZ	TB,EOPNXT	;GET PTR TO LAST USED
NEOP1:	HRRZ	TC,CUREOP	;AIM AT NEXT WORD PAIR
	ADDI	TC,2
	MOVEM	TC,CUREOP
	CAIL	TC,(TB)		;AT END?
	POPJ	PP,		;YES
	MOVE	TD,(TC)		;LOOKING AT A PAIR OF 0'S?
	IOR	TD,1(TC)
	JUMPE	TD,NEOP1	;YES,  SKIP IT
	POPJ	PP,

;CLEAR SUBSCRIPTS FROM EOPTAB ENTRY

CLRSUB:	HRRZ	TC,EOPLOC	;MAKE PTR TO ENTRY
	ADD	TC,M.ARG1	;(USING OUTPUT OF PTRGEN)
	MOVE	TA,	M.ARG2##	;GET SUBSCRIPT COUNT.
	JUMPE	TA,CPOPJ##	;EXIT IF NO SUBSCRIPT
	IMULI	TA,2
	HRRI	TB,3(TC)	;MAKE BLT AC
	HRLI	TB,-1(TB)
	ADDI	TA,-2(TB)	;FIX PTR TO END OF LIST
	SETZM	2(TC)		;ZAP
	BLT	TB,(TA)
	POPJ	PP,

;SPECIAL ROUTINE USED BY UNSGEN
;  TO PROCESS BOTH UNSDES OPERATOR AND UNSTR OPERATOR
;EACH OF THESE OPERATORS HAS 1 REQUIRED AND 2 OPTIONAL OPERANDS
;IF EITHER OPERAND IS MISSING, [-2 + 0] IS STORED IN EOPTAB
;AT ENTRY,
;  ARGSTR CONTAINS THE ADDR OF THE REQUIRED OPERAND
;  W1 CONTAINS THE CURRENT OPERATOR (WHICH MUST BE PRESERVED)
;	IF BIT 34 OF TB IS 0 THE FIRST OPTIONAL OPERAND IS MISSING.
;	IF BIT 35 OF TB IS 0 THE SECOND OPTIONAL OPERAND IS MISSING.

FIXOPS:	CAIN	TB,3		;BOTH OPERANDS PRESENT?
	POPJ	PP,		;YES

	PUSH	PP,W1		;NO, SAVE OPERATOR
	MOVNI	W1,	2		;SET UP W1.
	TRNN	TB,	3		;ARE BOTH OPERANDS MISSING?
	JRST		FIXOP2		;YES, GO STORE TWO [-2 + 0]'S
	SOJN	TB,	FIXOP3		;IF THE SECOND OPERAND IS MISSING,
					; GO STORE ONE [-2 + 0]

				;FIRST OPERAND IS MISSING.
	PUSHJ	PP,PUSH12	;  MAKE ROOM FOR 2 MORE WORDS ON EOPTAB
	HRRZ	TC,ARGSTR##	;GET ADDR OF REQUIRED OPERAND
	HLRZ	TB,1(TC)	;GET ITS SUBSCRIPT COUNT
	IMULI	TB,2
	ADDI	TC,2(TB)	;SKIP TO 2ND
	HLRZ	TB,1(TC)	;GET 2ND'S SUBSCRIPT COUNT
	MOVNI	TB,1(TB)	;COUNT TOTAL # ENTRIES TO MOVE UP
	HRLZI	TB,(TB)		;CTR TO LH
	HRRI	TB,(TC)		;POINTER FOR MOVE-UP
	MOVE	TA,(TB)		;INIT THE MOVE-UP
	MOVE	TD,1(TB)
FIXOP1:	EXCH	TA,2(TB)	;MOVE UP A WORD PAIR
	EXCH	TD,3(TB)
	AOJ	TB,
	AOBJN	TB,FIXOP1

	MOVEM	W1,	(TC)		;CAN'T USE PUSH%T, CAUSE WE'RE IN THE
	SETZM		1(TC)		; MIDDLE OF THE TABLE.
	JRST	FIXOP4

FIXOP2:	PUSHJ	PP,PUSH%T	;STORE [-2 + 0] ON EOPTAB AS 1ST OPERAND.
FIXOP3:	PUSHJ	PP,PUSH%T	;STORE [-2 + 0] ON EOPTAB AS 2ND OPERAND.
FIXOP4:	POP	PP,W1		;RESTORE OPERATOR
	POPJ	PP,

;STORE W1 AND A 0 ON EOPTAB

PUSH%T:	JFFO	W1,PUSH12##

COMMENT	\

	SUBROUTINE TO CHECK AND REMEMBER THE COMMON CHARACTERISTICS OF
THE PRINCIPAL OPERAND FOR THE OPERATION.  FOR STRING THIS IS THE
RECEIVING ITEM AND FOR UNSTRING IT IS THE SENDING ITEM.

CALL:
	JSP	W2,	SETFST

ENTRY CONDITIONS:
	THE OPERAND HAS BEEN SET UP AS THE A OPERAND.
	(TB) = THE MODE OF THE OPERAND.

EXIT CONDITIONS:
	THE OPERAND IS SET UP AS THE B OPERAND.
	TB IS DESTROYED.

RETURNS:
	IF NO ERRORS ARE ENCOUNTERED WE RETURN TO CALL+1 OTHERWISE,
WE DISPLATCH TO THE APPROPRIATE ERROR ROUTINE WHICH WILL LEAVE STRGEN,
VIA POPJ PP, NEVER TO RETURN.

\

SETFST:	CAILE	TB,	DSMODE##	;IF IT'S NOT DISPLAY,
	JRST		STRE1		; IT'S AN ERROR.

	MOVE	TB,	[XWD	EBASEA##,EBASEB##]	;COPY A INTO B.
	BLT	TB,	EBASBX##

	SWOFF	FBSIGN!FBNUM!FBSUB;	;COPY THE FLAGS TOO.
	TSWF	FASIGN;
	SWON	FBSIGN;
	TSWF	FANUM;
	SWON	FBNUM;

;DON'T BOTHER COPYING THE SUBSCRIPT FLAG.

	JRST		(W2)		;RETURN.

COMMENT	\
	SUBROUTINE TO REMEMBER THE RELATIVE EOPTAB ADDRESS OF THE FIRST
OPERAND FOLLOWING THE OPERATOR WHICH PRECEEDED THE TERMINATING OPERATOR.
FOR STRING, THIS IS THE RECEIVING ITEM'S ADDRESS AND FOR UNSTRING THIS
IS THE SENDING ITEM'S ADDRESS.

CALL:
	JSP	W2,	SETLST

ENTRY CONDITIONS:
	(ARGSTR) = ABSOLUTE EOPTAB ADDRESS.

EXIT CONDITIONS:
	(ARGSTR) = RELATIVE EOPTAB ADDRESS.
	(CUREOP) = ABSOLUTE EOPTAB ADDRESS.

RETURNS:
	ALWAYS TO CALL+1.

\

SETLST:	HRRZ	TC,	ARGSTR##	;GET THE ABS ADDRESS.
	MOVEM	TC,	CUREOP##	;SAVE IT.
	PUSHJ	PP,	MAKREL		;MAKE IT RELATIVE.
	MOVEM	TA,	ARGSTR##	;SAVE IT.
	MOVE	TB,	(TC)		;MAKE SURE THIS OPERAND ISN'T
	TLNN	TB,	GNLIT!GNFIGC	; A LITERAL OR A FIGURATIVE
	JRST		(W2)		; CONSTANT.

	MOVEI	DW,	E.373		;IT IS, COMPLAIN.
	JRST		OPNFAT##

COMMENT	\

	SUBROUTINE TO CHECK THE CHARACTERISTICS OF AN ITEM WHICH IS 
GOING TO RECEIVE A COUNT (EG., A POINTER, COUNT OR TALLY ITEM.)

CALL:
	JSP	W2,	CHKPTR
	EXP		<RTN>

WHERE:
	<RTN> IS THE ENTRY TO SOME OTHER ROUTINE WHICH WILL CHECK THE
ITEM'S SIZE AND RETURN TO OUR CALLER VIA JRST (W2), IF IT IS ACCEPTABLE
OR GO GENERATE AN ERROR AND LEAVE STRGEN, VIA POPJ PP, IF IT ISN'T.

ENTRY CONDITIONS:
	THE ITEM TO BE CHECKED IS THE A OPERAND.
	(TB) = THE MODE OF THE OPERAND.

EXIT CONDITIONS:
	NONE.

RETURNS:
	IF NO ERRORS ARE ENCOUNTERED, CALL+1 OTHERWISE WE DISPATCH TO
THE APPROPRIATE ERROR ROUTINE WHICH WILL LEAVE STRGEN, VIA POPJ PP,
NEVER TO RETURN.

\

CHKPTR:	TSWF	FANUM;			;IF IT'S NOT NUMERIC OR
	SKIPE		EDPLA##		; HAS DECIMAL PLACES,
	JRST		STRE2		; IT'S AN ERROR.

	CAIN	TB,	EDMODE##	;IF IT'S EDITED,
	JRST		STRE3		; IT'S AN ERROR.

	AOJA	W2,	@(W2)		;GO CHECK THE SIZE.

COMMENT	\
	ROUTINE TO CHECK THE SIZE OF UNSTRING'S TALLYING ITEM.

CALL:
	JSP	W2,	TLYSIZ

ENTRY CONDITIONS:
	THE MODE OF THE OPERAND IS IN EMODEA
	THE NUMBER OF DIGITS IN THE TALLYING ITEM IS IN ESIZEA.
	THE NUMBER OF SOURCE ITEMS IS IN RH(ARGCTR)

EXIT CONDITIONS:
	ESIZEB AND TB ARE DESTROYED.

RETURNS:
	IF THE SIZE IS OK WE RETURN TO CALL+1 OTHERWISE WE DISPATCH TO
THE APPROPRIATE ERROR ROUTINE WHICH WILL LEAVE STRGEN, VIA POPJ PP,
NEVER TO RETURN.
\
TLYSIZ:	HRRZ	TB,	ARGCTR##	;GET NUMBER OF SOURCES.
	MOVEM	TB,	ESIZEB##	;PUT IT WHERE PTRSIZ CAN FIND IT.
	SKIPA	TB,	EMODEA##	;GET THE OPERAND'S MODE AND FALL
					; INTO PTRSIZ, BUT SKIP THE
					; AOS ESIZEB.

COMMENT	\
	ROUTINE TO CHECK THE SIZE OF A POINTER ITEM OR A COUNT ITEM.

CALL:
	JSP	W2,	PTRSIZ

ENTRY CONDITIONS:
	THE NUMBER OF DIGITS IN THE POINTER OR COUNT IS IN ESIZEA.
	THE LARGEST NUMBER, LESS ONE, THAT THE POINTER MUST BE CAPABLE
OF HOLDING IS IN ESIZEB.

EXIT CONDITIONS:
	ESIZEB AND TB ARE DESTROYED.

RETURNS:
	SAME AS TLYSIZ.
\
PTRSIZ:	AOS		ESIZEB		;THE ITEM HAS TO BE ABLE TO HOLD
					; AT LEAST (ESIZEB).
	CAIE	TB,	FPMODE##	;COMP-1
	CAIN	TB,	F2MODE##	;OR COMP-2
	JRST		(W2)		; WILL ALWAYS BE BIG ENOUGH.
	HRRZ	TB,	ESIZEA		;GET THE NUMBER OF DIGITS.
	CAIL	TB,	^D10		;TEN OR MORE IS ALWAYS ENOUGH.
	JRST		(W2)
	MOVE	TB,	POWR10##(TB)	;SEE WHAT THE LARGEST NUMBER IT
					; WILL HOLD IS.
	CAMG	TB,	ESIZEB		;IF IT'S TOO SMALL IT'S AN
	JRST		STRE4		; ERROR.
	JRST		(W2)		;ALL IS WELL, RETURN.

COMMENT	\

	ROUTINE TO BUILD A POINTER.

CALL:
	PUSHJ	PP,	BLDPTR

ENTRY CONDITIONS:
	(CUREOP) = EOPTAB ADDRESS OF OPERAND.

EXIT CONDITIONS:
	(TB) = MODE OF OPERAND.
	PARAMETERS HAVE BEEN BUILT AND THEIR ARG IS IN EOPTAB.
	(CUREOP) = EOPTAB ADDRESS OF NEXT OPERAND.
	TA, TB, TC, TD, TE MAY BE GARBAGED.

RETURNS:
	IF THERE WAS A PARAMETER AND NO ERRORS WERE ENCOUNTERED WE
RETURN TO CALL+1.
	IF THERE WASN'T A PARAMETER (INDICATED BY [-2 + 0] IN EOPTAB
WE RETURN TO CALL+3.
	IF ANY ERRORS ARE ENCOUNTERED WE RETURN TO CALLER'S CALLER.

\

BLDPTR:	HRRZ	TC,	CUREOP##	;PICK UP EOPTAB ADDRESS OF OPERAND.
	HRREI	TB,	-2		;IS THERE AN OPERAND?
	CAME	TB,	(TC)
	JRST		BLDPTG		;YES, GO ON.

;NO OPERAND, RETURN TO CALL+3.

	SETZM		NODPPF##	;CLEAR A FLAG
	PUSHJ	PP,	NXTEOP		;BUMP UP TO NEXT OPERAND.
	POP	PP,	TB
	JRST		2(TB)

;PROCESS THE OPERAND.

BLDPTG:	PUSH	PP,	EREXIT		;SETOPA SOMETIMES POP'S OFF
					; A RETURN IF IT FINDS AN ERROR
					; SO FORCE IT THROUGH OUR ERROR
					; EXIT, IF IT DOES SO.
	PUSHJ	PP,	SETOPA##	;GO SET UP THE OPERAND.
	POP	PP,	TC		;GET RID OF ERROR EXIT.
	TSWF	FERROR;			;ANY OTHER PROBLEMS?
EREXIT:	JRST		SLEAVE		;YES, RETURN TO CALLER'S CALLER.

	MOVE	TA,	ETABLA##	;IF THE ITEM IS EDITED, MAKE
	LDB	TB,	LNKCOD##	; SURE WE USE THE EXTERNAL
	CAIE	TB,	CD.DAT		; SIZE.
	JRST		BLDPTI
	PUSHJ	PP,	LNKSET##
	LDB	TB,	DA.EDT##
	JUMPE	TB,	BLDPTI
	LDB	TB,	DA.EXS##
	MOVEM	TB,	ESIZEA##

BLDPTI:	MOVE	TC,	CUREOP##	;ASSUME THAT WE WILL DETECT
	LDB	CP,	[POINT	7,(TC),35]	; AN ERROR LATER ON.
	LDB	LN,	[POINT	13,(TC),28]

	SKIPN		NODPPF		;DISALLOW DECIMAL PLACES?
	 JRST		BLDPTJ		;NO
	SETZM		NODPPF		;CLEAR FLAG
	SKIPN		EDPLA		;ANY?
	 JRST		BLDPTJ		;NO, ALL OK
	SKIPG		EDPLA
	 SKIPA		DW,[E.604]	;NEG DEC. PLACES = P-SHIFTED
	MOVEI		DW,E.96		;?DEC PLACES NOT ALLOWED
	PUSHJ	PP,	FATAL##
	SETZM		EDPLA		;PRETEND ZERO DECIMAL PLACES

BLDPTJ:	HRRZ	TC,	CUREOP##	;SAVE THE RELATIVE EOPTAB ADDRESS
	PUSHJ	PP,	MAKREL		; IN CASE EOPTAB MOVES.

	TSWF	FASUB;			;ANY SUBSCRIPTS?
	JRST		BLDPSU		;YES, GO WORRY OVER THEM.
	SETZM		M.ARG2##	;CLEAR THE SUBSCRIPT COUNT.

	MOVE	TB,	EMODEA##	;SEE WHAT WE GOT.
	CAIN	TB,	LTMODE##	;IF IT'S A LITERAL
	PUSHJ	PP,	BLDLIT		; GO PUT IT IN LITAB.
	CAIN	TB,	FCMODE##	;IF IT'S A FIGURATIVEC CONSTANT,
	PUSHJ	PP,	BLDFGC		; GO MAKE IT INTO SOMETHING REASONABLE.

COMMENT	\

	THE FOLLOWING ROUTINES WILL BUILD THE POINTER FOR THE OPERAND.
	THE POINTER LOOKS LIKE:

	<BYTE POINTER> OR <SUBSCRIPT BLOCK>
	BYTE (1)0(4)<TYPE>(1)0,<SEPFLG>,<NUMFLG>,<SGNFLG>,0,<JSTFLG>(1)0(1)<SDECPL>(5)<DECPLC>(18)<SIZE>

WHERE:
	<BYTE POINTER> IS A BYTE POINTER TO THE ITEM.
	<SUBSCRIPT BLOCK> IS THE PARAMETER BLOCK FOR A CALL TO SUBSCR.
	<TYPE> IS THE MODE OF THE OPERAND.
	<SEPFLG> IS 1 IF THE OPERAND'S SIGN IS SEPARATE
	<NUMFLG> IS 1 IF THE OPERAND IS NUMERIC.
	<SGNFLG> IS 1 IF THE OPERAND IS SIGNED.
	<JSTFLG> IS 1 IF THE OPERAND IS RIGHT JUSTIFIED.
	<SDECPL> IS THE SIGN OF THE NO. OF DECIMAL PLACES
	<DECPLC> IS THE NUMBER (MAGNITUDE) OF DECIMAL PLACES
	<SIZE> IS THE SIZE OF THE OPERAND IN BYTES OR DIGITS.

\

BLDPTK:	MOVE	TA,	[XWD	BYTLIT##,2]	;BUILD THE BYTE POINTER.
	PUSHJ	PP,	STASHI
	PUSHJ	PP,	MBYTEA##

	AOS	TA,	ELITPC##	;REMEMBER WHERE WE PUT IT.
	ADD	TA,	[XWD	AS.MSC##,AS.LIT##-1]
	MOVSM	TA,	M.ARGP##

BLDPTM:	MOVE	TA,	[XWD	OCTLIT##,1]	;WE'RE GOING TO PUT THE
	PUSHJ	PP,	STASHI		; DESCRIPTOR WORD IN LITAB.
	PUSHJ	PP,	BLDDSC		;GO BUILD IT.
	PUSHJ	PP,	STASHL##	;GO PUT IT IN LITAB.
	AOS		ELITPC##	;BUMP THE PC.

BLDPTN:	HRRZ	TC,	EOPLOC##	;GET OUR ABSOLUTE EOPTAB LOCATION
	ADD	TC,	M.ARG1##	;(EOPTAB MAY HAVE MOVED ON US.)
	MOVEM	TC,	CUREOP##

	MOVE	TB,	[Z	15,AS.CNB##]	;SET ARG TYPE AS 15.
	TSWF	FASUB;			;IF THE ITEM IS SUBSCRIPTED
	SKIPN		M.STR##		; AND WE'RE DOING A SPECIAL
	TRNA				; SUBSCRIPT ITEM, CHANGE IT
	TLO	TB,	(1B8)		; TO 35.

	MOVEM	TB,	(TC)		;SET UP FOR RETURN.
	MOVE	TB,	M.ARGP##
	MOVEM	TB,	1(TC)

	PUSHJ	PP,	CLRSUB		;GET RID OF SUBSCRIPT JUNK.
	PUSHJ	PP,	NXTEOP		;SKIP UP TO NEXT OPERAND.
BLDPTP:	MOVE	TB,	EMODEA##	;GET OPERAND'S MODE.
	POPJ	PP,			;RETURN.

;OPERAND IS SUBSCRIPTED.

BLDPSU:	HLRZ	TB,	1(TC)		;GET THE SUBSCRIPT COUNT.
	MOVEM	TB,	M.ARG2##	;SAVE IT FOR LATER.
	HRLI	TC,	2(TC)		;SET UP "OPERND".
	MOVSM	TC,	OPERND##

	PUSH	PP,	LN		;[646] SAVE LINE NUMBER OF OPERAND
	PUSH	PP,	CP		;[646] AND CHARACTER POSITION
	PUSHJ	PP,	SUBSCA##	;DO THE SUBSCRIPT THING.
	POP	PP,	CP		;[646] RESTORE CURRENT OPERAND'S CP
	POP	PP,	LN		;[646] RESTORE LINE NUMBER
	TSWT	FASUB;			;WERE THE SUBSCRIPTS LITERALS?
	JRST		BLDPTK		;YES, SKIP THIS MESS.

	SKIPE	TA,	M.STR##		;SPECIAL SUBSCRIPTING REQUIRED?
	JRST		BLDPSS		;YES, GO WORRY OVER IT.

;THE PARAMETER IS GOING TO END UP IN %PARAMS.

	MOVE	CH,	[XWD	AS.OCT##,2]	;PUT OUT OCT 0 AND THE
	PUSHJ	PP,	PUTAS1##		; DESCRIPTOR WORD.
	SETZI	CH,
	PUSHJ	PP,	PUTAS1##

	PUSHJ	PP,	BLDDSC		;GO BUILD THE DESCRIPTOR WORD.
	MOVE	CH,	TA
	PUSHJ	PP,	PUTAS1##

	MOVEI	TA,	2		;BUMP THE PC.
	ADDB	TA,	EAS1PC##
	ADD	TA,	[XWD	AS.MSC##,AS.PAR##-2]	;REMEMBER WHERE
	MOVSM	TA,	M.ARGP##			; WE PUT IT.

;GENERATE "MOVEM	12,	%PARM+N".

	MOVE	CH,	[XWD	MOVEM.##+ASINC+500,AS.MSC##]
	PUSHJ	PP,	PUTASY##
	HLRZ	CH,	M.ARGP##
	PUSHJ	PP,	PUTASN##

	JRST		BLDPTN		;GO FINISH UP.

;SPECIAL SUBSCRIPTING IS REQUIRED:

BLDPSS:	IOR	TA,	[XWD	AS.MSC##,AS.LIT##]	;REMEMBER WHERE
	MOVSM	TA,	M.ARGP##			; IT IS.
	SKIPN		SSU.CT##	;WERE ALL SUBSCRIPTS COMP?
	PJRST		BLDPTM		;YES, GO WRITE OUT THE DESCRIPTOR WORD
					; AND RETURN TO CALLER.
	PUSHJ	PP,	BLDPTM		;NO, GO WRITE OUT THE DESCRIPTOR
					; WORD AND COME BACK.

	MOVE	TA,	SSU.CT##	;SEE HOW MANY WORDS TO WRITE.
	ASH	TA,	1
	HRLI	TA,	XWDLIT##	;WRITE THEM AS XWD'S.
	PUSHJ	PP,	STASHI		;GO WRITE THE HEADER.

	SETZI	TB,
BLDPSW:	SOSGE	TA,	SSU.CT##	;ANY MORE WORDS?
	JRST		BLDPTP		;NO, RETURN.
	HLRZ	TA,	SSU.PT##(TB)	;GET THE MODE.
	PUSHJ	PP,	STASHL##	;PUT IT IN THE LEFT HALF.
	HRLZ	TA,	SSU.PT##(TB)	;GET THE ADDRESS.
	HRRI	TA,	AS.MSC##
	PUSHJ	PP,	STASHL##	;PUT IT IN THE RIGHT HALF.
	AOS		ELITPC##	;BUMP THE LITERAL PC.
	AOJA	TB,	BLDPSW		;GO LOOK FOR MORE.

;BUILD A DESCRIPTOR WORD AND RETURN IT IN TA.

BLDDSC:	MOVE	TB,	EMODEA##	;GET THE TYPE.
	TSWF	FANUM;			;SET THE NUMERIC FLAG IF
	TLO	TB,	(1B2)		; NECESSARY.
	TSWF	FASIGN;			;SAME FOR SIGN FLAG.
	TLO	TB,	(1B3)

	HRRZ	TA,	ETABLA##	;IF THE OPERAND ISN'T A
	LDB	TC,	LNKCOD##	; DATA ITEM DON'T WORRY
	CAIE	TC,	CD.DAT		; ABOUT JUSTIFICATION.
	JRST		BLDDS1

	PUSHJ	PP,	LNKSET##	;GET THE ABS DATAB LOC.
	LDB	TC,	DA.JST##	;SET THE JUSTIFIED FLAG
	JUMPE	TC,	BLDDSL		; IF NECESSARY.
	TLO	TB,	(1B5)
BLDDSL:
IFN ANS74,<
	LDB	TC,	DA.SSC##	;SEPARATE SIGN CHARACTER?
	JUMPE	TC,	BLDDS1		;NO
	TLO	TB,	(1B1)		;YES, LIGHT THE BIT
>
BLDDS1:	ROT	TB,	-5+^D18		;POSITION THE FLAGS.
	HRLI	TA,	(TB)
	HRR	TA,	ESIZEA##	;SET THE SIZE.
	MOVM	TB,EDPLA		;GET NUMBER OF DECIMAL PLACES
	SKIPGE	EDPLA			;IS IT NEGATIVE?
	TLO	TA,(1B12)		;YES, LIGHT SIGN BIT
	DPB	TB,[POINT 5,TA,17]	;STASH NO. OF DECIMAL PLACES
	POPJ	PP,			;RETURN.

;THE OPERAND IS A LITERAL - PUT IT IN LITAB AND RETURN WITH (TB) = THE NEW MODE.

BLDLIT:	PUSH	PP,	ESIZEB##	;SAVE THE PRINCIPAL OPERATOR'S SIZE.
	MOVE	TA,	ESIZEA##	;PRETEND IT'S THE SAME SIZE 
	MOVEM	TA,	ESIZEB##	; AS THE LITERAL.
	PUSHJ	PP,	LITD.0##	;GO BUILD THE LITERAL.
	POP	PP,	ESIZEB##	;RESTORE PRINCIPAL OPERATOR'S SIZE.
	MOVE	TB,	EMODEA##	;SET UP FOR RETURN.
	POPJ	PP,			;RETURN.

;THE OPERAND IS A FIGURATIVE CONSTANT - IF IT'S NOT TALLY OR
;TODAY, WE PUT A ONE CHARACTER LITERAL INTO LITAB AND RETURN.  IF IT'S
;TALLY, WE SIMPLY RETURN.  IF IT'S TODAY WE DO ALL KINDS OF WEIRD THINGS.

BLDFGC:
IFN ANS74,<
	SWOFF	FANUM+FASIGN		;IT WILL BECOME A NON-NUMERIC LITERAL
>
IFN ANS68,<
	MOVEI	TA,	TALLY.##	;IF IT'S TALLY
	CAMN	TA,	EBASEA##	; SIMPLY RETURN.
	POPJ	PP,
>
	SKIPN		EFLAGA##	;IF IT'S TODAY, WE PROCESS
	JRST		BLDTDY		; IT SPECIAL LIKE.

	MOVE	TA,	[XWD	OCTLIT##,1]	;WE'RE GOING TO PUT
	PUSHJ	PP,	STASHI		; IT IN LITAB AS AN
					; OCTAL NUMBER.
	SOS	TA,	EFLAGA##	;SELECT THE APPROPRIATE CHAR.
	MOVE	TB,	EMODEB##
	LDB	TA,	WHCFGC(TB)
	LSH	TA,	@PSTNFC(TB)	;LEFT JUSTIFY IT.
	PUSHJ	PP,	STASHL##	;PUT IT IN LITAB.
	AOS	TA,	ELITPC##	;BUMP THE PC.
	ADDI	TA,	AS.LIT##-1	;CHANGE THE A OPERAND TO POINT
	MOVEM	TA,	EINCRA##	; TO THE LITERAL.
	MOVEM	TB,	EMODEA##
	MOVEI	TA,	1
	MOVEM	TA,	ESIZEA##
	MOVE	TA,	[XWD	^D36,AS.MSC##]
	MOVEM	TA,	EBASEA##
	POPJ	PP,			;RETURN.

WHCFGC:	POINT	6,FGCS(TA),5		;SIXBIT.
	POINT	7,FGCS(TA),12		;ASCII.
	POINT	9,FGCS(TA),21		;EBCDIC.

FGCS:	BYTE	(6)' '	(7)40	(9)100	;SPACE.
	BYTE	(6)'0'	(7)60	(9)360	;ZERO.
	BYTE	(6)'"'	(7)42	(9)177	;QUOTE.
	BYTE	(6)77	(7)177	(9)377	;HIGH-VALUES.
	BYTE	(6)0	(7)0	(9)0	;LOW-VALUES.

;HOW MUCH WE SHIFT TO LEFT JUSTIFY THE FIGURATIVE CONSTANT.

PSTNFC:	EXP	^D36-6
	EXP	^D36-7
	EXP	^D36-9

;THE OPERAND IS "TODAY".  GET TODAY AND MOVE IT TO A TEMP.

BLDTDY:	PUSH	PP,	SW		;SAVE THE FLAGS.
	MOVE	TA,	[XWD	EBASEB##,ESAVEB##]	;SAVE THE PRINCIPAL
	BLT	TA,	ESAVBX##			; OPERAND.

	MOVEI	TA,	^D12		;MAKE THE RECEIVING FIELD BE
	MOVEM	TA,	ESIZEB##	; A TEMP ^D12 CHARACTERS LONG.
	MOVEI	TE,	2
	PUSHJ	PP,	GETEMP##
	HRRZ	TA,	EACC
	HRRZM	TA,	EINCRB##
	MOVEI	TE,	1
	SKIPE		EMODEB##
	PUSHJ	PP,	GETEMP##
	MOVE	TA,	[XWD	^D36,AS.MSC##]
	MOVEM	TA,	EBASEB##

	PUSHJ	PP,	MXX.##		;GO GENERATE THE MOVE.

	MOVE	TA,	[XWD	EBASEB##,EBASEA##]	;NOW MAKE THE TEMP
	BLT	TA,	EBASAX##			; THE OPERAND.

	MOVE	TA,	[XWD	ESAVEB##,EBASEB##]	;RESTORE THE
	BLT	TA,	EBASBX##			; PRINCIPAL OPERAND.
	POP	PP,	SW		;DON'T FORGET ABOUT THE SWITCHES.
	POPJ	PP,			;RETURN.


;FOUND AN ERROR, POP OFF ONE RETURN AND RETURN TO CALLER'S CALLER.

SLEAVE:	SETZM	NODPPF##	;CLEAR A FLAG
	POP	PP,	TB
	POPJ	PP,

COMMENT	\

	ROUTINE TO TRANSFER AN ARG FROM EOPTAB TO LITAB.  OR IF THERE
IS NO OPERAND (INDICATED BY [-2 + 0] IN EOPTAB), OCT 0 IS PLACED IN LITAB.

CALL:
	PUSHJ	PP,	BLDARG

ENTRY CONDITIONS:
	(CUREOP) = EOPTAB ADDRESS OF OPERAND.

EXIT CONDITIONS:
	(CUREOP) = EOPTAB ADDRESS OF NEXT OPERAND.
	TA, TB, TC ARE DESTROYED.

RETURNS:
	ALWAYS TO CALL+1.

\

BLDARG:	HRRZ	TC,	CUREOP##	;PICK UP THE EOPTAB ADDRESS OF OPERAND.
	HRREI	TB,	-2		;IS THERE AN OPERAND?
	CAME	TB,	(TC)
	JRST		BLDARL		;YES, GO ON.

;NO OPERAND, PUT OCT 0 IN LITAB.

	MOVE	TA,	[XWD	OCTLIT##,1]
	PUSHJ	PP,	STASHI
	SETZI	TA,
	PUSHJ	PP,	STASHL##
	AOS		ELITPC##

	PJRST		NXTEOP		;BUMP UP TO NEXT OPERAND AND RETURN.

;PUT THE OPERAND IN LITAB AS AN XWD.

BLDARL:	MOVE	TA,	[XWD	XWDLIT##,2]
	PUSHJ	PP,	STASHI
	MOVE	TA,	(TC)
	PUSHJ	PP,	STASHL##
	MOVE	TA,	1(TC)
	PUSHJ	PP,	STASHL##
	AOS		ELITPC##

	PJRST		NXTEOP		;BUMP UP TO NEXT OPERAND AND RETURN.

	END