DISPCOM867
(George Source)
Macros used: ALTLEN, BRUSEN, BXU, CJOBLOCK, COMERR, DOLPMON, DORPMON, DOSPMON, DOUTHIER, ENDCOM, FLENME, FPCACA, FPERENTA, HUNT, HUNT2, HUNTW, INFORM, INFORMX, MENDAREA, MONOUT, MONOUTX, OUTBLOCK, OUTPARAM, PARAPASS, PERCON, SEG, SEGENTRY, SETNCORE, SETUPCORE, SPARAPAS, TESTHKN, TESTRACE, TRACE
- DISPCOM867.txt
22FL #LIS K0DISPCOM 22R2 ... SEG DISPCOM,867,SECTION CENT,,G400 234B ...[ 23*Q ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 23M6 ...[ 23YG SEGENTRY K1DISPCOM,XENTRY 24D6 # PARAMETERS OF THE SEGMENT 24K# ...#UNS G400 24QG ...# THIS CHAPTER IS FOR G3PLUS-IH MK2 24XQ #DEF VLENGTH=11 [LENGTH OF 'DISPLAY'BLOCK 25CB #DEF VCHARS=A1 [POSN OF CHAR COUNT 25X2 #DEF VMESS=A1+1 [& MESSAGE IN'DISPLAY'BLOCK 26BL RTPAR +0 [TEMP STORE FOR ROUTING PARAM 26W= Q1 +1 27*W Q4 +4 27TG ZJ1 +JZDISPM 28*6 ZJ2 +JZDISPC 28JY ... SEGENTRY K50DISPCOM 28SQ Q41 +41 [MAX LENGTH OF 'DISPLAY' MESSAGE 29#B QAST #32 29S2 QMINUS1 #77777777 2=?L QMASK #77000000 2=*8 ...#UNS G400 2=BQ ...( 2=D# ...ZDSK1 +G400MESSAGE 2=FW ...ZDSK5 +G400MESSGE5 2=HD ...ZDSK2 4HCR00 2=K2 ...ZDSK3 4HCE00 2=LJ ...ZDSK6 4HOP00 2=N6 ...ZDSK4 +2 2=PN ...) 2=R= # DISPLAY COMMAND.THE FIRST PARAMETER MAY BE 0,1,2 OR 3,WHICH 2?=W # INDICATES WHERE OUTPUT IS TO TAKE PLACE: 2?QG # 2#=6 # 0 -MONITORING FILE ONLY 2#PQ # 1 -MONITORING FILE & CLUSTER CONSOLE 2*9B # 2 -MONITORING FILE & OPERATORS CONSOLE 2*P2 # 3 -MONITORING FILE & CLUSTER CONSOLE & OPERATORS CONSOLE 2B8L # 2BN= # ALTERNATIVELY,AN ONLINE PERIPHERAL MAY BE SPECIFIED WHICH IS 2C7W # INTENDED TO CATER FOR THOSE CASES WHERE DIFFERENT CONSOLES MAY BE 2CMG # MONITORING DIFFERENT PERIPHERALS.AT PRESENT,HOWEVER,THIS USE WILL 2D76 # BE LIMITED TO MEAN CENTRAL CONSOLE ONLY. 2DLQ # 2F6B # THE SECOND PARAMETER IS PASSED TO A CPB/CUNI BLOCK,THE FIRST 40 2FL2 # CHARACTERS ARE STORED IN THE 'DISPLAY' BLOCK AND THE PARAMETER IS 2G5L # SENT AS PART OF A MONITORING FILE MESSAGE 2GK= # 2H4W XENTRY 2HJG #SKIP K6DISPCOM>99-99 2J46 TRACE 1,DISPLAY 2JHQ # 2K3B # ANALYSES ROUTING PARAMETER,STORING IT AS 0,1,2 OR 3 (WITH 4 ADDED 2KH2 # AS PART OF THE INTERNAL MECHANISM),WHICHEVER WAS SPECIFIED,OR AS 2L2L # 2 IN THE CASE OF AN ONLINE PERIPHERAL. 2LG= # 2L^W PARAPASS [PASS FIRST PARAM 2MFG HUNT 2,CPB,CUNI [FIND PARAM 2MLN ...#UNS G400 2MRW ... BRUSEN XDSK1 2M^6 LDX 6 ANUM(2) 2NDQ TXU 6 QMINUS1(1) [NON EXISTANT PARAM 2NYB BCC ZA1 2PD2 ANDN 6 #7777 2PXL BZE 6 ZA1 [NULL PARAM 2QC= LDCH 4 APARA(2) 2QWW BNZ 4 ZA16 [JUMP IF NOT ZERO 2RBG TXU 6 Q1(1) 2RW6 BCC ZA17 2S*Q BRN ZA1 [ERROR IF MORE THAN 1 CHARACTER 2STB ZA16 TXL 4 Q4(1) 2T*2 BCC ZA13 [JUMP UNLESS ONE,TWO OR THREE 2TSL ZA12 TXU 6 Q1(1) 2W#= BCC ZA7 2WRW BRN ZA1 [ERROR IF MORE THAN 1 CHARACTER 2X?G ZA13 2XR6 TXU 4 QAST(1) 2XW= ...#UNS G400 2X^B ... BCS XDSK1 2Y4G ...#UNS G400 2Y7L ...#SKI 2Y=Q BCS ZA1 [JUMP UNLESS ASTERISK 2YQB PERCON [CONVERT PERIPH NAME TO TYPE,UNIT NO 2^=2 HUNTW 2,CPAR,GPERCON [FIND CONVERTED PARAMETER 2^PL BNG 2 ZA10 [FINISH-ERROR REPORTED BY PERCON 3CWQ #SKI K6DISPCOM<99-99 3DBB TRACE A1(2),DISTYUN 3DW2 SMO FX2 3F*L LDX 4 CONTEXT 3FT= ANDN 4 #1000 3G#W BZE 4 ZA17 [JUMP IF NO CORE IMAGE 3GSG FPCACA 3,FX2 3H#6 HUNT2 3,APERI,APERIRES 3HRQ FPERENTA 3,A1(2),ZA15 3J?B LDX 4 1(3) 3JR2 ANDX 4 GSIGN 3K=L ERX 4 GSIGN 3KQ= BZE 4 ZA17 3L9W LDN 4 2 [CENTRAL CONSOLE ONLY 3LPG BRN ZA7 3MNQ ZA17 LDN 7 1 3N8B TESTRACE 7,NOOUT [ERROR IF NO OUTPUT ANYWHERE 3NN2 ZA7 3P7L #SKIP K6DISPCOM>99-99 3PM= TRACE 4,DISUNUM 3Q6W ADN 4 4 [ADD 4 TO ROUTING PARAMETER FOR 3QLG [CLUSTERS 3R66 # HUNTS FOR DISPLAY BLOCK-IF NOT FOUND,MAKES A NEW ONE 3RKQ SPARAPASS [PASS SECOND PARAM 3S5B HUNT 2,CPB,CUNI [FIND IT 3SK2 LDX 6 ANUM(2) [NO OF CHARS 3T4L TXU 6 QMINUS1(1) [NON EXISTANT 3TJ= BCS ZA5 3W3W LDN 6 0 3WHG ZA5 ANDN 6 #7777 3X36 LDX 5 6 [NO OF CHARS TO BE MOVED 3XGQ TXL 5 Q41(1) [IF LESS THAN 41 3Y2B BCS ZA3 3Y=8 ... SEGENTRY K51DISPCOM 3YG2 LDN 5 40 3Y^L LDX 6 5 3^F= ZA3 LDX 7 5 3^YW ADN 7 3 42DG SRL 7 2 [NO OF WORDS IN MESSAGE 42Y6 ADN 7 1 [PLUS ONE FOR COUNT 43CQ HUNTW 3,APED,ADISPLAY [FIND PREVIOUS DISPLAY BLOCK 43XB BPZ 3 ZA11 44C2 SETUPCORE 7,3,APED,ADISPLAY [IF NOT FOUND,MAKE A NEW ONE 44WL BRN ZA2 45B= ZA11 LDX 0 ALOGLEN(3) 45TW SBX 0 7 46*G BPZ 0 ZA2 [J IF OLD BLOCK IS LONG ENOUGH 46T6 ALTLEN 3,7,APED,ADISPLAY 47#Q HUNTW 3,APED,ADISPLAY [AND RELOCATE IT 47SB # TRANSFERS MESSAGE PARAM INTO BLOCK GIVEN BY X3 48#2 ZA2 48RL HUNT 2,CPB,CUNI [FIND PARAM 49?= STO 5 VCHARS(3) [CHAR COUNT TO DISPLAY BLOCK 49QW BZE 5 ZA4 [JUMP IF NULL MESSAGE 4==G ADN 2 APARA [MOVE MESSAGE 4=Q6 ADN 3 VMESS 4?9Q ADN 5 3 4?PB SRL 5 2 4#92 SMO 5 4#NL MOVE 2 0 4*8= ZA4 OUTPARAM 6,APARA,CPB,CUNI 4*=T ...#UNS G400 4**D ...( 4*D3 ... DOLPMON 7 4*GL ... DOSPMON [ENSURE OK IF HOOK 4*K9 ...) 4*MW MONOUTX ZJ1(1) [MESSAGE TO MONITORING FILE 4*T4 ...#UNS G400 4B2= ... DORPMON 7 [RESET FOR HOOK 4B7G # SENDS MESSAGE TO OPERATORS 4BM6 TXU 4 Q4(1) 4C6Q BCC ZA10 [NO CONSOLE OUTPUT 4CBJ ... SEGENTRY K52DISPCOM 4CLB LDN 7 19 4D62 OUTBLOCK 7 4DKL OUTPARAM 6,APARA,CPB,CUNI [FIRST PARAM FOR CONSOLE O/P 4F5= SETNCORE 8,7,ADATA,JLN [BLOCK FOR O/P OF JOB & USER NAMES 4FJW ADN 7 VCHARS 4G4G CJOBLOCK 2 [FIND JOB BLOCK 4GJ6 LDX 3 7 4H3Q SMO FX2 4HHB STO 4 AWORK1 [PRESERVE ROUTRG PARAMETER 4J32 FLENME JUSER,JNAME [JOB & USER NAMES TO ADATA/JLN BLOCK 4JGL LDX 2 3 4K2= ZA14 BCHX 2 £ [STEP CHARACTER PTR 4KFW LDCH 0 1(2) [LOAD CHARACTER FROM DATA BLOCK 4K^G SBN 0 #36 4LF6 BNZ 0 ZA14 [JUMP UNLESS '.' 4LYQ LDN 0 #34 4MDB DCH 0 1(2) [CHANGE '.' TO ',' 4MY2 SMO FX2 4NCL LDX 4 AWORK1 [PICK UP ROUTING PARAM 4NX= OUTPARAM 0(3),VMESS,ADATA,JLN [SECOND PARAM FOR CONSOLE O/P 4PBW INFORMX 4,ZJ2(1),1 4PWG ZA10 4QB6 #SKIP K6DISPCOM>99-99 4QTQ TRACE 1,DISPEND 4R*B ENDCOM 4RT2 ZA1 COMERR JZRTPAR 4S#L ZA15 4SS= COMERR ERUNALLOC [UNALLOCATED PERIPHERAL 4T?W NOOUT MONOUT JMTRACE1 4TRG BRN ZA7 4W?6 NOCORE 4WQQ LDN 4 0 4X=B BRN ZA7 4X=K ...#UNS G400 4X=S ...( 4X?3 ...XDSK1 TESTHKN XDSK9 [ERROR IF NOT HOOK 4X?= ... LDX 6 ANUM(2) 4X?F ... ANDN 6 #7777 4X?N ... TXU 6 ZDSK4(1) 4X?X ... BCS ZA1 4X#6 ... LDX 4 APARA(2) 4X#* ... ANDX 4 HALFTOP [ GET FIRST PARAMETER 4X#J ... TXU 4 ZDSK2(1) 4X#R ... BCC XDSK2 [ J IF CR 4X*2 ... TXU 4 ZDSK6(1) 4X*9 ... BCC XDSK12 [J IF OP 4X*D ... TXU 4 ZDSK3(1) 4X*M ... BCS ZA1 [J IF NOT CE 4X*W ...# CE CASE 4XB5 ... DOUTHIER [GET COMMAND HIERARCHY 4XB# ... LDN 4 1 4XBH ... BRN XDSK3 4XBQ ...XDSK12 4XB^ ... NGN 4 1 4XC8 ... BRN XDSK3 4XCC ...# CR CASE (AND CE,OP CONTINUED) 4XCL ...XDSK2 LDN 4 0 4XCT ...XDSK3 SPARAPAS 4XD4 ... HUNT 2,CPB,CUNI 4XD? ... LDX 6 ANUM(2) 4XDG ... BXU 6 QMINUS1(1),XDSK4 4XDP ... LDN 6 0 4XDY ...XDSK4 ANDN 6 #777 4XF7 ... OUTPARAM 6,APARA,CPB,CUNI 4XFB ... BNG 4 XDSK8 [J IF OP 4XFK ... LDX 0 CONTEXT(2) 4XFS ... ANDN 0 #11 4XG3 ... BZE 0 XDSK7 [J IF NOUSER AND NOT MOP 4XG= ... DOLPMON 7 4XGF ... DOSPMON 4XGN ... BNZ 4 XDSK5 [J IF CE 4XGX ... MONOUTX ZDSK1(1) [ CR TO MON FILE 4XH6 ... BRN XDSK6 4XH* ...XDSK5 MONOUTX ZDSK5(1) [ CE TO MON FILE 4XHJ ...XDSK6 DORPMON 7 4XHR ... ENDCOM 4XJ2 ...XDSK7 BNZ 4 XDSK13 [ J IF CE 4XJ9 ... LDX 0 JSOURCE(2) 4XJD ... BZE 0 XDSK8 4XJM ... INFORM 0,G400MESSGE2,1 [ CR TO CLUSTER CONSOLE 4XJW ... ENDCOM 4XK5 ...XDSK8 INFORM 1,G400MESSGE1,1 [ CR TO CENTRAL CONSOLE 4XK# ... ENDCOM 4XKH ...XDSK9 BRUSEN XDSK10 4XKQ ... BRN ZA1 4XK^ ...XDSK10 COMERR JCONTINC,JDIR 4XL8 ... ENDCOM 4XLC ...XDSK13 4XLL ... LDX 0 JSOURCE(2) 4XLT ... BZE 0 XDSK14 4XM4 ... INFORM 0,G400MESSGE4,1 [ CE TO CLUSTER CONSOLE 4XM? ... ENDCOM 4XMG ...XDSK14 4XMP ... INFORM 1,G400MESSGE3,1 [ CE TO CENTRAL CONSOLE 4XMY ... ENDCOM 4XN7 ...) 4XQ2 MENDAREA 20,GAPDISPCOM 4Y9L #END ^^^^ ...24365514000300000000