{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: PMDUMPDA85)}}
====== PMDUMPDA85 ======
(George Source)
**Macros used:** [[george:macro:BLOCK|BLOCK]], [[george:macro:DATUMADD|DATUMADD]], [[george:macro:DATUMBLK|DATUMBLK]], [[george:macro:DCA|DCA]], [[george:macro:ERROR|ERROR]], [[george:macro:FINDPEREC|FINDPEREC]], [[george:macro:GPERI|GPERI]], [[george:macro:JBUSY|JBUSY]], [[george:macro:JENG|JENG]], [[george:macro:JENV|JENV]], [[george:macro:LINT|LINT]], [[george:macro:LPROP|LPROP]], [[george:macro:LTYPE|LTYPE]], [[george:macro:ON|ON]], [[george:macro:PMOVE|PMOVE]], [[george:macro:SEGENTRY|SEGENTRY]]
22FL #OPT K0PMDUMPDA=0
22^= #LIS K0PMDUMPDA>K0POST>K0ALLGEO
23DW #SEG PMDUMPDA85 [M.C.D. MANN
23YG #
24D6 #
24XQ # THIS SEGMENT ASKS THE OPERATOR FOR A UDAS DEVICE ONTO
25CB # WHICH THE POSTMORTEM SHOULD BE DUMPED.IT CHECKS THE
25X2 # VALIDITY OF REPLY AND FINDS THE PROPER PLACE FOR DUMP
26BL # TO START
26W= #
27*W #
27TG # A COMMUNICATION AREA, WHICH IS USED THROUGHOUT THE DUMP, IS
28*6 # INITIALISED TO CONTAIN INFORMATION DESCRIBING THE DA FILE TO
28SQ # WHICH THE DUMP IS BEING TAKEN. THIS AREA IS INITIALLY
29#B # LOCATED JDUMPFD (1024) WORDS ABOVE THE ADDRESS POINTED TO
29S2 # BY FXPM1 AND IS SUBSEQUENTLY MOVED DOWN CORE BY K5PMDUMP TO
2=?L # [FXPM1], THE LOCATION OF WHICH IS REMEMBERED IN FXPM1DUMP.
2=R= #
2?=W #
2?QG # THE FORMAT OF THIS AREA IS AS FOLLOWS:
2#=6 #
2#PQ #
2*9B # FXPM1DUMP -> WORD 0 : 4HPMDA
2*P2 # 1 : 4HCOMM
2B8L # JDUMPFD -> 2 : TYPE / SUBTYPE OF THE DA FILE
2BN= # 3 : ADDRESS OF THE FIRST CYLINDER
2C7W # OF THE FILE
2CMG # 4 : DISPLACEMENT OF THE FIRST BLOCK OF
2D76 # THE FILE WITHIN THE FIRST CYLINDER
2DLQ # 5 : NUMBER OF CYLINDERS IN THE FILE
2F6B # 6 : NUMBER OF BLOCKS PER CYLINDER
2FL2 # 7 : STORAGE UNIT SERIAL NUMBER (SUSN)
2G5L # UFIC -> 8 : DATUMISED HARDWARE ADDRESS OF THE
2GK= # FILE'S FILE INDEX CELL (FIC)
2H4W # 9 : WORD ADDRESS OF THE START OF THE
2HJG # FIC WITHIN ITS HARDWARE BLOCK
2J46 # 10 : CODED LOCATION OF THE ENGAGE BUTTON
2JHQ # BIT FOR THE OPERATORS' CONSOLE
2K3B # 11 : FLAG WORD USED TO RECORD THE CAUSE
2KH2 # OF ANY FAILURE DURING THE DUMP
2L2L #
2LG= # THIS CAN CONTAIN THE FOLLOWING
2L^W # VALUES IMMEDIATELY AFTER A FAILURE:
2MFG #
2M^6 # -1 : THE DISC HAS FAILED
2NDQ # 1 : THE DISC HAS BECOME INOPERABLE
2NYB # AND THE OPERATOR, AFTER
2PD2 # RECEIVING A "UNIT N FIX"
2PXL # REQUEST, HAS INITIATED
2QC= # THE INPUT OF A MESSAGE ON
2QWW # THE CONSOLE
2RBG # 2 : THE DISC FILE HAS BECOME FULL
2RW6 #
2S*Q #
2STB # NOTE THAT WORDS 2 TO 7 INCLUSIVE OF THIS AREA COMPRISE A DUMMY
2T*2 # FILE DESCRIPTION FOR USE BY THE DATUM FIXED CORE SEGMENT WHEN
2TSL # CONVERTING BLOCK ADDRESSES TO HARDWARE FORMAT IN
2W#= # PREPARATION FOR A DISC TRANSFER. THIS FILE DESCRIPTION
2WRW # IS ANALOGOUS TO A BSTB/CCTABLE BLOCK : SEE THE DATUMADD AND
2X?G # DATUMBLK MACROS.
2XR6 #
2Y=Q #
2YQB 8HPMDUMPDA
2^=2 # ENTRY POINT TABLE
2^PL #
329= SEGENTRY K1PMDUMPDA,XK1PMDUMPDA
32NW SEGENTRY K2PMDUMPDA,XK2PMDUMPDA
338G SEGENTRY K3PMDUMPDA,XK3PMDUMPDA
33N6 SEGENTRY K4PMDUMPDA,XK4PMDUMPDA
347Q #
34MB #
3572 #DEF UFIC=JDUMPFD+6 [FILE INDEX CELL
35LL MESSA 27,27H^*SUSN,OP'S NO.,FILENAME?^*
366= MESSB 35,35H^*PLEASE LOAD ON UNIT ^*
36KW MESSC 19,19H^*INVALID MESSAGE^*
375G MESSD 34,34H^* NOT ON ^*
37K6 MESSE 30,30H^*DISC/FILE FORMAT ERROR ^*
384Q MESSF 18,18H^*UNIT FIX^*
38JB MESSG 19,19H ^*UNIT FAIL^*
3942 MESSH 32,32H^*TRACK * BLOCK *
39HL MESSI 12,12H^* *
3=3= MESSK 26,26H^* NOT ON ^*
3=GW MESSL 18,18H^*DISC FILE FULL^*
3?2G XSUSN +0,+0 [TO HOLD SUSN
3?G6 XOPSNO +0 [OP'S NUMBER
3?^Q XFNAME 12H [HOLDS FILENAME
3#FB XOPSNOD 4H [OP'S NUMBER IN DECIMAL
3#^2 XTEMP
3*DL #REP 7
3*Y= 0
3BCW XALPH #73,#41
3BXG X512 512
3CC6 SEVEN 7,8
3CWQ THIRTEEN 13
3DBB TWEN4 24
3DW2 XTWBIT 0 [HOLDS T/W ENGAGE BIT POS.
3F*L XDABIT 0 [HOLDS DA ENGAGE BIT POS.
3FT= XSTYP 0 [SUBTYPE FOR UDAS DEVICES
3G#W XLINK 0 [LINK FOR S/R CALLS
3GSG XFLINK 0 [ DTTO
3H#6 XLINKA 0
3HRQ XLASTC #37777777 [INDICATES LAST CELL IN FIC
3J?B WORDPART 0 [DISPLACEMENT WITHIN DISC BLOCK
3JR2 X3 0 [DUMP FOR ACC3
3K=L SPACE #20
3KQ= SPACES #20202020
3L9W XCOMMA #34
3LPG XLINK2 0
3M96 XLINK3 0
3MNQ XLINK4 0
3N8B XLINK5 0
3NN2 XLINK6 0
3P7L XDA 4HDA00
3PM= XMT 4HMT00
3Q6W X111 111
3QLG X7S #77777
3R66 #
3RKQ #
3S5B # SUBROUTINE TO CHECK WHETHER A DEVICE IS ENGAGED GIVEN THE
3SK2 # UNIT'S "ENGAGE BIT POSITION" IN X5 (SEE THE XUNS ROUTINE)
3T4L #
3TJ= # EXIT 0 : THE UNIT ISN'T ENGAGED
3W3W # EXIT 1 : THE UNIT IS ENGAGED
3WHG #
3X36 XCHENG
3XGQ LDN 4 0
3Y2B LDCH 2 5
3YG2 SLL 45 9
3Y^L LDCT 3 #400
3^F= BZE 4 XCHN
3^YW SMO 4
42DG SRL 3 0
42Y6 XCHN ANDX 3 EBA(2)
43CQ BZE 3 (0) [EXIT 0 IF NOT ENG,
43XB EXIT 0 1 [EXIT 1 IF ENG.
44C2 #
44WL # SUBROUTINE TO CLEAR AN ENGAGE BIT GIVEN A POINTER TO THE
45B= # UNIT'S DEVICE LIST IN X3
45TW #
46*G # RETURNS THE UNIT'S "ENGAGE BIT POSITION" IN X6 AS:
46T6 #
47#Q # BITS 0 - 8 : BIT POSITION WITHIN EBA WORD
47SB # BITS 9 - 23 : NUMBER OF WORD WITHIN THE EBA
48#2 #
48RL XUNS LINT 3,6
49?= DVS 5 TWEN4(1)
49QW LDX 7 5
4==G LDX 2 6
4=Q6 SLL 6 9
4?9Q SRL 56 9
4?PB LDCT 5 #400
4#92 BZE 7 XUN
4#NL SMO 7
4*8= SRL 5 0
4*MW XUN ORS 5 EBA(2)
4B7G ERS 5 EBA(2) [UNSET THE BIT
4BM6 EXIT 0 0
4C6Q # S/R TO CONVERT DECIMAL POINTED AT BY X3
4CLB # TO BINARY IN X4 AND X5.COUNT IN X7
4D62 XDECBIN
4DKL LDN 4 0
4F5= LDN 5 0
4FJW XDB CDB 4 0(3)
4G4G BCS XFEX [J IF NON NUMERIC
4GJ6 BCHX 3 £
4H3Q BCT 7 XDB
4HHB EXIT 0 0
4J32 # DA-PERI READ S/R
4JGL XDAPERI
4K2= STO 0 XLINK(1) [STORE LINK
4KFW STO 5 XLINK6(1)
4K^G XDAGAIN
4LF6 LDN 6 0 [READ MODE
4LYQ SMO FXPMDR
4MDB LDX 2 JMTPTR [PICK UP DA DEVICE LIST POINTER
4MY2 XDABUSY
4NCL JBUSY 2,XDABUSY [WAIT IF THE DEVICE IS BUSY
4NX= DCA 2,DLA,6,MODE [DEPOSIT MODE
4PBW LDN 6 128
4PWG DCA 2,STO,6,COUNT [DEPOSIT COUNT
4QB6 LDN 6 JDUMPFD+8(1)
4QTQ DCA 2,STO,6,CTSA [BUFFER ADDRESS
4R*B DCA 2,STO,5,DTSA [HARDWARE ADDRESS
4RT2 SMO FXPMDR
4S#L LDN 3 JMTPTR-CPPTR [GET 'BLOCK' START
4SS= GPERI 2,3,NC [START IT ROLLING
4T?W XDABUS
4TRG JBUSY 2,XDABUS [WAIT FOR THE TRANSFER TO FINISH
4W?6 SMO FXPMDR
4WQQ LDX 6 JMTRW1 [LOAD REPLY WORD
4X=B SRL 6 18 [LOOK AT THE TOP CHARACTER
4XQ2 BZE 6 XDAOK [J IF TRANSFER OK
4Y9L ANDN 6 1
4YP= BZE 6 XK3PMDUMPDA [J IF NOT DISENGAGED-I.E.FAIL
4^8W LDX 4 XOPSNOD(1)
4^NG STO 4 MESSF+3(1) [STORE OP'S NO.IN MESSAGE
5286 LDN 3 MESSF(1)
52MQ CALL 7 (JCONOUT) [UNIT NN FIX
537B CALL 0 XTWDA [WAIT FOR INPUT OR DEVICE ENGAGED
53M2 BRN XGEOG [J IF VALID INPUT RECEIVED ON CONSOLE
546L LDX 5 XLINK6(1) [DEVICE IS NOW ENGAGED
54L= BRN XDAGAIN [SO TRY AGAIN
555W XDAOK LDX 0 XLINK(1)
55KG EXIT 0 0
5656 #
56JQ # SUBROUTINE TO INFORM OPERATORS ABOUT A TRANSFER FAILURE
574B # OUTPUTS CURRENT BLOCK,TRACK AND PERI CONTROL AREA IN OCTAL
57J2 #
583L XK3PMDUMPDA
58H= LDX 1 FXPM1
592W STO 0 XFLINK(1)
59GG SMO FXPMDR
5=26 LDX 6 JMTGEOG [PICK UP DA DEVICE'S UNIT NUMBER
5=FQ CALL 7 (JGNO1) [CONVERT IT TO CHARACTER FORM
5=^B STO 5 MESSG+3(1) [AND INSERT IT IN THE "FAIL" MESSAGE
5?F2 LDN 3 MESSG(1)
5?YL CALL 7 (JCONOUT) [UNIT NN FAIL
5#D= SMO FXPMDR
5#XW LDX 4 JMTRW1 [LOAD THE DA PERI REPLY WORD
5*CG SMO FXPMDR
5*X6 LDX 2 JMTPTR [PICK UP THE DISC DL POINTER
5BBQ LTYPE 2,5 [FIND OUT THE UNIT'S TYPE
5BWB SBN 5 6
5CB2 LDN 7 0
5CTL BZE 5 XEDS8 [J IF EDS8
5D*= SBN 5 7
5DSW BNZ 5 XNOTFD [J IF NOT FSD
5F#G LPROP 2,7 [FIND OUT THE PROPERTY CODE
5FS6 SRL 7 6
5G?Q ANDN 7 1 [AND CALCULATE THE SUB-TYPE
5GRB ADN 7 3
5H?2 BRN XEDS8
5HQL XNOTFD
5J== SBN 5 13
5JPW BZE 5 XEDS3060 [J IF EDS30 OR EDS60
5K9G CALL 0 XEXEC [IMPOSSIBLE: TAKE AN EXEC PM
5KP6 XEDS3060
5L8Q LDN 7 1
5LNB XEDS8
5M82 STO 7 0 [COMPOSITE DEVICE TYPE IS NOW IN X0
5MML SMO FXPMDR
5N7= LDX 3 JMTPTR
5NLW DCA 3,LDX,5,DTSA [GET H/W ADDR
5P6G BNZ 0 NEDS8 [J IF NOT EDS8
5PL6 SLC 56 6
5Q5Q SLL 5 2
5QKB SLC 56 4
5R52 ANDN 6 #377 [TRACK TO X6
5RJL SLL 5 2
5S4= SLL 45 4
5SHW SLL 5 3
5T3G SRL 45 4
5TH6 SRL 5 17 [BLOCK TO X5
5W2Q BRN XW2
5WGB NEDS8 SBN 0 1
5X22 BZE 0 XE3OFA [J IF EDS 30/60
5XFL SBN 0 2
5X^= BZE 0 XE3OFA [J IF FDS 2A
5YDW SRL 56 39 [TRACK IN X6 FOR 2B
5YYG SMO FXPMDR
5^D6 LDX 3 JMTPTR
5^XQ DCA 3,LDX,4,DTSA
62CB ANDX 4 X7S(1)
62X2 LDEX 5 4
63BL SRL 4 9
63W= MPA 4 X111(1) [BLOCK IN X5
64*W BRN XW2
64TG XE3OFA [EDS30/60 OR FDS 2A
65*6 LDN 6 0
65SQ SLC 56 12
66#B SRL 5 12
66S2 XW2 CALL 2 XOCT [BLOCK NO.TO OCTAL
67?L STO 7 MESSH+7(1) [& STORE IN MESSAGE
67R= STO 0 MESSH+8(1)
68=W LDX 5 6
68QG CALL 2 XOCT [TRACK TO OCTAL
69=6 STO 0 MESSH+4(1) [& INTO MESSAGE
69PQ LDN 3 MESSH(1)
6=9B CALL 7 (JCONOUT)
6=P2 SMO FXPMDR
6?8L LDX 3 JMTPTR
6?N= DCA 3,LDX,5,MODE
6#7W CALL 2 XOCT
6#MG STO 7 MESSI+2(1)
6*76 STO 0 MESSI+3(1)
6*LQ LDN 3 MESSI(1)
6B6B CALL 7 (JCONOUT)
6BL2 SMO FXPMDR
6C5L LDX 5 JMTRW1
6CK= CALL 2 XOCT
6D4W STO 7 MESSI+2(1)
6DJG STO 0 MESSI+3(1)
6F46 LDN 3 MESSI(1)
6FHQ CALL 7 (JCONOUT)
6G3B SMO FXPMDR
6GH2 LDX 3 JMTPTR
6H2L DCA 3,LDX,5,COUNT
6HG= CALL 2 XOCT
6H^W STO 7 MESSI+2(1)
6JFG STO 0 MESSI+3(1)
6J^6 LDN 3 MESSI(1)
6KDQ CALL 7 (JCONOUT)
6KYB SMO FXPMDR
6LD2 LDX 3 JMTPTR
6LXL DCA 3,LDX,5,CTSA
6MC= CALL 2 XOCT
6MWW STO 7 MESSI+2(1)
6NBG STO 0 MESSI+3(1)
6NW6 LDN 3 MESSI(1)
6P*Q CALL 7 (JCONOUT)
6PTB SMO FXPMDR
6Q*2 LDX 3 JMTPTR
6QSL DCA 3,LDX,5,DTSA
6R#= CALL 2 XOCT
6RRW STO 7 MESSI+2(1)
6S?G STO 0 MESSI+3(1)
6SR6 LDN 3 MESSI(1)
6T=Q CALL 7 (JCONOUT)
6TQB BRN TOUT
6W=2 # S/R TO CONVERT BINARY NO. IN X5 INTO
6WPL # OCTAL IN X7 AND X0
6X9= XOCT LDN 6 8
6XNW XOCT1 LDN 4 0
6Y8G SLL 45 3
6YN6 SLL 70 6
6^7Q DCH 4 0
6^MB BCT 6 XOCT1
7272 EXIT 2 0
72LL #
736= # ROUTINE TO EXTRACT A SPECIFIED PARAMETER
73KW # FROM A GIVEN FIELD OF PARAMETERS ADDRESSED BY JCCBUF
745G #
74K6 # ON ENTRY X5 CONTAINS NUMBER OF PARAMETER
754Q # X6 CONTAINS TOTAL NUMBER OF CHARS IN FIELD
75JB #
7642 # ON EXIT X3 CONTAINS MODIFIER POINTING TO FIRST CHARACTER
76HL # OF REQUIRED PARAMETER
773= # X7 CONTAINS NUMBER OF CHARACTERS IN PARAMETER
77GW # IF ZERO NULL PARAMETER
782G #
78G6 # LINK X0
78^Q #
79FB # ACCS 1,2,4,5 UNCHANGED
79^2 #
7=DL PMPAR STO 5 XLINK4(1) [ PARAMETER NUMBER
7=Y= STO 6 XLINK2(1) [ CHARS IN FIELD
7?CW STOZ XLINK5(1)
7?XG LDN 7 1
7#C6 PAR6 LDCH 6 0(3) [ GET NEXT CHAR
7#WQ TXU 6 SPACE(1)
7*BB BCC PAR [ J IF SPACE
7*W2 STO 3 XLINK3(1)
7B*L PAR3 TXU 6 XCOMMA(1)
7BT= BCC PAR1 [ J IF COMMA
7C#W ADS 7 XLINK5(1) [ INCREMENT CHAR. COUNT
7CSG BCHX 3 £
7D#6 PAR5 SBS 7 XLINK2(1)
7DRQ LDX 6 XLINK2(1)
7F?B BZE 6 PAR2 [ ALL FIELD EXAMINED ? J IF YES
7FR2 LDCH 6 0(3) [ LOAD NEXT CHAR
7G=L BRN PAR3 [ LOAD NEXT CHAR
7GQ= PAR1 SBS 7 XLINK4(1)
7H9W LDX 6 XLINK4(1)
7HPG BZE 6 PAR4 [ J IF PARAMETER WANTED
7J96 STOZ XLINK5(1) [ INITIALISE CHARS. IN THIS PARAMETER
7JNQ BCHX 3 £
7K8B STO 3 XLINK3(1)
7KN2 BRN PAR5 [ COUNT CHARS. IN THIS PARAMETER
7L7L PAR BCHX 3 £
7LM= SBS 7 XLINK2(1)
7M6W LDX 6 XLINK2(1)
7MLG BNZ 6 PAR6 [ J IF MORE CHARS TO CHECK
7N66 PAR2 SBS 7 XLINK4(1)
7NKQ LDX 6 XLINK4(1)
7P5B BZE 6 PAR4 [ J IF PARAMETER WANTED
7PK2 STOZ XLINK3(1)
7Q4L STOZ XLINK5(1)
7QJ= PAR4 LDX 7 XLINK5(1) [ SET UP EXIT CONDITIONS
7R3W LDX 3 XLINK3(1)
7RHG EXIT 0 0 [ OUT AGAIN.
7S36 #
7SGQ #
7T2B # S/R TO CHECK VALIDITY OF PARAMETERS IN CONSOLE INPUT
7TG2 # ENTRY X3=START ADDR. OF MESSAGE
7T^L # X5=NO. OF CHARS IN MESSAGE
7WF= # EXIT ALL EXCEPT X1 UNDEFINED
7WYW # LINK X0
7XDG # EX 0 INVALID MESSAGE
7XY6 # EX 1 MESSAGE OK
7YCQ #
7YXB VALID STO 0 XLINK(1)
7^C2 STO 3 X3(1)
7^WL LDX 7 SPACES(1)
82B= STO 7 XSUSN(1)
82TW LDN 6 XSUSN(1)
83*G LDN 7 XSUSN+1(1)
83T6 MOVE 6 5
84#Q LDX 2 5
84SB LDN 4 1 [PAR. ONE
85#2 VNXT LDX 3 X3(1) [START OF MESSAGE
85RL LDX 5 4 [NO. OF PARAMETER
86?= LDX 6 2 [TOTAL NO OF CHARS IN MESSAGE
86QW CALL 0 PMPAR [GET PAR. INDICATED BY X5
87=G BZE 7 XFEX [NULL?,SO FAIL EXIT
87Q6 SBN 4 1
889Q BZE 4 XPAR1 [J TO VALIDATE FIRST PAR
88PB SBN 4 1
8992 BZE 4 XPAR2 [J TO VALIDATE 2ND PAR
89NL SBN 4 1
8=8= BZE 4 XPAR3 [J TO 3RD PAR
8=MW CALL 0 XEXEC [SHOULD NEVER HAPPEN
8?7G XPAR3 LDCH 4 0(3)
8?M6 TXL 4 XALPH(1)
8#6Q BCC XFEX [J TO FAIL EX
8#LB TXL 4 XALPH+1(1)
8*62 BCS XFEX [IF 1ST CHAR NOT ALPHABETIC
8*KL TXL 7 THIRTEEN(1)
8B5= BCS XLOK [J IF LENGTH OK
8BJW LDX 4 7
8C4G LDN 6 0
8CJ6 SPC LDCH 0 0(3)
8D3Q ADN 6 1
8DHB TXU 0 SPACE(1)
8F32 BCC SPC1
8FGL LDX 5 6
8G2= SPC1 BCT 4 SPC
8GFW TXL 5 THIRTEEN(1)
8G^G BCC XFEX
8HF6 LDX 7 5
8HYQ LDX 3 XLINK3(1) [RESTORE X3
8JDB XLOK LDN 4 XFNAME(1)
8JY2 SMO 7
8KCL MVCH 3 0 [STORE FILENAME
8KX= LDX 0 XLINK(1)
8LBW EXIT 0 1 [OK EXIT
8LWG XPAR1 LDCH 4 0(3)
8MB6 SBN 4 8
8MTQ BNG 4 XPAR1A [J IF OCTAL DIGIT
8N*B SBN 7 3
8NT2 BPZ 7 XFEX [J IF MORE THAN 4 CHARACTERS: ERROR
8P#L ADN 7 3
8PS= LDN 5 0
8Q?W LDN 4 5
8QRG SMO 7
8R?6 MVCH 3 0 [MOVE INTO TOP OF X5
8RQQ TXU 5 XMT(1)
8S=B BCC XMTDUMP [IF MT,GO TO MT DUMP
8SQ2 TXU 5 XDA(1)
8T9L BCS XFEX [J IF NOT DA
8TP= SBN 2 3
8W8W BNG 2 XFEX [ERROR IF THERE ARE ...
8WNG BZE 2 XFEX [ ... NO MORE CHARACTERS LEFT
8X86 LDX 3 X3(1)
8XMQ SLC 3 2 [ELSE WE'LL MAKE
8Y7B ADN 3 3 [DA DISAPPEAR
8YM2 SRC 3 2 [FROM THE INPUT
8^6L STO 3 X3(1)
8^L= LDN 4 1 [MESSAGE WITH FEW
925W BRN VNXT [DEFT STROKES
92KG XPAR1A TXL 7 SEVEN(1)
9356 BCC XFEX [J IF > 6 DIGITS
93JQ LDN 4 XSUSN(1)
944B SMO 7
94J2 MVCH 3 0
953L LDX 3 XLINK3(1)
95H= LDN 6 0
962W NXCH LDCH 4 0(3)
96GG TXL 4 SEVEN+1(1)
9726 BCC XFEX [J IF NOT OCTAL
97FQ SLL 6 3
97^B ADX 6 4
98F2 BCHX 3 £
98YL BCT 7 NXCH
99D= LDN 4 2
99XW STO 6 JDUMPFD+5(1) [SAVE SUSN FOR LATER USE
9=CG BRN VNXT
9=X6 XFEX LDX 0 XLINK(1)
9?BQ EXIT 0 0 [FAIL EXIT
9?WB XPAR2 LDN 4 XOPSNOD(1)
9#B2 SMO 7
9#TL MVCH 3 0
9**= LDX 3 XLINK3(1)
9*SW CALL 0 XDECBIN [CONVERT OP'S NO TO BINARY
9B#G TXL 5 X512(1)
9BS6 BCC XFEX [J IF < 512
9C?Q STO 5 XOPSNO(1) [STORE IF OK
9CRB SMO FXPMDR
9D?2 STO 5 JMTGEOG
9DQL LDN 4 3
9F== BRN VNXT
9FPW #
9G9G #
9GP6 # S/R TO TAKE EXEC PM IN UNLIKELY CASE GEORGE PM GOES FUNNY
9GW# ...XEXEC
9H3G ... JENV XEXEC1,CMESTAR
9H8N ... '142 0 0
9H*W ...XEXEC1
9HH4 ... '171 0 #14
9HNB #
9J82 # MT DISCOVERED IN INPUT.WE ARE NOT WANTED AND SO CALL
9JML # PMDUMPMT ON STAGE.
9K7= XMTDUMP
9KLW LDX 6 2 ["MT" FOUND AS FIRST PARAMETER
9L6G LDN 5 2
9LL6 LDX 3 X3(1)
9M5Q CALL 0 PMPAR [LOOK AT THE SECOND PARAMETER
9MKB BZE 7 XMTD1 [NULL : OK
9N52 LDCH 4 0(3)
9NJL SLL 4 6
9P4= STO 4 5
9PHW BCHX 3 £
9Q3G LDCH 4 0(3) [IF THE SECOND PARAMETER
9QH6 ORX 4 5
9R2Q SBN 4 #4441
9RGB BZE 4 XFEX [IS "DA" : NOT HAVING THAT!
9S22 XMTD1
9SFL LDN 4 64+128
9S^= SMO FXPMDR
9TDW ERS 4 ALLPOST
9TYG PMOVE PMDUMPMT,FXPM1,2
9WD6 #
9WXQ # S/R TO EITHER ENGAGE DEVICE OR TO GET NEW INPUT
9XCB # EXIT ALL EXCEPT X1 UNDEFINED
9XX2 XTWDA STO 0 XLINKA(1)
9YBL T30 LDX 5 XTWBIT(1)
9YW= CALL 0 XCHENG [T/W ENGAGED?
9^*W BRN XNOTW [J IF NOT
9^TG ERS 3 EBA(2) [CLEAR T/W ENG.BIT
=2*6 TIN1 CALL 7 (JCTWIN) [GET INPUT
=2SQ BRN TIN1
=3#B ANDN 6 #777 [GET NO. OF
=3S2 NGX 5 6 [CHARS READ
=4?L ADN 5 64
=4R= BZE 5 T30 [J IF SPACES OR NOTHING
=5=W LDN 3 XSUSN(1) [SAVE PREVIOUS PARS
=5QG LDN 4 XTEMP(1) [IN CASE
=6=6 MOVE 3 7 [INPUT IS RUBBISH
=6PQ LDN 3 FCINBUF
=79B CALL 0 VALID [VALIDATE THE INPUT
=7P2 BRN XGARB [RUBBISH!
=88L LDX 0 XLINKA(1)
=8N= EXIT 0 0
=97W XGARB LDN 3 XTEMP(1) [REHABILITATE THE OLD
=9MG LDN 4 XSUSN(1) [PARS
==76 MOVE 3 7
==LQ LDN 3 MESSC(1)
=?6B CALL 7 (JCONOUT) ['INVALID MESSAGE'
=?L2 BRN T30 [SEARCH AGAIN
=#5L XNOTW LDX 5 XDABIT(1)
=#K= CALL 0 XCHENG [DEVICE ENGAGED?
=*4W BRN T30 [J IF NOT
=*JG LDX 0 XLINKA(1)
=B46 EXIT 0 1
=BHQ #
=C3B #
=CH2 XK1PMDUMPDA
=D2L LDX 1 FXPM1
=DG= TOUT LDN 3 MESSA(1)
=D^W CALL 7 (JCONOUT) [ASK FOR 'SUSN,OP'S NO,F/NAME?'
=FFG TIN CALL 7 (JCTWIN) [GET REPLY
=F^6 BRN TIN [TRY AGAIN
=GDQ XK2PNT ANDN 6 #777 [ISOLATE CHAR COUNT
=GYB NGX 5 6
=HD2 ADN 5 64 [NO.OF CHARS READ
=HXL BZE 5 TOUT
=JC= LDN 3 FCINBUF [START ADDR.OF INPUT
=JWW CALL 0 VALID [VALIDATE REPLY
=KBG BRN TOUT [RUBBISH
=KW6 LDX 3 JCTWPTR
=L*Q CALL 0 XUNS [UNSET ENG.BIT IF SET
=LTB STO 6 XTWBIT(1) [STORE ENG.BIT POSITION
=M*2 XGEOG LDX 6 XOPSNO(1) [GET UNIT'S GEOGRAPHIC NUMBER
=MSL FINDPEREC 2,APGEOG,6 [FIND ITS DEV.RECORD
=N#= BNG 2 TOUT
=NRW LTYPE 2,5 [GET THE TYPE
=P?G SBN 5 6 [IS IT EDS8?
=PR6 LDN 7 0
=Q=Q BZE 5 XUDAS [J IF YES
=QQB SBN 5 7 [OR FDS?
=R=2 BNZ 5 NOTFD [J IF NOT
=RPL LPROP 2,7 [ELSE GET
=S9= SRL 7 6 [PROPERTY CODE
=SNW ANDN 7 1 [& CALCULATE
=T8G ADN 7 3 [SUBTYPE
=TN6 BRN XUDAS
=W7Q NOTFD SBN 5 13 [EDS30/60?
=WMB BNZ 5 TOUT [J IF NOT
=X72 LDN 7 1
=XLL XUDAS STO 7 XSTYP(1) [REMEMBER THE SUB-TYPE
=Y6= SMO FXPMDR
=YKW LDX 5 JMTPTR [IS IT 1ST TIME?
=^5G BZE 5 TSTOR [J IF YES
=^K6 TXU 5 2
?24Q BCC XSAME [J IF SAME DEV. AS LAST TIME
?2JB SMO FXPMDR
?342 LDN 4 JMTREC [UNDUMP PREVIOUS
?3HL MOVE 4 K53-K50 [DEV. RECORD
?43= TSTOR SMO FXPMDR
?4GW STO 2 JMTPTR [STORE DEV. REC. PTR
?52G SMO FXPMDR
?5G6 LDN 4 JMTREC
?5^Q LDX 3 2
?6FB MOVE 3 K53-K50 [SAVE NEW DEV. REC.PTR
?6^2 XSAME JENG 2,XENG [J IF ENGAGED
?7DL LDX 3 2 [DEVICE LIST POINTER FOR XUNS
?7Y= CALL 0 XUNS [ELSE UNSET ENG. BIT IN EBA AREA
?8CW STO 6 XDABIT(1) [STORE THE BIT'S POSN.
?8XG LDCT 6 #400 [PRINT THE MESSAGE:
?9C6 ORN 6 MESSB+4(1)
?9WQ LDN 5 XSUSN(1) ["PLEASE LOAD CSN ON UNIT N"
?=BB MVCH 5 6
?=W2 LDN 5 XOPSNOD(1)
??*L LDCT 6 #200
??T= ORN 6 MESSB+8(1)
?##W MVCH 5 4
?#SG LDN 3 MESSB(1)
?*#6 CALL 7 (JCONOUT)
?*RQ CALL 0 XTWDA
?B?B BRN XGEOG
?BR2 # DEVICE ENGAGED AT LAST - OR AT FIRST
?C=L XENG LDCT 5 #60 [SET UP DUMMY FD
?CQ= ADX 5 XSTYP(1) [AREA- SO THAT WE
?D9W STO 5 JDUMPFD(1) [CAN READ SCA
?DPG STOZ JDUMPFD+1(1)
?F96 STOZ JDUMPFD+2(1)
?FNQ LDN 5 100
?G8B STO 5 JDUMPFD+3(1)
?GN2 LDN 5 80
?H7L STO 5 JDUMPFD+4(1)
?HM= LDN 0 1
?J6W LDN 1 JDUMPFD-A1(1)
?JLG DATUMBLK 0,1 [CONVERT BLOCK ADDR TO H/W ADDR
?K66 BZE 1 XNG1
?KKQ BZE 2 XNG
?L5B XNG1 CALL 0 XEXEC [GO FOR EXEC PM
?LK2 XNG LDX 5 1
?M4L LDX 1 FXPM1 [RELOAD SEG MODIFIER
?MJ= STO 5 UFIC(1) [SAVE DATUMISED FIC H/W ADDRESS
?N3W CALL 0 XDAPERI [READ SCA
?NHG LDN 5 JDUMPFD+8(1) [CORE ADDRESS OF THE FIC BLOCK
?P36 SUM 4 128 [CHECKSUM THE BLOCK
?PGQ LDN 7 1
?Q2B BNZ 4 XERR [J IF CHECKSUM FAIL ON READ
?QG2 LDX 5 JDUMPFD+13(1) [1ST WORD OF CONTROL HEADER
?Q^L SLL 5 6
?RF= SRL 5 6
?RYW TXU 5 JDUMPFD+5(1)
?SDG BCS XNSUSN [J IF WRONG SUSN
?SY6 LDX 5 JDUMPFD+21(1)
?TCQ STO 5 JDUMPFD+4(1) [STO NO OF BLKS/CYLINDER
?TXB LDX 2 1 [SET MODIFIER FOR FIC'S
?WC2 ADN 2 JDUMPFD+27
?WWL XNXCEL LDX 7 0(2)
?XB= BNG 7 XFER [J IF FILE NOT FOUND
?XTW LDX 4 2(2) [PICK UP THE FILENAME
?Y*G LDX 5 3(2)
?YT6 LDX 6 4(2) [FROM THIS FILE INDEX CELL
?^#Q TXU 4 XFNAME(1)
?^SB TXU 5 XFNAME+1(1) [COMPARE THE NAME WITH FILENAME REQUI
#2#2 TXU 6 XFNAME+2(1)
#2RL BCC XFOK [J IF WE'VE FOUND OUR FILE
#3?= TXU 7 XLASTC(1)
#3QW BCC XFER [FILE NOT FOUND
#4=G BNZ 7 XNXBL [NXT CELL ELSEWHERE
#4Q6 ADN 2 17
#59Q BRN XNXCEL [TRY AGAIN
#5PB XNXBL LDN 4 128
#692 LDN 3 JDUMPFD-A1(1) [ADDR OF FD
#6NL LDX 5 7 [WORD ADDR WITHIN OUR BLK
#78= LDN 6 0
#7MW SLL 67 17 [X6=BLK ADDR
#87G SLC 7 7 [X7=WORD ADDR
#8M6 STO 7 WORDPART(1) [STORE WORD ADDRESS WITHIN BLOCK
#96Q DATUMADD 5,3,4 [GET H/W ADDR OF THE BLOCK
#9LB BNZ 1 XN2
#=62 BZE 2 XN2
#=KL CALL 0 XEXEC [GO GET EXEC PM
#?5= XN2 LDX 5 1 [DATUMISED H/W ADDR
#?JW LDX 1 FXPM1
##4G STO 5 UFIC(1) [ & STORE IT
##J6 CALL 0 XDAPERI [READ THE BLOCK
#*3Q LDN 5 JDUMPFD+8(1) [CORE ADDRESS OF THE FIC BLOCK
#*HB SUM 4 128 [CHECKSUM THE BLOCK
#B32 LDN 7 1
#BGL BNZ 4 XERR [J IF CHECKSUM FAIL ON READ
#C2= LDX 2 1
#CFW ADN 2 JDUMPFD+8
#C^G ADX 2 WORDPART(1) [POINT TO THE FIC BLOCK IN CORE
#DF6 BRN XNXCEL [& TRY OUR LUCK AGAIN
#DYQ XFOK LDX 5 2
#FDB SBN 5 JDUMPFD+8 [SAVE THE WORD ADDRESS OF OUR FIC
#FY2 SBX 5 1 [WITHIN ITS DISC BLOCK FOR USE WHEN
#GCL STO 5 UFIC+1(1) [UPDATING THE FIC AFTER THE DUMP
#K*B LDX 5 7(2)
#KT2 SLL 5 2
#L#L LDN 7 3
#LF4 ... BNG 5 XERR [J IF SYSTEM FILE SPECIFIED
#LKG ... LDX 4 10(2)
#LPY ... ANDN 4 #77
#LWB ... SBN 4 4
#M2S ... LDN 7 2
#M7= ... BNZ 4 XERR [J IF FILE NOT 4 BLOCK BUCKETS
#M?W SLL 5 7
#MRG SRL 5 9
#N?6 SBN 5 1
#NQQ LDN 7 4
#P=B BNZ 5 XERR [MORE THAN 1 FAC
#PQ2 LDX 4 1(2) [PICK UP POINTER TO FILE AREA CELL
#Q9L STO 4 5 [AND SAVE IT FOR DATUMADD
#QP= SLL 4 17
#R8W SRL 4 17 [ISOLATE THE WORD DISPLACEMENT
#RNG STO 4 WORDPART(1) [WITHIN BLOCK AND SAVE FOR LATER USE
#S86 LDN 4 128
#SMQ LDN 3 JDUMPFD-A1(1)
#T7B DATUMADD 5,3,4 [DATUMISE FAC WORD ADDR
#TM2 BNZ 1 XN3
#W6L BZE 2 XN3
#WL= CALL 0 XEXEC [GET EXEC PM
#X5W XN3 LDX 5 1
#XKG LDX 1 FXPM1
#Y56 CALL 0 XDAPERI [READ FAC BLOCK
#YJQ SMO WORDPART(1)
#^4B LDN 2 JDUMPFD+8(1) [CORE ADDRESS OF THE FAC IN X2
#^J2 LDX 5 0(2)
*23L LDN 7 4
*2H= BNZ 5 XERR
*32W LDX 5 1(2)
*3GG ANDX 5 XLASTC(1) [GET RID OF B0
*426 DVS 4 JDUMPFD+4(1) [BLKS/CYLINDER
*4FQ STO 4 JDUMPFD+2(1) [STORE DISPL.OF BLK WITHIN CYL.
*4^B STO 5 JDUMPFD+1(1) [STORE START CYLINDER ADDR.
*5F2 LDX 5 2(2) [BLOCK ADDR OF LAST BLOCK + 1
*5YL ANDX 5 XLASTC(1) [GET RID OF B0
*6D= SBN 5 1
*6XW DVS 4 JDUMPFD+4(1) [LAST CYLINDER
*7CG SBX 5 JDUMPFD+1(1) [NO OF CYLS=LAST-FIRST
*7X6 STO 5 JDUMPFD+3(1) [STORE IT
*8BQ LDX 5 4(2) [STORE BLKS/CYLINDER
*8WB STO 5 JDUMPFD+4(1) [FILE IN FD AREA
*9B2 LDX 3 JCTWPTR [UNSET THE CENTRAL CONSOLE'S ENGAGE
*9TL CALL 0 XUNS [BUTTON BIT AND SAVE ITS POSITION
*=*= STO 6 JDUMPFD+8(1) [IN THE COMMUNICATION AREA
*=SW STOZ JDUMPFD+9(1) [ZEROISE THE "FAIL FLAG"
*?#G PMOVE PMDUMP,FXPM1,5
*?S6 XNSUSN LDN 4 XSUSN(1)
*#?Q LDN 5 MESSK+2(1)
*#RB MOVE 4 2 [MOVE IN SUSN
**?2 LDX 4 XOPSNOD(1)
**QL STO 4 MESSK+6(1) [MOVE IN OP'S NO.
*B== LDN 3 MESSK(1)
*BPW CALL 7 (JCONOUT) ['......NOT ON ...'
*C9G BRN TOUT
*CP6 XFER LDN 4 XFNAME(1)
*D8Q LDN 5 MESSD+2(1)
*DNB MOVE 4 3 [MOVE F/NAME INTO ERROR MESSAGE
*F82 LDN 4 XSUSN(1)
*FML LDN 5 MESSD+7(1)
*G7= MOVE 4 2 [MOVE IN THE SUSN
*GLW LDN 3 MESSD(1)
*H6G CALL 7 (JCONOUT) ['FILE --- NOT ON ... '
*HL6 BRN TOUT
*J5Q XERR LDN 3 MESSE+7(1)
*JKB BCHX 3 £
*K52 DCH 7 0(3)
*KJL LDN 3 MESSE(1)
*L4= CALL 7 (JCONOUT) [DISC/FILE FORMAT ERROR N
*LHW BRN TOUT
*M3G XK2PMDUMPDA
*MH6 LDX 1 FXPM1
*N2Q SMO FXPMDR
*NGB LDX 6 JPCONREPLY [LOAD CONSOLE REPLY FROM LAST PERI
*P22 BRN XK2PNT
*PFL #
*P^= # 'FILE FULL' CONDITION DETECTED
*QDW #
*QYG XK4PMDUMPDA
*RD6 LDX 1 FXPM1
*RXQ LDN 3 MESSL(1)
*SCB CALL 7 (JCONOUT)
*SX2 BRN TOUT
*TBL #
*TW= #END
^^^^ ...064775100004