source: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGUTSTX.m@ 949

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1RGUTSTX ;CAIRO/DKM - M syntax analyzer;22-Oct-1998 10:39;DKM
2 ;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
3 ;=================================================================
4 ; Perform syntactic analysis of a line of M code.
5 ; Inputs:
6 ; RGM = M statement(s)
7 ; RGO = Options:
8 ; L = Line label allowed
9 ; . = Dotted syntax allowed
10 ; N = Do not init parsing tables
11 ; D = Do not delete parsing tables
12 ; Z = Process all Z-extensions as valid
13 ; Outputs:
14 ; Returns 0 if successfully parsed. Otherwise returns E^P^M
15 ; where E is an error code (see ERRORS label), P is the
16 ; character position where the error occurred, and M is the
17 ; error message.
18 ;=================================================================
19ENTRY(RGM,RGO) ;
20 N RGPSN,RGLEN,RGERR,RGRN,RGQT,RGF,RGPID,RGCMD
21 S RGM=$$UP^XLFSTR(RGM),RGO=$$UP^XLFSTR($G(RGO)),RGPSN=1,RGLEN=$L(RGM),RGERR=0,RGQT="""",RGF=0,RGPID="RGUTSTX"_$J,U="^"
22 D LOAD:RGO'["N",PARSE:RGLEN
23 K:RGO'["D" ^TMP(RGPID)
24 Q $S(RGERR:RGERR_U_$S(RGPSN>RGLEN:RGLEN,1:RGPSN)_U_$S(RGERR<0:$$EC^%ZOSV,1:$P($T(ERRORS+RGERR),";;",2)),1:0)
25PARSE N RGZ,RGZ1
26 S @$$TRAP^RGZOSF("ERROR^RGUTSTX")
27 I RGO["L" D Q:RGERR
28 .S:$E(RGM)'=" " RGPSN=$$LABEL^RGUTSTX0
29 .I $$NEXT^RGUTSTX0("("),'$$NEXT^RGUTSTX0(")") D
30 ..F RGPSN=RGPSN:1 D Q:$E(RGM,RGPSN)'=","!RGERR
31 ...S RGPSN=$$NAME^RGUTSTX0(RGPSN,"L%")
32 ..Q:RGERR
33 ..S:'$$NEXT^RGUTSTX0(")") RGERR=3
34 .S:" "'[$E(RGM,RGPSN) RGERR=2
35 I RGO["." F RGPSN=RGPSN:1:RGLEN+1 Q:". "'[$E(RGM,RGPSN)
36 F Q:RGERR D SKPSPC Q:";"[$E(RGM,RGPSN) D
37 .S RGCMD=""
38 .F RGPSN=RGPSN:1 S RGZ=$E(RGM,RGPSN) Q:RGZ'?1A S RGCMD=RGCMD_RGZ
39 .I RGCMD="" S RGERR=4 Q
40 .I $D(^TMP(RGPID,"CMD",RGCMD)) S RGCMD=^(RGCMD)
41 .E I RGO["Z" S RGCMD="PC;OPT;ARGS("":M"")"
42 .E S RGERR=4 Q
43 .F RGRN=1:1:$L(RGCMD,";") D CMD^RGUTSTX0($P(RGCMD,";",RGRN)) Q:RGERR!'RGRN
44 .I 'RGERR," "'[$E(RGM,RGPSN) S RGERR=2
45 .E S RGPSN=RGPSN+1
46 Q
47 ; Skip over blanks
48SKPSPC F Q:'$$NEXT^RGUTSTX0(" ")
49 Q
50 ; Load tables
51LOAD N RGZ,RGZ1,RGZ2,RGL
52 K ^TMP(RGPID)
53 F RGL="CMD","FCN","SYS" D
54 .F RGZ=1:1 S RGZ1=$P($T(@RGL+RGZ),";;",2,999) Q:RGZ1="" D
55 ..S RGZ2=$P(RGZ1,";"),RGZ1=$P(RGZ1,";",2,999)
56 ..F Q:RGZ2="" D
57 ...S ^TMP(RGPID,RGL,$P(RGZ2,","))=RGZ1,RGZ2=$P(RGZ2,",",2,999)
58 Q
59ERROR S RGERR=-1
60 Q
61CMD ;;*Commands*
62 ;;B,BREAK;PC;OPT;ARGS()
63 ;;C,CLOSE;PC;ARGS(":M")
64 ;;D,DO;PC;OPT;LBL(2)
65 ;;E,ELSE;NPC;OPT;ARGS()
66 ;;F,FOR;NPC;OPT;FOR
67 ;;G,GOTO;PC;LBL(1)
68 ;;H,HALT,HANG;PC;OPT;EXP()
69 ;;I,IF;NPC;OPT;ARGS()
70 ;;J,JOB;PC;LBL(2)
71 ;;K,KILL;PC;OPT;KILL
72 ;;L,LOCK;PC;OPT;LOCK
73 ;;M,MERGE;PC;MERGE
74 ;;N,NEW;PC;OPT;NEW
75 ;;O,OPEN;PC;ARGS(":M")
76 ;;Q,QUIT;PC;OPT;EXP()
77 ;;R,READ;PC;READ
78 ;;S,SET;PC;SET
79 ;;U,USE;PC;ARGS(":M")
80 ;;V,VIEW;PC;ARGS(":M")
81 ;;W,WRITE;PC;WRITE
82 ;;X,XECUTE;PC;ARGS(":")
83 ;;ZT,ZTRAP;PC;OPT;EXP()
84 ;;ZS,ZSAVE;PC;OPT;EXP()
85 ;;ZR,ZREMOVE;PC;OPT;LBL(1)
86 ;;ZP,ZPRINT
87 ;;
88FCN ;;*Intrinsic functions*
89 ;;A,ASCII;;1-2
90 ;;C,CHAR;;1-999
91 ;;D,DATA;;1-1;V
92 ;;E,EXTRACT;S;1-3
93 ;;F,FIND;;2-3
94 ;;FN,FNUMBER;;2-3
95 ;;G,GET;;1-2;V
96 ;;J,JUSTIFY;;1-3
97 ;;L,LENGTH;;1-2
98 ;;N,NEXT;;1-2
99 ;;NA,NAME;;1-2;V
100 ;;O,ORDER;;1-2;V
101 ;;P,PIECE;S;2-4
102 ;;Q,QUERY;;1-2;V
103 ;;R,RANDOM;;1-1
104 ;;S,SELECT;:;1-999
105 ;;T,TEXT;;1-1;L
106 ;;TR,TRANSLATE;;2-3
107 ;;V,VIEW;;1-999
108 ;;
109SYS ;;*System variables*
110 ;;D,DEVICE
111 ;;ET,ETRAP;SN
112 ;;H,HOROLOG
113 ;;I,IO
114 ;;J,JOB
115 ;;K,KEY
116 ;;P,PRINCIPAL
117 ;;S,STORAGE
118 ;;SY,SYSTEM
119 ;;T,TEST
120 ;;TL,TLEVEL
121 ;;TR,TRESTART
122 ;;X;S
123 ;;Y;S
124 ;;ZT,ZTRAP;S
125 ;;ZE,ZERROR;S
126 ;;
127ERRORS ;;*Error messages*
128 ;;Bad variable name
129 ;;Syntax error
130 ;;Unbalanced parentheses
131 ;;Unrecognized command
132 ;;Postconditional not allowed
133 ;;Missing operand
134 ;;Unrecognized intrinsic function/variable
135 ;;Incorrect number of arguments
136 ;;Missing closing quote
137 ;;Illegal pattern
138 ;;Bad label name
139 ;;12
Note: See TracBrowser for help on using the repository browser.