File: decomment.m

package info (click to toggle)
fis-gtm 7.1-006-1
  • links: PTS, VCS
  • area: main
  • in suites: trixie
  • size: 32,908 kB
  • sloc: ansic: 344,906; asm: 5,184; csh: 4,859; sh: 2,000; awk: 294; makefile: 73; sed: 13
file content (320 lines) | stat: -rw-r--r-- 11,271 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;								;
; Copyright (c) 2010-2018 Fidelity National Information		;
; Services, Inc. and/or its subsidiaries. All rights reserved.	;
; 								;
; 	This source code contains the intellectual property	;
; 	of its copyright holder(s), and is made available	;
; 	under a license.  If you do not know the terms of	;
; 	the license, please stop and do not read further.	;
;	    	     	    	     	    	 		;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Part of gengtmdeftypes.
;
; Routine to remove C comments from a C routine or header file. File to read is specified
; on command line (e.g "$gtm_dist/mumps -run file-to-uncomment.c"). Uncommented
; version of file is written to stdout and can be piped wherever. Note this is sufficient
; to decomment OUR (GT.M source code) code but may need additions to be truly general purpose.
;
	Set TRUE=1,FALSE=0
	;
	Set infile=$ZCmdline
	Do:(""=infile)
	. Write "Missing parm: file to operate on",!
	. Halt
	;
	; Initialization - simple token types
	;
	Set TKEOL=1		; End of line
	Set TKEOF=2		; End of file
	Set TKDQUOTE=3		; Double quote '"'
	Set TKCOMSTRT=4 	; Comment start "/*"
	Set TKCOMEND=5		; Comment end "*/"
	Set TKSLASH=6		; Potential piece of comment start/end
	Set TKASTERISK=7	; Potential piece of comment start/end
	Set TKBACKSLASH=8	; Character escape
	Set TKOTHER=9		; Everything else than what we care about
	;
	Set CharScn("*")=TKASTERISK
	Set CharScn("\")=TKBACKSLASH
	Set CharScn("""")=TKDQUOTE
	Set CharScn("/")=TKSLASH
	;
	; Open file make sure exists
	;
	Open infile:Readonly
	Use infile
	Set inline=1
	Set (CommentMode,QuoteMode,NextTokEol)=FALSE
	;
	; Prime the tokenizer pump
	;
	Set (inbuf,outbuf,token,dirtoken,tokenval,dirtokenval)=""
	Do GetToken(FALSE)	; Set tokens - neither of the "fake" tokens initialized earlier need flushing
	Do GetToken(FALSE)	; Set director token (next)
	For  Quit:TKEOF=token  Do
	. ;
	. ; If this char is supposed to be escaped because of a previous backslash, make it type TKOTHER so it is otherwise ignored
	. ; from a parsing standpoint..
	. ;
	. If TKEOL=token Do		; End of line - Next!
	. . Do GetToken(TRUE)
	. Else  If TKBACKSLASH=token,TKEOL'=dirtoken Do
	. . Do GetToken('CommentMode)
	. . ;
	. . ; We have a new char to inflict on ourselves. But this char has been "escaped" so any special meaning
	. . ; it would ordinarily have disappears - just set its token type to TKOTHER so it plays nice with everything else.
	. . ;
	. . Set:(TKEOF'=token) token=TKOTHER
	. Else  If 'QuoteMode,TKCOMSTRT=token Do	; Entering comment mode (so long as not already in quote mode)
	. . Do:(CommentMode) Error("INTERROR","F","Comment mode already on when entering comment mode")
	. . Set comstart=inline,CommentMode=TRUE
	. . Do GetToken(FALSE)
	. . For  Quit:((TKEOF=token)!(TKCOMEND=token))  Do
	. . . Do GetToken(FALSE)
	. . . Do:((TKBACKSLASH=token)&(TKEOL'=dirtoken))
	. . . . Do GetToken(FALSE)
	. . . . Set:((TKEOF'=token)&(TKEOL'=token)) token=TKOTHER
	. . Do:(TKEOF=token) Error("COMENDNF","E","Hit end of routine while looking for end of comment started at line "_comstart)
	. . Do GetToken(FALSE)
	. . Set CommentMode=FALSE
	. Else  If TKCOMEND=token Do Error("FNDCOMNICM","F","Located end-of-comment token in line "_inline_" while not in comment mode")
	. Else  If 'CommentMode,TKDQUOTE=token Do	; Entering quoted text mode (ignored if already in comment mode)
	. . Do:(QuoteMode) Error("INTERROR","F","Quote mode already on when entering quote mode")
	. . Set QuoteMode=TRUE
	. . Do GetToken(TRUE)
	. . Do:((TKBACKSLASH=token)&(TKEOL'=dirtoken))
	. . . Do GetToken(TRUE)
	. . . Set:((TKEOF'=token)&(TKEOL'=token)) token=TKOTHER
	. . Set done=FALSE
	. . ;
	. . ; On each loop iteration, there are two possibilities if a quote is detected:
	. . ;   1. If the director char is also a quote, then we do not leave quote mode but do push the scan pointer to
	. . ;      the char following the director quote.
	. . ;   2. If the director char is NOT a quote, quote mode is done.
	. . ;
	. . For  Quit:(done!(TKEOF=token)!(TKEOL=token))  Do
	. . . If TKDQUOTE=token Do
	. . . . ;
	. . . . ; We found a potentially quote ending quote. But if the next token is also a quote, then
	. . . . ; this is an escaped quote and not an ending quote.
	. . . . ;
	. . . . If TKDQUOTE=dirtoken Do
	. . . . . Do GetToken(TRUE)	; Not and ending quote, just eat the second one and continue scan
	. . . . . Do:((TKBACKSLASH=token)&(TKEOL'=dirtoken))
	. . . . . . Do GetToken(TRUE)
	. . . . . . Set:((TKEOF'=token)&(TKEOL'=token)) token=TKOTHER
	. . . . Else  Do
	. . . . . Set done=TRUE		; Else, this is an ending quote - set loop terminator
	. . . . . Set QuoteMode=FALSE	; .. and exit quote mode
	. . . Else  Do GetToken(TRUE)
	. . Do:(TKEOF=token) Error("CLOSQUOTNF","E","Routine ended while searching for closing quote")
	. . Do:(TKEOL=token) Error("LINENDQT","E","Line ("_inline_") ended while searching for closing quote")
	. . Do GetToken(TRUE)
	. Else  Do GetToken(TRUE)
	;
	Do:(""'=outbuf) FlushOutbuf	; Wee bit 'o cleanup
	Close inbuf,outbuf
	Quit

;
; Routine to "tokenize" the input file. These are not compiler-tokens but simplistic
; comment-detecting removal tokens so are much coarser grain. Not a lot of care about
; anything except that which allows comments across lines to be removed while dealing
; appropriately with quotes and escaped chars.
;
; Argument tells whether to flush the current token to the output buffer or not before
; it gets replaced.
;
GetToken(flush)
	New done,seenchr,prevtoken
	Set done=FALSE
	Quit:(TKEOF=token) TKEOF
	Do:(flush)		; Buffer output token and if ends line, write it
	. Set outbuf=outbuf_tokenval
	. Do:(TKEOL=token) FlushOutbuf
	Do:(TKEOF=dirtoken)
	. ;
	. ; Simple case where we are out of input
	. ;
	. Set token=TKEOF
	. Set tokenval=""
	. Set done=TRUE
	Quit:done
	;
	; Else we need the next token
	;
	Set prevtoken=token
	Set token=dirtoken
	Set tokenval=dirtokenval
	;
	; If our last inbuf reading was ended by endofline (NextTokEol is true) meaning we returned
	; whatever we got (if anything) before that, take care of that now.
	;
	Do:NextTokEol
	. Set dirtoken=TKEOL
	. Set dirtokenval=""
	. Set NextTokEol=FALSE
	. Set done=TRUE
	Quit:done

	;
	; Scan to create next director token/val
	;
	Set dirtokenval=""
	Do:(""=inbuf)
	. If $ZEof Do		; Oops, at EOF with nothing read
	. . Set dirtoken=TKEOF
	. . Set dirtokenval=""
	. . Set done=TRUE
	. Else  Do		; Read a new line - still might detect EOF but might get lucky too!
	. . Read inbuf
	. . If $ZEof Do
	. . . If ""=dirtokenval Set dirtoken=TKEOF
	. . . Set done=TRUE
	. . Set inline=inline+1
	;
	; Quick pre-check for simple blank (null) line if not already done
	;
	Do:('done&(""=inbuf))	; Null line is just a TKEOL return
	. Set dirtoken=TKEOL
	. Set dirtokenval=""
	. Set done=TRUE
	Quit:done		; Processing already complete - bypass scan
	;
	; Scan input line for token-ending chars
	;
	For scnp=1:1:$ZLength(inbuf) Quit:done  Do
	. Set chr=$ZExtract(inbuf,scnp)
	. Do:(0<$Data(CharScn(chr)))
	. . If TKASTERISK=CharScn(chr) Do		; Possible end of comment
	. . . Set chr2=$ZExtract(inbuf,scnp+1)
	. . . Do:(TKSLASH=$Get(CharScn(chr2),TKOTHER))
	. . . . ;
	. . . . ; We have an end-of-comment token. Stop the scan here if we have scanned chars to
	. . . . ; return the scanned part as TKOTHER. We will return the end of comment token for the
	. . . . ; next scan. If we have scanned nothing, then we return the end of comment token.
	. . . . ;
	. . . . If (1<scnp) Do				; Returning previous string as TKOTHER
	. . . . . Set dirtokenval=$ZExtract(inbuf,1,scnp-1)
	. . . . . Set dirtoken=TKOTHER
	. . . . . Set inbuf=$ZExtract(inbuf,scnp,99999)
	. . . . Else  Do
	. . . . . Set dirtokenval="*/"
	. . . . . Set dirtoken=TKCOMEND
	. . . . . Set inbuf=$ZExtract(inbuf,3,99999)
	. . . . . Set:(""=inbuf) NextTokEol=TRUE
	. . . . Set done=TRUE
	. . Else  If TKBACKSLASH=CharScn(chr) Do	; Escaped char coming up
	. . . ;
	. . . ; Same deal as above - return char if first char scanned, else return previously scanned.
	. . . ;
	. . . If (1<scnp) Do
	. . . . Set dirtokenval=$ZExtract(inbuf,1,scnp-1)
	. . . . Set dirtoken=TKOTHER
	. . . . Set inbuf=$ZExtract(inbuf,scnp,99999)
	. . . Else  Do
	. . . . Set dirtokenval="\"
	. . . . Set dirtoken=TKBACKSLASH
	. . . . Set inbuf=$ZExtract(inbuf,2,99999)
	. . . . Set:(""=inbuf) NextTokEol=TRUE
	. . . Set done=TRUE
	. . Else  If TKSLASH=CharScn(chr) Do		; Possible start of comment
	. . . Set chr2=$ZExtract(inbuf,scnp+1)
	. . . Do:(TKASTERISK=$Get(CharScn(chr2),TKOTHER))
	. . . . ;
	. . . . ; Same deal as above - return char if first char scanned, else return previously scanned.
	. . . . ;
	. . . . If (1<scnp) Do			; Returning previous string as TKOTHER
	. . . . . Set dirtokenval=dirtokenval_$ZExtract(inbuf,1,scnp-1)
	. . . . . Set dirtoken=TKOTHER
	. . . . . Set inbuf=$ZExtract(inbuf,scnp,99999)
	. . . . Else  Do
	. . . . . Set dirtokenval="/*"
	. . . . . Set dirtoken=TKCOMSTRT
	. . . . . Set inbuf=$ZExtract(inbuf,3,99999)
	. . . . Set done=TRUE
	. . Else  Do:(TKDQUOTE=$Get(CharScn(chr),TKOTHER))
	. . . ;
	. . . ; We have a quote token. Stop scan here if have scanned chars to return previous scan as
	. . . ; TKOTHER. We will return the quote token on the next scan. If we have scanned nothing,
	. . . ; return the start of comment token.
	. . . ;
	. . . If (1<scnp) Do			; Returning previous string as TKOTHER
	. . . . Set dirtokenval=dirtokenval_$ZExtract(inbuf,1,scnp-1)
	. . . . Set dirtoken=TKOTHER
	. . . . Set inbuf=$ZExtract(inbuf,scnp,99999)
	. . . Else  Do
	. . . . Set dirtokenval=""""
	. . . . Set dirtoken=TKDQUOTE
	. . . . Set inbuf=$ZExtract(inbuf,2,99999)
	. . . . Set:(""=inbuf) NextTokEol=TRUE
	. . . Set done=TRUE
	;
	; Coming out of the loop, two possibilities:
	;
	;   1. We are done, token set all is well - just return
	;   2. We ran out of text in the buffer after reading something - return text as TKOTHER
	;      setting NextTolEol so end-of-line is processed next call.
	;
	Quit:done	; Case 1
	;
	; Assumption here is we ran out of text - assert that
	;
	If $ZLength(inbuf)'=scnp Do Error("ASSERT","F","Did not scan full line yet loop ended without done set")
	Else  Do	; Case 2
	. Set dirtoken=TKOTHER
	. Set dirtokenval=inbuf
	. Set inbuf=""
	. Set NextTokEol=TRUE
	Quit

;
; Routine to flush output buffer (routine sans comments)
;
FlushOutbuf
	Use $Principal
	Write outbuf,!
	Set outbuf=""
	Use infile
	Quit

;
; Output error message - generate dump for fatal errors..
;
Error(msgid,severity,text)
	New zshowdmps
	Use $Principal
	Write !,"DECOMMENT-",severity,"-",msgid," ",text,!!
	Do:("F"=severity)
	. Set zshowdmps=$Increment(ZShowDumpsCreated)
	. Set dumpfile="decomment-fail.zshowdmp-"_$ZDate($Horolog,"YEARMMDD-2460SS")_"-"_zshowdmps_".txt"
	. Open dumpfile:New
	. Use dumpfile
	. ZShow "*"
	. Close dumpfile
	Halt

;
; Routines to enable debugging
;
dbgzwrite(zwrarg,sfx)
	New saveio
	Set saveio=$IO
	Use $Principal
	Write "DbgZwrite at ",$Stack($Stack-1,"PLACE"),":----------- ",$Select(""'=$Get(sfx,""):"("_sfx_")",TRUE:"")_":",!
	ZWrite @zwrarg
	Use saveio
	Quit

;
; Debugging routine..
;
dbgwrite(text)
	New saveio
	Set saveio=$IO
	Use $Principal
	Write text,!
	Use saveio
	Quit