Trailing-Edge
-
PDP-10 Archives
-
scratch
-
10,7/unscsp/strlib/strloc.mac
There are 5 other files named strloc.mac in the archive. Click here to see a list.
TITLE RELITN
SEARCH STRDCL
IFE HIGH,<
TWOSEG
RELOC 400000>
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1974,1979 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
ENTRY REL$L,REL$
REL$L: AOS -1(P) ;PASS LEN RATHER THAN POS
REL$:
ST.POS=T1
ST.IBP=T0 ;T0=T1+1
EXCH SVP,-2(P) ;ADDR OF RETURN ARRAY
EXCH ST.POS,-1(P) ;POSITION TO ADJUST TO
SAVE <ST.IBP>
SUBI ST.POS,1 ;POS-POS REQUIRES ADJUSTMENT BY ONE TO GET THINGS RIGHT
HRRZ ST.IBP,1(SVP) ;LEN
SUB ST.IBP,ST.POS
IFE CHECK,<
TLNE ST.IBP,777777 ;HALF-WORD MAXES ON MAX & LEN
ERROR UOF$##>
MOVEM ST.IBP,1(SVP)
IFE BND.CH,<
HRRZ ST.IBP,2(SVP) ;MAXLEN
SUB ST.IBP,ST.POS
IFE CHECK,<
TLNE ST.IBP,777777 ;HALF-WORD MAXES ON MAX & LEN
ERROR UOF$##>
MOVEM ST.IBP,2(SVP)>
IFE ANYSIZ,<
LDB ST.IBP,[BPSIZ2,,0]
IDIV ST.POS,CPW$##(ST.IBP)>
IFN ANYSIZ,<
IDIVI ST.POS,CPW> ;SETS UP ST.IBP
ADDM ST.POS,0(SVP) ;UPDATE BYTEP BY WORDS
JUMPLE ST.IBP,REL$C
REL$1: IBP 0(SVP)
SOJG ST.IBP,REL$1
REL$E:
RESTOR <ST.IBP>
EXCH SVP,-2(P)
EXCH ST.POS,-1(P)
POPJ P,
REL$C: JUMPE ST.IBP,REL$E
IFE CHECK,<
ERROR SLI$##> ;NOTED BUT ALLOWED
IFE ANYSIZ,<
LDB ST.POS,[BPSIZ2,,0]
ADD ST.IBP,CPW$##(ST.POS)>
IFN ANYSIZ,<
ADDI ST.IBP,CPW> ;MOVES MOD5 UP A LEVEL
JRST REL$1
PRGEND
; ******************
TITLE CANON$
SEARCH STRDCL
IFE HIGH,<
TWOSEG
RELOC 400000>
ENTRY CANON$
CANON$:
ADDI R0,TYP.X1
JRST @R0 ;DATA TYPE INDEXED TABLE (IMMED. FOLLOWS)
TYP.X1:
JRST STR.SP ;FOR INTERNAL USE AND STRING PTR CONSTANT
JRST STR.C ;LOGICAL TREAT AS DATA-VARYING STRING
JRST STR.5 ;INTEGER IS LEN=5
ERROR IDT$## ;WILL RETURN DIRECTLY TO CALLER
JRST STR.5 ;REAL IS LEN=5
ERROR IDT$## ;WILL RETURN DIRECTLY TO CALLER
ERROR IDT$## ;WILL RETURN DIRECTLY TO CALLER
ERROR IDT$## ;WILL RETURN DIRECTLY TO CALLER
JRST STR.10 ;DP IS LEN=10
JRST STR.10 ;COBOL COMP-2
ERROR IDT$## ;WILL RETURN DIRECTLY TO CALLER
ERROR IDT$## ;WILL RETURN DIRECTLY TO CALLER
JRST STR.SP ;COMPLEX IS STRING PTR
JRST STR.SP ;BYTE DESCRIPTOR IS STR PTR
ERROR IDT$## ;WILL RETURN DIRECTLY TO CALLER
JRST STR.Z ;ASCIZ
STR.SP: MOVE R0,0(R1) ; SET UP USER'S (UBS)
MOVE R1,1(R1) ;THE LEN & MAX
IFE BND.CH,<
TLNN R1,777777 ;WILL EQUATE 0 (NO SKIP) TO MAX
TLO R1,777777> ;AFFECT OF ORING LEFT SIDE
POPJ P,
STR.C: MOVE R0,R1 ;BUILD (UBS) FROM USER'S STR. PTR
HRLI R0,IPOSIZ
MOVE R1,-1(R1) ;CNT IS BEFORE WORD PTED. AT BY ARG
IFE BND.CH,<
TLNN R1,777777 ;WILL EQUATE 0 (NO SKIP) TO MAX
TLO R1,777777> ;AFFECT OF ORING LEFT SIDE
POPJ P,
STR.Z: SAVE <C1>
HRLI R1,IPOSIZ ;BYTE PTR TO ---Z STRING
PUSH P,R1 ;WILL NEED LATER
SETZ R0,
STR.Z1: ILDB C1,R1
SKIPE C1
AOJA R0,STR.Z1
IFN BND.CH, <HRRZ R1,R0>
IFE BND.CH, <HRRO R1,R0>
POP P,R0 ;THE BP
RESTOR <C1>
POPJ P,
STR.10: MOVE R0,R1
HRLI R0,IPOSIZ
IFN BND.CH, <MOVEI R1,12>
IFE BND.CH, <MOVE R1,[12,,12]> ;LEN AND MAX
POPJ P,
STR.5: MOVE R0,R1
HRLI R0,IPOSIZ
IFN BND.CH, <MOVEI R1,5>
IFE BND.CH, <MOVE R1,[5,,5]> ;DITTO FOR SING. PREC.
POPJ P,
PRGEND
; *******************
TITLE RAX$
SEARCH STRDCL
IFE HIGH,<
TWOSEG
RELOC 400000>
ENTRY RAX$
RAX$: ;RESTORE ALL AND EXIT
POPALL
POPJ P,
PRGEND
; ******************
TITLE CB.SV$
SEARCH STRDCL
IFE HIGH,<
TWOSEG
RELOC 400000>
ENTRY CB.SV$,CB.FA$
CB.SV$: ;CMBSTR SAV REGS AND ARG SET UP
SAVALL
JRST 0(R1)
CB.FA$: SETZ R0,
SETZ R1,
RETURN
PRGEND
; ****************
TITLE FC.SV$
SEARCH STRDCL
IFE HIGH,<
TWOSEG
RELOC 400000>
ENTRY FC.SV$
FC.SV$: ;FNDCHAR SAVE REGS AND ARG SET UP
SAVALL
MOVEI MODE,RETUBS ;WILL BE CHECKED BY FNDCHR EXIT CODE
MOVEI BASP,@1(AP)
MOVE MASK,@2(AP)
JRST 0(R1)
PRGEND
; *****************
TITLE FS.SV$
SEARCH STRDCL
IFE HIGH,<
TWOSEG
RELOC 400000>
ENTRY FS.SV$
FS.SV$: ;DITTO FOR FNDSTR.
SAVALL
MOVEI CAP,1(AP) ;SET UP CURR ARG PTR
MOVEI MODE,RETUBS ! MORE.1
JRST 0(R1)
PRGEND
; ***************
TITLE CS.SV$
SEARCH STRDCL
IFE HIGH,<
TWOSEG
RELOC 400000>
ENTRY CS.SV$
CS.SV$: ;DITTO FOR CMPSTR.
SAVALL
MOVE MODE,@2(AP)
JRST 0(R1)
END