PMLP866
(George Source)
Macros used: CLHLFDON, DCA, FINDPEREC, JBUSY, JENG, JENVNOT, JFAIL, JRIGHT, JWRONG, LGEOG, LTYPE, RIGHT, SEGENTRY, SWIN, XYZ
- PMLP866.txt
22^= #OPT K0PMLP=0 23DW #LIS K0PMLP>K0POST>K0ALLGEO 24D6 # 24XQ ...#SEG PMLP84 [KAREL KOSKUBA - DIAG 25CB # 25X2 # THIS SEGMENT CHECKS THAT A LP IS AVAILABLE FOR A POSTMORTEM 26BL # LISTING 26W= # 27*W 8HPMLP 27TG # 28*6 # ENTRY POINT TABLE 28SQ # 29#B ... SEGENTRY K1PMLP,XK1PMLP 2=?L # 2=BQ ...MESSA +34,34H^*NO LP AVAILABLE FOR POSTMORTEM^* 2=FW ...MESSB +35,35H^*IS LP AVAILABLE FOR POSTMORTEM?^* 2=K2 ...MESSC +23,23H ^*UNIT NOT A LP^* 2=N6 ...MESSD +25,25H ^*UNIT IS WRONGED^* 2=R= ...MESSE +21,21H ^*UNIT FAILED^* 2=WB ...MESSF +34,34H ^*UNIT BUSY, UNABLE TO USE^* 2=^G ...MESSG +18,18H ^*UNIT FIX^* 2?2? ...MESSH +31,31H ^*UNIT IS NOT AVAILABLE^* 2?34 ...MESSI +34,34H ^*UNIT ALREADY SWITCHED IN^* 2?3T ...MESSJ +19,19H ^*SW REJECTED^* 2?4L ...SPACE #20 2?=W ...SPACEFUL 4H 2?#Q ...XYES 4HYES0 2?BL ...XNO 4HNO00 2?DG ...XRITE 4H00RI 2?GB ...XSW 4H00SW 2?H# ...XLPMN 4H00LP 2?J= ...XLPTYPE +2 2?MB ...NUM 4H 2?NY ...XLINK +0 2?QG # 2#=6 XK1PMLP 2#PQ LDN 1 2 [LP IS TYPE 2 2*9B ... FINDPEREC 3,APFOTY,1,XYZ,,,XLP10 [GET A LP 2*P2 BPZ 3 XLP [J IF THERE IS ONE. 2*Y^ ... LDX 1 FXPMDR 2B8Y ... LDX 7 JLPPTR(1) [DO WE WANT TO ASK Q LP AVAILABLE 2BDX ... BNZ 7 XLP11 [YES 2BNW ...XLP2 STO 3 JUNITNO(1) [INDICATE IN JUNITNO NO LP AVAILABLE 2BYT ... SMO FXPM1 2C8S ... LDN 3 MESSA [OUTPUT TO CONSOLE NO LP AVAILABLE 2CDR ... CALL 7 (JCONOUT) 2CRY ... BRN (JPMSEG) [RETURN TO PMDR 2CWK ...XLP 2C^= ...#UNS G3SIGNET 2D3X ...( 2D6J ... JENVNOT NOTMEEP,MEEP 2D99 ... TXU 3 ASIGNETPTR [IS IT A SIGNET PRINTER? 2D?W ... BCC XYZ [IF YES THEN JUMP TO FIND ANOTHER LP 2DBH ...NOTMEEP 2DF8 ...) 2DH^ ... JWRONG 3,XLP10 [J IF LP WRONGED 2DLQ JFAIL 3,XYZ [J IF LAST PERI TO IT FAILED 2DR? ... JBUSY 3,XLP10 [J IF LEFT BUSY FROM GEORGE 2DXS ... JENG 3,XLP1 [IS LP ENGAGED J IF YES 2F4* ...XLP10 SMO FXPMDR 2F8W ... STO 3 JLPPTR [STORE DEVICE RECORD POINTER TO 2F*C ... BRN XYZ [INDICATE WE WANT TO OUTPUT 2FFY ... ["IS LP AVAILABLE" MSG 2FLF ...XLP1 LDX 1 FXPMDR 2FR8 ... STO 3 JLPPTR(1) [STORE DEVICE RECORD POINTER 2G5L LDN 4 JLPREC [ALSO MOVE PART OF RECORD 2GK= MOVE 3 K53-K50 [INTO PMDR BUFFER 2GQD ...#UNS AR1 2GXL ... CLHLFDON 3 [CLEAR HALFDONEBIT 2H4W LGEOG 3,7 2HJG ... STO 7 JLPGEOG(1) 2NYB LDN 6 121 2PD2 DCA 3,STO,6,COUNT [SET COUNT -ALWAYS 121 2PXL LDN 6 0 2QC= DCA 3,DLA,6,MODE [SET UP MODE -ALWAYS 0 2QWW ... BRN (JPMSEG) 2QX6 ...XLP11 STOZ JLPPTR(1) [CLEAR DEVICE RECORD POINTER 2QXB ...XLP3 SMO FXPM1 2QXL ... LDN 3 MESSB [OUTPUT CONSOLE MSG 2QXW ... CALL 7 (JCONOUT) [IS LP AVAILABLE FOR POSTMORTEM? 2QY6 ...XLP4 CALL 7 (JCTWIN) [PERI ON TYPEWRITER INPUT 2QYB ... BRN XLP4 [A NOT OK TRANSFER TRY AGAIN 2QYL ... ANDN 6 #777 [GET REMAINDER COUNT FROM REPLY WORD 2QYW ... NGX 6 6 [AND CALC NUMBER OF CHAR READ 2Q^6 ... ADN 6 64 2Q^B ... BZE 6 XLP3 [NO CHAR READ ASK QUESTION AGAIN 2Q^L ... LDX 1 FXPM1 2Q^Q ... LDN 3 JCCBUF [LOAD ADDR READ BUFFER 2Q^W ... LDN 0 24 [SHIFT FACTOR FOR LEFT JUSTIFY 2R22 ... LDN 4 4 2R26 ...XLP5 LDCH 7 0(3) [LOAD CHAR 2R2= ... TXU 7 SPACE(1) [IS IT A SPACE 2R2B ... BCS XLP6 [NO 2R2G ... BCHX 3 £ [YES IGNORE IT 2R2L ... BCT 6 XLP5 2R2Q ... BRN XLP61 2R2W ...XLP6 SLL 5 6 [MOVE CURRENT CONTENTS TO LEFT 2R32 ... DCH 7 5 [AND INSERT NEW CHAR ON RIGHT 2R36 ... SBN 0 6 [ADJUST SHIFT FACTOR 2R3= ... BCT 6 XLP62 [HAVE WE FINISHED J NO 2R3B ...XLP61 BZE 0 XLP63 [4 CHAR? 2R3G ... SMO 0 [IF NOT 2R3L ... SLL 5 0 [LEFT JUSTIFY 2R3Q ... BRN XLP63 2R3W ...XLP62 BCHX 3 £ 2R42 ... BCT 4 XLP5 2R46 ... ADN 4 1 2R4= ...XLP63 NGX 4 4 [ADJUST NO OF SIG CHARS 2R4B ... ADN 4 5 2R4L ... TXU 5 XYES(1) [IS IT 'YES' 2R4W ... BCC XK1PMLP [YES -SEARCH DEVICE LIST AGAIN 2R56 ... TXU 5 XNO(1) [IS IT 'NO' 2R5B ... BCC XLP12 [YES 2R5H ... LDX 3 4 [SAVE NO DIGITS FOR CONVERSION 2R5J ... LDX 4 SPACEFUL(1) [CLEAR NUM 2R5K ... STO 4 NUM(1) 2R5N ... LDN 4 0 2R5T ... SLL 45 12 [ISOLATE TOP 2 CHARS 2R62 ... TXU 4 XRITE(1) [ARE THEY RI? 2R67 ... BCC XLPRI [YES 2R6# ... JENVNOT XLP13,CME 2R6F ... TXU 4 XSW(1) [ARE THEY SW? 2R6L ... BCC XLPSW [YES 2R6R ...XLP13 SRL 45 12 [SHIFT TOP 2 CHARS BACK AS GEOG NO 2R6Y ... CALL 0 XDECBIN [CONVERT GEOG NO TO BINARY 2R7B ... FINDPEREC 3,APGEOG,7 [LOOK FOR PERIPHERAL WITH GEOG NO 2R7L ... BNG 3 XLP3 [PERIPHERAL NOT FOUND 2R7W ... LTYPE 3,6 [FIND PERIPHERAL TYPE 2R86 ... TXU 6 XLPTYPE(1) [IS IT LP 2R8B ... BCS XLP9 [NO 2R8L ... LDN 5 MESSD(1) 2R8W ... JWRONG 3,XLP8 [IS LP WRONGED -YES 2R96 ...XLP71 LDN 5 MESSE(1) 2R9B ... JFAIL 3,XLP8 [DID IF FAIL LAST PERI -YES 2R9L ... LDN 5 MESSF(1) 2R9W ... JBUSY 3,XLP8 [IS LP BUSY -YES 2R=6 ... LDN 5 MESSG(1) 2R=B ... JENG 3,XLP1 [IS LP ENGAGED-J IF YES 2R=L ...XLP8 LDX 4 NUM(1) [OUTPUT CONSOLE MSG 2R=W ... LDX 3 5 2R?6 ... STO 4 3(3) 2R?B ... CALL 7 (JCONOUT) 2R?L ... BRN XLP3 2R?W ...XLP9 LDN 5 MESSC(1) 2R#6 ... BRN XLP8 2R#B ...XLP12 LDX 1 FXPMDR 2R#L ... NGN 3 4095 2R#W ... BRN XLP2 2RBG # 2RBQ ...XLPRI SBN 3 2 [ADJUST NO. DIGITS FOR CONVERSION 2RBW ... BZE 3 XLP9 [NO GEOG NO. 2RC2 ... CALL 0 XDECBIN [CONVERT GEOG NO TO BINARY 2RC= ... FINDPEREC 3,APGEOG,7 2RCG ... BNG 3 XLP3 [ENTRY NOT FOUND 2RCQ ... LTYPE 3,6 [ENTRY FOUND. IS IT 2RD2 ... TXU 6 XLPTYPE(1) [A LP? 2RD= ... BCS XLP9 [NO ERROR 2RDG ... JRIGHT 3,XLP1 [J IF DEVICE RIGHT 2RDQ ...XLPRIT 2RF2 ... RIGHT 3 [ELSE RIGHT IT 2RF= ... BRN XLP1 2RFG ...# 2RFQ ...# THE FOLLOWING CODE IS TO SWITCH IN A LP ON REQUEST 2RG2 ...# UNDER A CME ENVIRONMENT ONLY 2RG= ...# 2RGG ...XLPSW SBN 3 2 2RGL ... BZE 3 XLP9 [NO GEOG NO. 2RGQ ... CALL 0 XDECBIN 2RH2 ... FINDPEREC 3,APGEOG,7,,,XLPSW1 2RH= ... LDN 5 MESSI(1) 2RHG ... BPZ 3 XLP8 [ALREADY SWITCHED IN 2RHQ ... LDN 5 MESSH(1) [NOT FOUND 2RJ2 ... BRN XLP8 2RJ= ...XLPSW1 2RJG ... LTYPE 3,6 [ENTRY FOUND IS IT 2RJQ ... TXU 6 XLPTYPE(1) [A LP? 2RK2 ... BCS XLP9 [NO ERROR 2RK6 ... JENVNOT XLPSW3,CME,EXCL 2RK= ... SWIN 3,,XLPSW2,PM [YES - SO SWITCH IN 2RKG ... BRN XLPRIT [SUCCESSFUL 2RKQ ...XLPSW2 2RKW ... LDX 1 FXPM1 2RL2 ... LDN 3 MESSJ(1) [SWITCH IN REJECTED 2RL= ... LDX 5 NUM(1) [SO OUTPUT ERROR MSG 2RLG ... DSA 5 1(3) 2RLQ ... CALL 7 (JCONOUT) 2RM2 ... BRN XLP3 2RM4 ...XLPSW3 2RM6 ... SWINSTAR 3,XLPMN(1),7,XLPSW2 2RM8 ... BRN XLPRIT 2RM= ...# 2RMG ...# ROUTINE TO CONVERT GEOGRAPHICAL NUMBER FROM DECIMAL TO 2RMQ ...# BINARY PRESERVING THE NUMBER IN DECIMAL FORMAT AS WELL 2RN2 ...# IF ANY OF THE CHARACTERS ARE NOT NUMERICAL THE ROUTINE 2RN= ...# BRANCHES OUT TO REOUTPUT THE QUESTION "IS LP AVAILABLE" 2RNG ...# ENTRY X0=LINK 2RNQ ...# X5=GEOG NO LEFT JUSTIFIED ZERO-FILLED 2RP2 ...# EXIT X6-7=DL BINARY GEOG NO 2RP= ...# NUM=RIGHT JUSTIFIED DECIMAL GEOG NO 2RPG ...# 2RPQ ...XDECBIN 2RQ2 ... STO 0 XLINK(1) [STORE LINK 2RQ= ... LDN 7 0 [CLEAR FOR CONVERSION 2RQG ... LDX 0 SPACEFUL(1) 2RQQ ...XDB SLC 0 6 2RR2 ... SLC 5 6 2RR= ... DCH 5 0 2RRG ... CDB 6 5 2RRQ ... BCS XLP3 [NON NUMERIC CHAR 2RS2 ... BCT 3 XDB 2RS= ... STO 0 NUM(1) [STORE GEOG NO IN DECIMAL 2RSG ... LDX 0 XLINK(1) 2RSQ ... EXIT 0 0 2RW6 # 2STB # 2T*2 #END ^^^^ ...55273704000400000000