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

; UPD ID= 1149 on 5/24/83 at 6:07 AM by INGERSOLL                       
TITLE	STRING - COBOL OTS STRING/UNSTRING ROUTINES
SUBTTL	D.A.WRIGHT

	SEARCH COPYRT
	SALL

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

COPYRIGHT (C) 1979, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION

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

;EDIT HISTORY
;WHO	DATE	COMMENT

;***** V12B *****
;JEH	22-MAR-83	[1060] Use spaces as leading pading character.
;LEM	 7-Jun-82	[1032] Can not STRING a one byte field into a one byte field.

	SEARCH	LBLPRM		;DEFINE PARAMETERS
	%%LBLP==:%%LBLP
	EXTERN	EASTB.		;MAKE SURE EASTBL IS LOADED

;GET COMMON MACRO DEFINITIONS
	IFN TOPS20,	SEARCH MACSYM
	IFE TOPS20,	SEARCH MACTEN


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

	OPDEF	PJRST	[JRST]
	OPDEF	NOP	[TRN]	;FAST NO-OP

;THESE ROUTINES ARE CALLED AS FOLLOWS:
;	[JRST	%TAG]		;SKIP OVER RUNTIME ROUTINES
;	[<RUNTIME ROUTINES>]
;[%TAG:]			;TAG PRESENT IF RUNTIME ROUTINES PRESENT
;	MOVEI	AC16,%LITNN	;ADDRESS OF ARGUMENT LIST
;	PUSHJ	PP,XXX

SUBTTL	REVISION HISTORY

;NAME	DATE		COMMENTS
;
;
;
;
;
;
;
;
;
;
;
;
;
;DAW	1-AUG-79	EXTENSIVE REWRITE OF STRING/UNSTRING
;			TO SUPPORT VARIABLE-LENGTH ITEMS
;
;** V12A SHIPPED WITH OLD STRING/UNSTRING **

;COMMON DEFINITIONS FOR STRING AND UNSTRING

;ACS

CV=0		;CONVERSION INSTRUCTION
T1=1		;TEMP.
T2=2
T3=3
T4=4
TAG=5		;ADDRESS OF A ROUTINE TO CALL
DSTBP=6		;CURRENT DEST. BYTE PTR
DSTCC=7		;CURRENT DEST. CHARACTER-COUNT
SRCBP=10	;CURRENT SOURCE BYTE PTR
SRCCC=11	;CURRENT SOURCE CHAR COUNT

;*** WARNING - TO CHANGE THE VALUE OF "C" HERE REQUIRES CHANGING EASTBL ***
C=12		;CHARACTER VALUES
DLMBP=13	;CURRENT DELIMITER BYTE PTR
DLMCC=14	;CURRENT DELIMITER CC

F=15		;FLAGS
PA=16		;ADDRESS OF ARGUMENT LIST
PP=17		;PUSHDOWN PTR.


;COMMON FLAGS -1B0 THRU 1B9
FL.OVF==1B0		;'OVERFLOW' OCCURRED

SUBTTL	CONCEPTS FOR THE PROGRAMMER

;  This page is for programmers who wish to understand/modify
;the argument list for the STRING and UNSTRING code.
;
;  Since STRING and UNSTRING only deal with DISPLAY mode strings,
;all items that are non-DISPLAY (such as COMP items) must
;be moved to a temporary DISPLAY area before they can be used
;by STRING and UNSTRING.
;
;  When dealing with an item, a 2-word block is used to hold
;the byte pointer and character count of the item. This block
;is called a "BP-CC-BLOCK", it's format is:
;	<Byte pointer to the item>	;1 word
;	<# of bytes in the item>	;1 word
;
;  Whenever STRING and UNSTRING are passed pointers to items,
;they must be given the address of the BP-CC-BLOCK for the item.
;Sometimes the BP-CC-BLOCK may be elsewhere in the literal table,
;or it may not be known at runtime (this happens if the item
;has a depending variable or is subscripted).
;
;  BSI = Byte Size Indicator. Every BSI has one of three values:
;	0 = The item is SIXBIT  (6-bit bytes)
;	1 = The item is ASCII   (7-bit bytes)
;	2 = The item is EBCDIC  (9-bit bytes)
;  Along with the BP-CC-BLOCK information, STR. and UNS. must
;be aware of the usage of the item. The BSI of each item
;is put somewhere handy in the argument list.

;  The argument lists may contain pointers to runtime
;routines to set up the BP-CC-BLOCK, and/or move non-DISPLAY mode
;items to a temporary DISPLAY-mode area or visa versa.
;Since the STRING and UNSTRING algorithms sometimes require
;that subscripting be done dynamically during the execution
;of the statement, it may be necessary to call a routine to setup
;the BP-CC-BLOCK for an item. The routines are always called with
;a "PUSHJ 17,address" and should return with a "POPJ 17,".
;All AC's (except 17, of course) may be smashed to accomplish
;the purpose of the runtime routine.
;
;  The STRING argument list is detailed before the STRING code,
;and the UNSTRING argument list is detailed before the UNSTRING code.

SUBTTL	STRING

;The argument list format is:
;
;%LITNN: <STRING-HEADER-WORD>		;1 word
;	<DEST.INFO>			;1 word
;	[<POINTER.INFO>]		;1 word (optional)
;	<SOURCE-SERIES-INFO-ENTRIES>	;one or more entries (each .GT.1 word)
;
;In detail:
;
;<STRING-HEADER-WORD> is
;	XWD  -# OF SOURCE-SERIES-ENTRIES,STRING-FLAGS
;
;<DEST.INFO> is
;	2B35 = BSI of the destination data item.
;Note:	STR. assumes that the BP-CC of the destination
;	item has been stored in DSP.BP and DSP.CC.
;
;<POINTER.INFO> (only present is there was a pointer item) is:
;	XWD 0,%TAG (address of runtime routine to store pointer value)
;
;Note:	Whether or not there was a pointer item, STR. expects an
;	appropriate value for the pointer item to have been stored in
;	PT.VAL. When there is no pointer item, PT.VAL should contain 1.
;
;  The code at %TAG is "PUSHJ'd" to. It should move the value in PT.VAL
;to the actual POINTER data item.
;
;
;  (continued on the following page)

; Format of the STRING argument list  (continued)

;
;<SOURCE-SERIES-INFO-ENTRIES> is one or more <SS-INFO-ENTRY>'s.
;
;<SS-INFO-ENTRY> is:
;	<# of source items in this series>
;	[XWD DELIMITER-FLAGS + BSI ,, DLM.TP] ;1 Word (Optional)
;	[%TAG.DL or 0]			;1 Word (Optional)
;	<SOURCE-ARG-ENTRIES>		;1 or more entries, each 2 words
;
;	BIT 0 THRU BIT 16 = DELIMITER-FLAGS
;	2B17 = BSI of the delimiter
;	DLM.TP = Address of the BP-CC for this delimiter, or 0
;
; If %TAG.DL is non-zero, it is an address of a runtime routine to setup
;DLM.BP and DLM.CC for this delimiter. If %TAG.DL is zero, DLM.TP will
;point to the BP-CC-BLOCK for the delimiter, which will be copied
;into DLM.BP and DLM.CC.
;
;<SOURCE-ARG-ENTRIES> is one or more <SOURCE-ARG-ENTRY>.
;
;<SOURCE-ARG-ENTRY> is:
;	BSI.Source,,SRC.TP	;1 word
;	%TAG.SR or 0		;1 word
;
;	2B17 = BSI of the source item
;	SRC.TP = Address of the BP-CC for this source, or 0 (if %TAG.SR).
; If %TAG.SR is present, it is the address of a runtime routine to setup
;SRC.BP and SRC.CC for this source. STR. dynamically gets the BP and CC
;for each source item by using either SRC.TP or calling the routine at
;%TAG.SR.

;DEFINITIONS FOR "STRING"
;FLAGS
	FL.DSZ==1B10		;THIS GROUP OF SOURCES IS DELIMITED BY SIZE

;STRING-FLAGS (copied from argument list)
	FL.GPT==1B18		;THERE WAS A POINTER ITEM

;DELIMITER-FLAGS
	SF%DSZ==1B0		;NO DELIMITER ITEM - DELIMITED BY SIZE

;HERE IS THE ENTRY POINT FOR "STRING" WITH OVERFLOW CLAUSE
STR.O:	PUSHJ	PP,STR.		;CALL STRING ROUTINE
	TXNE	F,FL.OVF	;WAS THERE OVERFLOW?
	AOS	(PP)		;YES, RETURN TO CALL+2
	POPJ	PP,		;IF NO OVERFLOW, RETURN TO CALL+1

;HERE IS THE ENTRY POINT FOR THE "STRING" STATEMENT
STR.:	MOVEM	PA,BS.AGL##	;SAVE BASE ADDRESS OF ARG LIST
	HRRZ	F,(PA)		;SET FLAG WORD TO THE STRING FLAGS
	HLRE	T1,(PA)		;GET -# OF SOURCE STRINGS
	MOVMM	T1,SS.CNT##	;SAVE COUNT

	MOVE	T1,1(PA)	;GET DEST. INFO
	MOVEM	T1,DST.MD##	;SAVE DEST. MODE

	TXNE	F,FL.GPT	;GOT A "POINTER" ITEM?
	 JRST	[MOVE T1,2(PA)	;YES, GET THE TAG
		MOVEM T1,TAG.PT## ;SAVE "POINTER ITEM" TAG
		MOVEI T2,3(PA)	;ADDR OF FIRST SOURCE-SERIES ARG
		JRST STR01]	;GO ON
	SETZM	TAG.PT##	;NO 'POINTER ITEM' TAG, CLEAR IT
	MOVEI	T2,2(PA)	;ADDR OF FIRST SOURCE-SERIES ARG
STR01:	MOVEM	T2,NX.SSA##	;SAVE "NEXT SOURCE-SERIES" ARG.

;CHECK FOR INITIAL OVERFLOW.  THE POINTER ITEM HAS BEEN STORED IN PT.VAL.
; THE INITIAL CC OF THE RECEIVING ITEM IS IN DST.CC

	DMOVE	DSTBP,DST.BP##	;GET BP IN DSTBP, CC IN DSTCC
	HRRZ	T1,PT.VAL##
	JUMPLE	T1,SOVFLO	;IF PTR ITEM IS LESS THAN 1, OVERFLOW
	CAILE	T1,(DSTCC)	;[1032] ENOUGH CHARS IN DEST?
	 JRST	SOVFLO		;NO, OVERFLOW

;ADJUST BYTE PTR AND COUNT OF THE RECEIVING ITEM.
	SOJE	T1,STR02	;IF WE DON'T HAVE TO ADJUST IT, LEAVE
	SUBI	DSTCC,(T1)	;ADJUST THE COUNT.
	ADJBP	T1,DSTBP	;ADJUST THE BYTE PTR
	MOVE	DSTBP,T1	;PUT BYTE PTR BACK

;FALL INTO STR02  TO TRANSFER 1ST SET OF SOURCES.

;TRANSFER A SET OF SOURCES TO THE DESTINATION.
; HERE WITH NX.SSA POINTING TO THE NEXT STRING-SERIES ARG.
;
; DSTBP IS THE CURRENT BP TO THE DESTINATION
; DSTCC IS THE CURRENT CC OF THE DESTINATION

STR02:	HRRZ	T1,NX.SSA##	;POINT AT FIRST WORD OF SOURCE-SERIES ENTRY
	MOVE	T2,(T1)		;GET # SOURCES
	MOVEM	T2,NUM.SR##	;SAVE # SOURCES
	MOVE	T3,1(T1)	;GET FLAGS WORD FOR DELIMITER
	TXNE	T3,SF%DSZ	;WAS IT DELIMITED BY SIZE
	 JRST	STR03		;YES
	TXZ	F,FL.DSZ	;NO, CLEAR FLAG

;STORE %TAG OR 0 IN TAG.DL
	MOVE	T2,2(T1)
	MOVEM	T2,TAG.DL##

;STORE %TEMP PTR
	HRRZ	T2,1(T1)
	MOVEM	T2,DLM.TP##	;SAVE IT

;SETUP DELIMITER BP AND CC
	SKIPN	TAG,TAG.DL##	;IS THERE A TAG?
	 JRST	[DMOVE	T1,@DLM.TP	;NO, GET BP AND CC FROM %LIT
		DMOVEM	T1,DLM.BP##	;STORE IN DLM.BP
		JRST	STR04]		;GO TO COMMON CODE
	PUSHJ	PP,CALTAG	;GO SETUP DLM.BP AND DLM.CC
	JRST	STR04		;GO TO COMMON CODE


;HERE IF NO DELIMITER
STR03:	TXO	F,FL.DSZ	;SET "DELIMITED BY SIZE" FLAG
;	JRST	STR04

; HERE WITH DLM.BP AND DLM.CC SET UP IF A DELIMITER.
; IF THERE WAS NO DELIMITER (DELIMITED BY SIZE), THE FLAG FL.DSZ IS ON.

STR04:	HRRZ	T1,NX.SSA##	;START OF SOURCE-SERIES
	MOVEI	T1,3(T1)	;POINT TO FIRST SOURCE
	MOVEM	T1,NX.SRC##	;SAVE START OF NEXT SOURCE

;HERE WITH T1 POINTING TO THE NEXT SOURCE ARGUMENT
STR05:	MOVE	T2,(T1)		;GET FLAGS + BSI.SOURCE,,%TEMP OR 0
	HRRZM	T2,SRC.TP##

	MOVE	T3,1(T1)	;%TAG OR 0
	MOVEM	T3,TAG.SR##	;TAG FOR SOURCE

;SETUP CONVERSION INSTRUCTION(S)
	LDB	T4,[POINT 3,T2,17]	;T4:= BSI OF SOURCE STRING
	TXNE	F,FL.DSZ	;IF DELIMITED BY SIZE,
	 JRST	STR05A		; SKIP THIS
	DMOVE	DLMBP,DLM.BP	;GET BP AND CC FOR DELIM ITEM
	HRRZ	T1,NX.SSA##	;GET BSI OF DELIMITER IN T3
	LDB	T3,[POINT 3,1(T1),17]
	XCT	TT.CVD(T4)	;GET INST TO CONVERT DELIMITER TO SOURCE MODE
	MOVEM	CV,CV.DLM##	;SAVE IT

;SETUP CONVERSION INSTRUCTION TO CONVERT SOURCE TO RECEIVING ITEM'S MODE
STR05A:	MOVE	T3,T4		;SOURCE MODE IN T3
	HRRZ	T1,DST.MD##	;DEST. MODE TO INDEX BY
	XCT	TT.CVD(T1)	;GET INST TO CONVERT SOURCE TO DEST.


;(LEAVE SOURCE CONVERSION INSTRUCTION IN CV)

;SETUP SRC.BP AND SRC.CC
	SKIPN	TAG,TAG.SR##	;TAG FOR SOURCE?
	 JRST	[DMOVE	SRCBP,@SRC.TP##	;NO, GET %LIT BLOCK
		DMOVEM	SRCBP,SRC.BP##	;SAVE SRC.BP
		JRST	STR06]
	PUSHJ	PP,CALTAG	;CALL USER ROUTINE TO SETUP SRC.CC AND SRC.BP
	DMOVE	SRCBP,SRC.BP##	;FETCH INITIAL SOURCE ENTRIES

;HERE WITH SRC.BP AND SRC.CC = INITIAL BP AND CC OF SOURCE ITEM
;SRCBP, SRCCC ARE SET UP

;THIS IS MAIN LOOP OF STRING/UNSTRING ROUTINE.

STR06:	TXNE	F,FL.DSZ	;IF DELIMITED BY SIZE,
	 JRST	STR10		;GO STUFF AS MUCH AS WE CAN

	ILDB	T1,DLMBP	;GET 1ST CHAR OF DELIMITER

SMLD:	ILDB	C,SRCBP		;GET A SOURCE CHAR
	XCT	CV.DLM##	;CONVERT CHARS TO SAME MODE
	CAIN	C,(T1)		;SAME?
	 JRST	SMLL		;EQUAL, TRY TO MATCH MORE

SMLH:	SOJL	DSTCC,SOVFLO	;IS THE DESTINATION IS FULL, IT'S
				; AN OVERFLOW
	LDB	T1,SRCBP	;GET THE CHAR AGAIN, IN T1 NOW
	XCT	CV		;CONVERT TO DEST. MODE
	IDPB	T1,DSTBP	;STORE CHAR IN DESTINATION
	AOS	PT.VAL##	;BUMP THE POINTER VALUE
	LDB	T1,DLMBP	;GET 1ST CHAR OF DELIM AGAIN
	SOJG	SRCCC,SMLD	;IF THERE ARE MORE SOURCE CHARS,
				; GO TRY TO MATCH AGAIN.
	JRST	NXTSR		;OTHERWISE, GO GET THE NEXT SOURCE

;FIRST CHAR OF DELIMITER MATCHES A SOURCE CHAR.
SMLL:	CAIN	DLMCC,1		;IF DELIMITER IS ONLY 1 CHAR LONG,
	 JRST	NXTSR		;GO TO NEXT SOURCE
	DMOVEM	SRCBP,SRC.BP	;SAVE SOURCE INFO (WHERE WE ARE NOW)
SMLP:	SOJLE	DLMCC,NXTSR	;IF THERE IS NO MORE DELIMITER, IT'S A MATCH
	SOJLE	SRCCC,SMLT	;IF THERE IS NO MORE SOURCE, IT'S NOT A MATCH
	ILDB	T1,DLMBP	;GET NEXT DELIMITER CHARACTER
	ILDB	C,SRCBP		;GET NEXT SOURCE CHARACTER
	XCT	CV.DLM##	;CONVERT IF NECESSARY
	CAIN	T1,(C)		;DOES THIS CHAR MATCH?
	 JRST	SMLP		;YES, KEEP GOING

;DELIMITER DOESN'T MATCH SOURCE.
SMLT:	DMOVE	SRCBP,SRC.BP	;RESTORE SOURCE INFO.
	DMOVE	DLMBP,DLM.BP	;RESTORE INITIAL DELIM INFO
	ILDB	T1,DLMBP	; GET 1ST CHAR IN T1
	LDB	C,SRCBP		;GET 1ST (MATCHING) CHAR IN SOURCE
	JRST	SMLH		;PICK UP WHERE WE LEFT OFF.

;HERE IF DELIMITED BY SIZE. STUFF AS MUCH AS WE CAN INTO THE DEST.
STR10:	SOJL	SRCCC,NXTSR	;JUMP IF NO MORE SOURCE
	ILDB	T1,SRCBP	;GET A SOURCE CHAR
	XCT	CV		;CONVERT SOURCE TO DEST MODE
	SOJL	DSTCC,SOVFLO	;OVERFLOW IF NO MORE DEST.
	IDPB	T1,DSTBP	;ELSE STORE CHAR
	AOS	PT.VAL##	;BUMP POINTER VALUE
	JRST	STR10		;LOOP

;HERE TO GO ON TO NEXT SOURCE ITEM
NXTSR:	SOSG	NUM.SR		;ANY MORE SOURCES?
	 JRST	NXTSS		;NO, GO ON TO NEXT SOURCE-SERIES
	MOVEI	T1,2		;YES, BUMP PTR
	ADDB	T1,NX.SRC##	; AND GET THE NEW ONE IN T1
	JRST	STR05		;GO DO IT

;HERE TO GO ON TO NEXT SOURCE-SERIES
NXTSS:	SOSG	SS.CNT		;ANY MORE?
	 JRST	STRDON		;NO, DONE
	SKIPE	TAG,TAG.PT##	;STORE POINTER ITEM
	 PUSHJ	PP,CALTAG	; INCASE SUBSCRIPTING NEEDS NEW VALUE
	HRRZ	T1,NX.SSA	;GET PTR TO THE SOURCE-SERIES WE JUST DID
	MOVE	T2,(T1)		;GET # SOURCES
	LSH	T2,1		; TWO WORDS FOR EACH ONE
	ADDI	T2,3		;+2 FOR THE DELIMITER ITEM +1 FOR SOURCE COUNT
	ADD	T2,T1		;+OLD LOC
	MOVEM	T2,NX.SSA	;SAVE NEW NX.SSA
	JRST	STR02		;GO DO IT


;HERE WHEN STRING IS DONE, NO OVERFLOW ENCOUNTERED
STRDON:	SKIPE	TAG,TAG.PT##	;STORE FINAL POINTER VALUE
	 PUSHJ	PP,CALTAG	;IF THERE WAS A POINTER ITEM
	POPJ	PP,		;RETURN

;HERE FOR OVERFLOW
SOVFLO:	TXO	F,FL.OVF	;SET OVERFLOW FLAG
	JRST	STRDON		;RETURN

SUBTTL	UNSTRING

;THE ARGUMENT LIST FORMAT IS:
;
;%LITNN: <UNSTRING-HEADER-WORD>		;1 word
;	<SOURCE-ITEM-INFO>		;1 word
;	[<POINTER-ITEM-INFO>]		;1 word (optional)
;	[<TALLYING-ITEM-INFO>]		;1 word (optional)
;	# delimiter items		;1 word
;	[<DELIMITER-ITEM-INFO>]		;optional 2-word blocks
;	<DESTINATION-ITEM-BLOCK>	;1 or more, 2 to 5 words each
;
;<UNSTRING-HEADER-WORD> is:
;	-# of destinations,,UNSTRING-FLAGS
;
;<SOURCE-ITEM-INFO> is:
;	2B35 = BSI of the source item
;Note:	UNS. assumes that the BP-CC of the source item has been
;	stored in SRC.BP and SRC.CC.
;
;<POINTER-ITEM-INFO> is:
;	XWD 0,%TAG.PT
; %TAG.PT is the address of a routine that is called by UNS. to
;store the pointer item away from PT.VAL.
;
;<TALLYING-ITEM-INFO> is:
;	XWD 0,%TAG.TL
;  %TAG.TL is the address of a routine that is called by UNS. to
;store the tallying item away from TL.VAL.
;
;<DELIMITER-ITEM-INFO> is a 2-word block for each delimiter:
;	DELIM-FLAGS + BSI.DELIMITER ,, PTR TO BP-CC-BLOCK
;	%TAG.DELIM or 0
;
;  %TAG.DELIM is the address of a routine that is called to
;setup the BP-CC block. If the TAG is present, the BP-CC-BLOCK
;will be setup in %TEMP, else it will be in the literals.
;
; (continued on next page)

;
; Format of the UNSTRING arg list  (continued)
;
;<DESTINATION-ITEM-BLOCK> is:
;	<DESTINATION-ITEM-INFO>		;2 words
;	[<DELIMITER-STORE-INFO>]	;optional, 2 words
;	[<COUNT-ITEM-INFO>]		;optional, 1 word
;
;<DESTINATION-ITEM-INFO> is:
;	DEST-FLAGS + BSI.DEST ,, PTR TO BP-CC BLOCK FOR DEST.
;	%TAG.ST ,, %TAG.DA
;
; If %TAG.ST is non-zero, it is the address of a routine to setup
;the BP-CC block.  If %TAG.DA is non-zero, it is the address of a routine
;that stores away the destination from OU.TMP to the actual destination
;item.
;
;<DELIMITER-STORE-INFO> is:
;	DELSTORE-FLAGS + BSI.DELSTORE ,, PTR TO BP-CC BLOCK FOR DELSTORE.
;	%TAG.ST ,, %TAG.DA
;
;  The tags are used in the same manner as for the destination items.
;
;<COUNT-ITEM-INFO> is:
;	XWD 0, %TAG.CT	;address of runtime routine.
;
; %TAG.CT points to code that stores away the value of the count item
;from CT.VAL to the real data item.

;DEFINITIONS FOR UNSTRING

FL.NDL==1B10		;NO DELIMITER ITEMS PRESENT
FL.ALL==1B11		;"ALL" SPECIFIED FOR CURRENT DELIMITER
FL.MAT==1B12		; WE HAD AT LEAST 1 MATCHING OCCURANCE OF AN 'ALL'
			;DELIMITER

;UNSTRING-FLAGS (copied from the the argument list)
FL.UPT==1B18		;POINTER ITEM PRESENT
FL.UTL==1B19		;TALLYING ITEM PRESENT

;DELIM-FLAGS
	DE%ALL==1B1		;'ALL' SPECIFIED FOR THIS DELIMITER

;DEST-FLAGS
	US%RIN==1B0		;RECEIVING ITEM IS NUMERIC
	US%RRJ==1B1		;RECEIVING ITEM IS RIGHT-JUSTIFIED
	US%GDS==1B2		;GOT DEL-STORE
	US%GCT==1B3		;GOT COUNT ITEM

;DELSTORE-FLAGS
	DS%NUM==1B0		;DELIM STORE IS NUMERIC
	DS%JST==1B1		;DELIM STORE IS RIGHT-JUSTIFIED

;HERE FOR UNSTRING WITH OVERFLOW CLAUSE
UNS.O:	PUSHJ	PP,UNS.		;DO THE UNSTRING
	TXNE	F,FL.OVF	;WAS THERE OVERFLOW?
	AOS	(PP)		;YES, RETURN TO CALL+2
	POPJ	PP,		;IF NO OVERFLOW, RETURN TO CALL+1

;HERE FOR UNSTRING
UNS.:	HRRZ	F,(PA)		;GET INITIAL UNSTRING FLAGS
	HLRE	T1,(PA)		;GET -# OF "INTO" ITEMS
	MOVMM	T1,NUM.RC##	;SAVE # RECEIVING ITEMS LEFT TO DO

	MOVE	T1,1(PA)	;GET SOURCE INFO.
	MOVEM	T1,SRC.MD##	;SAVE SOURCE MODE

	MOVEI	T4,2(PA)	;T4:=WHERE WE ARE IN ARG LIST
	TXNN	F,FL.UPT	;GOT A POINTER ITEM?
	 JRST	UNS01		;NO
	MOVE	T1,(T4)		;YES, GET THE TAG
	MOVEM	T1,TAG.PT##	;SAVE "POINTER ITEM" TAG
	AOJA	T4,.+2
UNS01:	SETZM	TAG.PT##	;CLEAR TAG IF NO POINTER ITEM
	TXNN	F,FL.UTL	;GOT A TALLYING ITEM
	 JRST	UNS02		;NO
	MOVE	T1,(T4)		;YES, GET THE TAG
	MOVEM	T1,TAG.TL##	;SAVE "TALLYING ITEM" TAG
	AOJA	T4,.+2
UNS02:	SETZM	TAG.TL##	;CLEAR TAG IF NO TALLYING ITEM
	MOVEM	T4,BS.AGL##	;SAVE BASE FOR DELIMITER ITEMS

;CHECK FOR INITIAL OVERFLOW, AND ADJUST THE SOURCE STRING.
;THE POINTER ITEM HAS BEEN STORED IN PT.VAL.  THE INITIAL
; CC AND BP OF THE SOURCE ITEM IS IN SRC.BP AND SRC.CC.

	DMOVE	SRCBP,SRC.BP##	;GET BP IN SRCBP, CC IN SRCCC
	HRRZ	T1,PT.VAL##
	JUMPLE	T1,UNSOVL	;IF PTR ITEM .LT. 1, OVERFLOW

	SOJE	T1,UNS03	;IF WE DON'T HAVE TO ADJUST IT, LEAVE
	SUBI	SRCCC,(T1)	;ADJUST THE COUNT
	JUMPLE	SRCCC,UNSOVL	;IF PTR PAST END OF SOURCE, LEAVE

;ADJUST BYTE PTR AND COUNT OF THE SOURCE ITEM
	ADJBP	T1,SRCBP
	MOVE	SRCBP,T1	;PUT NEW BYTE PTR IN SRCBP
	DMOVEM	SRCBP,SRC.BP##	;SAVE NEW SOURCE BP.
;FALL INTO UNS03

;SOURCE STRING IS NOW SETUP IN SRCBP AND SRCCC.

UNS03:	HRRZ	T1,BS.AGL	;GET BASE OF DELIMITER ARGS
	SKIPN	T2,(T1)		;GET M= # DELIMITERS
	 TXO	F,FL.NDL	;"NO DELIMITERS"
	LSH	T2,1		; 2 WORDS FOR EACH DELIMITER
	ADDI	T1,1(T2)	;T1:= BASE OF DEST. ITEMS
	MOVEM	T1,NX.SRC##	;NX.SRC:= NEXT DEST. ITEM

;HERE IS MAIN LOOP OF UNSTRING ROUTINE.
; SRCBP AND SRCCC REFLECT WHERE WE ARE IN THE SOURCE SO FAR.
;NX.SRC POINTS TO THE NEXT DEST.  NUM.RC IS THE NUMBER OF
; RECEIVING ITEMS LEFT TO DO. BS.AGL POINTS TO THE DELIMITER ITEMS.

;SETUP NEXT DEST BP AND CC

UNS04:	HRRZ	T1,NX.SRC##	;POINT TO 2-WORD DEST INFO
	LDB	T4,[POINT 3,(T1),17] ;GET BSI OF DEST.
	HRRZ	T3,SRC.MD##	;CONVERTING FROM BSI OF SOURCE
	XCT	TT.CVD(T4)	;GET CONVERSION INSTRUCTION.
	MOVEM	CV,CV.SDS##	; SAVE IT

	HRRZ	T2,(T1)		;GET %LIT OR %TEMP PTR
	MOVEM	T2,DST.TP##	;SAVE IT (NOTE: MUST BE NON-ZERO!)
	MOVE	T3,1(T1)	;GET %TAG1,%TAG2
	HLRZM	T3,TAG.ST##	; TAG TO SETUP %TEMP
	HRRZM	T3,TAG.DA##	; TAG TO STORE OU.TMP AWAY
	SKIPE	TAG,TAG.ST##	;HAVE TO SETUP %TEMP?
	 PUSHJ	PP,CALTAG	;YES, SETUP %TEMP NOW

	DMOVE	DSTBP,@DST.TP##	;GET DEST BP AND CC
	DMOVEM	DSTBP,DST.BP##	;SAVE INITIAL VALUES

	HRRZ	T1,NX.SRC##	;LOOK AT NEXT SOURCE
	MOVE	T2,(T1)		;GET FLAG WORD
	TXNN	T2,US%GCT	;GOT A COUNT ITEM?
	 JRST	UNS05		;NO
	TXNE	T2,US%GDS	;ALSO GOT A DELIM STORE?
	 SKIPA	TAG,4(T1)	;YES, GET FIFTH WORD
	MOVE	TAG,2(T1)	;NO, GET 3RD WORD OF ENTRY
	MOVEM	TAG,TAG.CT##	;STORE TAG FOR THE COUNT ITEM
	  TRNA			;AND SKIP
UNS05:	SETZM	TAG.CT##	;NO TAG FOR THE COUNT ITEM
;NOW DSTBP AND DSTCC ARE SETUP FOR THE NEXT DESTINATION.
;CV.SDS CONTAINS THE INSTRUCTION TO CONVERT FROM SOURCE TO DEST MODE.

;CHECK FOR DELIMITERS
	TXNN	F,FL.NDL	;SKIP IF NO DELIMITERS TO WORRY ABOUT
	 JRST	UNS10		; THERE ARE, GO WORRY ABOUT THEM

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

;HERE WITH NO DELIMITERS TO WORRY ABOUT, DEST ALL SET UP.
;FIND # CHARS TO MOVE INTO THIS DEST.
	CAILE	DSTCC,(SRCCC)	;IF DEST. IS LARGER THAN
	 JRST	UNS06		;SOURCE, MOVE ALL CHARS IN THE SOURCE

;DEST IS SMALLER THAN SOURCE. MOVE AS MANY CHARS AS WE CAN,
; DON'T HAVE TO WORRY ABOUT JUSTIFICATION.
UNS05A:	MOVE	T3,DSTCC	;# CHARS TO MOVE
	MOVEM	T3,CT.VAL##	;SAVE COUNT VALUE
	ADDM	T3,PT.VAL##	;ADJUST POINTER VALUE
	PUSHJ	PP,MOVSDS	;MOVE SOURCE TO DEST..
	SKIPE	TAG,TAG.DA##	;STORE AWAY FROM OU.TMP?
	 PUSHJ	PP,CALTAG	;YES, GO DO IT
	PUSHJ	PP,BMPTAL	;BUMP "TALLYING" ITEM
	SKIPE	TAG,TAG.CT##	;DO WE HAVE A COUNT ITEM?
	  PUSHJ	PP,CALTAG	;YES, STORE IT AWAY
	SKIPE	TAG,TAG.PT##	;DO WE HAVE A POINTER ITEM?
	 PUSHJ	PP,CALTAG	;YES, STORE NEW VALUE

;GO ON TO NEXT DEST.
UNS05B:	JUMPE	SRCCC,UNSDON	;DONE IF SOURCE RAN OUT
	SOSG	NUM.RC##	;ANY MORE RECEIVING ITEMS?
	 JRST	UNSOVL		;NO, OVERFLOW
	PUSHJ	PP,NXTDST	;SETUP NEXT DEST
	JRST	UNS04		;GO ON TO NEXT DEST.

;HERE WHEN DEST. IS .GT. # CHARS REMAINING IN SOURCE.
;WE HAVE TO CHECK FOR JUSTIFICATION AND DO THE APPROPRIATE THING.

UNS06:	HRRZ	T1,NX.SRC##	;START OF 2-WORD BLOCK
	MOVE	T3,(T1)		;GET FLAG WORD
	TXNE	T3,US%RRJ	;IF RECEIVING ITEM IS RIGHT-JUSTIFIED, PAD
	 JRST	UNS07		;GO PAD TO THE LEFT FIRST

;MOVE THE CHARS, THEN PAD TO THE RIGHT
	MOVE	T3,SRCCC	;# CHARS TO MOVE
	MOVEM	T3,CT.VAL##	;SAVE COUNT VALUE
	ADDM	T3,PT.VAL##	;ADD TO POINTER VALUE
	PUSHJ	PP,MOVSDS	;MOVE SOURCE TO DEST..
	SKIPE	TAG,TAG.DA##	; STORE DEST FROM OU.TMP?
	 PUSHJ	PP,CALTAG	;YES
	PUSHJ	PP,BMPTAL	;BUMP "TALLYING" ITEM
	SKIPE	TAG,TAG.CT##	;DO WE HAVE A COUNT ITEM?
	  PUSHJ	PP,CALTAG	;YES, STORE IT AWAY
	SKIPE	TAG,TAG.PT##	;DO WE HAVE A POINTER ITEM?
	 PUSHJ	PP,CALTAG	;YES, STORE VALUE

	MOVE	T1,DSTCC	;# CHARS LEFT IN DESTINATION
	PUSHJ	PP,PADDST	;PAD IT OUT
	JRST	UNS05B		;GO DO NEXT DEST, IF ANY


;HERE TO RIGHT-JUSTIFY THE DEST.
UNS07:	HRRZ	T1,DSTCC	;FIND # CHARS TO PAD WITH
	SUB	T1,SRCCC
	PUSHJ	PP,PADDST	;GO PAD THE DEST NOW.
	JRST	UNS05A		;NOW MOVE EQUAL # OF CHARS

;HERE FOR UNSTRING WITH DELIMITERS TO WORRY ABOUT
;NOW DSTCC AND DSTBP ARE SETUP FOR THE NEXT DESTINATION.
; TAG.CT IS THE TAG FOR THE COUNT ITEM (IF ANY).

;SETUP DELIMITERS
UNS10:	HRRZ	T1,BS.AGL##	;POINTER TO BASE OF DELIMITER ARGS
	MOVE	T2,(T1)		;GET # OF DELIMITERS
	MOVEM	T2,NUM.DL##	;SAVE # LEFT TO DO
	MOVEI	T1,1(T1)	;T1:= PTR TO FIRST DELIM ARG.

;HERE WITH T1 POINTING TO NEXT DELIM ENTRY
UNS11:	SKIPE	TAG,1(T1)	;CALL EACH %TAG
	 PUSHJ	PP,CALTAG	;TO SETUP %TEMP, IF NECESSARY
	SOSG	NUM.DL##	;ANY MORE TO DO?
	 JRST	UNS12		;NO, DONE
	ADDI	T1,2		;BUMP PTR TO NEXT DELIMITER ENTRY
	JRST	UNS11		;LOOP

;HERE WHEN ALL DELIMS HAVE BEEN SETUP
; FIND AN OCCURANCE OF A DELIMITER OR END OF SOURCE.

UNS12:	DMOVEM	SRCBP,SRD.BP##	;SAVE WHERE WE ARE IN SOURCE NOW
	SETZM	CT.VAL##	;# CHARS EXAMINED

;CHECK ALL DELIMITERS TO SEE IF ONE STARTS MATCHING AT THIS CHARACTER

UNS15:	HRRZ	T1,BS.AGL##	;POINTER TO BASE OF DELIMITER ARGS
	MOVE	T2,(T1)		;GET # OF DELIMITERS
	MOVEM	T2,NUM.DL##	;SAVE # LEFT TO DO
	MOVEI	T1,1(T1)	;WHERE NEXT DELIMITER IS
	MOVEM	T1,NX.DLM##	;SAVE "NEXT DELIMITER" ENTRY
;	JRST	UNS16		;GO CHECK FIRST DELIM AGAINST
				; THE CURRENT SOURCE CHARACTER

;HERE TO CHECK NEXT DELIMITER AGAINST THE CURRENT SOURCE CHAR
UNS16:	TXZ	F,FL.MAT	;NO MATCH YET
	DMOVE	SRCBP,SRD.BP##	;GET CURRENT SOURCE POSITION
	HRRZ	T1,NX.DLM##	;HERE IS DELIMITER ENTRY
	MOVE	T2,(T1)		;GET FLAG WORD
	TXNE	T2,DE%ALL	;"ALL" SPECIFIED?
	 TXOA	F,FL.ALL	;YES, SET FLAG
	TXZ	F,FL.ALL	; ELSE CLEAR FLAG
	SETZM	CT.DLM##	;COUNT OF CHARS MATCHED BY THE DELIMITER

;SET CV:= CONVERSION INSTRUCTION
	LDB	T3,[POINT 3,T2,17] ;CONVERT FROM MODE OF DELIMITER
	HRRZ	T4,SRC.MD##	;SOURCE MODE
	XCT	TT.CVD(T4)	;CV:= INST TO CONVERT

;SETUP DLMBP AND DLMCC, DLM.BP AND DLM.CC
	HRRZ	T1,(T1)		;%LIT OR %TEMP
	DMOVE	DLMBP,(T1)	;SETUP BP AND CC
	DMOVEM	DLMBP,DLM.BP##	;AND STORE AWAY INCASE "ALL" SPECIFIED

	ILDB	C,SRCBP		;LOOK AT NEXT CHAR
	SUBI	SRCCC,1
	ILDB	T1,DLMBP	;GET DELIM CHAR
	SUBI	DLMCC,1
	XCT	CV		;CONVERT DELIM TO SOURCE MODE
	CAIN	T1,(C)		;FIRST CHAR MATCH?
	 JRST	UNS17		;YES

;HERE IF THIS DELIM DOESN'T MATCH
UNS16A:	SOSG	NUM.DL##	;MORE DELIMITERS TO DO?
	 JRST	UNS16B		;NO, DO NEXT CHAR OF SOURCE
	MOVEI	T1,2
	ADDM	T1,NX.DLM##	;BUMP PTR TO NEXT DELIMITER
	JRST	UNS16

;NO MATCH AT THIS CHARACTER POSITION. TRY NEXT ONE
UNS16B:	IBP	SRD.BP##	;INCREMENT BYTE PTR
	SOSE	SRD.CC##	;ANY MORE SOURCE CHARS?
	JRST	UNS15		;YES, TRY AGAIN FOR THIS CHAR

;HERE WHEN ALL CHARS IN SOURCE HAVE BEEN EXAMINED, 
; WITH NO MATCHING DELIMITERS.

UNS16C:	MOVE	T3,SRC.CC##	;COPY REST OF SOURCE TO THIS DESTINATION
	DMOVE	SRCBP,SRD.BP##	;GET START FOR NEXT EXAMIN. IN SRCBP
	JRST	UNS21

;ANOTHER CHAR OF DELIMITER MATCHED
UNS17:	JUMPE	DLMCC,UNS18	;THIS DELIM MATCHED
	JUMPE	SRCCC,[TXNE F,FL.MAT ;SOURCE RAN OUT, DID WE MATCH
					; ONCE BEFORE THIS?
			JRST UNS17A	;YES
			JRST UNS16A]	;NO MATCH FOR THIS DELIM

;MORE CHARS IN BOTH SOURCE AND DELIMITER.. KEEP CHECKING
	ILDB	C,SRCBP
	SUBI	SRCCC,1
	ILDB	T1,DLMBP
	SUBI	DLMCC,1
	XCT	CV		;CONVERT DELIM TO SOURCE MODE
	CAIN	T1,(C)		;STILL MATCH?
	 JRST	UNS17		;YES.

;STOPPED MATCHING.. IF "ALL" WAS SPECIFIED,
; AND AT LEAST ONE MATCH, IT'S A MATCH
	TXNN	F,FL.MAT	;DID WE GET A MATCH?
	 JRST	UNS16A		;NO

;HERE IF ONE OR MORE OCCURANCES OF 'ALL' DELIMITER MATCHED.
;RESET THE SRCCC AND SRCBP TO AFTER THE LAST ONE THAT MATCHED.

UNS17A:	DMOVE	SRCBP,SRA.BP##	;GET LAST SAVED SOURCE BP AND CC
	JRST	UNS20		;MATCHED, # CHARS IN "CT.VAL"

;THIS DELIM MATCHED. IF "ALL" SPECIFIED, TRY TO MATCH SOME MORE
UNS18:	DMOVE	DLMBP,DLM.BP##	;GET INITIAL DELIM PARAMS
	TXNN	F,FL.ALL	;"ALL" SPECIFIED FOR THIS DELIM?
	 JRST	UNS19		;NO
	TXO	F,FL.MAT	;SET "MATCHED" FLAG
	ADDM	DLMCC,CT.DLM##	; BUMP COUNTER ANOTHER N PLACES

; SAVE POSITION OF THE SOURCE, INCASE IT STOPS MATCHING.
;IF IT DOES, THE SAVED POSITION WILL BE USED TO RESUME EXAMINATION
;OF THE SOURCE STRING.

	DMOVEM	SRCBP,SRA.BP##
	JRST	UNS17		;TRY FOR SOME MORE

;HERE IF DELIM MATCHED, 'ALL' NOT SPECIFIED
UNS19:	MOVEM	DLMCC,CT.DLM##	; # CHARS TO COPY
;	JRST	UNS20		;GO DO THIS DEST.

;HERE WHEN A DELIMITER MATCHED, # CHARS OF DELIMITER THAT MATCHED IN CT.DLM
; THE POSITION AND COUNT OF THE SOURCE STRING WHEN IT STARTED
;MATCHING THE DELIMITER IS IN SRD.BP AND SRD.CC.
; THE ADDRESS OF THE 2-WORD BLOCK DESCRIBING THIS DELIMITER IS IN NX.DLM

UNS20:	MOVE	T3,SRC.CC##	;FIND # CHARS TO COPY
	SUB	T3,SRD.CC##

;HERE WITH T3= # CHARS TO COPY TO DESTINATION.
; DST.BP , DST.CC , DSTBP AND DSTCC ARE ALL SETUP NOW.
; SRCBP AND SRCCC CONTAINS THE BP AND CC AFTER THE DELIMITER
; (TO START EXAMINATION FOR NEXT DESTINATION)

UNS21:	MOVEM	T3,CT.VAL##	;SAVE COUNT VALUE
	ADDM	T3,PT.VAL##	;ADJUST POINTER VALUE
	EXCH	SRCBP,SRC.BP##	;GET SOURCE BP, STORE NEW ONE
	EXCH	SRCCC,SRC.CC##	;GET SOURCE CC, STORE NEW ONE
	CAIGE	T3,(DSTCC)	;FILL UP THIS DEST?
	 JRST	UNS22		;NO, FILLER PROBLEMS

;DEST IS SMALLER THAN SOURCE. MOVE (DSTCC) CHARS.
	HRRZ	T1,NX.SRC##	;CHECK FOR RIGHT JUSTIFICATION
	MOVE	T2,(T1)
	TXNE	T2,US%RRJ	;IS THERE ANY?
	 JRST	UNS21A		;YES
UNS21B:	MOVE	T3,DSTCC	;# CHARS TO MOVE
	PUSHJ	PP,MOVSDS	;MOVE SOURCE TO DEST..
	SKIPE	TAG,TAG.DA##	;STORE DELIM AWAY FROM OU.TMP?
	 PUSHJ	PP,CALTAG	;YES
	JRST	UNS30		;GO STORE DELIM STORE

;RIGHT-JUSTIFICATION, HAVE TO SKIP OVER SOURCE CHARS
UNS21A:	SUB	T3,DSTCC	;# CHARS TO ADJUST SOURCE
	JUMPE	T3,UNS21B	;JUMP IF NO ADJUSTMENT NEEDED
	SUB	SRCCC,T3
	IBP	SRCBP
	SOJG	T3,.-1
	JRST	UNS21B		;FINISHED ADJUSTING SOURCE

;WORRY ABOUT JUSTIFICATION IN DESTINATION
UNS22:	HRRZ	T1,NX.SRC##	;POINT TO THIS ENTRY
	MOVE	T2,(T1)		;GET FLAG WORD
	TXNE	T2,US%RRJ	;IS RECEIVING ITEM RIGHT-JUSTIFIED?
	 JRST	UNS23		;YES, GO DO THAT

;NORMAL JUSTIFICATION. MOVE (T3) CHARS, THEN PAD THE REST
	PUSHJ	PP,MOVSDS	;MOVE THE CHARS
	MOVE	T1,DSTCC	;# CHARS LEFT IN DEST..
	PUSHJ	PP,PADDST	;PAD IT OUT
	JRST	UNS30		;GO STORE DELIM STORE

;RIGHT JUSTIFICATION. PAD, THEN MOVE (T3) CHARS.
UNS23:	HRRZ	T1,DSTCC	;FIND # CHARS TO PAD
	SUB	T1,T3
	PUSH	PP,T3		;SAVE # CHARS TO MOVE
	PUSHJ	PP,PADDST
	POP	PP,T3		;RESTORE # CHARS TO MOVE
	PUSHJ	PP,MOVSDS	;MOVE (T3) CHARS
	SKIPE	TAG,TAG.DA##	;STORE DELIM AWAY FROM OU.TMP?
	 PUSHJ	PP,CALTAG	;YES
;	JRST	UNS30		;GO STORE DELIM STORE

;PUT DELIMITER IN DELIMITER STORE
UNS30:	MOVE	T1,CT.DLM##	;# CHARS IN DELIMITER
	ADDM	T1,PT.VAL##	;WE WILL SKIP OVER THIS MANY SOURCE CHARS
	HRRZ	T1,NX.SRC##	;FIND THIS ENTRY
	MOVE	T2,(T1)		;GET FLAGS
	TXNN	T2,US%GDS	;DO WE HAVE A DELIMITER STORE?
	 JRST	UNS80		;NO

	DMOVE	DLMBP,DLM.BP##	;GET THIS DELIMITER BP AND CC

;IF "ALL" WAS SPECIFIED, WE ONLY STORE 1 OCCURANCE OF THE DELIMITER
; IN THE DELIMITER STORE.  ANS68 STORED THE ACTUAL TEXT OF THE DELIMITER.
	HRRZ	T2,CT.DLM##	;GET # CHARS IN REAL DELIMITER
	CAILE	T2,(DLMCC)	;IF BIGGER THAN DELIM SIZE,
	MOVE	T2,DLMCC	; USE # CHARS IN THE DELIMITER
	MOVEM	T2,CT.DLM##	;PRETEND THIS IS NEW DELIM COUNT
	MOVE	T3,3(T1)	;GET %TAG1, %TAG2
	HLRZM	T3,TAG.ST##	;TAG TO SETUP %TEMP FOR DELIM STORE
	HRRZM	T3,TAG.DA##	;TAG TO STORE DELIM STORE AWAY FROM OU.TMP

	HRRZ	T2,2(T1)	;%LIT OR %TEMP
	MOVEM	T2,DST.TP##	; STORE AWAY

;SETUP BP AND CC IN DSTBP AND DSTCC
	SKIPE	TAG,TAG.ST##	;HAVE TO SETUP %TEMP?
	 PUSHJ	PP,CALTAG	;YES, GO DO IT
	DMOVE	DSTBP,@DST.TP##	;GET BP AND CC FOR DELSTORE

; SETUP THE INSTRUCTION TO CONVERT FROM DELIM MODE TO DELSTORE MODE,
; AND PUT IN CV
	LDB	T4,[POINT 3,2(T1),17] ;GET BSI OF DELSTORE ITEM
	HRRZ	T1,NX.DLM	;GET DELIMITER ARGUMENTS
	MOVE	T2,(T1)		;GET FLAG WORD
	LDB	T3,[POINT 3,T2,17] ;CONVERT FROM MODE OF DELIMITER.
	XCT	TT.CVD(T4)	;SETUP CV= CONVERSION INSTRUCTION

	MOVE	T3,CT.DLM##	;GET # CHARS TO COPY TO DEST.
	CAIGE	T3,(DSTCC)	;FILL UP THIS DELSTORE?
	 JRST	UNS35		;NO, HAVE TO PAD

;DELSTORE IS SMALLER (OR EQUAL IN SIZE) TO # CHARS TO STORE.
;  MOVE (DSTCC) CHARS.
	HRRZ	T1,NX.SRC
	MOVE	T2,2(T1)	;GET FLAGS
	TXNE	T2,DS%JST	;RIGHT-JUSTIFIED DELSTORE?
	 JRST	UNS33		;YES

	MOVE	T3,DSTCC
	PUSHJ	PP,MOVDDS	;MOVE DELIMITER TO DELSTORE
	JRST	UNS39		;MOVE DONE

;HERE IF DELSTORE IS RIGHT-JUSTIFIED, AND WE ARE TRUNCATING.
UNS33:	SUB	T3,DSTCC	;# CHARS TO SKIP OVER IN DELIM
UNS33A:	SOJL	T3,UNS34	;JUMP WHEN DONE
	SUBI	DLMCC,1
	IBP	DLMBP		;SKIP OVER A CHAR IN DELIMITER
	SKIPN	DLMCC		; AT END OF DELIMITER?
	DMOVE	DLMBP,DLM.BP##	;YES, SET TO BEGINNING AGAIN
	JRST	UNS33A		;LOOP TO SKIP CHARS

UNS34:	MOVE	T3,DSTCC	;# CHARS TO MOVE
	PUSHJ	PP,MOVDDS	;MOVE DELIMITER TO DELSTORE
	JRST	UNS39		;MOVE DONE

;WORRY ABOUT JUSTIFICATION IN DELSTORE
UNS35:	HRRZ	T1,NX.SRC##
	MOVE	T2,2(T1)	;GET FLAG WORD
	TXNE	T2,DS%JST	; IS DEL STORE JUST RIGHT?
	 JRST	UNS37		;YES

;NORMAL JUSTIFICATION.
	PUSHJ	PP,MOVDDS	;MOVE (T3) CHARS
	MOVE	T1,DSTCC	;# CHARS LEFT IN DELSTORE
	PUSHJ	PP,PADDLS	;PAD THE DELSTORE
	JRST	UNS39		;DONE

;RIGHT JUSTIFICATION IN DELSTORE.
UNS37:	HRRZ	T1,DSTCC	;FIND # CHARS TO PAD WITH
	SUB	T1,T3
	PUSH	PP,T3		;SAVE # CHARS TO MOVE
	PUSHJ	PP,PADDLS	;PAD IT
	POP	PP,T3		;RESTORE # CHARS TO MOVE
	PUSHJ	PP,MOVDDS	;MOVE (T3) CHARS
;	JRST	UNS39		;DONE THE MOVE

;THE MOVE IS DONE (TO DELIMITER STORE).
; STORE IT AWAY FROM OU.TMP IF NECESSARY.
UNS39:	SKIPE	TAG,TAG.DA##
	 PUSHJ	PP,CALTAG

;DELIM STORE IS STORED. BUMP THE COUNT AND TALLY ITEMS
UNS80:	PUSHJ	PP,BMPTAL	;BUMP TALLY ITEM
	SKIPE	TAG,TAG.CT	; IF COUNT ITEM PRESENT,
	 PUSHJ	PP,CALTAG	;STORE THE VALUE
	SKIPE	TAG,TAG.PT##	;IF POINTER ITEM PRESENT,
	 PUSHJ	PP,CALTAG	;STORE THE NEW VALUE
	DMOVE	SRCBP,SRC.BP##	;GET NEW POSITION TO START IN SOURCE
	JRST	UNS05B		;GO ON TO NEXT DESTINATION

;HERE TO RETURN FROM UNSTRING
UNSDON:	POPJ	PP,

;HERE WHEN OVERFLOW OCCURS IN UNSTRING STMT.
UNSOVL:	TXO	F,FL.OVF	;SET "OVERFLOW" FLAG
	JRST	UNSDON		;AND GO DO FINAL ACTIONS

SUBTTL SUBROUTINES

;ROUTINE TO CALL A TAG ROUTINE.
;ENTER WITH TAG/  ROUTINE ADDRESS
;	PUSHJ	PP,CALTAG
;	<RETURNS HERE AFTER ROUTINE DONE>
;ALL ACS ARE PRESERVED EXCEPT 16 AND 17

CALTAG:	MOVEM	0,SSACB.##	;[1163]SAVE AC15
	MOVE	0,[1,,SSACB.+1] ;[1163]
	BLT	0,SSACB.+15	;[1163]SAVE AC1-AC15
	PUSHJ	PP,@TAG		;CALL THE USER ROUTINE
	MOVE	0,[SSACB.+1,,1] ;[1163]RESTORE ACS
	BLT	0,15		;[1163]
	MOVE	0,SSACB.	;[1163]RESTORE AC0
	POPJ	PP,		;RETURN

;ROUTINE TO BUMP THE TALLYING ITEM
; ONLY DESTROYS AC "TAG"
BMPTAL:	AOS	TL.VAL##	;COUNT ANOTHER RECEIVING ITEM ACTED UPON
	SKIPE	TAG,TAG.TL##	;WAS THERE A TAG FOR THE TALLYING ITEM?
	 PUSHJ	PP,CALTAG	;YES, CALL ROUTINE TO STORE IT
	POPJ	PP,		;NO, RETURN


;ROUTINE TO GO ON TO NEXT DESTINATION.
;FIGURES OUT HOW MUCH TO BUMP NX.SRC.

NXTDST:	HRRZ	T1,NX.SRC##	;CURRENT DEST ARGUMENTS
	MOVE	T2,(T1)		;GET FLAG WORD
	TXNE	T2,US%GDS	;GOT A DELIM STORE?
	ADDI	T1,2		;YES, TWO WORDS FOR IT
	TXNE	T2,US%GCT	;GOT A COUNT ITEM?
	ADDI	T1,1		;YES, ONE WORD FOR IT
	ADDI	T1,2		;+2 FOR THE DEST ITEM
	MOVEM	T1,NX.SRC##	;SAVE START OF NEXT DEST.
	POPJ	PP,		;RETURN

;ROUTINE TO MOVE CHARS FROM SOURCE TO DEST.
;CALL:	T3/ # CHARS TO MOVE
;	PUSHJ PP,MOVSDS
;	<RETURNS HERE>

MOVSDS:	SOJL	T3,CPOPJ	;JUMP IF NO MORE CHARS TO MOVE
	ILDB	T1,SRCBP	;GET A SOURCE CHAR
	SUBI	SRCCC,1		;ADJUST SRC PTR
	XCT	CV.SDS##	;CONVERT TO DEST MODE
	IDPB	T1,DSTBP	;STORE IN DEST STRING
	SUBI	DSTCC,1		;ADJUST DST COUNT
	JRST	MOVSDS		;GO ON TO NEXT CHAR


;ROUTINE TO MOVE CHARS FROM DELIMITER TO DELSTORE.
;CALL:	T3/ # CHARS TO MOVE
;	CV/ INSTRUCTION TO CONVERT DELIM CHARS TO DELSTORE MODE CHARS
;	DLMBP AND DLMCC ARE CURRENT PTR TO DELIMITER.
;	PUSHJ	PP,MOVDDS
;	<RETURNS HERE>

MOVDDS:	SOJL	T3,CPOPJ	;JUMP IF NO MORE CHARS TO MOVE
	ILDB	T1,DLMBP	;GET A CHAR FROM DELIMITER
	SUBI	DLMCC,1		;ADJUST DELIM PTR
	XCT	CV		;CONVERT TO DELSTORE MODE
	IDPB	T1,DSTBP	;STORE IN DELSTORE
	SUBI	DSTCC,1
	JUMPG	DLMCC,MOVDDS	;KEEP GOING IF MORE CHARS IN DELIMITER
	DMOVE	DLMBP,DLM.BP##	;SETUP DELIM AGAIN ("ALL" WAS SPECIFIED")
	JRST	MOVDDS		;CONTINUE ON

;ROUTINE TO PAD THE DESTINATION.
;CALL:	T1/ # CHARS TO PAD
;	NX.SRC POINTS TO DEST ENTRY
; DSTBP AND DSTCC WILL BE MODIFIED.

PADDST:	HRRZ	T4,NX.SRC##	;POINT TO ENTRY
	LDB	T3,[POINT 3,(T4),17] ;GET BSI OF DEST.
;;;;	MOVE	T2,(T4)		;;GET FLAGS
	MOVE	T4,(T4)		;[1060] GET FLAGS
	HLRZ	T2,SPCZRO(T3)	;[1060] GET A SPACE IN PROPER MODE
	TXNE	T4,US%RRJ	;[1060] IS DESTINATION RIGHT JUSTIFIED?
	 JRST	PADDS1		;[1060]	YES, STICK WITH SPACES
	TXNE	T2,US%RIN	;IS RECEIVING ITEM NUMERIC?
	 JRST	PADZRO		;YES, PAD WITH ZEROES
	JRST	PADDS1		;GO DO IT

PADZRO:	HRRZ	T2,SPCZRO(T3)	;GET A ZERO IN PROPER MODE
PADDS1:	IDPB	T2,DSTBP	;STORE A PAD CHAR IN DEST.
	SUBI	DSTCC,1		;FIX DEST COUNT
	SOJG	T1,PADDS1	;LOOP FOR ALL CHARS WE ARE SUPPOSED TO PAD
CPOPJ:	POPJ	PP,		;THEN RETURN

;ROUTINE TO PAD THE DELIMITER-STORE ITEM.
;JUST LIKE PADDST, EXCEPT LOOKS AT A DIFFERENT BIT.
PADDLS:	HRRZ	T4,NX.SRC##	;POINT TO ENTRY
	LDB	T3,[POINT 3,2(T4),17] ;GET BSI OF DELSTORE
	MOVE	T2,2(T4)		;GET FLAGS
	TXNE	T2,DS%NUM	;IS DELIM STORE NUMERIC?
	 JRST	PADZRO		;YES, PAD WITH ZEROES
	HLRZ	T2,SPCZRO(T3)	;NO, PAD WITH SPACES
	JRST	PADDS1

SPCZRO:	XWD	0,20		;SIXBIT SPACE,,ZERO
	XWD	40,60		;ASCII SPACE,,ZERO
	XWD	100,360		;EBCDIC SPACE,,ZERO

SUBTTL	TABLES

;TT.CVD - CONVERT CHARACTERS FROM ONE MODE TO ANOTHER
;INDEXED BY BSI OF SOURCE ITEM
; T3 CONTAINS THE BSI OF THE DESTINATION CHARACTERS
;CV WILL BE THE INSTRUCTION TO CONVERT THE CHARACTER IN T1

TT.CVD:	MOVE	CV,TT.RE6(T3)
	MOVE	CV,TT.RE7(T3)
	MOVE	CV,TT.RE9(T3)

TT.RE6:	NOP
	LDB	T1,IPT761##
	LDB	T1,IPT961##

TT.RE7:	LDB	T1,IPT671##
	NOP
	LDB	T1,IPT971##

TT.RE9:	LDB	T1,IPT691##
	LDB	T1,IPT791##
	NOP

END