84 lines
3.7 KiB
Plaintext
84 lines
3.7 KiB
Plaintext
* Tokenize a string - 08/06/2018
|
|
TOKSTR CSECT
|
|
USING TOKSTR,R13 base register
|
|
B 72(R15) skip savearea
|
|
DC 17F'0' savearea
|
|
SAVE (14,12) save previous context
|
|
ST R13,4(R15) link backward
|
|
ST R15,8(R13) link forward
|
|
LR R13,R15 set addressability
|
|
MVC N,=A(1) n=1
|
|
LA R7,1 i1=1
|
|
LA R6,1 i=1
|
|
DO WHILE=(C,R6,LE,LENS) do i=1 to length(s);
|
|
LA R4,S-1 @s-1
|
|
AR R4,R6 +i
|
|
MVC C,0(R4) c=substr(s,i,1)
|
|
IF CLI,C,EQ,C',' THEN if c=',' then do
|
|
BAL R14,TOK call tok
|
|
LR R2,R8 i2
|
|
SR R2,R7 i2-i1
|
|
LA R2,1(R2) i2-i1+1
|
|
L R1,N n
|
|
SLA R1,1 *2
|
|
STH R2,TALEN-2(R1) talen(n)=i2-i1+1
|
|
L R2,N n
|
|
LA R2,1(R2) n+1
|
|
ST R2,N n=n+1
|
|
LA R7,1(R6) i1=i+1
|
|
ENDIF , endif
|
|
LA R6,1(R6) i++
|
|
ENDDO , enddo i
|
|
BAL R14,TOK call tok
|
|
LR R2,R8 i2
|
|
SR R2,R7 i2-i1
|
|
LA R2,1(R2) i2-i1+1
|
|
L R1,N n
|
|
SLA R1,1 *2
|
|
STH R2,TALEN-2(R1) talen(n)=i2-i1+1
|
|
LA R11,PG pgi=@pg
|
|
LA R6,1 i=1
|
|
DO WHILE=(C,R6,LE,N) do i=1 to n
|
|
LR R1,R6 i
|
|
SLA R1,1 *2
|
|
LH R10,TALEN-2(R1) l=talen(i)
|
|
LR R1,R6 i
|
|
SLA R1,3 *8
|
|
LA R4,TABLE-8(R1) @table(i)
|
|
LR R2,R10 l
|
|
BCTR R2,0 ~
|
|
EX R2,MVCX output table(i) length(l)
|
|
AR R11,R10 pgi=pgi+l
|
|
IF C,R6,NE,N THEN if i^=n then
|
|
MVC 0(1,R11),=C'.' output '.'
|
|
LA R11,1(R11) pgi=pgi+1
|
|
ENDIF , endif
|
|
LA R6,1(R6) i++
|
|
ENDDO , enddo i
|
|
XPRNT PG,L'PG print
|
|
L R13,4(0,R13) restore previous savearea pointer
|
|
RETURN (14,12),RC=0 restore registers from calling sav
|
|
TOK LR R5,R6 i <--
|
|
BCTR R5,0 i-1 |
|
|
LR R8,R5 i2=i-1
|
|
SR R5,R7 i2-i1
|
|
LA R5,1(R5) l=i2-i1+1 source length
|
|
L R1,N n
|
|
SLA R1,3 *8
|
|
LA R2,TABLE-8(R1) @table(n)
|
|
LA R4,S-1 @s-1
|
|
AR R4,R7 @s+i1-1
|
|
LA R3,8 target length
|
|
MVCL R2,R4 table(n)=substr(s,i1,i2-i1+1) |
|
|
BR R14 End TOK subroutine <--
|
|
MVCX MVC 0(0,R11),0(R4) output table(i)
|
|
S DC CL80'Hello,How,Are,You,Today' <== input string ==
|
|
LENS DC F'23' length(s) <==
|
|
TABLE DC 8CL8' ' table(8)
|
|
TALEN DC 8H'0' talen(8)
|
|
C DS CL1 char
|
|
N DS F number of tokens
|
|
PG DC CL80' ' buffer
|
|
YREGS
|
|
END TOKSTR
|