{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: PMLP866)}}
====== PMLP866 ======
(George Source)
**Macros used:** [[george:macro:CLHLFDON|CLHLFDON]], [[george:macro:DCA|DCA]], [[george:macro:FINDPEREC|FINDPEREC]], [[george:macro:JBUSY|JBUSY]], [[george:macro:JENG|JENG]], [[george:macro:JENVNOT|JENVNOT]], [[george:macro:JFAIL|JFAIL]], [[george:macro:JRIGHT|JRIGHT]], [[george:macro:JWRONG|JWRONG]], [[george:macro:LGEOG|LGEOG]], [[george:macro:LTYPE|LTYPE]], [[george:macro:RIGHT|RIGHT]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SWIN|SWIN]], [[george:macro:XYZ|XYZ]]
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