Trailing-Edge
-
PDP-10 Archives
-
BB-H580E-SB_1985
-
strngl.mac
There are 3 other files named strngl.mac in the archive. Click here to see a list.
; UPD ID= 2100 on 10/31/79 at 10:32 AM by WRIGHT
TITLE STRNGL - LIBOL STRING/UNSTRING ROUTINES
SUBTTL D.A.WRIGHT
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
HISEG
SALL
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 31-OCT-79 CHECK FOR 12A (INCOMPATIBLE) ARG LIST.. AND
; TELL USER THAT RECOMPILATION IS NECESSARY
;
;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
;[V12B] CHECK FOR 12A ARG LIST.. IT'S INCOMPATIBLE WITH 12B. THE
;[V12B] PROGRAMS THAT USE "STRING" AND "UNSTRING" MUST BE RECOMPILED.
;[V12B] THIS CODE SHOULD BE REMOVED IN V13
IFN 1,<
SKIPGE (PA) ;NOT -N,,FLAGS?
JRST STR1OK ;YES
TTCALL 3,[ASCIZ/?"STRING" ARG LIST INCORRECT - /]
LDB T1,[POINT 6,COBVR.##,17] ;GET MINOR VERSION NUMBER OF MAIN PRG.
MOVEI T2,[ASCIZ/RECOMPILE PROGRAM WITH COBOL 12B
/]
CAIN T2,2 ;IS MAIN PROGRAM 12B?
MOVEI T2,[ASCIZ/A SUBROUTINE NOT COMPILED WITH COBOL 12B?
/]
TTCALL 3,(T2) ;TYPE MESSAGE
JRST KILL.## ;BOMB OUT PRG.
STR1OK:
>;[V12B] END IFN 1
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
CAIL T1,(DSTCC) ;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.
IFN BIS,<
ADJBP T1,DSTBP ;ADJUST THE BYTE PTR
MOVE DSTBP,T1 ;PUT BYTE PTR BACK
>
IFE BIS,<
IBP DSTBP ;BUMP THE BYTE PTR OVER THE
SOJG T1,.-1 ; UNWANTED BYTES.
>
;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
;[V12B] CHECK FOR 12A ARG LIST AND COMPLAIN
;[V12B] THIS CODE SHOULD GO AWAY IN VERSION 13
IFN 1,<
SKIPGE (PA) ;NOT -DESTS,,FLAGS?
JRST UNS1OK ;IT IS, OK
TTCALL 3,[ASCIZ/?"UNSTRING" ARG LIST INCORRECT - /]
LDB T1,[POINT 6,COBVR.##,17] ;SEE IF MAIN PRG IS 12B
MOVEI T2,[ASCIZ/RECOMPILE PROGRAM WITH COBOL 12B
/]
CAIN T1,2 ;BUT WAS IT 12B?
MOVEI T2,[ASCIZ/A SUBROUTINE NOT COMPILED WITH COBOL 12B?
/]
TTCALL 3,(T2) ;TYPE MESSAGE
JRST KILL.## ;ABORT
UNS1OK:
>;[V12B] END IFN 1
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
IFN BIS,<
ADJBP T1,SRCBP
MOVE SRCBP,T1 ;PUT NEW BYTE PTR IN SRCBP
>
IFE BIS,<
IBP SRCBP ;BUMP PTR OVER THE
SOJG T1,.-1 ; UNWANTED BYTES.
>
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.
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
IFN ANS74,<
;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
>;END IFN ANS74
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
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.## ;SAVE AC0
MOVE 0,[1,,SSACB.+1]
BLT 0,SSACB.+15 ;SAVE AC1-AC15
PUSHJ PP,@TAG ;CALL THE USER ROUTINE
MOVE 0,[SSACB.+1,,1] ;RESTORE ACS
BLT 0,15
MOVE 0,SSACB. ;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
; 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.SDS## ;CONVERT TO DEST 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
TXNE T2,US%RIN ;IS RECEIVING ITEM NUMERIC?
JRST PADZRO ;YES, PAD WITH ZEROES
HLRZ T2,SPCZRO(T3) ;GET A SPACE IN PROPER MODE
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