fis-gtm/sr_port/msg.m

176 lines
7.6 KiB
Mathematica

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;
; Copyright 2001, 2006 Fidelity Information Services, Inc ;
; ;
; 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. ;
; ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
New ansiopen,err,fn,i1,in,lo,msg,out,outansi,severe,txt,up,vms
Set severe("warning")=0
Set severe("success")=1
Set severe("error")=2
Set severe("info")=3
Set severe("fatal")=4
Set severe("severe")=4
Set up="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Set lo="abcdefghijklmnopqrstuvwxyz"
;
; On Unix, start this program with .../mumps -run msg filename osname
; On VMS, first compile and link msg.m into msg.exe
; then $ commandname == $disk$xxx:[dir.sub]msg.exe
; then $ commandname filename osname
;
Set txt=$ZCMDLINE
Set:$TRanslate($Piece(txt," ",1),"/RUN","-run")="-run" txt=$Piece(txt," ",3,$Length(txt)+2)
Set fn=$Piece(txt," ",1)
Set vms=($Select($Length(txt," ")>1:$Piece(txt," ",2),1:$Piece($ZVERSION," ",3))="VMS")
;
Set in=$ZPARSE(fn,"","",".msg")
Set out=$ZPARSE(fn,"NAME"),txt=$ZPARSE(out,"","[]",".c")
Set l=$Length(txt),outansi=txt
set ext=$Select(vms:".C",1:".c"),extl=ext_";"
Set:$Extract(txt,l-1,l)=ext outansi=$Extract(txt,1,l-2)
Set:$Extract(txt,l-2,l)=extl outansi=$Extract(txt,1,l-3)
Set out=outansi_"_ctl.c",outansi=outansi_"_ansi.h"
Set fn=$ZPARSE(fn,"NAME")
Set fn=$TRanslate(fn,up,lo)
Set cnt=0
Open in:readonly,out:newversion
Set ansiopen=0
Use out Do hdr
For Use in Read msg Quit:$TRanslate(msg,lo,up)?.E1".FACILITY".E
Set err=0 Do Quit:err
. New i1,i2,upmsg
. ; Expect a line like:
. ; .FACILITY GTM,246/PREFIX=ERR_
. Set upmsg=$TRanslate(msg,lo_$Char(9)_",/=",up_" ")_" "
. For i1=1:1 Quit:$Extract(upmsg,i1)'=" "
. If $Extract(upmsg,i1,i1+9)'=".FACILITY " Do Set err=1 Quit
. . Use $Principal Write !!,"Message file format error in ",in,":"
. . Write !,$TRanslate(msg,$Char(9)," "),!?i1,"^-------^",!,"Expected: '.FACILITY'.",!
. . Quit
. For i1=i1+10:1 Quit:$Extract(upmsg,i1)'=" "
. For i2=i1:1 Quit:$Extract(upmsg,i2)=" "
. Set facility=$Extract(msg,i1,i2-1)
. For i1=i2:1 Quit:$Extract(upmsg,i1)'=" "
. For i2=i1:1 Quit:$Extract(upmsg,i2)=" "
. Set facnum=$Extract(msg,i1,i2-1)
. If facnum>2047 Do Set err=1 Quit
. . Use $Principal Write !!,"Message file format error in ",in,":"
. . Write !,"Expected a number between 1 and 2047, found """,facnum,""".",!
. . Quit
. For i1=i2:1 Quit:$Extract(upmsg,i1)'=" "
. For i2=i1:1 Quit:$Extract(upmsg,i2)=" "
. If $Extract(upmsg,i1,i2)'="PREFIX " Do Set err=1 Quit
. . Use $Principal Write !!,"Message file format error in ",in,":"
. . Write !,$TRanslate(msg,$Char(9)," "),!?i1,"^-----^",!,"Expected: 'PREFIX='.",!
. . Quit
. For i1=i2:1 Quit:$Extract(upmsg,i1)'=" "
. For i2=i1:1 Quit:$Extract(upmsg,i2)=" "
. Set prefix=$Extract(msg,i1,i2-1)
. Use out Write "#include ""mdef.h""",!
. Write "#include ""error.h""",!!
. Write:'vms "LITDEF"_$Char(9)_"err_msg "_fn_"[] = {",!
. Quit
For Use in Quit:$ZEOF Read msg Do:$Extract(msg,1)?1u
. New delim,i1,lomsg
. Set cnt=cnt+1 If cnt>4095 Do
. . Use $Principal Write !!,"Message file format error in ",in,":"
. . Write !,"Cannot process more than 4095 messages."
. . Write !,"Overflow occurred at:",!,msg
. . Quit
. ; Expect a line like:
. ; MNEMONIC <error message text>/severity/fao=###!/ansi=### ! comment
. ; or:
. ; MNEMONIC "error message text"/severity/fao=###!/ansi=### ! comment
. For i1=1:1 Quit:$Extract($TRanslate(msg,$Char(9)," "),i1)=" "
. Set outmsg(cnt)=$Extract(msg,1,i1-1)
. For i1=i1:1 Quit:$Extract(msg,i1)="<" Quit:$Extract(msg,i1)=""""
. Set text=""""
. Set delim=$Extract(msg,i1) For i1=i1+1:1 Do Quit:delim=""
. . If $Extract(msg,i1)=">",delim="<" Set delim="" Quit
. . If $Extract(msg,i1)="""",delim="""",$Extract(msg,i1+1)'="""" Set delim="" Quit
. . Set:$Extract(msg,i1)="""" text=text_"\" Set text=text_$Extract(msg,i1)
. . Quit
. Set text=text_""""
. Set (severity,fao)="",ansi="none",lomsg=$TRanslate($Extract(msg,i1+1,$Length(msg)),up_$Char(9,32),lo)
. For Quit:lomsg="" Do
. . New key,ok,s,val
. . If $Extract(lomsg,1,2)="!/" Set lomsg=$Extract(lomsg,2,$Length(lomsg)) Quit
. . If $Extract(lomsg,1)="!" Set lomsg="" Quit
. . If $Extract(lomsg,1)'="/" Do
. . . Use $Principal Write !!,"Message file format error in ",in,":"
. . . Write !,"All options must be preceded by a forward slash (/), Found:",!,msg
. . . Write !,"Error encountered at: ",lomsg
. . . Quit
. . Set ok=0
. . For i1=2:1:$Length(lomsg)+1 Quit:$Extract(lomsg,i1)="/"
. . Set key=$Piece($Extract(lomsg,2,i1-1),"=",1),val=$TRanslate($Piece($Extract(lomsg,2,i1-1),"=",2),"!")
. . If key="" Do Quit
. . . Use $Principal Write !!,"Message file format error in ",in,":"
. . . Write !,"Error message specification:",!,msg
. . . Write !,"Empty keyword encountered: ",lomsg
. . . Quit
. . If $Data(severe(key)) Set severity=severe(key),ok=1
. . If 'ok,$Extract("fao",1,$Length(key))=key Set:+val=val fao=val,ok=1
. . If 'ok,$Extract("ansi",1,$Length(key))=key Set:+val=val ansi=val,ok=1
. . Do:'ok
. . . Use $Principal Write !!,"Message file format error in ",in,":"
. . . Write !,"Error message specification:",!,msg
. . . Write !,"Option not recognized: ",lomsg
. . . Quit
. . Set lomsg=$Extract(lomsg,i1,$Length(lomsg))
. . Quit
. If severity="" Do Quit
. . Use $Principal Write !!,"Message file format error in ",in,":"
. . Write !,"Error message specification:",!,msg
. . Write !,"Severity not specified."
. . Quit
. If fao="" Do Quit
. . Use $Principal Write !!,"Message file format error in ",in,":"
. . Write !,"Error message specification:",!,msg
. . Write !,"Format item count (fao) not specified."
. . Quit
. Set outmsg(cnt,"code")=(facnum+2048)*65536+((cnt+4096)*8)+severity
. If 'vms Use out Write $Char(9),"""",outmsg(cnt),""", ",text,", ",fao,",",!
. If ansiopen,ansi="none" Set ansi=0 ; Make !/ansi= specification optional (except for first one)
. Quit:ansi="none"
. Do:'ansiopen
. . Open outansi:newversion Use outansi
. . Do hdr Set ansiopen=1 Write !,"const static readonly int error_ansi[] = {",!
. . Quit
. Use outansi Write $Char(9),$Justify(ansi,4),",",$Char(9),"/* ",outmsg(cnt)," */",!
. Quit
Use out
Do:'vms
. Write "};",!!
. For i1=1:1:cnt Write "LITDEF",$Char(9),"int ",prefix,outmsg(i1)," = ",outmsg(i1,"code"),";",!
. Quit
; VMS can have addresses in constants, most Unix platforms cannot.
Write !,$Select(vms:"LITDEF",1:"GBLDEF"),$Char(9),"err_ctl "_fn_"_ctl = {",!
Write $Char(9),facnum,",",!
Write $Char(9),""""_facility_""",",!
Write $Char(9),$Select(vms:"NULL,",1:"&"_fn_"[0],"),!
Write $Char(9),cnt_"};",!
If ansiopen Use outansi Write $Char(9),"};",! Close outansi
Quit
hdr New year
Set year=$ZDATE($Horolog,"YEAR")
Write "/****************************************************************",!
Write " *",$Char(9,9,9,9,9,9,9,9),"*",!
Write " *",$Char(9),"Copyright 2001"
Write:year'=2001 ",",year Write " Fidelity Information Services, Inc",$Char(9),"*",!
Write " *",$Char(9,9,9,9,9,9,9,9),"*",!
Write " *",$Char(9),"This source code contains the intellectual property",$Char(9),"*",!
Write " *",$Char(9),"of its copyright holder(s), and is made available",$Char(9),"*",!
Write " *",$Char(9),"under a license. If you do not know the terms of",$Char(9),"*",!
Write " *",$Char(9),"the license, please stop and do not read further.",$Char(9),"*",!
Write " *",$Char(9,9,9,9,9,9,9,9),"*",!
Write " ****************************************************************/",!!
Quit
;