.TITLE UNMESSAGE .IDENT /V1.11/ ; Program from a DECUS tape to convert an executable image which ; contains a message file (the sort of thing found in SYS$MESSAGE) ; to a source message file, with some limitations. ; 29-Aug-1990 B. Z. Lederman Replace FORTRAN output code module with ; 'native' Macro-32, put in 'real' ; descriptors, improve some error handling ; ; Lower case Macro code is original code (don't know the author), upper ; case is mine. .LIBRARY 'SYS$LIBRARY:LIB' $mscdef $midxdef $mrecdef $mfacdef $secdef .PSECT _MSG_CODE long, rd, nowrt, exe .ENTRY UNMESSAGE, ^m pushaq dyn_desc pushaq p1 calls #2, g^cli$get_value ; msg file to uncompile CMPL R0, #CLI$_ABSENT ; was input file mising? BEQL 110$ ; branch if yes, default is o.k. CMPL R0, #CLI$_PRESENT ; was input file specified? BEQL 110$ ; branch if yes, o.k. too JSB ERROR ; check for other errors 110$: PUSHAQ OUT_FILE_DESC PUSHAQ OUTPUT CALLS #2, G^CLI$GET_VALUE ; get output file spec CMPL R0, #CLI$_ABSENT ; was value missing? BEQL 120$ ; branch if yes, default is o.k. CMPL R0, #CLI$_PRESENT ; was value present BEQL 115$ ; branch if yes, o.k. too JSB ERROR ; check for other errors 115$: $FAB_STORE - ; move file name into FAB FAB = OUT_FAB, - FNA = @OUT_FILE_DESC+DSC$A_POINTER, - FNS = OUT_FILE_DESC MOVAB OUT_FAB, R8 ; store for error routine 120$: $CREATE FAB = OUT_FAB ; open the output file JSB RMSERROR $CONNECT - RAB = OUT_RAB ; connect to the output file JSB RMSERROR 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$ .ALIGN LONG 20$: ret .ALIGN LONG .ENTRY GO_AHEAD, ^m movl map_adr, r2 cmpw msc$w_sanity(r2), #msc$c_sanity beql 10$ $exit_s code = #0 .ALIGN LONG 10$: addl3 r2, msc$l_index_off(r2), r3 cmpb midx$b_sanity(r3), #midx$c_sanity beql 20$ $exit_s code = #0 .ALIGN LONG 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 .ALIGN LONG .ENTRY UNCOMPILE_MESSAGE, ^m 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 .ALIGN LONG 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 .ALIGN LONG 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$ .ALIGN LONG 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 .ALIGN LONG 40$: bbc #11, mfac$w_number(r5), 42$ pushab null brb 44$ .ALIGN LONG 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$ .ALIGN LONG 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 $RAB_STORE - RAB = OUT_RAB, - RSZ = BUFFER ; update output record size $PUT RAB = OUT_RAB ; output record JSB RMSERROR movzbl #buffer_size, buffer ; reset 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 $RAB_STORE - RAB = OUT_RAB, - RSZ = BUFFER ; update output record size $PUT RAB = OUT_RAB ; output record JSB RMSERROR movzbl #buffer_size, buffer ; reset 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 $RAB_STORE - RAB = OUT_RAB, - RSZ = BUFFER ; update output record size $PUT RAB = OUT_RAB ; output record JSB RMSERROR movzbl #buffer_size, buffer ; reset 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 $RAB_STORE - RAB = OUT_RAB, - RSZ = BUFFER ; update output record size $PUT RAB = OUT_RAB ; output record JSB RMSERROR movzbl #buffer_size, buffer ; reset output buffer ; 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 ; if reinstated, replace with $PUT ; jsb error ; movzbl #buffer_size, buffer ret .ALIGN LONG ERROR: ; Check system service status (in R0) BLBS R0, 300$ ; If low bit set, not an error PUSHL R0 ; push status value CALLS #1, G^LIB$SIGNAL ; signal error 300$: RSB .ALIGN LONG RMSERROR: BLBS R0, 400$ ; If low bit set, no error occurred PUSHL FAB$L_STV(R8) ; push RMS status values PUSHL FAB$L_STS(R8) PUSHL R0 CALLS #2, G^LIB$SIGNAL ; signal error 400$: RSB .ALIGN LONG .ENTRY MSG_MAP_MSGFILE, ^M ; ret-status = msg_map_msgfile ( msgfile ) movl 4(ap), r0 movb (r0), IN_FAB+fab$b_fns movl 4(r0), IN_FAB+fab$l_fna MOVAB IN_FAB, R8 ; store for error routine $open fab = IN_FAB JSB RMSERROR blbc r0, 10$ $crmpsc_s - ; create and map address space inadr = inadr, - retadr = map_adr, - flags = #, - chan = IN_FAB+fab$l_stv, - vbn = #2 JSB ERROR 10$: ret .PSECT _MSG_LOCAL LONG, rd, wrt, noexe IN_FAB: $fab dnm = , - fac = get, - fop = ufo .ALIGN LONG OUT_FAB: $FAB FAC = PUT, - ; PUT records only FNM = , - ; default output to SYS$OUTPUT DNM = , - ; default if partial name given FOP = , - ; sequential access RAT = CR, - ; 'carriage-return' carriage control RFM = VAR ; variable length records .ALIGN LONG OUT_RAB: $RAB FAB = OUT_FAB, - RBF = BUFADR, - ; address of buffer RSZ = BUFFER, - ; size of buffer ROP = WBH ; write-behind .ALIGN LONG inadr: .long ^x200, ^x200 ; starting addresses for CRMPSC 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 .ALIGN LONG dyn_desc: ; Dynamic string descriptors .WORD 0 .BYTE DSC$K_DTYPE_T .BYTE DSC$K_CLASS_D .ADDRESS 0 OUT_FILE_DESC: ; dynamic descriptor to hold output .WORD 0 ; file name .BYTE DSC$K_DTYPE_T .BYTE DSC$K_CLASS_D OUT_FILE_ADDR: .ADDRESS 0 buffer_size = 255 buffer: .WORD buffer_size ; descriptor to point to output buffer .BYTE DSC$K_DTYPE_T .BYTE DSC$K_CLASS_S BUFFER_AD: .ADDRESS bufadr bufadr: .blkb buffer_size .PSECT _MSG_READONLY long, 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' OUTPUT: .ASCID 'OUTPUT' 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!_ /FAO=!UB /IDENT=!AC' ;tmp: .ascid '!!!_!XB, !XB, !XB, !XB, !XB' .END UNMESSAGE