$! UNMESSAGE, VMS 4.n error message file decompiler
$ ws:=write sys$output
$ ws "Creating the necessary files."
$ copy:=copy/log
$ copy sys$input UNMESSAGE.MAR
$ deck
        .title  unmessage
; placed in the public domain, by Joe Meadows Jr.
; US Mail -
;  4841 268th ave N.E.
;  Redmond Wa. 98052
;cheers.

.library        'sys$library:lib'
$mscdef
$midxdef
$mrecdef
$mfacdef
$secdef

        .psect  _msg_code       rd,nowrt,exe

        .entry  unmessage,^m<r2,r3,r4>

        pushaq  dyn_desc
        pushaq  p1
        calls   #2,g^cli$get_value      ; msg file to uncompile

        calls   #0,init_output

        pushaq  dyn_desc
        calls   #1,g^msg_map_msgfile    ; map it into memory
        jsb     error

        addl    #16,map_adr
        movl    map_adr,r2

10$:    movl    (r2),r3
        beql    20$
        addl    r3,map_adr
        calls   #0,g^go_ahead
        addl    #4,r2
        movl    r2,map_adr
        brb     10$
20$:    ret

        .entry  go_ahead,^m<r2,r3,r4>

        movl    map_adr,r2
        cmpw    msc$w_sanity(r2),#msc$c_sanity
        beql    10$
        $exit_s code=#0

10$:    addl3   r2,msc$l_index_off(r2),r3
        cmpb    midx$b_sanity(r3),#midx$c_sanity
        beql    20$
        $exit_s code=#0

20$:    movzwl  midx$w_size(r3),r4
        addl    r3,r4
        addl    #midx$c_entries,r3

30$:    pushl   r3
        calls   #1,g^uncompile_message
        jsb     error

40$:    addl    #midx$c_length,r3
        cmpl    r3,r4
        blss    30$

        ret

        .entry  uncompile_message,^m<r2,r3,r4,r5,r6,r7>

        movl    4(ap),r0
        movl    (r0),r2                 ; message code
        addl3   map_adr,4(r0),r3        ; message address

        blbc    r3,10$          ; if low bit set then this is a subindex ptr

        decl    r3
        cmpb    midx$b_sanity(r3),#midx$c_sanity
        beql    2$
        $exit_s code=#0
2$:     movzwl  midx$w_size(r3),r4
        addl    r3,r4
        addl    #midx$c_entries,r3
3$:     pushl   r3
        calls   #1,g^uncompile_message
        jsb     error
4$:     addl    #midx$c_length,r3
        cmpl    r3,r4
        blss    3$
        ret

10$:    extzv   #sts$v_fac_no,#sts$s_fac_no,r2,r4       ; facility code

        tstb    fac_flg ; is this first time through?
        beql    20$
        cmpw    r4,cur_fac
        bneq    20$
        brw     50$

20$:    movb    #1,fac_flg
        movl    map_adr,r0      ; map address
        addl3   r0,msc$l_fac_off(r0),r5
        movzwl  (r5),r6         ; size of facility section
        addl    r5,r6                   ; facility end
        addl    #2,r5                   ; facility start

30$:    cmpw    mfac$w_number(r5),r4    ; right facility?
        beql    40$
        movzbl  mfac$b_namelen(r5),r7
        addl    #3,r5
        addl    r7,r5                   ; point to next facility
        cmpl    r5,r6
        blss    30$
        $exit_s code=#0         ; error=no matching facility

40$:    bbc     #11,mfac$w_number(r5),42$
        pushab  null
        brb     44$
42$:    pushab  system
44$:    bbs     #15,mfac$w_number(r5),46$
        tstw    mfac$w_number(r5)
        beql    46$             ; bogus check for /share
        pushab  null
        brb     48$
46$:    pushab  shared
48$:    extzv   #0,#11,mfac$w_number(r5),-(sp)
        pushab  mfac$b_namelen(r5)
        pushab  buffer
        pushab  buffer
        pushab  facmsg
        calls   #7,g^sys$fao
        jsb     error
        pushab  buffer
        calls   #1,g^put_output
        jsb     error
        movzbl  #buffer_size,buffer     ; fix up output buffer
        movw    mfac$w_number(r5),cur_fac
        movw    #1,cur_bas
        movb    #-1,cur_sev

50$:    extzv   #sts$v_severity,#sts$s_severity,r2,r4   ; severity
        cmpb    r4,cur_sev
        beql    60$
        movb    r4,cur_sev
        movab   severities,r0
        movzbl  (r4)[r0],r4
        addl3   r4,r0,-(sp)     ; address of severity
        pushab  buffer
        pushab  buffer
        pushab  sevmsg
        calls   #4,g^sys$fao
        jsb     error
        pushab  buffer
        calls   #1,g^put_output
        jsb     error
        movzbl  #buffer_size,buffer     ; fix up output buffer

60$:    extzv   #sts$v_code,#sts$s_code,r2,r4           ; code
        cmpw    cur_bas,r4      ; is this the code we expected next?
        beql    70$

        movw    r4,cur_bas
        pushl   r4
        pushab  buffer
        pushab  buffer
        pushab  basmsg
        calls   #4,g^sys$fao
        jsb     error
        pushab  buffer
        calls   #1,g^put_output
        jsb     error
        movzbl  #buffer_size,buffer     ; fix up output buffer

70$:    incw    cur_bas
        ; /detail=
        ; /user_value=
        ; /language=
        pushab  mrec$b_identlen(r3)     ; ident
        movzbl  mrec$b_faocnt(r3),-(sp) ; fao count
        movzbl  mrec$b_identlen(r3),r0
        addl    #10,r0
        addl3   r3,r0,-(sp)             ; error message
        pushl   r2                      ; error code
        pushab  buffer
        pushab  buffer
        pushab  errmsg
        calls   #7,g^sys$fao
        jsb     error
        pushab  buffer
        calls   #1,g^put_output
        movzbl  #buffer_size,buffer
        jsb     error

;       movzbl  mrec$b_lang(r3),-(sp)
;       movzbl  mrec$b_userval(r3),-(sp)
;       movzbl  mrec$b_level(r3),-(sp)
;       movzbl  mrec$b_flags(r3),-(sp)
;       movzbl  mrec$b_type(r3),-(sp)
;       pushab  buffer
;       pushab  buffer
;       pushab  tmp
;       calls   #8,g^sys$fao
;       jsb     error
;       pushab  buffer
;       calls   #1,g^put_output
;       movzbl  #buffer_size,buffer
;       jsb     error

        ret

;tmp:   .ascid  '!!!_!XB,!XB,!XB,!XB,!XB'

error:  blbc    r0,10$
        rsb
10$:    $exit_s code=r0


        .entry  msg_map_msgfile,0
        ; ret-status = msg_map_msgfile ( msgfile )
        movl    4(ap),r0
        movb    (r0),fab+fab$b_fns
        movl    4(r0),fab+fab$l_fna
        $open   fab=fab
        blbc    r0,10$
        $crmpsc_s -
                inadr=inadr,retadr=map_adr,flags=#<sec$m_expreg>,-
                chan=fab+fab$l_stv,vbn=#2
10$:    ret

        .psect  _msg_local      rd,wrt,noexe

fab:            $fab    dnm=<SYS$MESSAGE:SYSMSG.EXE>,fac=get,fop=ufo
inadr:          .long   ^x200,^x200
map_adr:        .quad
cur_fac:        .word   ; current facility
cur_bas:        .word   ; current expected base
cur_sev:        .byte   ; current expected severity
fac_flg:        .byte   ; first time through flag

dyn_desc:
        .long   ^x020E0000,0
buffer_size=255
buffer: .long   buffer_size,bufadr
bufadr: .blkb   buffer_size

        .psect  _msg_readonly   rd,nowrt,noexe

severities:
        .byte   0$-severities
        .byte   1$-severities
        .byte   2$-severities
        .byte   3$-severities
        .byte   4$-severities
        .byte   5$-severities
        .byte   5$-severities
        .byte   5$-severities
0$:     .ascic  'WARNING'
1$:     .ascic  'SUCCESS'
2$:     .ascic  'ERROR'
3$:     .ascic  'INFORMATION'
4$:     .ascic  'FATAL'
5$:     .ascic  '?'

p1:     .ascid  'P1'

facmsg: .ascid  '.FACILITY!_!AC,!UW!AC!AC'
system: .ascic  ' /SYSTEM'
shared: .ascic  ' /SHARED'
null:   .byte   0

basmsg: .ascid  '.BASE!_!_!UW'
sevmsg: .ascid  '.SEVERITY!_!AC'
errmsg: .ascid  '_!XL!_<!AC> /FAO=!UB /IDENT=!AC'

        .end    unmessage
$ eod
$ copy sys$input OUTPUT.FOR
$ deck

        subroutine init_output
        implicit integer (a-z)
        character*252 output
        call cli$get_value('OUTPUT',output,len)
        if (len.eq.0) then
         output='SYS$OUTPUT'
         len=10
        end if
        open(file=output(:len),unit=1,status='new',
     >       carriagecontrol='list',recl=4096)
        return
        end

        integer function put_output(string)
        implicit integer (a-z)
        character*(*) string
        write(1,'(a)') string
        put_output=1
        return
        end
$eod
$ copy sys$input UNMESSAGE.CLD
$deck

!***********************************UNMESSAGE***********************************
define verb UNMESSAGE
   image EXE$DIR:UNMESSAGE
   parameter P1
      value (type=$infile)
   qualifier OUTPUT
      value (type=$outfile)
$eod
$ copy sys$input UNMESSAGE.COMPILE
$deck
! Source name, object name, compile command, link options, required files
unmessage.mar,.obj,Macro
output.for,.obj,Fortran
$eod
$ ws "and now, since I don't know if you have the compile.com"
$ ws "posted with VERB, I'll just compile it by hand, heck,"
$ ws "there's only two modules, (I don't remember why I even"
$ ws "bothered with the fortran one...)"
$ ws "Compiling OUTPUT.FOR"
$ fortran output.for
$ ws "Compiling UNMESSAGE.MAR"
$ macro unmessage.mar
$ ws "and now to link them ..."
$ link unmessage,output
$ ws "and to define the UNMESSAGE command"
$ set command unmessage
$ ws "All done. "
$ ws "by the way, you'll need to define EXE$DIR to point"
$ ws "to where you put the executable..."
$!
$!
$! Last summer after I finished with Verb, I attacked the Error message
$! files, and wote a program to generate Source code which could then
$! be modified and used to regenerate the Error message file. I had
$! originally intended to use it to figure out what number was associated
$! with a particular message (I wanted to call SYS$EXIT and have an
$! appropriate error message appear). Because of the some of the information
$! not being in the error message file I wasn't exactly able to do what I
$! wanted, (I couldn't get the name of the original symbol, i.e. nowhere
$! was the word SYS$_NORMAL to be found, actually though, for the most
$! part, the IDENT's match the symbol name, except where the original
$! source had it's own IDENT..  ButI stray..)
$!        Anyway, I was just wondering if anyone was interested in
$! a copy of this program. If nothing else, it's fun to go in and
$! change SYS$MESSAGE:SYSMSG (Is that the one? Its been a while..)
$! So that you get (a) completely erroneous error message (great gag
$! for some poor sap), (b) A bit freindlier error message, or
$! (c) Valley girl error messages...
$!        Actually, all I ever use it for is for finding that perfect error
$! message to use when exiting a program (I'm lazy, why write my own?).
$!        If there's enough interest I'll post the sources (after
$! I check to see if I used Tabs...)
