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
|