Google
 

Trailing-Edge - PDP-10 Archives - BB-H506E-SM - cobol/source/ostrng.mac
There are 4 other files named ostrng.mac in the archive. Click here to see a list.
; UPD ID= 2265 on 12/20/79 at 12:05 PM by NIXON                         
TITLE	OSTRNG FOR LIBOL V12C
SUBTTL	OLD STRING/UNSTRING ROUTINES			/ACK



	SEARCH	COPYRT
	SALL

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1975, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE.

	SEARCH	LBLPRM
	%%LBLP==:%%LBLP

;REVISION HISTORY:

;V12 *****

;DMN	19-SEP-78	[537] FIX EDIT 521, USE TMP.DP (NEEDS FIX TO COMUNI)

;V10 *****

; EHM	14-DEC-77	[521] FIX UNSTRING INTO FIELD WITH DECIMAL PLACES.
;	10-DEC-76	[464] FIX FOR SUBSCRIPTED DESTINATIONS IN REENTRANT COBOL PROGRAM.
;	20-JUN-75	/ACK	CREATION.

;*****

	ENTRY	STR.		;STRING WITHOUT OVERFLOW.
	ENTRY	STR.O		;STRING WITH OVERFLOW.
	ENTRY	UNS.		;UNSTRING WITHOUT OVERFLOW.
	ENTRY	UNS.O		;UNSTRING WITH OVERFLOW.

SALL
HISEG
	.COPYRIGHT		;Put COPYRIGHT statement in .REL file.

	SUBTTL	DEFINITIONS.

;ACCUMULATORS:

	ERR==0			;ERROR STATUS.

	T1==S1			;TEMPS.
	T2==S2
	T3==S3

	DSTPTR==4		;DESTINATION BYTE POINTER.
	DSTCNT==5		;DESTINATION CHARACTER COUNT.

	DLMPTR==6		;DELIMITER BYTE POINTER.
	DLMCNT==7		;DELIMITER CHARACTER COUNT.

	SRCPTR==10		;SOURCE BYTE POINTER.
	SRCCNT==11		;SOURCE CHARACTER COUNT.

	SW==12			;SWITCHES.

	CVTSDL==13		;INSTRUCTION WHICH CONVERTS EITHER THE
				; SOURCE OR DELIMITER CHAR.
	CMPSDL==14		;INSTRUCTION WHICH COMPARES THE SOURCE
				; TO THE DELIMITER.
	CVTSDS==15		;INSTRUCTION WHICH CONVERTS THE SOURCE
				; CHARACTER TO THE DESTINATION'S MODE.

	AP==16			;POINTER TO ARG LIST.

	PP==17			;PUSH DOWN POINTER.

;OTHER NAMES FOR THE ACCUMULATORS:

	SRCH==T2		;HOLDS A CHAR FROM THE SOURCE.
	DLCH==T3		;HOLDS A CHAR FROM THE DELIMITER.

	T4==4			;MORE TEMPS USED BY SUBROUTINES.
	T5==5
	T6==6

	SXR==12			;WHERE SUBSCRIPTING ROUTINE RETURNS THE
				; BYTE POINTER.
;SWITCHES AND FLAGS:

;  SWITCHES IN SW:

	ALL==(1B1)		;ALL WAS SPECIFIED FOR THE CURRENT DELIMITER.
	MATCH==(1B2)		;WE MATCHED A DELIMITER.
	JST==(1B3)		;THE CURRENT OUTPUT ARG IS RIGHT JUSTIFIED.
	NODLMS==(1B4)		;THERE WERE NO DELIMITERS FOR THE UNSTRING.
	NUM==(1B5)		;THE CURRENT ARG IS NUMERIC.
	SGN==(1B6)		;THE CURRENT ARG IS SIGNED.
	NOSTOR==(1B7)		;DON'T STORE THE POINTER ITEM AND TALLY
				; ITEM EVEN IF THE CURRENT ITEM IS SUBSCRIPTED.
	OJST==(1B8)		;THE OUTPUT ARG IS RIGHT JUSTIFIED.
	ONUM==(1B9)		;THE OUTPUT ARG IS NUMERIC.
	SEP==(1B10)		;THE SIGN IS SEPARATE

;  FLAGS IN THE ARG LIST:

	SUBS==(1B8)		;THE ARG IS SUBSCRIPTED.
	ALLFLG==1B35		;THE DELIMITER HAD ALL SPECIFIED.

;  FLAGS IN THE PARAMETERS:

	SEPFLG==(1B6)		;THE SIGN IS SEPARATE
	NUMFLG==(1B7)		;THE ARG IS NUMERIC.
	SGNFLG==(1B8)		;THE ARG IS SIGNED.
	JSTFLG==(1B10)		;THE ARG IS RIGHT JUSTIFIED.
	NEGDEC==(1B12)		;NEGATIVE DECIMAL PLACES


;  FLAGS IN THE SECOND WORD OF THE SUBSCRIPT BLOCK.

	SUB1DF==1B18		;FIRST SUBSCRIPT'S DEPENDING ITEM IS NOT COMP.
	SUB1SF==1B19		;FIRST SUBSCRIPT IS NOT COMP.
	SUB2DF==1B20		;SECOND SUBSCRIPT'S DEPENDING ITEM IS NOT COMP.
	SUB2SF==1B21		;SECOND SUBSCRIPT IS NOT COMP.
	SUB3DF==1B22		;THIRD SUBSCRIPT'S DEPENDING ITEM IS NOT COMP.
	SUB3SF==1B23		;THIRD SUBSCRIPT IS NOT COMP.
;MISCELLANEOUS SYMBOLS:

;  ERROR RETURNS:

	FTLERR==-1		;HAD A FATAL ERROR WHICH HAS ALREADY
				; BEEN PROCESSED.
	ENDARG==1		;HIT THE END OF THE ARGLIST.
	NULARG==2		;GOT AN ARG, BUT ITS SIZE WAS 0.
	OMTARG==3		;THE ARG WAS OMMITTED.

;  NAMES FOR TEMPORARY STORAGE:

	DLMTMP==0		;PLACE TO STORE NUMERIC DELIMITERS.
	SRCTMP==1		;PLACE TO STORE NUMERIC SOURCES.
	DSTTMP==2		;PLACE TO STORE NUMERIC DESTINATIONS.

;  DATA MODES:

	D6MODE==0		;DISPLAY-6.
	D7MODE==1		;DISPLAY-7.
	D9MODE==2		;DISPLAY-9.

	DSMODE==2		;HIGHEST DISPLAY MODE.

	C1MODE==3		;ONE WORD COMP.
	C2MODE==4		;TWO WORD COMP.
	FPMODE==5		;COMP-1.
	C3MODE==6		;COMP-3.


;OPDEFS:

	OPDEF	PJRST	[JRST]

	DLM.AC==SRC.MD##		;USE RHS TO HOLD COUNT OF REPETITION IN ALL "?"
	SUBTTL	STRING ROUTINES.

;STRING WITH OVERFLOW CLAUSE:

STR.O:	PUSHJ	PP,	STR.		;GO DO THE STRING.
	JUMPL	DSTCNT,	RET.2##		;IF THE DESTINATION IS FULL AND
					; WE HAD TRIED TO PUT MORE IN IT,
					; IT'S AN OVERFLOW, RETURN TO CALL+2.
	POPJ	PP,			;OTHERWISE, RETURN TO CALL+1.


;STRING ROUTINE:

STR.:	PUSHJ	PP,	INITL		;GO INITIALIZE.

	SETZM		TL.ARG##	;DON'T TRY TO STORE INTO THE
					; TALLYING ITEM (WHAT TALLYING ITEM?)

;SET UP THE RECEIVING ITEM AND POINTER ITEM.

	PUSHJ	PP,	GTDOUT		;GO GET A DISPLAY OUTPUT ARG.
	JUMPN	ERR,	STRUBL		;IF THERE WERE PROBLEMS, DIE.

	MOVEM	T3,	DST.MD##	;SAVE THE MODE.

	PUSHJ	PP,	SETF2		;GO SET UP THE POINTER ITEM AND
					; ADJUST THE RECEIVING ITEM'S
					; PARAMETERS.
	JUMPN	ERR,	STRUBL		;IF THERE WERE PROBLEMS, DIE.

	JUMPL	T2,	SOVFLO		;IF THERE IS NOTHING LEFT TO
					; THE RECEIVING ITEM, IT'S
					; AN OVERFLOW.

	MOVE	DSTPTR,	T1		;SET UP DESTINATION PARAMS.
	MOVEI	DSTCNT,	1(T2)		;BUMP CHAR COUNT BY 1 BECAUSE
					; WE WILL TEST IT BEFORE WE STORE
					; INTO IT.
;TRANSFER A SET OF SOURCES TO THE DESTINATION.

SXTDL:	HRRI	SW,	DLMTMP		;WHICH TEMP TO USE, IF WE NEED ONE.
	PUSHJ	PP,	GTDIN		;GO GET A DELIMITER.
	JUMPE	ERR,	SXTDLD		;IF NOTHING UNUSUAL HAPPENED, GO ON.
	CAIN	ERR,	ENDARG		;IF THERE ARE NO MORE ARGS,
	JRST		DONE		; GO CLEAN UP AND RETURN.
	CAIE	ERR,	OMTARG		;IF THE ARG WAS OMMITTED
	CAIN	ERR,	NULARG		; OR NULL,
	TRNA				; DELIMIT BY SIZE.
	JRST		STRUBL		;OTHERWISE, DIE.

	SETZB	ERR,	T1		;CLEAR ERROR CONDITION AND
	SETOB	T2,	T3		; SET UP DUMMY DELIMITER PARAM.

SXTDLD:
IFN BIS,<
	DMOVEM	T1,	DLM.BP##	;SAVE DELIMITER PARAMS.
>
IFE BIS,<
	MOVEM	T1,	DLM.BP##
	MOVEM	T2,	DLM.CC##
>
	MOVEM	T3,	DLM.MD##

;INITIALIZE FOR A SET OF SOURCES.

	AOS	T1,	PT.AGL##	;GET ARG POINTER.
	MOVE	T1,	-1(T1)		;GET COUNT OF SOURCES.
	MOVEM	T1,	SU.AGL##	;SAVE IT.

;PICK UP THE NEXT SOURCE.

SXTSR:	SOSGE	T1,	SU.AGL##	;ANY MORE SOURCES?
	JRST		SXTDL		;NO, GO SEE IF THERE ARE MORE
					; DELIMITERS.

	HRRI	SW,	SRCTMP		;WHICH TEMP TO USE, IF NECESSARY.
	PUSHJ	PP,	GTDIN		;GO GET THE SOURCE'S PARAMS.
	JUMPE	ERR,	SXTSRD		;IF NOTHING HAPPENED, GO ON.
	CAIE	ERR,	NULARG		;IF IT WASN'T A NULL ARG,
	JRST		STRUBL		; WE 'RE IN TROUBLE.
	SETZI	ERR,			;OTHERWISE, IGNORE IT.
	JRST		SXTSR

SXTSRD:
IFN BIS,<
	DMOVE	SRCPTR,T1
>
IFE BIS,<
	MOVE	SRCPTR,	T1		;SAVE SOURCE'S PARAMS.
	MOVE	SRCCNT,	T2
>
	HRLZM	T3,	SRC.MD##

;SET UP CONVERSION/COMPARISON INSTRUCTIONS.

	HRLZI	CVTSDL,	(<JFCL>)	;MAKE CONVERSION A NO-OP.
	HRLZI	CMPSDL,	(<TRNA>)	;MAKE COMPARISON A NO-OP THAT SKIPS.
	SKIPL		DLM.MD##	;IS THERE A DELIMITER?
	PUSHJ	PP,	SCVSDL		;YES, GO SET UP SOURCE/DELIMITER INSTR'S.
	PUSHJ	PP,	SCVSDS		;GO SET UP SOURCE/DESTINATION INSTR.
;MAIN LOOP FOR STRING ROUTINE.

	MOVE	DLMPTR,	DLM.BP##	;GET THE FIRST CHARACTER OF THE
	ILDB	DLCH,	DLMPTR		; DELIMITER.

SMLD:	ILDB	SRCH,	SRCPTR		;GET A SOURCE CHAR.
	XCT		CVTSDL		;CONVERT, IF NECESSARY.
	XCT		CMPSDL		;COMPARE SOURCE/DELIMITER.
	JRST		SMLL		;EQUAL, GO TRY TO MATCH MORE.

SMLH:	SOJL	DSTCNT,	DONE		;IF THE DESTINATION IS FULL,
					; IT'S AN OVERFLOW.
	XCT		CVTSDS		;CONVERT, IF NECESSARY.
	IDPB	SRCH,	DSTPTR		;STASH THE CHAR.
	AOS		PT.VLU##	;BUMP THE POINTER.
	SOJGE	SRCCNT,	SMLD		;IF THERE ARE MORE SOURCE
					; CHAR'S GO TRY TO MATCH AGAIN.
	JRST		SXTSR		;OTHERWISE, GO GET THE NEXT SOURCE.

;FIRST CHAR OF DELIMITER MATCHES A SOURCE CHAR.

SMLL:	SKIPG	DLMCNT,	DLM.CC##	;SET UP DELIMITER.
	JRST		SXTSR		;IF IT'S ONLY ONE CHAR LONG, GO
					; GET THE NEXT SOURCE.
IFN BIS,<
	DMOVEM	SRCPTR,SRC.PT##	
>
IFE BIS,<
	MOVEM	SRCPTR,	SRC.PT##	;SAVE SOURCE INFO.
	MOVEM	SRCCNT,	SRC.CT##
>

SMLP:	SOJL	DLMCNT,	SXTSR		;IF THERE IS NO MORE DELIMITER,
					; IT'S A MATCH.
	SOJL	SRCCNT,	SMLT		;IF THERE IS NO MORE SOURCE, IT'S
					; NOT A MATCH.
	ILDB	DLCH,	DLMPTR		;GET THE NEXT DELIMITER CHAR.
	ILDB	SRCH,	SRCPTR		;GET THE NEXT SOURCE CHAR.
	XCT		CVTSDL		;CONVERT IF NECESSARY.
	XCT		CMPSDL		;COMPARE SOURCE/DELIMITER.
	JRST		SMLP		;GO SEE IF THERE IS ANY MORE.

;DELIMITER DOESN'T MATCH SOURCE.

SMLT:
IFN BIS,<
	DMOVE	SRCPTR,SRC.PT
>
IFE BIS,<
	MOVE	SRCPTR,	SRC.PT##	;RESTORE SOURCE INFO.
	MOVE	SRCCNT,	SRC.CT##
>
	LDB	SRCH,	SRCPTR

	MOVE	DLMPTR,	DLM.BP##	;GET THE FIRST CHAR OF THE
	ILDB	DLCH,	DLMPTR		; DELIMITER AGAIN.

	JRST		SMLH		;PICK UP WHERE WE LEFT OFF.
;OVERFLOW ON INITIAL POINTER VALUE.

SOVFLO:	SETOI	DSTCNT,			;MAKE THE COUNT NEGATIVE.
	POPJ	PP,
	SUBTTL	UNSTRING ROUTINES.

;UNSTRING WITH OVERFLOW CLAUSE.

UNS.O:	PUSHJ	PP,	UNS.		;GO DO THE UNSTRING.
	JUMPGE	SRCCNT,	RET.2##		;IF THERE ARE SOURCE
					; CHAR'S LEFT, OVERFLOW.
	POPJ	PP,			;OTHERWISE, RETURN TO CALL+1.


;UNSTRING ROUTINE:

UNS.:	PUSHJ	PP,	INITL		;INITIALIZE.

;SET UP SENDING ITEM, POINTER ITEM AND TALLYING ITEM.

	HRRI	SW,	SRCTMP		;WHICH TEMP TO USE IF NECESSARY.
	PUSHJ	PP,	GTDIN		;GO GET AN ARG.
	JUMPN	ERR,	UTRUBL		;IF THERE WERE PROBLEMS, GO DIE.

	HRLZM	T3,	SRC.MD##	;SAVE THE SOURCE'S MODE.

	PUSHJ	PP,	SETF2		;GO GET THE POINTER ITEM AND
					; ADJUST THE SENDING ITEM'S PARAM'S.
	JUMPN	ERR,	UTRUBL		;IF THERE WERE PROBLEMS, GO DIE.

	JUMPL	T2,	UOVFLO		;IF THERE IS NOTHING LEFT TO THE
					; SOURCE, IT'S AN OVERFLOW.

IFN BIS,<
	DMOVE	SRCPTR,T1
	DMOVEM	SRCPTR,SRC.BP##
>
IFE BIS,<
	MOVE	SRCPTR,	T1		;SET UP SOURCE'S PARAMS.
	MOVE	SRCCNT,	T2
	MOVEM	SRCPTR,	SRC.BP##	;NOTE WHERE WE ARE IN THE SOURECE.
	MOVEM	SRCCNT,	SRC.CC##
>

	AOS	T1,	PT.AGL##	;BUMP UP TO NEXT ARG.
	MOVE	T1,	-1(T1)		;PICK UP THE TALLYING ITEM'S ARG.
	MOVEM	T1,	TL.ARG##	;SAVE IT.
	SETZM		TL.VLU##	;CLEAR THE TALLY COUNT.

;SET UP POINTER TO DELIMITERS AND BUMP THE ARG POINTER OVER THEM.

	AOS	T1,	PT.AGL##	;GET THE POINTER TO THE ARGS.
	SKIPN	T2,	-1(T1)		;GET NUMBER OF WORDS USED FOR
					; DELIMITERS.
	TLO	SW,	NODLMS		;IF THERE AREN'T ANY DELIMITERS,
					; NOTE IT.
	ADDB	T2,	PT.AGL##	;MOVE POINTER OVER DELIMITERS.
IFN BIS,<
	DMOVEM	T1,	BS.DLM##
>
IFE BIS,<
	MOVEM	T1,	BS.DLM##	;SAVE BASE OF DELIMITER ARGS.
	MOVEM	T2,	TP.DLM##	;SAVE TOP OF DELIMITER ARGS.
>
;MAIN UNSTRING LOOP.

UML:	JUMPL	SRCCNT,	DONE		;IF THERE IS NO MORE SOURCE,
					; WE'RE THROUGH.
	MOVE	T1,	PT.AGL##	;GET THE POINTER TO THE ARG LIST.
	MOVE	T2,	(T1)		;GET THE DELIMITER STORE'S
					; ARG POINTER.
	IOR	T2,	1(T1)		;GET THE COUNT ITEM'S ARG POINTER.
	TLNE	T2,	SUBS		;IF EITHER OF THEM ARE SUBSCRIPTED
	PUSHJ	PP,	SPTATL		; GO STORE THE POINTER AND TALLY
					; ITEMS.

	PUSHJ	PP,	GTDOUT		;GO GET A DESTINATION.
	JUMPE	ERR,	UMLD		;IF NOTHING SPECIAL HAPPENED, GO ON.
	CAIN	ERR,	ENDARG		;IF THERE ARE NO MORE DESTINATIONS
	JRST		DONE		; WE'RE THROUGH.
	CAIE	ERR,	NULARG		;IF IT WASN'T A NULL ARG,
	JRST		UTRUBL		; WE'RE IN TROUBLE.

	SETZI	ERR,			;CLEAR THE ERROR INDICATOR.
	SETOI	T2,			;SET UP A DUMMY DESTINATION.
	SETZB	T1,	T3

UMLD:
IFN BIS,<
	DMOVE	DSTPTR,	T1
>
IFE BIS,<
	MOVE	DSTPTR,	T1		;SET UP DESTINATION PARAMS.
	MOVE	DSTCNT,	T2
>
	MOVEM	T3,	DST.MD##

	TLNN	SW,	NODLMS		;WERE THERE ANY DELIMITERS?
	JRST		UMLH		;YES, GO EXAMINE THE SOURCE.

;THERE WEREN'T ANY DELIMITERS, MOVE AS MUCH AS WE CAN INTO THE DESTINATION.

	CAILE	DSTCNT,	(SRCCNT)	;IF THE DESTINATION IS LARGER
	SKIPA	T1,	SRC.CC##	; THAN THE SOURCE, MOVE ALL OF
					; THE CHARS IN THE SOURCE.
	MOVE	T1,	DSTCNT		;OTHERWISE, ONLY MOVE ENOUGH TO
					; FILL THE DESTINATION.
	EXCH	T1,	SRC.CC##	;SET NUMBER OF CHARS TO MOVE.
	SUBI	T1,	1(DSTCNT)	;SEE HOW MANY CHARS WILL BE
					; LEFT IN THE SOURCE.
	PUSH	PP,	T1		;SAVE IT.
	SETOM		SE.DLM##	;SET NUMBER OF CHARS TO BE MOVED
					; TO THE DELIMITER STORE TO ZERO.

	PUSHJ	PP,	STOREM		;GO DO THE MOVE.

	POP	PP,	SRCCNT		;SET NUMBER OF CHARS REMAINING
					; IN THE SOURCE.
	JUMPN	ERR,	UTRUBL		;IF WE HAD PROBLEMS DURING THE
					; MOVE, GO DIE.
	MOVEM	SRCCNT,	SRC.CC##	;NOTE WHERE WE ARE IN THE SOURCE.
	JRST		UML		;GO DO THE NEXT DESTINATION.
;THERE WERE DELIMITERS, WE HAVE TO EXAMINE THE SOURCE.

UMLH:	MOVE	T1,	BS.DLM##	;SET UP POINTER TO DELIMITERS.
	MOVEM	T1,	SU.AGL##

UMLL:	HRLM	SRCCNT,	SE.DLM##	;INITIALIZE START AND END OF
	HRRM	SRCCNT,	SE.DLM##	; DELIMITER.

	AOS		SU.AGL##	;BUMP UP TO NEXT DELIMITER.
	AOS	T1,	SU.AGL##
	CAMG	T1,	TP.DLM##	;HAVE WE GONE TOO FAR?
	JRST		UMLDS		;NO, GO CHECK THIS DELIMITER.

;CHECKED THE CURRENT SOURCE CHAR AGAINST ALL DELIMITERS.

	IBP		SRCPTR		;BUMP UP TO NEXT SOURCE CHAR.
	SOJGE	SRCCNT,	UMLH		;IF THERE ARE MORE SOURCE CHARS, LOOP.

	SETOM		SE.DLM##	;FORCE EVERYTHING INTO THE
					; CURRENT SOURCE.

UMLP:	PUSHJ	PP,	STOREM		;GO DO THE MOVE.
	JUMPN	ERR,	UTRUBL		;IF THERE WERE PROBLEMS, DIE.
	JRST		UML		;GO SEE IF THERE ARE MORE SOURCE CHARS.

;CHECK A DELIMITER AGAINST THE CURRENT SOURCE CHAR.

UMLDS:	MOVE	T2,	-1(T1)		;GET THE ALL FLAG.
	TRNE	T2,	ALLFLG		;REMEMBER ITS SETTING.
	TLOA	SW,	ALL
	TLZ	SW,	ALL

	MOVE	T1,	-2(T1)		;GET THE ARG.
	HRRI	SW,	DLMTMP		;WHICH TEMP TO USE IF NECESSARY.
	PUSHJ	PP,	GTPRMT		;GO GET THE PARAMS.
	JUMPE	ERR,	UMLDSD		;IF THERE WEREN'T ANY PROBLEMS, GO ON.
	CAIE	ERR,	NULARG		;IF IT WAS A NULL ARG, IGNORE IT.
	JRST		UTRUBL		;OTHERWISE, DIE.
	SETZI	ERR,
	JRST		UMLL

UMLDSD:
IFN BIS,<
	DMOVEM	T1,	DLM.BP##	;SAVE DELIMITER INFO.
>
IFE BIS,<
	MOVEM	T1,	DLM.BP##	;SAVE DELIMITER INFO.
	MOVEM	T2,	DLM.CC##
>
	MOVEM	T3,	DLM.MD##

	PUSHJ	PP,	SCVSDL		;SET UP CONVERSION/COMPARISON INSTR.
;COMPARE SOURCE AND DELIMITER.

	TLZ	SW,	MATCH		;TURN OFF MATCH FLAG.

IFN BIS,<
	DMOVEM	SRCPTR, SRC.PT
>
IFE BIS,<
	MOVEM	SRCPTR,	SRC.PT##	;SAVE SOURCE INFO.
	MOVEM	SRCCNT,	SRC.CT##
>

UMLDSH:
IFN BIS,<
	DMOVE	DLMPTR,DLM.BP
>
IFE BIS,<
	MOVE	DLMPTR,	DLM.BP##	;SET UP DELIMITER.
	MOVE	DLMCNT,	DLM.CC##
>

	SKIPGE		SRCCNT		;IF THE SOURCE ISN'T NULL,
UMLDSP:	SOJL	SRCCNT,	UMLDST		;DON'T DECREMENT THE FIRST TIME.
	ILDB	SRCH,	SRCPTR		;GET A SOURCE CHAR.
	ILDB	DLCH,	DLMPTR		;GET A DELIMITER CHAR.
	XCT		CVTSDL		;CONVERT, IF NECESSARY.
	XCT		CMPSDL		;COMPARE THEM.
	JRST		UMLDSX		;EQUAL, GO TRY TO MATCH MORE.

UMLDST:	TLNE	SW,	MATCH		;DID WE HAVE A MATCH?
	JRST		UMLP		;YES, GO DO THE MOVE AND LOOP.

;SOURCE DOESN'T MATCH DELIMITER.

IFN BIS,<
	DMOVE	SRCPTR,SRC.PT
>
IFE BIS,<
	MOVE	SRCPTR,	SRC.PT##	;RESTORE SOURCE INFO.
	MOVE	SRCCNT,	SRC.CT##
>
	JRST		UMLL		;GO LOOK FOR ANOTHER DELIMITER.

;SOURCE CHAR MATCHES DELIMITER CHAR.

UMLDSX:	SOJGE	DLMCNT,	UMLDSP		;IF THERE IS MORE TO THIS DELIMITER,
					; GO LOOK AT MORE OF THE SOURCE.
	SUBI	SRCCNT,	1		;UPDATE THE SOURCE COUNT.
IFN ANS74,<
	TLC	SW,ALL!MATCH		;WAS ALL SPECIFIED
	TLCN	SW,ALL!MATCH		;AND DO WE ALREADY HAVE A MATCH?
	PUSHJ	PP,[	AOS	DLM.AC	;YES, COUNT REPETITIONS
			HRLZS	SE.DLM	;PRETEND LAST OCCURRENCE OF
			POPJ	PP,]	; DELIMITER STRING IS ONLY ONE
>
	HRRM	SRCCNT,	SE.DLM##	;REMEMBER WHERE THE DELIMITER ENDS.
	TLNN	SW,	ALL		;WAS ALL SPECIFIED?
	JRST		UMLP		;NO, GO DO THE MOVE.
	TLO	SW,	MATCH		;NOTE THAT WE HAD A MATCH.
	JRST		UMLDSH		;GO TRY TO MATCH AGAIN.


;WE HAD AN OVERFLOW ON THE INITIAL POINTER VALUE.

UOVFLO:	SETZI	SRCCNT,			;MAKE THE COUNT NON NEGATIVE.
	POPJ	PP,			;RETURN.
	SUBTTL	COMMON SUBROUTINES FOR STRING/UNSTRING.

;INITIALIZATION ROUTINE.

INITL:	MOVEM	AP,	BS.AGL##	;SET BASE OF ARG LIST.
	MOVEM	AP,	PT.AGL##	;SET POINTER TO CURRENT ARG.
	HLRE	T1,	-1(AP)		;GET ARG COUNT.
	SUBI	AP,	(T1)		;FORM ADDR OF LAST ARG+1.
	HRRZM	AP,	TP.AGL##	;SAVE IT.

	SETZB	SW,	ERR		;CLEAR THE SWITCH AND ERROR REGS.

	MOVE	T1,	D6MODE		;SET THE PREFERED MODE TO
	MOVEM	T1,	PF.MDE##	; DISPLAY-6.

CPOPJ:	POPJ	PP,			;RETURN.
;ROUTINE TO PICK UP THE POINTER ITEM AND ADJUST THE ITEM IN T1 AND T2.

SETF2:	PUSH	PP,	T1		;SAVE THE ITEM'S PARAMS.
	PUSH	PP,	T2

	MOVEM	T3,	PF.MDE##	;MAKE THE PREFERED MODE THIS
					; ITEM'S MODE.

	MOVE	T1,	@PT.AGL##	;GET THE POINTER ARG.
	MOVEM	T1,	PT.ARG##	;SAVE IT.

	PUSHJ	PP,	GTNIN		;GET A NUMERIC INPUT ARG'S VALUE.
	JUMPE	ERR,	SETF2D		;IF NOTHING UNUSUAL HAPPEND, GO ON.
	CAIE	ERR,	OMTARG		;IF IT WASN'T AN OMMITTED ARG,
	JRST		SETF2L		; LET THE CALLER WORRY ABOUT IT.

;  POINTER WAS OMMITTED.

	SETZB	ERR,	T1		;DEFAULT VALUE TO 1.
	MOVEI	T2,	1

;  POINTER VALUE IS IN T1 AND T2 AS A DOUBLE PRECISION NUMBER.

SETF2D:	JUMPN	T1,	SETF2H		;IF THE HIGH ORDER WORD ISN'T
	JUMPLE	T2,	SETF2H		; ZERO OR THE VALUE WAS LESS THAN
					; ONE, IT'S AN OVERFLOW.

	MOVEM	T2,	PT.VLU##	;SAVE THE POINTER VALUE.
	MOVE	T3,	T2

;  ADJUST THE BYTE POINTER AND COUNT OF THE ITEM.

	POP	PP,	T2		;GET THE COUNT AND
	POP	PP,	T1		; BYTE POINTER BACK.

	SOJLE	T3,	CPOPJ		;IF WE DON'T HAVE TO ADJUST IT, LEAVE.
	SUBI	T2,	(T3)		;ADJUST THE COUNT.
	JUMPL	T2,	CPOPJ		;IF IT WENT NEGATIVE LEAVE.
IFN BIS,<
	ADJBP	T3,T1
	MOVE	T1,T3			;PUT BYTE PTR BACK
>
IFE BIS,<
	IBP		T1		;BUMP THE BYTE POINTER OVER THE
	SOJG	T3,	.-1		; UNWANTED BYTES.
>
	POPJ	PP,			;RETURN.

;  OVERFLOW ON POINTER'S INITIAL VALUE.

SETF2H:	SETOI	T2,			;SET THE COUNT TO -1 TO FORCE OVERFLOW.
SETF2L:	POP	PP,	T1		;CLEAN UP THE STACK.
	POP	PP,	T1
	POPJ	PP,			;RETURN
;SET UP COMPARISON/CONVERSION INSTRUCTIONS FOR SOURCE/DELIMITER.

SCVSDL:	HLRE	T1,	SRC.MD##	;GET THE SOURCE MODE.
	HRLZI	CVTSDL,	(<JFCL>)	;ASSUME SOURCE AND DELIMITER ARE
					; THE SAME MODE.
	CAME	T1,	DLM.MD##	;ARE THEY?
	HRLI	CVTSDL,	(<LDB	T1,0>)	;NO, HAVE TO DO A LDB THEN.
	IMULI	T1,	3		;FORM INDEX.
	ADD	T1,	DLM.MD
	HRR	CVTSDL,	SCVDLT(T1)	;SELECT A BYTE POINTER.
	HLLZ	CMPSDL,	SCVDLT(T1)	;SELECT A COMPARISON INSTRUCTION.
	POPJ	PP,			;RETURN.

;  TABLE OF INSTRUCTIONS.  LEFT HALF IS THE COMPARISON INSTRUCTION, RIGHT
;   HALF IS THE ADDRESS OF THE BYTE POINTER FOR THE CONVERSION INSTRUCTION.

SCVDLT:	CAIN	SRCH,	(DLCH)
	CAIN	T1,	SU.S67##(DLCH)
	CAIN	T1,	SU.S69##(DLCH)
	CAIN	T1,	SU.D67##(SRCH)
	CAIN	SRCH,	(DLCH)
	CAIN	T1,	SU.S79##(DLCH)
	CAIN	T1,	SU.D69##(SRCH)
	CAIN	T1,	SU.D79##(SRCH)
	CAIN	SRCH,	(DLCH)


;SET UP THE CONVERSION INSTRUCTION FOR SOURCE DESTINATION.

SCVSDS:	HLRE	T1,	SRC.MD##	;GET THE SOURCE MODE.
	IMULI	T1,	3		;FORM THE TABLE INDEX.
	ADD	T1,	DST.MD##
	MOVE	CVTSDS,	SCVSST(T1)	;GET THE INSTRUCTION.
	POPJ	PP,			;RETURN.

SCVSST:	JFCL
	LDB	SRCH,	SU.S67##
	LDB	SRCH,	SU.S69##
	LDB	SRCH,	SU.S76##
	JFCL
	LDB	SRCH,	SU.S79##
	LDB	SRCH,	SU.S96##
	LDB	SRCH,	SU.S97##
	JFCL
;ROUTINE TO SET UP A DISPLAY OUTPUT ARG'S PARAMS.  IF THE ARG IS NUMERIC
; WE WILL RETURN PARAMETERS WHICH WILL CAUSE THE ITEM TO BE STORED IN A
; TEMP.  THEN WHEN THE ROUTINE CLRTMP IS CALLED WE WILL STORE THE ARG.

GTDOUT:	PUSHJ	PP,	GTPRMS		;GET THE PARAMETERS.
	JUMPN	ERR,	CPOPJ		;PASS ERRORS BACK TO CALLER.

	TLZ	SW,	ONUM!OJST	;SAVE THE NUMERIC AND
	TLNE	SW,	NUM		; JUSTIFIED SWITCHES.
	TLO	SW,	ONUM
	TLNE	SW,	JST
	TLO	SW,	OJST

	TLNN	SW,	NUM		;IF THE ARG ISN'T NUMERIC,
	POPJ	PP,			; RETURN.

;  THE ARG IS NUMERIC.

	MOVE	T1,	PT.AGL##	;REMEMBER WHICH ARG WE ARE
	MOVEM	T1,	OU.ARP##	; WORKING ON.

	HRRI	T1,	OU.TMP##	;SET UP PARAMS TO POINT TO THE TEMP.
	MOVE	T3,	PF.MDE##	;USE THE PREFERED MODE.
	HLL	T1,	TMPTRS(T3)	;SELECT THE APPROPRIATE BYTE SIZE.

	MOVEM	T3,	OU.MDE##	;SAVE THE MODE (IT CAN CHANGE).

	TLO	SW,	JST!OJST!NUM	;MAKE SURE THE RIGHT JUSTIFIED
					; AND NUMERIC FLAGS ARE ON.

	POPJ	PP,			;RETURN.
;ROUTINE TO STORE THE NUMERIC ARG CURRENTLY STORED IN A TEMP.

CLRTMP:	SKIPN	T1,	OU.ARP##	;ANYTHING THERE?
	POPJ	PP,			;NO, RETURN.

	MOVE	T1,	-1(T1)		;GET THE POINTER TO THE PARAMS.
	PUSHJ	PP,	GTPRMT		;GET THE PARAMS.

	PUSHJ	PP,	SVACS		;SAVE NON-TEMP AC'S.

	PUSH	PP,	T1		;SAVE THE PARAMS.
	PUSH	PP,	T2
	PUSH	PP,	T3

	HRRI	T1,	OU.TMP##	;SET UP PARAMS.
	MOVE	T3,	OU.MDE##
	HLL	T1,	TMPTRS(T3)

	MOVE	T4,	TMP.DP##	;[537] NUM OF DECIMAL PLACES

	PUSHJ	PP,	GTNUM		;GO CONVERT THE DISPLAY NUMERIC
					; TO A TWO WORD COMP ITEM.
	JUMPLE	T4,	CLRTM1		;[521] DOES IT HAVE DECIMAL PLACES?
	CAIG	T4,	^D10		;[521] MORE THAN 10 DECIMAL PLACES
	JRST	CLRTMB			;[521] NO GET ONE WORD POWER OF 10
	SUBI	T4,	^D11		;[521] GET INDEX INTO DPWR10
	LSH	T4,	1		;[521]
IFE BIS,<
	MOVE	T5,	DC.TB2+1(T4)	;[521] GET 2-WORD POWER 
	MOVE	T4,	DC.TB2(T4)	;[521] OF 10 IN 4 & 5
>
IFN BIS,<
	DMOVE	T4,DC.TB2(T4)		;[521]
>
	JRST	CLRTMC			;[521] GO DO MULTIPLY
CLRTMB:	MOVE	T5,	DC.TB1(T4)	;[521] GET ONE WORD POWER OF 10
	SETZ	T4,			;[521] MAKE IT A 2 WORD 
CLRTMC:
IFN BIS,<
	DMUL	T1,T4			;[521] RESULT IN 1 & 2 & 3 & 4
	DMOVE	T1,T3			;[521] PUT RESULT IN AC 1 & 2
>
IFE BIS,<
;MULTIPLY HIGH-B BY LOW-A, LEAVING  A 1-WORD PRODUCT IN T4.
	IMUL	T4,T2

;THEN MULTIPLY LOW-A BY LOW-B, LEAVING A 2-WORD PRODUCT IN AC'S T2 & T3
	MUL	T2,T5

;AND MULTIPLY HIGH-A BY LOW-B, LEAVING A 1-WORD PRODUCT IN T1.
	IMUL	T1,T5

;THE LOW-ORDER WORD OF THE FINAL PRODUCT NOW APPEARS IN T3. FIX UP
;HIGH-ORDER HALF.
	ADD	T1,T2		;ADD HIGH HALF OF RESULT OF MUL2
	ADD	T1,T4		;  AND RESULT OF MUL1 TO GIVE FINAL HIGH HALF.
	TLZ	T1,1B18		;IGNORE OVERFLOW
	MOVE	T2,T3		;GET RESULT IN T1 & T2
>

CLRTM1:	POP	PP,	T5		;[521]GET THE ORIGIONAL PARAMS BACK.
	POP	PP,	T4
	POP	PP,	T3

	PUSHJ	PP,	PUTNUM		;GO STORE THE NUMBER.

	SETZM		OU.ARP##	;REMEMBER THAT WE HAVE STORED IT.

	POPJ	PP,			;RETURN.
;ROUTINE TO GET A DISPLAY INPUT ARG.  IF IT IS NUMERIC, MAKE IT DISPLAY.

GTDIN:	PUSHJ	PP,	GTPRMS		;GET THE PARAMS.
	JUMPN	ERR,	CPOPJ		;PASS ERRORS BACK TO CALLER.
	TLZN	SW,	NUM		;IF THE ARG ISN'T NUMERIC,
	POPJ	PP,			; RETURN.
	TLZE	SW,	SEP		;IF SEPARATE SIGN,
	POPJ	PP,			; LEAVE IT DISPLAY

;  THE ARG IS NUMERIC.  MAKE IT DISPLAY.

	PUSHJ	PP,	SVACS		;SAVE NON-TEMP AC'S.
	PUSH	PP,	T2		;SAVE THE ITEM'S SIZE.

	PUSHJ	PP,	GTNUM		;GO GET THE NUMBER INTO T1 & T2.

	HRR	T3,	TMPTRS(SW)	;GET THE TEMP'S ADDRESS.
	MOVE	T4,	(PP)		;SET THE ITEM'S SIZE.
	MOVE	T5,	PF.MDE##	;USE THE PREFERED MODE.
	HLL	T3,	TMPTRS(T5)	;SET THE BYTE SIZE.
	TLZ	SW,	SGN		;MAKE IT UNSIGNED.

	PUSHJ	PP,	PUTNUM		;MOVE THE NUMBER TO TEMP.

	HRR	T1,	TMPTRS(SW)	;RECONSTRUCT PARAMS FOR CALLER.
	POP	PP,	T2
	MOVE	T3,	PF.MDE##
	HLL	T1,	TMPTRS(T3)

	POPJ	PP,			;RETURN.

;  POINTERS TO TEMPORARY STORAGE.  LEFT HALF IS INDEXED BY MODE, RIGHT
;   HALF IS INDEXED BY THE TEMP AREA DESIRED.

TMPTRS:	POINT	6,TMP.DL##	;DISPLAY-6 - DELIMITER.
	POINT	7,SR.TMP##	;DISPLAY-7 - SOURCE.
	POINT	9,OU.TMP##	;DISPLAY-9 - DESTINATION.
;ROUTINE TO GET THE PARAMS FOR THE NEXT ARG.

GTPRMS:	PUSHJ	PP,	NXTARG		;GO GET THE ARG POINTER.
	JUMPN	ERR,	CPOPJ		;PASS ERRORS BACK TO CALLER.

GTPRMT:	PUSHJ	PP,	GSETP		;GO GET THE PARAMETERS.
	JUMPN	ERR,	CPOPJ		;PASS ERRORS BACK TO CALLER.

;  PUT THE PARAMS IN A MORE AMINABLE FORMAT.

	TLZ	SW,	NUM!SGN!JST!SEP	;TRANSFER FLAGS TO THE SWITCH REGISTER.
	TLNE	T2,	SEPFLG
	TLO	SW,	SEP
	TLNE	T2,	NUMFLG
	TLO	SW,	NUM
	TLNE	T2,	SGNFLG
	TLO	SW,	SGN
	TLNE	T2,	JSTFLG
	TLO	SW,	JST

	LDB	T3,	[POINT 5,T2,17]	;[521] GET NO. DECIMAL PLACES
	TLNE	T2,	NEGDEC		;NEGATIVE DECIMAL PLACES?
	MOVNS		T3		; YES, NEGATE
	MOVEM	T3,	TMP.DP##	;[537] REMEMBER THAT
	LDB	T3,	[POINT	4,T2,4]		;GET THE MODE.

	HRRZI	T2,	(T2)		;ISOLATE THE SIZE.
	SOJGE	T2,	CPOPJ		;USE ZERO ORIGN INDEXING.

	MOVEI	ERR,	NULARG		;IF THE ARG IS NULL,
	POPJ	PP,			; TELL THE CALLER ABOUT IT.
;ROUTINE TO PICK UP THE NEXT ARG POINTER.

NXTARG:	AOS	T1,	PT.AGL##	;GET THE POINTER TO THE ARG POINTERS.
	CAMG	T1,	TP.AGL##	;HAVE WE GONE TOO FAR?
	JRST		NXTARK		;NO, GO GET THE ARG POINTER.
	MOVEI	ERR,	ENDARG		;TELL CALLER.
	POPJ	PP,

NXTARK:	SKIPE	T1,	-1(T1)		;WAS THE ARG OMMITTED?
	POPJ	PP,			;NO, RETURN WITH ARG POINTER IN T1.
	MOVEI	ERR,	OMTARG		;TELL CALLER.
	POPJ	PP,
;ROUTINE TO PICK UP A NUMERIC INPUT ARG.

GTNIN:	PUSHJ	PP,	GTPRMS		;GO GET THE PARAMETERS.
	JUMPN	ERR,	CPOPJ		;PASS ERRORS BACK TO CALLER.

GTNUM:	MOVE	T3,	GTNUMD(T3)	;PICK UP THE ADDRESSES OF SOME ROUTINES.
	AOJA	T2,	(T3)		;CORRECT THE SIZE AND DISPATCH.

GTNUMD:	XWD	GD6.##,	GTNUMH		;DISPLAY-6.
	XWD	GD7.##,	GTNUMH		;DISPLAY-7.
	XWD	GD9.##,	GTNUMH		;DISPLAY-9.
	XWD	0,	GTNUML		;ONE WORD COMP.
	XWD	0,	GTNUMP		;TWO WORD COMP.
	XWD	0,	GTNUMT		;COMP-1.
	XWD	GC3.##,	GTNUMH		;COMP-3.

;  DISPLAY OR COMP-3.

GTNUMH:	PUSH	PP,	T2		;SAVE THE SIZE.
	HLRZS		T3		;PUT LIBOL ROUTINE'S ADDRESS
					; IN THE RIGHT PLACE.
	PUSHJ	PP,	CLRTNI		;GO BUILD PARAMETER AND CALL ROUTINE.
	POP	PP,	T3		;GET THE SIZE BACK.
	CAIG	T3,	^D10		;ONE OR TWO WORD COMP.
	MULI	T1,	1		;ONE, MAKE IT TWO.
	POPJ	PP,			;RETURN.

;  ONE WORD COMP.

GTNUML:	MOVE	T1,	(T1)		;PICK IT UP.
	MULI	T1,	1		;MAKE IT TWO WORDS.
	POPJ	PP,			;RETURN.

;  TWO WORD COMP.

GTNUMP:
IFN BIS,<
	DMOVE	T1,0(T1)
>
IFE BIS,<
	MOVE	T2,	1(T1)		;PICK IT UP.
	MOVE	T1,	(T1)
>
	POPJ	PP,			;RETURN.

;  COMP-1.

GTNUMT:	PUSHJ	PP,	SVACS		;SAVE ALL NON-TEMP AC'S.
	MOVE	T1,	(T1)		;GET THE FLOATING POINT NUMBER.
	MOVE	AP,	[Z	T1,T1]	;SET UP THE PARAM.
	PJRST		FIX.##		;GO CONVERT IT AND RETURN.
;ROUTINE TO CALL AN EXTERNAL LIBOL ROUTINE TO PICK UP A NUMBER.

CLRTNI:	PUSHJ	PP,	SVACS		;SAVE ALL NON TEMP AC'S.

	DPB	T2,	[POINT	12,T1,17]	;BUILD THE PARAM.
	TLNE	SW,	SGN
	TLO	T1,	(1B6)

	MOVE	AP,	[Z	T1,T1]	;SET UP THE ARG POINTER.

	PJRST		(T3)		;GO DO THE CONVERSION AND RETURN.
;ROUTINE TO STORE THE DOUBLE PRECISION NUMBER IN T1 & T2 INTO THE ITEM
; WHOSE PARAMETERS ARE IN T3, T4 & T5.

PUTNUM:	AOS		T4		;CORRECT THE SIZE.
	DPB	T4,	[POINT	12,T3,17]	;BUILD A PARAMETER FOR
	TLNE	SW,	SGN			; A CALL TO AN EXTERNAL
	TLO	T3,	(1B6)			; LIBOL ROUTINE.

	PUSH	PP,	T3		;SAVE IT.
	PUSH	PP,	T5		;SAVE THE MODE.

;  LEFT TRUNCATE.

	HRLI	AP,	(<Z	T1,0>)	;SET UP LEFT HALF OF ARG.

	CAILE	T4,	^D10		;DO WE WANT A ONE OR TWO WORD COMP.
	JRST		PUTNUD		;TWO WORDS, GO ON.

	HRRI	AP,	DC.TB1##(T4)	;GET THE ADDRESS OF THE NUMBER
	PUSHJ	PP,	DIV.21##	; TO DIVIDE BY AND GO DO THE DIVISION.
	JRST		PUTNUF

PUTNUD:	SUBI	T4,	^D11		;GET THE ADDRES OF THE NUMBER
	LSH	T4,	1		; TO DIVIDE BY.
	HRRI	AP,	DC.TB2##(T4)
	PUSHJ	PP,	DIV.22##	;GO DO THE DIVISION.

	MOVE	T2,	T1+3		;PUT THE RESULTS WHERE WE CAN
PUTNUF:	MOVE	T1,	T1+2		; FIND THEM.

	POP	PP,	T5		;RESTORE THE PARAMS.
	POP	PP,	T3
	MOVE	T5,	PUTNUJ(T5)	;SELECT SOME ROUTINES.
	JRST		(T5)		;DISPATCH.

PUTNUJ:	XWD	PD6.##,	PUTNUP		;DISPLAY-6.
	XWD	PD7.##,	PUTNUP		;DISPLAY-7.
	XWD	PD9.##,	PUTNUP		;DISPLAY-9.
	XWD	0,	PUTNUT		;ONE WORD COMP.
	XWD	0,	PUTNUR		;TWO WORD COMP.
	XWD	0,	PUTNUV		;COMP-1.
	XWD	PC3.##,	PUTNUP		;COMP-3.

;  DISPLAY OR COMP-3.

PUTNUP:	HLRZS		T5		;GET THE ROUTINE TO USE.
	MOVE	AP,	[Z	T1,T3]	;SET UP THE PARAM.
	PJRST		(T5)		;GO STORE THE NUMBER AND RETURN.

;  TWO WORD COMP.

PUTNUR:
IFN BIS,<
	DMOVEM	T1,	(T3)
>
IFE BIS,<
	MOVEM	T2,	1(T3)		;STORE THE NUMBER.
	MOVEM	T1,	(T3)
>
	POPJ	PP,			;RETURN.

;  FLOATING POINT & ONE WORD COMP.

PUTNUV:
IFN BIS,<
	FLTR	T1,T1
>
IFE BIS,<
	PUSH	PP,	T3		;SAVE THE PARAM.
	MOVE	AP,	[Z	T1,T1]	;SET UP CALL TO FLOT.1.
	PUSHJ	PP,	FLOT.1##	;GO GET THE NUMBER IN FLOATING POINT.
	POP	PP,	T3		;GET THE PARAM BACK.
>
PUTNUT:	MOVEM	T1,	(T3)		;STORE RESULT.
	POPJ	PP,			;RETURN.
;ROUTINE TO GET A SET OF PARAMETERS.

GSETP:	TLNE	T1,	SUBS		;IS THE ARG SUBSCRIPTED?
	JRST		GSETPD		;YES, GO WORRY OVER IT.

IFN BIS,<
	DMOVE	T1,	(T1)
>
IFE BIS,<
	MOVE	T2,	1(T1)		;PICK UP THE PARAMS.
	MOVE	T1,	(T1)
>

	POPJ	PP,			;RETURN.

;  WORRY ABOUT SUBSCRIPTING.

GSETPD:	MOVEM	T1,	AP.TMP##	;SAVE THE ARG POINTER.

	TLNN	SW,	NOSTOR		;SHOULD WE STORE THE POINTER
					; AND TALLY ITEM?
	PUSHJ	PP,	SPTATL		;YES, GO DO SO.

	MOVE	T1,	AP.TMP##	;GET THE ARG POINTER BACK.
	HLRZ	T2,	1(T1)		;GET THE NUMBER OF SUBSCRIPTS.
	LSH	T2,	1		;FIGURE OUT THE ADDRESS OF THE
	ADDI	T2,	2(T1)		; DESCRIPTOR WORD.
	MOVE	T3,	(T2)		;GET THE DESCRIPTOR WORD.
	MOVEM	T3,	DW.TMP##	;SAVE IT.
	HRL	T2,	1(T1)		;PICK UP THE FLAGS.
	PUSH	PP,	T2		;SAVE FLAGS AND CONVERSION
					; PARAMETER ADDRESS-1.

	MOVE	T3,	2(T1)		;[464]GET THE TEMP ADDRS FOR THE
					; DEPENDING VARIABLE AND SUBSCRIPT.
	TLNE	T2,	SUB1DF		;FIRST SUBSCRIPT'S DEPENDING ITEM COMP?
	PUSHJ	PP,	MNUTMP		;NO, GO GET THE NUMBER.

	TLNE	T2,	SUB1SF		;FIRST SUBSCRIPT COMP?
	PUSHJ	PP,	MNUTMP		;NO, GO GET THE NUMBER.

	MOVE	T3,	4(T1)		;[464]REPEAT FOR SUBSEQUENT SUBSCRIPTS.
	TLNE	T2,	SUB2DF
	PUSHJ	PP,	MNUTMP

	TLNE	T2,	SUB2SF
	PUSHJ	PP,	MNUTMP

	MOVE	T3,	6(T1)		;[464]
	TLNE	T2,	SUB3DF
	PUSHJ	PP,	MNUTMP

	TLNE	T2,	SUB3SF
	PUSHJ	PP,	MNUTMP
;  ALL SUBSCRIPTS ARE NOW COMP ITEMS.

GSETPT:	POP	PP,	T2		;GET RID OF CONVERSION JUNK.

	PUSHJ	PP,	SVACS		;SAVE THE NON TEMP AC'S.

	HRRZ	AP,	AP.TMP##	;SET UP PARAM FOR SUBSCRIPT RTN.
	PUSHJ	PP,	SUBSC.##	;GO EVALUATE THE SUBSCRIPT.

	MOVE	T1,	SXR		;GET THE BYTE POINTER.
	TLZ	T1,	77

	MOVE	T2,	DW.TMP##	;GET THE DESCRIPTOR WORD.

	POPJ	PP,			;RETURN.


;  ROUTINE TO GET A NUMBER INTO A TEMP.

MNUTMP:	AOS	T2,	-1(PP)		;GET PARAMETER ADDRESS.
	MOVE	T1,	(T2)		;GET MODE AND POINTER.

	PUSH	PP,	T3		;SAVE TEMP ADDRESS.
	HLRZ	T3,	T1		;GET THE MODE.
	MOVE	T1,	@(T1)		;GET THE PARAM.
	LDB	T2,	[POINT	5,T1,17]	;PUT THE SIZE WHERE
						; GTNUM LIKES IT TO BE.
	SUBI	T2,	1		;GTNUM ALSO LIKES THE SIZE TO
					; BE ONE LESS THAN IT REALLY IS.

	PUSHJ	PP,	GTNUM		;GO GET THE NUMBER.

	POP	PP,	T3		;GET THE TEMP ADDRESS BACK.

	MOVEM	T2,	(T3)		;STORE THE NUMBER.

	MOVE	T2,	-1(PP)		;SET UP AC'S.
	MOVE	T1,	AP.TMP##
	MOVS	T3,	T3

	POPJ	PP,			;RETURN.
;ROUTINE TO STORE THE POINTER AND TALLY ITEMS.

DONE:	SETZI	ERR,			;COME HERE WHEN WE ARE DONE TO
					; STORE THE POINTER AND/OR TALLY.
SPTATL:	PUSHJ	PP,	SVACS		;SAVE NON TEMP AC'S.

	SKIPN	T1,	PT.ARG##	;GET THE POINTER ITEM'S ARG.
	JRST		SPTATD		;IF THERE ISN'T A POINTER ITEM,
					; GO ON.

	MOVE	T4,	PT.VLU##	;SAVE THE POINTER'S VALUE.
	SETZI	T6,

	PUSHJ	PP,	SPTATH		;GO STORE IT.

SPTATD:	SKIPN	T1,	TL.ARG##	;GET THE TALLYING ITEM'S ARG.
	POPJ	PP,			;IF THERE ISN'T A TALLYING ITEM,
					; LEAVE.

	PUSHJ	PP,	GTPRMT		;GO GET ITS PARAMS.
	PUSHJ	PP,	GTNUM		;GO GET ITS VALUE.

	JFCL	17,	.+1		;CLEAR ARITHMETIC FLAGS.
	ADD	T2,	TL.VLU##	;ADD IN THE TEMP TALLY.
	JCRY1	[AOJA	T1,	.+1]	;IF WE HAD A CARRY BUMP THE HIGH
					; ORDER WORD.
	TLNE	T1,	(1B0)		;MAKE SURE THE SIGNS AGREE.
	TLOA	T2,	(1B0)
	TLZ	T2,	(1B0)

	SETZM		TL.VLU##	;CLEAR THE TEMP TALLY.

	MOVE	T4,	T2		;SAVE THE TALLYING ITEM'S VALUE.
	MOVE	T6,	T1

	MOVE	T1,	TL.ARG##	;GET THE TALLYING ITEM'S ARG AGAIN.

;  STORE THE VALUE.

SPTATH:	PUSHJ	PP,	GTPRMT		;GO GET PARAMS.

	MOVE	T5,	T3		;SET UP THE PARAMS
	EXCH	T2,	T4		; AND SET UP THE NUMBER.
	MOVE	T3,	T1
	MOVE	T1,	T6

	PJRST		PUTNUM		;GO STORE IT AND RETURN.
;ROUTINE TO TRANSFER SOURCE TO DESTINATION AND DELIMITER STORE,
; STORE THE COUNT AND BUMP THE TALLYING ITEM.
;
;SOME HINTS TO ANY POOR UNFORTUNATES WHO HAVE TO READ THIS CODE:
; POINTERS TO VARIOUS FIELDS IN THE SOURCE STRING ARE KEPT IN
; TERMS OF THE NUMBER OF CHARACTERS TO THE RIGHTMOST END OF
; THE STRING.  SRC.CC CONTAINS A POINTER TO THE END OF THE
; NEXT STRING TO BE MOVED.  SE.DLM CONTAINS, IN THE LEFT HALF,
; A POINTER TO THE BEGINNING OF THE DELIMITER, AND IN THE RIGHT
; HALF A POINTER TO THE END.  WHEN MOVING THE SELECTED STRING
; FROM THE SOURCE (NOT THE DELIMITER), THE BEGINNING OF THE
; STRING IS DETERMINED BY THE BYTE POINTER IN SRCPTR.  FOR
; EXAMPLE, THE FOLLOWING UNSTRING STATEMENT:
;	UNSTRING "ABCDEFGHI" DELIMITED BY "DEF"
; WOULD RESULT, AT THE TIME OF THE CALL TO STOREM, IN SE.DLM
; CONTAINING 5,,2 (CHARACTERS ARE COUNTED RIGHT TO LEFT STARTING
; AT ZERO), SRCPTR WOULD POINT AT THE "A", AND SRC.CC WOULD
; CONTAIN 5.  UMOVE, THE ROUTINE THAT ACTUALLY DOES THE DATA
; MOVING, PAYS ATTENTION ONLY TO SRCPTR AND SRCCNT.  SRC.CC
; IS USED LATER ON (BACK AT UMLP) TO DETERMINE WHERE TO BEGIN
; SCANNING AGAIN AFTER THIS STORE.  THE RIGHT HALF OF DLM.AC
; CONTAINS THE NUMBER OF TIMES EXTRA DELIMITER STRINGS WERE
; SKIPPED DUE TO THE PRESENCE OF AN "ALL" CLAUSE IN THE UNSTRING
; STATEMENT, AND DLM.CC CONTAINS THE SIZE OF THE DELIMITER MINUS ONE.
;							/DLC

STOREM:	TLO	SW,	NOSTOR		;DON'T STORE POINTER OR TALLY.

;  MOVE SOURCE TO DESTINATION.

IFN BIS,<
	DMOVE	SRCPTR,	SRC.BP
>
IFE BIS,<
	MOVE	SRCPTR,	SRC.BP##	;POINT AT FIRST CHAR TO BE TRANSFERED.
	MOVE	SRCCNT,	SRC.CC##	;GET NUMBER OF CHARS LEFT IN SOURCE.
>

IFN ANS74,<
	MOVE	T2,DLM.CC		;BACKTRACK OVER ANY EXTRA
	ADDI	T2,1			; DELIMITERS SKIPPED BECAUSE
	HRRZ	T1,DLM.AC		; OF "ALL" CLAUSE
	IMULI	T2,(T1)
>
	HLRE	T1,	SE.DLM##	;GET NUMBER OF CHARS TO REMAIN
IFN ANS74,<
	ADD	T1,T2
>
	MOVEM	T1,	SRC.CC##	; AFTER THE TRANSFER AND SAVE IT.

	SUB	SRCCNT,	T1		;GET NUMBER OF CHARS TO MOVE.

	MOVEM	SRCCNT,	CT.VAL##	;SAVE IT FOR THE COUNT ITEM.
	ADDM	SRCCNT,	PT.VLU##	;BUMP POINTER ITEM.

	PUSHJ	PP,	UMOVE		;GO DO THE MOVE.
	PUSHJ	PP,	CLRTMP
IFN ANS74,<
	MOVE	T2,DLM.CC		;NOW MAKE SRC.CC AGAIN POINT
	ADDI	T2,1			; TO BEGINNING OF LAST
	HRRZ	T1,DLM.AC		; OCCURRENCE OF DELIMITER STRING
	IMULI	T2,(T1)
	MOVE	T1,SRC.CC		; ..
	SUB	T1,T2			; ..
	MOVEM	T1,SRC.CC		; ..
	JUMPE	T2,STORMA		;DON'T ADJUST BYTE POINTER IF UNNECESSARY
IFN BIS,<
	ADJBP	T2,SRCPTR		;SKIP OVER REDUNDANT DELIMITERS
	MOVE	SRCPTR,T2		; ..
>
IFE BIS,<
	IBP	SRCPTR
	SOJG	T2,.-1
>
STORMA:
>;END IFN ANS74

;  MOVE SOURCE TO DELIMITER STORE.

	MOVE	SRCCNT,	SRC.CC##	;GET NUMBER OF CHARS REMAINING.

	HRRE	T1,	SE.DLM##	;GET NUMBER OF CHARS TO REMAIN
	MOVEM	T1,	SRC.CC##	; AFTER THE TRANSFER AND SAVE IT.

	SUB	SRCCNT,	T1		;GET NUMBER OF CHARS TO MOVE.

	ADDM	SRCCNT,	PT.VLU##	;BUMP POINTER ITEM.

IFN ANS74,<
	HRRZ	T1,DLM.AC		;GET EXTRA REPETITIONS OF ALL
	HRRZ	T2,DLM.CC		;GET SIZE OF DELIMITER
	ADDI	T2,1			;ACCOUNT FOR ZERO-ORIGIN INDEX
	IMULI	T1,(T2)			;COMPUTE TOTAL DELIMITER SIZE
	ADDM	T1,PT.VLU		;BUMP POINTER ITEM
	HLLZS	DLM.AC			;JUST IN CASE
>
	PUSHJ	PP,	GTDOUT		;GO GET DELIMITER STORE'S PARAMS.
	JUMPE	ERR,	STORMD		;IF THERE WERE NO PROBLEMS, GO ON.
	CAIE	ERR,	OMTARG		;IF THE ARG WAS NULL OR OMITTED
	CAIN	ERR,	NULARG		; OR NULL, SET UP DUMMY PARAMS.
	TRNA
	JRST		UTRUBL		;OTHERWISE DIE.

;  DELIMITER STORE IS NULL OR OMITTED.

	SETZB	ERR,	T1		;CLEAR ERROR REGISTER AND
	SETZB	T2,	T3		; SET UP DUMMY PARAMS.

;  SAVE DELIMITER STORE'S PARAMS.

STORMD:
IFN BIS,<
	DMOVE	DSTPTR,	T1
>
IFE BIS,<
	MOVE	DSTPTR,	T1
	MOVE	DSTCNT,	T2
>
	MOVEM	T3,	DST.MD##
	PUSHJ	PP,	UMOVE		;GO DO THE MOVE.
	PUSHJ	PP,	CLRTMP

	AOS		TL.VLU##	;BUMP THE TALLY ITEM

	MOVEM	SRCPTR,	SRC.BP##	;SET UP POINTER TO CURRENT
					; SOURCE POSITION.
	MOVE	SRCCNT,	SRC.CC##	;GET NUMBER OF CHARS LEFT IN SOURCE.


;  NOW DO THE COUNT ITEM.

	PUSHJ	PP,	GTPRMS		;GO GET IT'S PARAMS.

	TLZ	SW,	NOSTOR		;ALLOW POINTER AND TALLYING ITEM
					; TO BE STORED.

	JUMPE	ERR,	STORMH		;IF THERE WERE NO PROBLEMS GETTING
					; THE COUNT ITEM'S PARAMS, GO ON.
	CAIE	ERR,	OMTARG		;IF THE COUNT ITEM WAS OMITTED
	CAIN	ERR,	NULARG		; OR NULL,
	TDZA	ERR,	ERR		; RETURN.
	JRST		UTRUBL		;OTHERWISE DIE.
	POPJ	PP,

STORMH:	PUSHJ	PP,	SVACS		;SAVE ALL NON TEMP AC'S.

IFN BIS,<
	DMOVE	T4,	T2
>
IFE BIS,<
	MOVE	T5,	T3		;SET UP PARAMS.
	MOVE	T4,	T2
>
	MOVE	T3,	T1

	SETZI	T1,			;GET THE COUNT ITEM'S VALUE.
	MOVE	T2,	CT.VAL##

	PJRST		PUTNUM		;GO STORE THE NUMBER AND RETURN.
;ROUTINE TO TRANSFER CHARS FROM THE SOURCE TO THE DESTINATION.

UMOVE:	PUSHJ	PP,	SCVSDS		;SET UP THE CONVERSION INSTRUCTION.

	MOVE	DLCH,	DST.MD##	;SELECT A PADD CHAR.
;ALWAYS PADD WITH SPACES SO THAT THE CONVERSION ROUTINES WILL PROCESS
; LEADING SIGNS ON ALPHANUMERIC FIELDS. /ACK 28-OCT-75
;	TLNE	SW,	ONUM		;NUMERIC OUTPUT?
;	SKIPA	DLCH,	PADDCH(DLCH)	;YES, USE ZEROES.
	HLR	DLCH,	PADDCH(DLCH)	;NO, USE SPACES.

	SOJL	SRCCNT,	UMOVEP		;IF THE SOURCE IS NULL,
					; GO PADD THE WHOLE THING.

	TLNN	SW,	OJST		;RIGHT JUSTIFICATION WANTED?
	JRST		UMOVEH		;NO, GO ON.

	MOVE	T1,	SRCCNT		;SEE IF WE HAVE TO PADD OR TRUNCATE.
	SUB	T1,	DSTCNT
	JUMPE	T1,	UMOVEH		;NEITHER, GO ON.
	JUMPG	T1,	UMOVED		;IF THE SOURCE IS LARGER, GO TRUNCATE.

;  DESTINATION IS LARGER THAN SOURCE - PADD.

	ADD	DSTCNT,	T1		;DECREMENT THE DESTINATION COUNT.
	IDPB	DLCH,	DSTPTR		;PADD THE ITEM.
	AOJL	T1,	.-1
	JRST		UMOVEH

;  SOURCE IS LARGER THAN DESTINATION - TRUNCATE.

UMOVED:	SUB	SRCCNT,	T1		;DECREMENT THE SOURCE COUNT.
IFN BIS,<
	ADJBP	T1,SRCPTR
	MOVE	SRCPTR,T1
>
IFE BIS,<
	IBP		SRCPTR		;SKIP OVER SOME CHARS.
	SOJG	T1,	.-1
>
;  MOVE CHARS FROM SOURCE TO DESTINATION.

UMOVEH:	JUMPL	DSTCNT,	UMOVEL		;IF THERE ISN'T ANY MORE ROOM IN
					; THE DESTINATION, GO ON.
	TRNA				;DON'T DECREMENT THE FIRST TIME.
UMOVEJ:	SOJL	SRCCNT,	UMOVEP		;IF THERE AREN'T ANY MORE CHARS
					; IN THE SOURCE, GO ON.
	ILDB	SRCH,	SRCPTR		;GET THE NEXT SOURCE CHAR.
	XCT		CVTSDS		;CONVERT IT.
	IDPB	SRCH,	DSTPTR		;STASH IT.
	SOJGE	DSTCNT,	UMOVEJ		;IF THERE IS MORE ROOM IN THE
					; DESTINATION LOOP.

;  DESTINATION IS FULL.

UMOVEL:
IFE BIS,<
	SOJL	SRCCNT,	CPOPJ		;ANY SOURCE LEFT?
	IBP		SRCPTR		;YES, SKIP OVER IT.
	SOJGE	SRCCNT,	.-1
>
IFN BIS,<
	JUMPLE	SRCCNT,.+3		;ANY SOURCE LEFT?
	ADJBP	SRCCNT,SRCPTR
	MOVE	SRCPTR,SRCCNT		;PUT BYTE PTR BACK
	SETO	SRCCNT,			;JUST INCASE
>
	POPJ	PP,			;RETURN.

;  NO MORE SOURCE.

UMOVEP:	JUMPL	DSTCNT,	CPOPJ		;ANY MORE ROOM IN THE DESTINATION?
	IDPB	DLCH,	DSTPTR		;YES, PADD THE ITEM.
	SOJGE	DSTCNT,	.-1
	POPJ	PP,			;RETURN.

;  TABLE OF PADD CHARS.  INDEX BY MODE.  LEFT HALVES ARE SPACES, RIGHT
;   HALVES ARE ZEROES.

PADDCH:	XWD	0,	20		;DISPLAY-6.
	XWD	40,	60		;DISPLAY-7.
	XWD	100,	360		;DISPLAY-9.
;ROUTINE TO SAVE AND RESTORE NON-TEMP AC'S.

SVACS:	EXCH	AP,	(PP)
	PUSH	PP,	CVTSDS
	PUSH	PP,	CMPSDL
	PUSH	PP,	CVTSDL
	PUSH	PP,	SW
	PUSH	PP,	SRCCNT
	PUSH	PP,	SRCPTR
	PUSH	PP,	DLMCNT
	PUSH	PP,	DLMPTR
	PUSH	PP,	DSTCNT
	PUSH	PP,	DSTPTR
	PUSH	PP,	.+3
	PUSH	PP,	AP
	MOVE	AP,	-14(PP)
	POPJ	PP,	.+1

	POP	PP,	DSTPTR
	POP	PP,	DSTCNT
	POP	PP,	DLMPTR
	POP	PP,	DLMCNT
	POP	PP,	SRCPTR
	POP	PP,	SRCCNT
	POP	PP,	SW
	POP	PP,	CVTSDL
	POP	PP,	CMPSDL
	POP	PP,	CVTSDS
	POP	PP,	AP
	POPJ	PP,
;ERROR ROUTINES:

STRUBL:	JUMPL	ERR,	CPOPJ
	SETZI	T2,
	JRST		TRUBLE

UTRUBL:	JUMPL	ERR,	CPOPJ
	SETOI	T2,

TRUBLE:	JUMPL	ERR,	CPOPJ
	OUTSTR	[ASCIZ	/
?Bad error code returned to /]
	SKIPE		T2
	OUTSTR	[ASCIZ	/UN/]
	OUTSTR	[ASCIZ	/STRING - continuing
/]
	SETOI	ERR,
	POPJ	PP,

	END