(George Source)
Macros used: BLOCK, DATUMADD, DATUMBLK, DCA, ERROR, FINDPEREC, GPERI, JBUSY, JENG, JENV, LINT, LPROP, LTYPE, ON, PMOVE, 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