File:  [Coherent Logic Development] / freem_fileman / USER / DIM2.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:20 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DIM2	;SFISC/XAK,GFT-MUMPS SYNTAX CHECKER ;10/31/91  3:26 PM
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: SUB	F %J=%I-1:-1 S %C1=$E(%,%J) Q:%C1'?1UN
    5: 	S %C1=$E(%,%J+1,%I-1) G ERR:%C1]""&(%C1'?1U.UN)&($E(%,%J,%I-1)'?1"%".UN) G:%C1]"" ERR:%[("."_%C1)
    6: 	S %(%N,0)=$S(%C1]""!($E(%,%J)="^"):"V^",$E(%,%J)="@":"@^",1:"0^"),%(%N,1)=0,%(%N,2)=0,%(%N,3)=0,%N=%N+1 G 1
    7: UP	G ERR:%N=0!("(,"[$E(%,%I-1))!($E(%,%I+1)]""&("<>_[]:/\?'+-=!&#*),"""'[$E(%,%I+1))) S %N=%N-1,%(%N,1)=%(%N,1)+1,%F=$P(%(%N,0),"^",1) G:'%F UP1 S %F=$P(%(%N,0),"^",2)
    8: 	S %F1=%(%N,1) G ERR:(%F1<+%F)!(%F1>$P(%F,";",2))!(%(%N,2)&'(%(%N,3)))
    9: UP1	K %(%N+1) G ERR:'%F&(%F'["V")&(%F'["@")&(%F'["P")&(%(%N,1)>1),1
   10: AR	G ERR:%N<1!("(,"[$E(%,%I-1))!('%(%N-1,3)&%(%N-1,2))!("@("[$E(%,1,2)) S %(%N-1,1)=%(%N-1,1)+1,%(%N-1,3)=0 G 1
   11: SEL	S %(%N-1,3)=%(%N-1,3)+1 G ERR:'%(%N-1,2)!(%(%N-1,3)>1),1
   12: GLO	D %INC G ERR:$E(%,%I,999)'?1U.UN.P.E&("%("'[%C)
   13: 	G ERR:"=+-\/<>(,#!&*':@[]_"'[$E(%,%I-2)
   14: B	S %I=%I-1 G 1
   15: PAT	S %L1=1 G ERR:%I=1
   16: C	D %INC
   17: C1	I %C?.N G:%C="" ERR:'$D(%L1),FINISH:'%L1,ERR K %L1 G C
   18: 	I %C="." K %L1 D %INC G ERR:%C="",P:%C'?1N,C1
   19: 	I %C="@" G B
   20: 	I %C'?1U,%C'="""" G ERR:'$D(%L1),ERR:%L1,B
   21: P	G ERR:$D(%L1) S %L1=0 I %C="""" D QUOTE G C
   22: P1	I "AULPCNE"[%C S %L1=%C D %INC G P1:%C]""
   23: 	I %L1?.A G C1
   24: ERR	S %ERR=1,%N=0
   25: FINISH	G ERR:%N'=0 K %C,%,%F,%F1,%I,%J,%L1,%L2,%N,%T,%Z1,%Z2,%FN,%FZ Q
   26: BINOP	S %Z1=""")%'" G OP
   27: MTHOP	S %Z1=""")%" G OP
   28: UNOP	S %Z1=""":<>+-'\/()%@#&!*=_][,",%Z2="""($+-=&!^%.@'" S:%C="'" %Z2=%Z2_"<>?[]" G OPCHK
   29: OP	S %Z2="""($+-^%@'." G OPCHK
   30: IND	G ERR:$E(%COM)="F" S %Z1="^?@(%+-=\/#*!&'_<>[]:,",%Z2="(+^-'$@%"""
   31: OPCHK	S %L1=$E(%,%I-1),%L2=$E(%,%I+1) S:"[]&!<>="[%C&(%L1="'") %L1=$E(%,%I-2) I %Z1'[%L1,%L1'?1UN G ERR
   32: 	I (%Z2'[%L2)&(%L2'?1UN)!(%L2="") G ERR
   33: 	G ERR:%L2=""!(("+-'@"'[%C)&(%L1=""))!(%C="'"&(%L1?1UN)&("[]?=<>"'[%L2))
   34: 1	G GG^DIM1
   35: 	;
   36: DATA	D %INC G ERR:%C="",DATA:"^@"[%C D %INC:%C="%",VAR G ERR:%ERR!("()"'[%C),GG1^DIM1
   37: QUOTE	D %INC I %C="" S %ERR=1 Q
   38: 	G QUOTE:%C'="""" Q:$E(%,%I+1)'=%C  S %I=%I+1 G QUOTE
   39: VAR	F %J=%I:1 S %C=$E(%,%J) Q:",<>?/\[]+-=_()*&#!':"[%C!((%C="@")&($E(%,%J+1)="(")&($E(%)="@"))  S:%C'?1UN %ERR=1 I (%C="^"),$D(%(%N-1,"F")),%(%N-1,"F")["TEXT" S %ERR=0 Q
   40: 	I %C="@"&'%ERR S %I=%J Q
   41: 	Q:%ERR  S %F=$E(%,%I,%J-1) S:%F]""&(%F'?1U.UN)&($E(%,%I-1,%J-1)'?1"%".UN)!(%F="^"&($E(%,%J)'="(")) %ERR=1 S %I=%J Q
   42: %INC	S %I=%I+1,%C=$E(%,%I)
   43: 	Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>