Trailing-Edge
-
PDP-10 Archives
-
cobol12c
-
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