js@UW-JUNE.ARPA (Joe Meadows) (03/22/86)
Well, no one told me what "enough interest" was, but, it seems
to me that there was enough of it to warrant posting this..
So, heres UNMESSAGE -
(cut cut, snip, snip, and so on ---)
$ 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. Cheers."
$ ws "by the way, you'll need to define EXE$DIR to point"
$ ws "to where you put the executable..."
$ ws "Cheers again."