IPBERROR867
(George Source)
Macros used: ACROSS, BXE, COOR1, COOR4, DCA, DEMAND, DISENGPER, DSCA, FPUT, FREECORE, GEOERR, GEOPACK, GPERI, GSPERI, HUNT2, HUNT2J, HUNTW, INFORMX, ISSUJOB, JSBUSY, LAMOP, LGEOG, LOCK, LONGOFF, LONGSET, MFREEW, MHUNTW, MOPOFF, OUTBLOCK, OUTNULL, OUTPACK, OUTPACKX, PERCHARS, SEGENTRY, SETNCORE, UNLOCK, UP, UPPLUS, VFREEW, WRONG
- IPBERROR867.txt
22FL #SEG IPBERROR [COMM - IPB 22^= [ (C) INTERNATIONAL COMPUTERS LTD. 1982 23DW #LIS K0IPBERROR>K0IPB>K0ALLGEO>K0GREATGEO 23YG 8HIPBERROR 24D6 SEGENTRY K1IPBERROR,X1IPBERROR 24XQ [ 25CB [ THIS SEGMENT IS ENTERED AFTER A CALL OF THE MACRO CCERROR 25X2 [ VARIOUS ACTIONS ARE TAKEN DEPENDENT UPON THE PARAMETERS OF 26BL [ THE MACRO 26W= [ 27*W XIN +IPBIN+AMOP 27TG ZIPBERR +JIPBERR 28*6 ZIPBPOST +IPBPOST 28SQ ZIPBTAKEPM +IPBTAKEPM 29#B ZIPBRECV +IPBRECOVER 29S2 XJWRONG +JWRONG 2=?L REOPENBLK 0,#40000000,#1130000,#1120000 2=R= TABLE 8HNULLENT 2?=W 8HINV IDEN [1 2?QG 8HTRANSFER [2 2#=6 8HUNTERMRD [3 2#PQ 8HINV SUP [4 2*9B 8HBIGREPRT [5 2*P2 8HNOCONTCR [6 2B8L 8HSSSWRONG [7 2BN= 8HREJECTOT [8 2C7W 8HREJECTIN [9 2CMG 8HWRONGSUP [10 2D76 8HWRONGILL [11 2DLQ 8HNOTCLOSE [12 2F6B 8HSS WRONG [13 2FL2 8HDATANOW? [14 2G5L 8HNOT80CHS [15 2GK= POSTSEG 0,#40000000,#00500000 2H4W ZIPBMOPOFF +IPBMOPOFF 2HJG SEGENTRY K52IPBERROR 2J46 MOPOFF +14 2JHQ +0 2K3B 14HMOP OFF, ,PM 2KH2 SEGENTRY K51IPBERROR 2L2L 4H 2LG= SPACE 4H000 2PD2 [ 2PXL [ SUBROUTINES 2QC= [ 2QWW SOUTP 2RBG SBX 7 FX1 2RW6 ZOUTC 2S*Q OUTPACKX 6,5,4,ZOUTC 2STB ADX 7 FX1 2T*2 EXIT 7 0 2TSL [ 2W#= SGEOG 2WRW SBX 7 FX1 2X?G LDX 3 AWORK4(2) 2XR6 LGEOG CPPTR(3),6 2Y=Q GEOPACK 3,6,C 2YQB LDN 5 1 2^=2 LDN 6 3 2^PL LDN 4 29 329= BRN ZOUTC 32NW [ 338G SINF 33N6 SBX 7 FX1 347Q LDN 1 1 34MB INFORMX 1,6,1 3572 ADX 7 FX1 35LL EXIT 7 0 366= [ 36KW [ 375G [ 37K6 [ K1 IPBERROR 384Q [ 38JB [ 3942 X1IPBERROR 39HL LDN 6 ACOMMUNE1(2) [SAVE CCERROR MACRO PARAMS. 3=3= LDN 7 AWORK1(2) 3=GW MOVE 6 2 3?2G HUNTW 3,AMXOR,ADCB [HUNT IDENT. BLK. 3?G6 BPZ 3 ZIDENT [J. ONE EXISTS = IDENT LEVEL ERROR 3?^Q LAMOP ,3 [GET ADDRESS OF AMOP/IPBIN IN X3 3#FB LDCT 0 #400 3#^2 ORS 0 AWORK3(2) [SET INDICATOR AWORK3 NEG = LINK LEVE 3*DL BRN ZJOIN [J. TO CONTINUE 3*Y= ZIDENT [IDENT ERROR 3BCW LONGSET CCERRWAIT,ZLNSE [J. IF ALREADY LONG SET 3BXG LDX 0 IDENTNO(3) 3CC6 STO 0 AWORK3(2) [ST. IDENT NO. IN AWORK3. 3CWQ LDX 3 IADIN(3) [LD. PTR. TO AMOP/IPBIN 3DBB ZJOIN 3DW2 STO 3 AWORK4(2) [ST. PTR. TO AMOP/IPBIN IN AWORK4 3F*L SETNCORE GSCANSIZE+2,3,AMXOR,GSCAN 3FT= LDX 0 GSCANPNTR [NEXT GSCAN ENTRY 3G#W LDX 7 GSCANBUFF 3GSG SBX 0 7 [REL START OF GSCAN BUFFER 3H#6 STO 0 A1(3) [LAST ENTRY 3HRQ LDX 0 GSCANVAL [LAST ENTRY 3J?B SBX 0 7 [RELATIVISE 3JR2 STO 0 A1+1(3) 3K=L LDN 0 A1+2(3) 3KQ= MOVE 7 GSCANSIZE [COPY GSCAN BUFFER 3L9W [ 3LPG LDN 7 #4000 3M96 ANDX 7 AWORK1(2) [EXTRA 4 WDS FOR %B FOR CLERROR. 3MNQ SRL 7 9 3N8B ADN 7 12 [4 WDS. PER PARAM 3NN2 OUTBLOCK 7 [SET UP BLOCK FOR PARAMS TO MESSAGE 3P7L CALL 7 SGEOG 3PM= LDXC 6 AWORK3(2) 3Q6W BCC ZIDENT1 [J. IDENT LEVEL 3QLG OUTNULL [NULL IDENT. NO. PARAM 3R66 BRN ZJOIN1 3RKQ ZIDENT1 3S5B LDX 3 AWORK4(2) 3SK2 LGEOG CPPTR(3),7 3T4L ORX 7 CACT 3TJ= GEOPACK 3,6 3W3W LDN 6 3 3WHG CALL 7 SOUTP [X5 & X4 ARE STILL OK 3X36 ZJOIN1 3XGQ SMO 2 3Y2B LDCH 6 AWORK1 3YG2 SLL 6 1 3Y^L SMO 6 3^F= LDN 6 TABLE(1) [FIND SUBMESSAGE FROM A TABLE 3^YW LDN 4 37 [VARCHC PDC 42DG LDN 5 2 42Y6 CALL 7 SOUTP 43CQ LDN 0 #4000 43XB ANDX 0 AWORK1(2) [B12 OF AWORK1=1 IF ADD. INFO. 44C2 BZE 0 NADINF [J. NO OCTAL ADD. INFO. 44WL LDN 6 AWORK2(2) [ADDR. OF ADD. INFO 45B= LDN 5 1 [1 WD OF OCTAL 45TW LDN 4 44 [OCTA PDC 46*G CALL 7 SOUTP 46T6 NADINF 47#Q LDX 6 ZIPBERR(1) [UNIT UN ERROR:IN FAILED STRG #OCTAL 47SB CALL 7 SINF 48#2 [ 48RL LDXC 6 AWORK3(2) 49?= BCS ZLINK [J. LINK LEVEL ERROR. 49QW [ 4==G [ IDENTIFIER LEVEL 4=Q6 [ 4?9Q HUNT2J 3,AMXOR,ADEVS,AWORK4(2),ZERR1 4?PB LDX 0 AWORK3(2) [IDENT NO. 4#92 SBX 0 A1+FOURTHWD(3) [SBN LOWEST IDENT NO 4#NL SLL 0 2 [FOURWD ENTRIES 4*8= ADX 3 0 [X3 PTR TO ADEVS ENTRY FOR IDENT 4*MW LDCT 0 #100 4B7G ANDX 0 A1+FOURTHWD(3) 4BM6 ORX 0 FINISH 4C6Q BNZ 0 ZMPFN [J. MOPPING OFF OR FINISHING 4NCL OUTEX 4NX= CALL 7 SGEOG 4PBW ZBRKI 4PWG DEMAND 1,IPBTAKEPM,ZJCD,ZBRKI,ZREN,1 [DEMAND A PM 4QB6 ZJCD [OPERATORS RESPONDED CANTDO. 4QTQ MHUNTW 3,AMXOR,ADCB 4R*B LDX 0 IADIN(3) 4RT2 STO 0 AWORK4(2) 4S#L LDX 0 IDENTNO(3) 4SS= STO 0 AWORK3(2) 4T?W LDX 3 AWORK4(2) [OUTPUT MESSAGE 4TRG LGEOG CPPTR(3),7 [SAYING IDENT WRONG 4W?6 ORX 7 CACT 4WQQ LDX 6 AWORK3(2) [X7 GEOEG NO. X6 = IDENT NO 4X=B GEOPACK 4,6 4XQ2 OUTPACK 4,1,GEOPER 4Y9L LDN 5 0 4YP= LDX 7 XJWRONG(1) [LD. WRONG MESS 4^8W INFORMX 5,7,1 4^NG HUNT2J 3,AMXOR,ADEVS,AWORK4(2),ZERR1 5286 LDN 6 #2000 [BIT 13 - CANTDO LABEL 52MQ LDX 0 AWORK3(2) [IDENT NO. 537B SBX 0 A1+FOURTHWD(3) [SBN LOWEST IDENT. NO. 53M2 SLL 0 2 [FOUR WD. ENTRIES. 546L ADX 3 0 [X3 PTR. TO ADEV'S ENTRY FOR IDENT. 54L= LDX 0 A1+FOURTHWD(3) 555W ANDN 0 #17 [MASK OUT DEVICE TYPE 55KG SBN 0 4 5656 BZE 0 ZCRTR [J. DEVICE TYPE = 04 IE CARD READER 56JQ SBN 0 2 574B BZE 0 ZCRTR [J. DEVICE TYPE = 06 IE TAPE READER 57J2 LDCT 0 #002 [LD. BIT 7 583L ERS 0 A1+FOURTHWD(3) [SET BIT 7 = WRONGED 58H= [ 592W ZCRTR 59GG LONGOFF 2 5=26 VFREEW AMXOR,GSCAN [SUB TO FREE GSCAN BLOCK 5=FQ ANDX 6 AWORK1(2) [LABELS SUPPLIED 5=^B BNG 6 ZUPP2 5?F2 BNZ 6 ZUPP1 5?YL UP [FOLLOW ON 5#D= ZUPP1 5#XW UPPLUS 1 [LABEL GIVEN 5*CG ZUPP2 UPPLUS 2 5*X6 [ 5BBQ ZMPFN 5BWB LDN 6 #1000 [BIT 14 - MOP OFF LABEL 5CB2 BRN ZCRTR 5CTL [ 5D*= [ 5DSW [ LINK LEVEL 5F#G [ 5FS6 ZLINK 5G?Q SMO 2 5GRB LDCH 6 AWORK1 [LD. MESSAGE SUB TYPE 5H?2 SBN 6 8 5HQL BNZ 6 ZLER1 [J. NOT REJECTOT 5J== [ REJECTOT 5JPW LDX 3 AWORK4(2) [LD. PTR TO AMOP/IPBIN 5K9G LDCT 0 #400 [B0 5KP6 ORS 0 IPBSW(3) [MARK IPBIN ACT. INOP. 5L8Q LDCT 0 #404 [B0 + B6 5LNB SMO IPBRING(3) 5M82 ORS 0 IPBSW-IPBRING [MARK OUTPUT ACT. 5MML ZRET 5N7= LDX 6 GSIGN [RETURN TO CALL SEG 5NLW BRN ZCRTR [FREE AND EXIT 5P6G [ 5PL6 ZLER1 5Q5Q SMO 2 5QKB LDCH 6 AWORK1 5R52 SBN 6 5 5RJL BZE 6 ZRET [J. BIG REPT = 5 5S4= SBN 6 1 5SHW BZE 6 ZRET [J. NOCONTCR = 6 5T3G SBN 6 1 5TH6 BZE 6 ZRET [J. SSSWRONG = 7 5W2Q SBN 6 2 5WGB BZE 6 ZRET [J. REJECTIN = 9 5X22 [ 5XFL SMO 2 5X^= LDCH 6 AWORK1 [LD. SUB MESS. 5YDW SBN 6 2 5YYG BZE 6 ZTERM [J. TRANSFER 5^D6 SBN 6 1 5^XQ BNZ 6 SPOST [J.NOT UNTERMRD GO TO OUTPUT POST 62CB ZTERM 62X2 LDX 3 AWORK4(2) [LD. PTR. TO AMOP 63BL LDX 0 IPBSW(3) 63W= BNG 0 ZRET [J. UNIT ALREADY INOP 64*W LDCT 0 #400 64TG ORS 0 IPBSW(3) [SET INOP BIT IN IPBIN 65*6 SMO IPBRING(3) 65SQ ORS 0 IPBSW-IPBRING [SET INOP BIT IN IPBOUT 66#B LDCT 0 #020 66S2 ANDX 0 IPBSW(3) 67?L BNZ 0 ZMPFN [J. MOP OFF IN PROGRESS 67R= CALL 7 SGEOG 68=W LDX 6 ZIPBRECV(1) [MESSAGE - ATTEMPTING RECOVERY 68QG CALL 7 SINF 69=6 [ SENT OUT RESET/REOPEN 69PQ SETNCORE 4,1,AMXOR,IOUT,1 [SET UP SUP SEG BLOCK 6=9B SMO FX1 6=P2 LDN 3 REOPENBLK 6?8L LDN 4 IMOPTY(1) 6?N= MOVE 3 4 6#7W ZRESREO 6#MG LOCK 1 6*76 LDN 0 #15 [END WRITE CANCEL READ MODE 6*LQ DCA ,STO,0,MODE [ST. MODE 6B6B STOZ CPRW1(2) [CLEAR REPLY WD. 6BL2 MHUNTW 3,AMXOR,IOUT 6C5L LDX 0 ALOGLEN(3) 6CK= SBN 0 IPBIDE-A1-1 [SIZE OF DATA SEG +1 FOR BSW 6D4W DCA ,STO,0,COUNT [ST. COUNT 6DJG LDN 0 IBSW(3) 6F46 DCA ,STO,0,CTSA [ST. START OF BLOCK TO BE OUTPUT 6FHQ GPERI ,2 [OUTPUT SUP SEGS -RESET REOPEN 6G3B LDX 6 CPRW1(2) 6GH2 BPZ 6 WAIT2 [J. TRANSFER COMPLETE 6H2L SLC 6 5 6HG= BNG 6 TINOP [BR. IF REJECTED INOP 6H^W SRC 6 1 6JFG BNG 6 TINOP [J. RECTECTED OPERABLE 6J^6 WAIT2 6KDQ COOR1 [WAIT FOR END OF TRANSFER CHAINING 6KYB LDX 0 CPRW1(2) 6LD2 SLC 0 5 6LXL BPZ 0 TINOP [J. INOP 6MC= SRC 0 2 6MWW BNG 0 TERR [J. ERROR 6NBG LDCT 0 #220 [BIT PATTER X1XX1 BITS 1 AND 4 SET 6NW6 ANDX 0 CPRW1(2) 6P*Q BNZ 0 TINOP [J. NOT IMPL 6PTB LDX 0 CPRW1(2) 6Q*2 ANDN 0 #7777 6QSL BNZ 0 TINOP [J. ONLY ONE WD. READ BY DCP 6R#= UNLOCK 3 [UNLOCK AMXOR IOUT BLK 6RRW VFREEW AMXOR,IOUT [FREE BLOCK 6S?G [ ATTEMPT TO RECOVER BY SENDING RESET REOPEN HAS WORKED. 6SR6 LDCT 0 #004 [B6 OF OUTPUT ACT SET 6T=Q SMO IPBRING(2) 6TQB ORS 0 IPBSW-IPBRING 6W=2 LDCT 0 #400 6WPL SMO IPBRING(2) 6X9= ANDX 0 IPBSW-IPBRING 6XNW SMO IPBRING(2) 6Y8G ERS 0 IPBSW-IPBRING [CLEAR INOP BIT 0 IN OUT ACTIVITY 6YN6 LDCT 0 #400 6^7Q ANDX 0 IPBSW(2) 6^MB ERS 0 IPBSW(2) [CLEAR INOP BIT 0 IN IN ACTIVITY 7272 BRN ZRET [RETURN TO CALLING SEG 72LL TERR [WRITE REJECTED OPERABLE OR ENDED. 736= [WAIT FOR READ TO FINISH 73KW UNLOCK 3 745G LDX 0 XIN(1) 74K6 SLL 0 12 754Q SBX 0 ATYPE(2) [TEST IF IN ACT 75JB BZE 0 TIN [J. YES 7642 LDX 2 IPBRING(2) [LD. PTR TO IN 76HL SBN 2 IPBRING 773= TIN HUNT2 3,AMXOR,INBF,2 77GW SEGENTRY K50IPBERROR [NPUSIZE MACRO 782G LDN 5 INPUSIZE+5 78G6 LOCK 3 78^Q ADN 3 A1 79FB LDX 2 FX2 79^2 LDN 7 2 7=DL JSBUSY ,ZERR1 7=Y= DSCA ,STO,3,CTSA [SET UP CONTROL AREA FOR READ 7?CW DSCA ,STO,5,COUNT 7?XG DSCA ,DLA,7,MODE 7#C6 GSPERI ,2 [DO PERI 7#WQ LDX 0 CPRW1(2) [CHECK REPLY 7*BB BPZ 0 SPOS [FINISHED ALREADY 7*W2 SLC 0 5 7B*L BNG 0 TINOP [J. INOP 7BT= SPOS COOR1 [WAIT 7C#W LDX 0 CPRW1(2) 7CSG SLC 0 5 7D#6 BPZ 0 TINOP [J. IF INOP. 7DRQ SRC 0 2 7F?B BNG 0 TINOP [B3 SET - ERROR 7FR2 SRC 0 1 7G=L BNG 0 TINOP [B2 SET - UNTERM READ 7GQ= MHUNTW 1,AMXOR,IOUT 7H9W BRN ZRESREO [ATTEMPT RESET/REOPEN AGAIN. 7HPG TINOP UNLOCK 3 7J96 VFREEW AMXOR,IOUT [FREE RESET-REOPEN SUP SEG BLK 7JNQ XINFOMESS 7K8B CALL 7 SGEOG 7KN2 LDX 6 ZIPBTAKEPM(1) [PLEASE TAKE PM MESSAGE 7L7L CALL 7 SINF 7LM= LDX 6 XIN(1) 7M6W SLL 6 12 7MLG SBX 6 ATYPE(2) 7N66 LDCT 0 #20 7NKQ BZE 6 XTIN [J. AMOP-IPBIN 7P5B SMO IPBRING(2) 7PK2 ANDX 0 IPBSW-IPBRING [MASK MOP OFF BIT 7Q4L BRN XOUT [J. CONTINUE 7QJ= XTIN ANDX 0 IPBSW(2) [MASK MOP OFF BIT 7R3W XOUT 7RHG SLL 0 2 7S36 ORX 0 FINISH [AND FINISH BIT 7SGQ BNZ 0 ZMPFN [J FINISH 7T2B LDX 4 ASYSTEMMESS [LD. MESSAGETIME 7TG2 XREPT BZE 4 XINFOMESS 7T^L COOR4 CCERRWAIT [WAIT 4 SECS 7WF= SBN 4 4 7WYW BNG 4 XINFOMESS [RE-OUTPUT MESSAGE. 7XDG BRN XREPT [REPEAT WAIT 7XY6 [ SEND POSTMORTEM TO DCP AND MOP OFF THE UNIT 7YCQ SPOST 7YXB LDCT 0 #400 7^C2 ORS 0 IPBSW(2) [SET INOP BIT IN INPUT ACT 7^WL SMO IPBRING(2) 82B= ORS 0 IPBSW-IPBRING [SET INOP BIT IN OUTPUT ACT. 82TW CALL 7 SGEOG 83*G LDX 6 ZIPBPOST(1) [IS BEING PUT INTO POSTMORTEM STATE 83T6 CALL 7 SINF 84#Q [ SEND OUT POSTMORTEM SUPSEG TO DCP 84SB SETNCORE 3,1,AMXOR,IOUT,1 [SET UP AN OUTPUT BLOCK. 85#2 SMO FX1 85RL LDN 3 POSTSEG [MOVE IN POSTMORTEM SUP.SEG 86?= LDN 4 IMOPTY(1) 86QW MOVE 3 3 87=G LOCK 1 87Q6 LDN 0 #15 [END WRITE CANCEL READ MODE 889Q DCA ,STO,0,MODE [ST. MODE 88PB STOZ CPRW1(2) [CLEAR REPLY WD. 8992 MHUNTW 3,AMXOR,IOUT 89NL LDX 0 ALOGLEN(3) 8=8= SBN 0 IPBIDE-A1-1 [SIZE OF DATA SEG+1 FOR BSW 8=MW DCA ,STO,0,COUNT [ST. COUNT 8?7G LDN 0 IBSW(3) 8?M6 DCA ,STO,0,CTSA [ST. START OF BLOCK TO BE OUTPUT. 8#6Q GPERI ,2 [OUTPUT SUP.SEG - POSTMORTEM 8#LB COOR1 [WAIT FOR END OF TRANSFER. 8*62 [DONT SEE ANY POINT IN CHECKING 8*KL [THE REPLY WORD AS THERE WILL BE 8B5= UNLOCK 1 [VERY LITTLE FOR US TO DO. 8BJW VFREEW AMXOR,IOUT 8C4G SEGENTRY K55IPBERROR 8CJ6 NULL [GEOERR IPBERR IF THE IPBPM MACRO 8D3Q NULL [IS ON 8DHB LONGOFF 2 [REMOVE LONGSET 8F32 VFREEW AMXOR,GSCAN [FREE GSCAN BLCK. 8FGL [ SEND OUT A MESSAGE TO THE OPERATOR INFORMING THEM UNIT WILL APPEAR 8G2= [ MOPPED OFF 8GFW XMOP 8G^G CALL 7 SGEOG 8HF6 LDX 6 ZIPBMOPOFF(1) [UNIT IS BEING MOPPED OFF. 8HYQ CALL 7 SINF 8JDB LDX 2 FX2 8JY2 LDX 3 AWORK4(2) 8KCL LGEOG CPPTR(3),6 8KX= GEOPACK 3,6,C [PACKED GEOPER PARAMETER 8LBW PERCHARS 3 [CONVERT TO ENGLISH FORM IN AC2 &AC3 8LWG SETNCORE 7,3,ADATA,CREADL [CREATE CREADL WITH MOP OFF COMMAND 8MB6 LDN 5 MOPOFF(1) 8MTQ LDN 6 A1(3) 8N*B MOVE 5 7 8NT2 XLD LDCH 0 ACOMMUNE2(2) 8P#L BXE 0 SPACE(1),XSP [J. WHEN = SPACE 8PS= DCH 0 A1+4(3) [PUT UNIT NO INTO COMMAND 8Q?W BCHX 3 XA 8QRG XA BCHX 2 XLD 8R?6 XSP 8RQQ [ 8S=B ISSUJOB 0 [INITIAGLISE A JOB TO MOP OFF 8SQ2 [ 8T9L XWAITMP 8TP= COOR4 #62 [GET WOKEN UP EVERY FONINTP SECS. 8W8W LDCT 0 #20 8WNG ANDX 0 IPBSW(2) [TEST TO SEE IF MOPPING OFF 8X86 BNZ 0 XMPOFF [J. MOPPING OFF 8XMQ LDCT 0 #400 [MOP OFF COMMAND FAILED 8Y7B ANDX 0 IPBSW(2) 8YM2 BNZ 0 XMOP [IF INOP REISSUE MOP OFF,PM COMMAND 8^6L GEOERR 1,FUNNYIPB [GEOERR - FUNNYIPB - STATE OF'IPB ODD 8^L= XMPOFF 925W LDCT 0 #040 [TEST READ INHIBIT 92KG ANDX 0 IPBSW(2) 9356 BZE 0 XWAITMP [J. TO WAIT FOR MOP OFF TO COMPLETE 93JQ ERS 0 IPBSW(2) [CLEAR B3 TO SHOW READ FINISHED 944B MHUNTW 3,AMXOR,ADEVS 94J2 LDX 2 A1+BPTR(3) [ZERO OR RINGED - MOP OFF' DUMMY ADCB 953L BZE 2 SFPA [J. FINISHED 95H= STOZ A1+BPTR(3) [CLEAR ADEVS 962W STOZ BPTR(2) [CLEAR ADCB 96GG SBN 2 A1+BPTR 9726 SFRED LDX 2 BPTR(2) 97FQ LDX 0 ATYPE(2) 97^B TXL 0 CACT 98F2 BCS SFRED 98YL FPUT [PUT MOPPING OFF ON LIST 99D= SFPA [FREEING ADEV'S 99XW LDX 2 3 9=CG LDX 4 ALOGLEN(3) 9=X6 SRL 4 2 9?BQ SBN 4 1 9?WB SFALOOP 9#B2 LDX 1 A1+BPTR+4(3) 9#TL BZE 1 SFALPA [NEXT ENTRY 9**= GEOERR 1,ADEVSRIN [A RING STILL EXISTS 9*SW SFALPA 9B#G ADN 3 4 9BS6 BCT 4 SFALOOP 9C?Q LDX 3 2 9CRB FREECORE 3 9D?2 MFREEW AMXOR,INBF 9DQL LDX 0 GSIGN 9F== STO 5 CHAINADD(2) [SET CHAINADD -VE TO AWAIT RESTART 9FPW STOZ IPBSW(2) [CLEAR IPBSW 9G9G DISENGPER [WAIT UNTIL OPERABLE 9GP6 COOR1 9H8Q ACROSS IPBSTART,5 [GO RESTART 9HNB ZERR1 GEOERR 1,NOADEVS 9J82 ZLNSE GEOERR 1,LONGSET 9JML #END ^^^^ ...074153530001