|
The following RPG program generates the TSTPROC Mi-program that when run will send a message to the requesters msg-q showing the processor serial number (NOT the system serial number). I'm trying to see if the result is predictable. It could be version dependent. It works on RISC V4R3. On CISC boxes I expect to get a result of X'00' s, but would like help with testing of this on various boxes, RISC, CISC, various releases. /*================================================================ * This program creates TSTPROC in *CURLIB = * Source statements for the MI compiler are found in array MI. = *================================================================ E MI 1 60 80 I DS I B 1 40#SRCLN I I 'TSTPROC *CURLIB' 5 24 #PGMLB I 25 74 #TEXT I I '*NONE' 75 94 #SRCFL I 95 104 #MBR I 105 117 #CHGDT I 105 105 #CENT I 106 107 #YY I 108 111 #MMDD I 112 117 #HMS I 118 137 #PRTFL I B 138 1410#STRPG I 142 151 #AUT I 152 327 #OP I B 328 3310#NOOPT C CALL 'QPRCRTPG' C PARM MI C PARM 4800 #SRCLN C PARM #PGMLB C PARM 'MI Comp' #TEXT C PARM #SRCFL C PARM #MBR C PARM #CHGDT C PARM ' ' #PRTFL C PARM 0 #STRPG C PARM '*USE' #AUT C PARM '*REPLACE'#OP C PARM 1 #NOOPT C MOVE *ON *INLR ** */ DCL SPCPTR .MACHINE-ATTR INIT(MACHINE-ATTR); DCL DD MACHINE-ATTR CHAR(2608) BDRY(16); DCL DD MAT-MAX-SIZE BIN(4) DEF(MACHINE-ATTR) POS(1) INIT(2608); DCL DD MAT-ACT-SIZE BIN(4) DEF(MACHINE-ATTR) POS(5); DCL DD MAT-P-SNBR CHAR(10) DEF(MACHINE-ATTR) POS(1125); ENTRY * EXT; MATMATR .MACHINE-ATTR, X'012C'; CPYBLAP MSG-TEXT, MAT-P-SNBR, " "; CVTHC MSG-TEXT-HEX, MAT-P-SNBR; CALLI SHOW-MESSAGE, *, .SHOW-MESSAGE; RTX *; /* SHOW A MESSAGE */ DCL SYSPTR .SEPT(6440) BAS(PCO-POINTER); DCL SPC PROCESS-COMMUNICATION-AREA BASPCO; DCL SPCPTR PCO-POINTER DIR; DCL SPCPTR .MSG-ID INIT(MSG-ID); DCL DD MSG-ID CHAR (7) INIT(" "); DCL SPCPTR .MSG-FILE INIT(MSG-FILE); DCL DD MSG-FILE CHAR(20) INIT(" "); DCL SPCPTR .MSG-TEXT INIT(MSG-TEXT); DCL DD MSG-TEXT CHAR(40); DCL DD MSG-TEXT-HEX CHAR(20) DEF(MSG-TEXT) POS(20); DCL SPCPTR .MSG-SIZE INIT(MSG-SIZE); DCL DD MSG-SIZE BIN( 4) INIT(40); DCL SPCPTR .MSG-TYPE INIT(MSG-TYPE); DCL DD MSG-TYPE CHAR(10) INIT("*INFO "); DCL SPCPTR .MSG-QS INIT(MSG-QS); DCL DD MSG-QS CHAR(20) INIT("*REQUESTER "); DCL SPCPTR .MSG-QSN INIT(MSG-QSN); DCL DD MSG-QSN BIN( 4) INIT(1); DCL SPCPTR .REPLY-Q INIT(REPLY-Q); DCL DD REPLY-Q CHAR(20) INIT(" "); DCL SPCPTR .MSG-KEY INIT(MSG-KEY); DCL DD MSG-KEY CHAR( 4); DCL SPCPTR .ERR-CODE INIT(ERR-CODE); DCL DD ERR-CODE BIN( 4) INIT(0); DCL OL QMHSNDM (.MSG-ID, .MSG-FILE, .MSG-TEXT, .MSG-SIZE, .MSG-TYPE, .MSG-QS, .MSG-QSN, .REPLY-Q, .MSG-KEY, .ERR-CODE) ARG; DCL INSPTR .SHOW-MESSAGE; ENTRY SHOW-MESSAGE INT; CALLX .SEPT(4268), QMHSNDM, *; /* SEND MSG TO MSGQ */ B .SHOW-MESSAGE; PEND; +--- | This is the Midrange System Mailing List! | To submit a new message, send your mail to MIDRANGE-L@midrange.com. | To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com. | To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com. | Questions should be directed to the list owner/operator: david@midrange.com +---
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.