(George Source)
Macros used: ACROSS, APPEND, APROPNAME, BXU, FI, FMOPG, GEOERR, HUNT2J, IF, MASK, MENDAREA, MHUNTW, MXB, OFF, ON, SEGENTRY, SETNCORE, TAB, TESTREP, THEN, VFREE
22FL ...#SEG LISTIDF [LEN WAGSTAFF 22PD ...# (C) COPYRIGHT INTERNATIONAL COMPUTERS 1982 22^= #OPT K0LISTIDF=0 23DW #LIS K0LISTIDF>K0ALLGEO>K0GREATGEO>K0COMMAND>K0IDF 23YG 8HLISTIDF 24D6 # ENTRY POINTS 24XQ SEGENTRY K1LISTIDF,Z1LISTIDF 25CB MENDAREA 25,K100LISTIDF 25X2 [ THIS SEGMENT LISTS INFORMATION WHICH IS PRESENT IN THE IDF. 269C ...# IT DEALS WITH MX,UX,IPB & (8.40 ONWARDS)CI 26HS ... 26W= XSUB 12HIDENTIFIER 27*W XIPB 28HCOMMUNICATIONS CONTROLLER 27DD ...XVIPB 28HVIRTUAL COMMS CONTROLLER 27F5 ...XEIPB 28HCOMMS CONTROLLER (7900E) 27FR ...XCOMIS 16HCOMMAND ISSUER 27KN ...XCIIU 8HIN USE 27PK ...XCINIU 12HNOT IN USE 27TG XSUBN 28HNO IDENTIFIERS ON THIS UNIT 28*6 ... 29S2 XTAB 4HNUL 2=?L 4HMOP 2=R= 4HTER 2?=W 4HSEN 2?GN ... 2?QG MULT 12HMULTIPLEXOR 2#=6 XUNI 12HUNIPLEXOR 2#PQ XMESS1 12HNOT ATTACHED 2*9B XMESS2 24HATTACHED TO CONCEPTUAL 2*P2 XUNIT 4HUNIT 2B8L XLINE 4HLINE 2BN= ON 12HONLINED 2C7W NON 12HNOT ONLINED 2CMG ... 2D## ...PVDU 4HPVDU 2DLQ TABLE #7420 2F6B #7430 2FL2 #7400 2G5L #7410 2GK= #7440 2H4W #7450 2HJG #7460 2J46 #7470 2JHQ #7540 2K3B #7550 2KH2 #7560 2L2L #7570 2LG= TAB 4HLP 2L^W 4HCR 2MFG 4HTW 2M^6 4HTR 2NDQ 4HTP 2NYB ...TABIPB 4HTTW 2PD2 4HT/W5 2PXL 4HAVDU 2QC= 4HLP 2QWW 4HCR 2RBG 4HT/W 2RW6 4HTR 2S*Q 4HTP 2STB 4H???? 2T*2 4H???? 2TSL 4HVDU 2W4D ... 2W96 ... 4HVSO 2W*S ... 4HVSI 2WD7 ... 4HERL [13 = ERROR LOGGER 2WDH ... 4HDIAL 2WDX ... 4HVALS 2WF? ... 4HX25 2WFM ... 4H???? 2WG3 ... 4H???? 2WGG ...XMESS 12HMOPPED OFF 2WYJ ... 12HMOPPED ON 2X#? ... 12HRIGHTED 2XN2 ...XWR 2XSN ... 12HWRONGED 2X^B ...XRID 12HRI (IDF WR) 2Y64 ...XWRID 12HWR (IDF RI) 2Y=Q XMAJ +10000 2^=2 TEN +10 2^?P ...MASK #37777777 2^*D ... #20202020 2^C7 ...XCOMS 8H,,,,,, 2^DW ...NOT 4HNOT 2^GK ...SPMESS 8HSPOOLING 2^J# ... 12H ATTENDED 2^L3 ... 12H UNATTENDED 2^LW ...XAUTO 8H AUTO 2^MQ ...RJE 8H 1901A 2^NN ...P7502 8H 7502 2^PL Z1LISTIDF 329= STOZ ACOMMUNE3(2) 32NW CALL 7 XMXB [RE-HUNT FOR ZERO RECORD. 338G LDX 3 BUNIT(2) [LOAD START OF UNIT CHAIN 33N6 CALL 0 SETUP 347Q BZE 3 XHERX 34MB XHER LDX 6 3 3572 CALL 0 XHUNT [CALL ROUTINE TO HUNT FOR BLOCK & CEL 35LL LDN 0 #42 366= STO 0 A1+1(1) [STO. PFCC. 36KW LDN 4 0 375G SMO 2 37K6 LDX 5 BTYPE(3) 384Q SLL 45 6 38JB SBN 4 10 3942 BZE 4 XUNX 39HL SMO FX1 3=3= LDN 4 MULT 3=GW XUNIX LDN 5 A1+3(1) [MOVE IN HEADING 3?2G MOVE 4 3 3?G6 SMO 2 3?^Q LDX 5 BTYPE(3) 3#FB ANDN 5 #7777 [MASK OUT GEO.NO. FOR HEADING 3#^2 ADN 1 A1+6 3*DL CALL 7 XCBD 3*Y= SBN 1 A1+6 3BCW LDN 6 A1+8(1) 3BXG XCON SMO 2 3CC6 LDX 4 BNUMB(3) [LD. BNUMB. 3CWQ BNG 4 XYMP [J. MOP ON 3DBB SMO FX1 3DW2 LDN 5 XMESS 3F*L ...XA MOVE 5 3 [MOVE IN MESSAGE 3FT= ... ADN 6 3 3G#W SLL 4 1 3GSG BNG 4 XWRG [J. WRONG. 3H#6 SMO FX1 3HRQ ... LDN 5 XMESS+6 3J?B XB MOVE 5 2 3JR2 ADN 6 2 3K=L SLL 4 1 3KQ= BNG 4 XONL [J. ONLINED 3L9W SMO FX1 3LPG LDN 5 NON 3M96 XC MOVE 5 3 3MDY ...XD 3MNQ CALL 0 WRITE [WRITE THIS RECORD TO THE FILE. 3N8B CALL 7 XMXB [CALL HUNT ROUTINE AS THE WRITE COOR. 3NN2 SMO 3 3P7L LDX 6 BLINE(2) [LD. BASE OF LINE CHAIN. 3PM= LDX 7 BRECNO(2) 3Q6W SLL 7 9 3QLG ADX 7 3 3R66 SMO FX2 3RKQ STO 7 AWORK1 [AWORK1=REC.NO.&CELL PTR. TO UNIT.CEL 3S5B SMO 2 3SK2 LDCH 5 BTYPE(3) 3T4L SBN 5 24 [SUBTRACT 7900 TYPE 3TJ= BZE 5 X7900A 3W3W CALL 0 SETUP 3WHG XMULT LDX 3 6 3X36 CALL 0 XHUNT [CALL ROUTINE TO HUNT BLOCK 3XGQ SMO 2 3Y2B LDCH 4 BTYPE(3) 3YG2 BZE 4 XNULL [THIS LINE IS NULL. 3Y^L SBN 4 1 3^F= BZE 4 XMOP [THIS LINE IS MOPPED. 3^YW SBN 4 1 42DG BZE 4 X7020 [THIS LINE HAS A 7020 ATTACHED. 42Y6 LDN 5 3 43CQ BRN XSEN 43XB XMOP LDN 5 1 44C2 XSEN SMO 2 44WL LDX 4 CONTCEP(3) [LD. PTR. TO SEE IF ATTACH TO CONCEP. 45B= BNZ 4 XATT [J. IT IS ATTACHED. 45TW CALL 6 XNAT [J. TO ROUTINE WHICH WILL BE SET UP 46*G [LINE IF NOT ATTACHED. 46T6 XPRINT1 47#Q CALL 0 WRITE [CALL ROUTINE TO WRITE BLOCK AWAY. 47SB CALL 0 SETUP 48#2 CALL 7 XMXB [HUNT FOR FILE. 48RL XPRINT 49?= SMO 2 49QW LDX 6 0(3) 4==G BNZ 6 XMULT [MORE LINES TO ANALYSIS. 4=Q6 SMO FX2 4?9Q LDX 6 AWORK1 [LD. PTR. TO UNIT CELL. 4?PB LDX 3 6 4#92 CALL 0 XHUNT [HUNT FOR REC. AND CELL PTRS. 4#NL SMO 2 4*8= LDX 7 0(3) [LD. FORWARD PTR. IN UNIT CELL 4*MW BNZ 7 XHERA [J. IF MORE UNITS DEFINED IN IDF. 4B7G # 4BM6 # THIS PIECE DEALS WITH 7900 TYPE CHAIN IF ONE EXISTS. 4C6Q # 4CLB XHERX 4D62 LDN 6 0 [FIRST REC. 4DKL LDN 3 BIPB [START OF 4F5= XHERB CALL 0 XHUNT [HUNT FOR BASE 4FJW SMO 3 4G4G LDX 6 0(2) 4GJ6 BZE 6 XCONCEP [NO 7900'S CONTINUE WITH CONCEPTUALS. 4H3Q LDX 3 6 4HHB CALL 0 XHUNT [HUNT FOR 7900 UNIT CELL. 4J32 LDN 0 #42 4JGL STO 0 A1+1(1) [STO. PFCC 4JM2 ... SMO 3 4JRB ... LDX 0 BTYPE(2) 4JXQ ... ANDN 0 #777 [GET GEOG.NO 4K46 ... BZE 0 XCI [J. IF CI 4K8G ... SMO FX1 ["COMM. 4K#W ... LDN 4 XIPB [CONTROLLER" 4KB8 ... SMO 3 [DISTINGUISH VIRTUAL 7900'S FROM 4KBL ... LDXC 5 BNO(2) [REAL 7900'S 4KC4 ... BCC XUNAME [NOT A VIRTUAL 7900 (BNO.B0=0) 4KCG ... SMO FX1 ["VIRTUAL COMMS 4KCY ... LDN 4 XVIPB [CONTROLLER" 4KD7 ... BRN XUNA 4KDB ...XUNAME 4KDG ... LDCT 7 #200 4KDL ... ANDX 7 5 4KDQ ... BZE 7 XUNA 4KDW ... SMO FX1 4KF2 ... LDN 4 XEIPB 4KF6 ...XUNA 4KF= ... LDN 5 A1+3(1) [INTO FAPB 4KKL ... MOVE 4 7 4KQ2 ... LDX 5 0 [PARAS FOR XCBD 4KWB ... ADN 1 A1+9 4L2Q ... BCHX 1 £ 4L76 ... BCHX 1 £ [TO GET X1 POINTING TO CORRECT PLACE 4L?G ... CALL 7 XCBD 4LCW ... MHUNTW 1,FILE,FAPB [HUNT BLOCK. 4LJ= ... LDN 6 A1+11(1) [POSITION FROM WHICH TO START MOVING 4LNL ... BRN XCON 4LT2 ...XCI SMO FX1 ["COMMAND 4L^B ... LDN 4 XCOMIS [ISSUER" 4M5Q ... LDN 5 A1+3(1) [INTO FAPB 4M=6 ... MOVE 4 4 4MBG ... SMO 3 [GET PROP.NAME 4MGW ... LDX 0 CIPROPNO(2) 4MM= ... APROPNAME 0,1,NOPR 4MRL ... MHUNTW 1,FILE,FAPB [APROPNAME COORS 4MY2 ... LDN 4 ACOMMUNE1(2) [PROP.NAME 4N4B ... LDN 5 A1+7(1) [INTO FAPB 4N8Q ... MOVE 4 3 4N*6 ... LDX 6 AWORK1(2) 4NFG ... LDX 3 6 4NKW ... CALL 0 XHUNT [CELL AGAIN 4NQ= ... SMO 3 4NWL ... LDX 4 BNUMB(2) 4P32 ... BNG 4 XCIMN [J. IF MOPPED ON 4P7B ... SMO FX1 ["MOPPED OFF" 4P?Q ... LDN 4 XMESS [INTO FAPB 4PD6 ... BRN XCIRW 4PJG ...XCIMN SMO FX1 ["MOPPED ON" 4PNW ... LDN 4 XMESS+3 [INTO FAPB 4PT= ...XCIRW LDN 5 A1+11(1) 4P^L ... MOVE 4 3 4Q62 ... SMO 3 4Q=B ... LDX 4 BNUMB(2) 4QBQ ... SLC 4 1 4QH6 ... BNG 4 XCIWR [J. IF CI "WRONGED" 4QMG ... SMO FX1 4QRW ... LDN 4 XCIIU ["IN USE" INTO FAPB 4QY= ... LDN 5 A1+14(1) 4R4L ... MOVE 4 2 4R92 ... BRN XD [BACK TO MAIN PATH 4R*B ...XCIWR SMO FX1 ["NOT IN USE" 4RFQ ... LDN 4 XCINIU [INTO FAPB 4RL6 ... LDN 5 A1+14(1) 4RQG ... MOVE 4 3 4RWW ... BRN XD [BACK TO MAIN PATH 4S3= ...NOPR GEOERR 1,LOSTPROP 4S7L ...XEND ACROSS LISTAST,1 4S#L XYMP 4SS= SMO FX1 4T?W ... LDN 5 XMESS+3 [MOP ON 4TRG BRN XA 4W?6 XWRG SMO FX1 4WQQ ... LDN 5 XWR [WRONG 4X=B BRN XB 4XQ2 XONL SMO FX1 4Y9L LDN 5 ON [ONLINED. 4YP= BRN XC 52MQ XHERA 537B LDX 3 7 53M2 BRN XHER [GO BACK TO SEARCH DOWN NEXT UNIT 546L XUNX SMO FX1 54L= LDN 4 XUNI 555W BRN XUNIX 55KG XLINEA 5656 SBX 4 FX1 56JQ SMO FX2 574B STO 4 AWORK4 [STO LINK 57J2 SMO FX1 583L LDX 4 XLINE 58H= STO 4 A1+4(1) [STO"LINE" 592W LDX 4 BRECNO(2) 59GG SLL 4 9 5=26 ADX 4 3 5=FQ SMO FX2 5=^B STO 4 AWORK2 [STO. PTR. TO LINE 5?F2 ADX 5 FX1 5?YL SMO 5 5#D= LDN 4 XTAB 5#XW LDN 5 A1+7(1) [MOVE IN TYPE 5*CG MOVE 4 1 5*X6 SMO 2 5BBQ LDX 5 BNO(3) 5BWB ADN 1 A1+5 5CB2 CALL 7 XCBD [CALCULATE AND MOVE IN LINE NO. 5CTL SBN 1 A1+5 5D*= SMO FX2 5DSW LDX 4 AWORK4 5F#G ADX 4 FX1 5FS6 EXIT 4 0 [EXIT. 5G?Q XNAT 5GRB SBX 6 FX1 5H?2 SMO FX2 5HQL STO 6 AWORK3 [STO LINK 5J== CALL 4 XLINEA [TYPE. 5JPW LDN 5 A1+10(1) 5K9G XNATI SMO FX1 5KP6 LDN 4 XMESS1 [MOVE IN MESSAGE TO SAY NOT ATTACHED. 5L8Q MOVE 4 3 5LNB SMO FX2 5M82 LDX 6 AWORK3 [LOAD LINK 5MML ADX 6 FX1 5N7= EXIT 6 0 [EXIT. 5NLW # 5P6G # THIS ROUTINE DEALS WITH THE CASE WHEN THE LINE IS ATTACHED. 5PL6 XYAT SBX 6 FX1 5Q5Q SMO FX2 5QKB STO 6 AWORK3 [STO LINK 5R52 CALL 4 XLINEA 5RJL LDN 5 0 [INITIAL POSITION. 5S4= XYATI SMO 2 5SHW LDX 6 CONTCEP(3) [LD. PTR. TO CONCEPTUAL CELL 5T3G LDX 3 6 5TH6 CALL 0 XHUNT [HUNT FOR REC. 5W2Q SMO FX1 5WGB LDN 4 XMESS2 [LD. PTR. TO MESSAGE 5X22 ADN 5 A1+10(1) [LD. PTR. ALONG LINE FOR PRINTING. 5X#B ... ADN 5 3 5XFL MOVE 4 6 5X^= SMO 3 [STORE THE CONCEPTUAL NAME IN AC1,AC2 5YDW LDN 4 1(2) [AND AC3. 5YYG ADN 5 6 5^D6 MOVE 4 3 5^XQ SMO FX2 62CB LDX 6 AWORK2 [LD. PTR. TO LINE CELL. 62X2 LDX 3 6 63BL CALL 0 XHUNT [HUNT FOR LINE CELL. 63W= SMO FX2 64*W LDX 6 AWORK3 [LOAD LINK 64TG ADX 6 FX1 [LOAD EXIT LINK 65*6 EXIT 6 0 [EXIT FROM ROUTINE TO GET CONCEPTUAL 65SQ XATT 66#B CALL 6 XYAT [CALL ROUTINE THAT DEALS WITH LNS. 66S2 BRN XPRINT1 [THAT ARE ATTACHED TO CON. 67?L # 67R= # THIS DEALS IF THE LINE HAS 7020'S HANGING OFF IT. 68=W # 68QG X7020 69=6 LDN 5 2 [LD. TYPE OF UNIT ON LINE 69PQ SMO 2 [TEST TO SEE THE LINE IS ATTACHED TO 6=9B LDX 4 CONTCEP(3) [A CONCEPTUAL. 6=P2 BZE 4 XAB [NO. 6?8L CALL 6 XYAT [YES ATTACHED TO A CONCEPTUAL. 6?N= BRN XBB 6#7W XAB CALL 6 XNAT [NO NOT ATTACHED TO A CONCEPTUAL. 6#MG XBB 6*76 CALL 0 WRITE [WRITE AWAY ATTACHED LINE. 6*LQ CALL 0 SETUP [SETUP NEW OUTPUT BLOCK. 6B6B SMO FX2 6BL2 LDX 3 AWORK2 [LD. PTR. TO LINE CELL. 6C5L LDX 6 3 6CK= CALL 0 XHUNT [HUNT FOR CELL. 6D4W SMO 3 6DJG LDX 6 BLINE(2) [LD. PTR. TO 7020 CHAIN FROM LINE CHN 6F46 LDX 3 6 6F9# ...XBCXX SMO FX2 6FBG ... STO 6 AWORK3 [SAVE PTR TO 7020 CELL 6FHQ CALL 0 XHUNT [HUNT FOR 7020 CELL. 6G3B XBCX SMO 2 6GH2 LDX 4 BNO(3) [LD. IDEN & POLLING ADDRESS. 6H2L ANDN 4 #7777 6HG= LDN 0 1 6H^W ANDX 0 4 6JFG BZE 0 XTERA 6J^6 SBN 4 1 6KDQ XTERA LDN 6 12 [LD. CT. OF VALID NO. OF POLLING ADDR 6KYB LDN 5 1 6LD2 LDX 1 FX1 6LXL XNXT SMO 5 6MC= TXU 4 TABLE-1(1) [TEST IF EQUAL TO POLL.ADD.IN TABLE. 6MWW BCC XEQ1 [J. IF EQUAL. 6NBG ADN 5 1 6NW6 BCT 6 XNXT [GO ROUND AGAIN 6P*Q [OUTPUT AN ERROR - JLARGETERM 6PTB XEQ1 BZE 0 XEQ 6Q*2 ADN 5 16 6QSL XEQ MHUNTW 1,FILE,FAPB [HUNT FOR OUTPUT BLOCK 6R#= LDX 4 5 6RRW SMO 2 6S?G LDX 6 BNO(3) 6SR6 LDN 5 #51 6T=Q SLL 56 12 6TQB LDCT 6 #340 6W=2 SLL 56 6 6WPL STO 5 A1+7(1) [ST. INTERFACE 6X9= ADN 1 1 6XNW LDN 5 #6400 [ST. "T" 6Y8G LDX 7 4 [CONVERT TERMINAL NO. 6YN6 SMO FX1 [TO DECIMAL - IT 6^7Q DVS 6 TEN [WILL HAVE MAX OF 2 CHS 6^MB BZE 7 X1CH 7272 ORX 5 7 72LL BRN X2CH 736= X1CH ORN 5 #20 73KW X2CH SLL 6 18 745G SLL 56 12 74K6 ORN 5 #20 [SPACE AFTER IT 754Q STO 5 A1+7(1) 754T ...# 754Y ...# THE FOLLOWING CODE (BETWEEN THE TWO LINES OF ***'S) IS FOR THE 7553 ...# CHARACTER BUFFERING PART OF THE "7503/SPOOLING" ENHANCEMENT. 7556 ...# WE USE ACUMULATOR 5 TO HOLD 7559 ...# "PREVIOUS DEFINED INTERFACE NO.", HEREINAFTER REFERRED TO AS 755# ...# "PREVIOUS" IN THE COMMENTS. 755C ...# ******************************************************************* 755G ...# 755K ... SMO 2 [TEST "SPOOLABLE"(7503) BIT 755N ... LDX 0 BNUMB(3) 755R ... SLL 0 4 755W ... BPZ 0 N7503 [J IF ORDINARY 7020 755^ ... 7564 ... CALL 0 WRITE 7567 ... CALL 0 SETUP 756= ... LDX 6 AWORK3(2) [PICK UP PTR TO CELL... 756* ... LDX 3 6 [..AND FIND IT, AS... 756D ... CALL 0 XHUNT [..S/R'S COORED 756H ... ADX 3 2 756L ... LDX 2 1 [FOR MVCH'S LATER ON 756P ... 756S ... LDX 5 BTYPE(3) [GET INTERFACE NO. 756X ... ANDN 5 #77 7572 ... LDX 4 5 7575 ... SBN 4 1 [X4 NOW=NO. OF COMMAS REQD 7578 ... ADN 2 A1+8 757? ... BZE 4 NOCOM 757B ... 757F ... LDX 1 FX1 [PUT COMMAS IN FAPB 757J ... ADN 1 XCOMS 757M ... SMO 4 757Q ... MVCH 1 0 757T ... 757Y ...NOCOM LDCH 1 BTYPE(3) [PUT DEVICE TYPE IN 7583 ...# NOW FOLLOWS A FRIG TO GET ROUND PROBLEM CAUSED BY 7586 ...# FACT THAT THERE'S ONLY 1 INTERFACE CELL IN IDF FOR BOTH 7589 ...# TW INTERFACES. YOU GET A PRIZE IF YOU CAN FOLLOW WHAT'S 758# ...# GOING ON. 758C ... LDN 0 3 [TEST TYPE AND.. 758G ... TXU 1 0 758K ... BCS NOTTW1 [J IF NOT TW 758N ... LDX 0 5(3) 758R ... BNZ 0 TW2 [J IF NOT TW 1ST INTERFACE 758W ... LDN 0 1 [OTHERWISE, PUT "TW 1ST INTFACE" 758^ ... STO 0 5(3) [..MARKER IN IDF CELL 7594 ... BRN NOTTW1 7597 ...TW2 STOZ 5(3) 759= ...NOTTW1 759* ... ADX 1 FX1 759D ... ADN 1 TAB-1 759H ... MVCH 1 4 759L ... 759P ... LDX 1 FX1 759S ... LDX 0 5(3) [TW INPUT IS ALWAYS.. 759X ... BNZ 0 NSPOO [.."NOT SPOOLING" 75=2 ... LDX 0 BNUMB(3) 75=5 ... SLL 0 5 75=8 ... BNG 0 YSPOO [J IF SPOOLING 75=? ... 75=B ...NSPOO ADN 1 NOT [PUT "NOT SPOOLING" IN FAPB 75=F ... MVCH 1 12 75=J ... BRN SPFIN 75=M ... 75=Q ...YSPOO ADN 1 SPMESS [PUT "SPOOLING" IN FAPB 75=T ... MVCH 1 8 75=Y ... SLL 0 1 75?3 ... BNG 0 UNAD [J IF UNATTENDED 75?6 ... 75?9 ... MVCH 1 9 [PUT "ATTENDED" 75?# ... BRN SPFIN 75?C ...UNAD ADN 1 3 [PUT "UNATTENDED" 75?G ... MVCH 1 11 75?K ... 75?N ...SPFIN LDX 0 5(3) 75?R ... BZE 0 NOTW1 [J IF NOT "TW 1ST INTFACE" 75?W ... ADN 5 1 [UPDATE "PREVIOUS" 75?^ ... STO 5 7 [NOCO EXPECTS "PREVIOUS" IN X7! 75#4 ... BRN NOCO 75#7 ...NOTW1 MHUNTW 1,FILE,FAPB [SAVE INTERNAL FAPB PTR IN X4 75#= ... SBX 2 1 [...AS XHUNT MAY COOR 75#* ... STO 2 4 75#D ... LDX 0 BLINE(3) 75#H ... BNG 0 TDONE [J IF THIS IS LAST INTERFACE 75#L ... 75#P ... LDX 6 0(3) [ELSE GET NEXT CELL 75#S ... SMO FX2 75#X ... STO 6 AWORK3 75*2 ... BZE 0 PTRER 75*5 ... LDX 3 6 75*8 ... CALL 0 XHUNT 75*? ... ADX 3 2 75*B ... LDX 2 1 75*F ... ADX 2 4 [RESTORE FAPB PTR 75*J ... 75*M ... LDX 0 BTYPE(3) [GET INTERFACE NO. 75*Q ... ANDN 0 #77 75*T ... STO 0 7 [KEEP FOR REF. NEXT TIME ROUND 75*Y ... SBX 0 5 75B3 ... SBN 0 1 [X0 NOW=NO. OF COMMAS REQD 75B6 ... BZE 0 NOCO 75B9 ... 75B# ... LDX 1 FX1 [PUT COMMAS IN FAPB 75BC ... ADN 1 XCOMS 75BG ... SMO 0 75BK ... MVCH 1 0 75BN ...NOCO CALL 0 WRITE 75BR ... CALL 0 SETUP 75BW ... 75B^ ... LDX 5 7 ["PREVIOUS" 75C4 ... LDX 6 AWORK3(2) [FIND CELL AGAIN (AFTER COOR) 75C7 ... LDX 3 6 75C= ... CALL 0 XHUNT 75C* ... ADX 3 2 75CD ... LDX 2 1 [SET UP FAPB PTR 75CH ... ADN 2 A1+8 75CL ... BRN NOCOM [LOOP ROUND AGAIN 75CP ... 75CS ...TDONE ADX 2 1 [RESTORE FAPB PTR 75CX ... LDN 0 6 75D2 ... SBX 0 5 [PUT COMMAS IN FOR REMAINING 75D5 ... BZE 0 NOC [...(UNDEFINED) INTERFACES 75D8 ... LDX 1 FX1 75D? ... ADN 1 XCOMS 75DB ... SMO 0 75DF ... MVCH 1 0 75DJ ... 75DM ...NOC LDX 6 0(3) [PTR TO NEXT CELL 75DQ ... SMO FX2 75DT ... STO 6 AWORK3 [...AND SAVE IT. NOW J TO OLD CODE 75DY ... BRN X7503FIN [...AT HIGHLY APPROPIATE POINT 75F3 ... 75F6 ...PTRER GEOERR 1,IDF PTR 75F9 ...# ******************************************************************* 75F# ...# 75FC ...N7503 75JB ADN 1 1 7642 LDN 7 1 76HL XAAZ 773= SMO 3 77GW LDCH 4 BTYPE(2) 782G LDN 0 3 78G6 SBX 0 4 [TEST FOR A "TW". 78^Q SMO 3 79FB LDX 5 BTYPE(2) [LD. INTERFACE NO. 79^2 ANDN 5 #77 7=DL BXU 5 7,XABAZ [J. IF NOT EQUAL. 7=Y= XDA 7?CW ADX 4 FX1 7?XG SMO 4 7#C6 LDX 6 TAB-1 [LD. VALUE IN TABLE 7#WQ LDN 4 2 7*BB XAZ SLL 56 6 7*W2 DCH 5 A1+7(1) [DEPOSITE A CHARACTER. 7B*L BCHX 1 £ 7BT= BCT 4 XAZ [J. BACK TO DEPOSITE NEXT CHAR. 7C#W BNZ 0 XABZ [J. IF NOT A "TW" 7CSG LDN 6 1 7D#6 LDN 0 1 7DRQ XACZ LDN 5 #34 7F?B DCH 5 A1+7(1) [DEPOSITE A COMMA 7FR2 BCHX 1 £ 7G=L LDN 4 3 7GQ= ADN 7 1 7H9W BZE 6 XAAZ 7HPG BRN XDA 7J96 XABAZ LDN 6 0 7JNQ BRN XACZ 7K8B XABZ 7KN2 LDN 5 6 7L7L SBX 5 7 7LM= BZE 5 XCX [J. END OF A 7020 7M6W LDN 5 #34 7MLG DCH 5 A1+7(1) [DEPOSITE A COMMA. 7N66 BCHX 1 £ 7NKQ SMO 2 7P5B LDX 6 0(3) 7PK2 BZE 6 XCXC [J.IF END OF INFO. GIVEN ON A 7020 7Q4L SMO 2 7QJ= LDX 4 4(3) [J. END OF INFO 7R3W BNG 4 XCXC 7RHG LDX 5 1 7S36 MHUNTW 1,FILE,FAPB 7SGQ SBX 5 1 7T2B LDX 4 7 7TG2 LDX 3 6 7T^L CALL 0 XHUNT [HUNT FOR NEXT INFO. 7020 CELL. 7WF= ADX 1 5 7WYW LDX 7 4 7XDG ADN 7 1 7XY6 BRN XAAZ 7YCQ XCXC 7YXB ADN 7 1 7^C2 LDN 5 6 7^WL SBX 5 7 82B= BZE 5 XCX 82TW LDN 5 #34 83*G DCH 5 A1+7(1) [DEPOSITE A COMMA 83T6 BCHX 1 XCXC 84#Q XCX 84SB SMO 3 85#2 LDX 6 0(2) 85HS ...X7503FIN 85RL CALL 0 WRITE [WRITE AWAY REC. 86?= LDX 3 6 86QW CALL 0 SETUP [SETUP A NEW BLOCK TO CONTAIN INFO 87=G BZE 6 XHAWK2 [J. IF NO MORE 7020 CELLS ON THIS LIN 87Q6 ... BRN XBCXX [J.BACK TO DEAL WITH NEXT 7020. 88PB XHAWK2 8992 SMO FX2 89NL LDX 6 AWORK2 8=8= LDX 3 6 8=MW CALL 0 XHUNT [HUNT FOR LINE CELL 8?7G BRN XPRINT 8?M6 # THIS DEALS IF LINE IS NULL. 8#6Q XNULL 8#LB LDN 5 0 8*62 BRN XSEN [J. BACK TO TEST IF LINE ATTACHED. 8*KL X7900A 8B5= BNZ 6 X7900 8BJW CALL 0 SETUP [NO IDENTIFIERS 8C4G LDN 4 #42 [ON THIS UNIT 8CJ6 STO 4 A1+1(1) 8D3Q LDN 5 A1+4(1) 8DHB SMO FX1 8F32 LDN 4 XSUBN 8FGL MOVE 4 7 8G2= BRN W1W 8GFW X7900 8G^G CALL 0 SETUP [SET UP BLOCK OF CORE 8HF6 LDN 5 A1+4(1) [LD. POSITION IN WRITE BLOCK 8HYQ SMO FX1 8JDB LDN 4 XSUB [LD. SUB HEADING 8JY2 MOVE 4 3 8KCL LDX 3 6 8MTQ XXWW CALL 0 XHUNT [HUNT FOR AN IDENTIFIER CELL 8N*B SMO 3 8NT2 LDX 5 BNO(2) [LD. IDENTIFIE NO. 8P#L ADN 1 A1+7 8PS= BCHX 1 £ 8Q?W BCHX 1 £ 8QRG CALL 7 XCBD [CALL ROUTINE TO CALCULATE NO. 8R?6 SBN 1 A1+7 8RQQ SMO 2 8S=B LDCH 4 BTYPE(3) 8S?K ... LDX 5 4 8S#2 ... ERN 5 #32 8S#C ... ANDN 5 #37 8S#S ... BNZ 5 NPVDU [J IF NOT PVDU 8S*9 ... SMO FX1 8S*L ... LDX 5 PVDU [LOAD PVDU TYPE 8SB3 ... BRN TPVD [AS #32 WONT FIT IN TABLE 8SBD ...NPVDU 8SJQ ... ANDN 4 #17 8SQ2 ADX 4 FX1 8T9L SMO 4 8TP= LDX 5 TABIPB [X5 = CHARACTER EQUIVELENT. 8W3L ...TPVD 8W8W STO 5 A1+9(1) 8W94 ... SMO 2 8W96 ... LDX 4 BTYPE(3) 8W97 ... STO 1 7 [SAVE FAPB ADDR 8W98 ... LDN 5 #7777 8W99 ... ANDX 5 4 [GET UNIT NO 8W9= ... FMOPG 1,5,IPB [FIND ITS AMOP ACT 8W9? ... BNG 1 NOADV [JUMP IF NO AMOP 8W9# ... HUNT2J 1,AMXOR,ADEVS,,NOADV [FIND ADEVS IF ANY 8W9* ... SMO 2 8W9B ... LDX 5 BNO(3) [GET IDENTIFIER NO 8W9C ... SBX 5 A1+FOURTHWD(1) [FIND LOCATION IN ADEVS 8W9D ... SLL 5 2 [MULT BY 4 8W9F ... LDCT 6 2 [SET BIT 7 8W9G ... SMO 5 8W9H ... ANDX 6 A1+FOURTHWD(1) [IS THIS IDE WRONGED 8W9J ... LDX 1 7 [RETREIVE FAPB ADDR 8W9K ... BNG 4 WRIDF [JUMP IF IDF WRONGED 8W9L ... BZE 6 QQ [JUMP IF RIGHTED 8W9M ... LDN 4 XWRID [OUTPUT WR(IDF RI) 8W9N ... BRN ZZ 8W9P ...WRIDF BNZ 6 ZW [OUTPUT WRONGED 8W9Q ... LDN 4 XRID [OUTPUT RI(IDF WR) 8W9R ... BRN ZZ 8W9S ...NOADV LDX 1 7 [COME HERE IF NO ADEVS 8W9T ... BPZ 4 QQ 8W9W ...ZW 8W9X ... LDN 4 XWR [SET WRONGED 8W9Y ...ZZ 8W9^ ... ADX 4 FX1 8W=2 ... LDN 5 A1+12(1) 8W=3 ... MOVE 4 3 [SET WRONGED 8W=4 ...QQ 8W=7 ... 8W=^ ... SMO 2 [TEST FOR RJE OR AUTO - SAME BIT 8W?R ... LDX 0 BTYPE(3) 8W#K ... LDX 5 0 8W*C ... SLL 0 7 8WB9 ... BPZ 0 NORJE [J IF NOT 8WC3 ... SLC 5 8 8WCT ... ANDN 5 #170 [MASK OUT DEVICE TYPE 8WDM ... SMO FX1 8WFF ... LDN 4 XAUTO [LD. AUTO. 8WG? ... BZE 5 QQ1 [J. DEVICE TYPE = TTW (ZERO) 8WH5 ... ADN 4 2 [PICK NEXT 2 WORDS - 1901A 8WHX ...QQ1 LDN 5 A1+10(1) 8WJP ... MOVE 4 2 8WKN ... 8WL^ ...NORJE 8WM5 ... ADX 2 3 8WM9 ... IF BS,2,IDF7502LP [ IDENTIFIER IS 7502 LP 8WM* ... THEN 8WMF ... SMO FX1 8WMK ... LDN 4 P7502 8WMP ... LDN 5 A1+10(1) 8WMT ... MOVE 4 2 8WM^ ... FI 8WN5 ... SBX 2 3 8WNG SMO 2 8X86 LDX 0 CONTCEP(3) 8XMQ BNZ 0 XYATIB [J. YES ATTACHED 8Y7B CALL 6 XNATIB 8YC8 ...W2W CALL 0 WRITE 8YM2 ... CALL 7 XMXB [RE-FIND RECORD AS WRITE COORDINATES 8YWS ... SMO 2 8^6L LDX 6 0(3) [LD. FORWARD PTR. TO NEXT IDENTIFIER. 8^82 ... ADX 3 2 8^=Q ... 8^#6 ... LDX 0 BTYPE(3) [TEST "SPOOLABLE"(7503) BIT 8^*G ... SLL 0 8 8^BW ... BNG 0 SPABL [J IF 7503 8^D= ... LDX 0 BNUMB(3) [WE NEED AN EXTRA "J 8^FL ... SLL 0 4 [IF SPOOLING" HERE SINCE 7503 8^H2 ... BNG 0 SPABL [I'P IDENTIFIERS ARE NOT 8^JB ... [MARKED AS "SPOOLABLE" 8^KQ ... BRN XIFIN 8^M6 ... 8^N9 ...SPABL 8^P# ... LDX 7 BNUMB(3) 8^QC ... CALL 0 SETUP [SETUP DOESN'T USE X7 8^RG ... SLL 7 4 8^SL ... LDX 4 FX1 8^W2 ... LDN 5 A1+10(1) 8^XB ... BNG 7 SPYES [J IF SPOOLING 8^YQ ... ADN 4 NOT [PUT "NOT SPOOLING" IN FAPB 9226 ... BRN SPEND 923G ... 924W ...SPYES ADN 4 SPMESS [PUT "SPOOLING" IN FAPB 926= ... MOVE 4 2 927L ... SLL 7 1 9292 ... ADN 5 2 92=B ... BNG 7 SPUNA [J IF UNATTENDED 92?Q ... ADN 4 2 [PUT "ATTENDED" IN 92*6 ... BRN SPEND 92BG ... 92CW ...SPUNA ADN 4 5 [PUT "UNATTENDED" IN 92F= ...SPEND MOVE 4 3 92GL ...W1W CALL 0 WRITE 92J2 ...XIFIN BNZ 6 X7900 [J IF MORE IDENTS ON THIS UNIT 92KG SMO FX2 9356 LDX 6 AWORK1 [LD. PTR.TO UNIT CELL. 93JQ LDX 3 6 944B CALL 0 SETUP 94J2 BRN XHERB [J. BACK. 953L XNATIB 95H= SBX 6 FX1 962W SMO FX2 96GG STO 6 AWORK3 [ST. LINK 9726 ... LDN 5 A1+12(1) [LD. POSITION ALONG LINE. 97#G ... ADN 5 3 97FQ BRN XNATI [J. TO OUTPUT MESSAGE NOT ATTACHED. 97^B # 98F2 # DEALS WITH IDENTIFIER ATTACHED. 98YL # 99D= XYATIB 99XW LDX 6 BRECNO(2) 9=CG SLL 6 9 9=X6 ADX 6 3 [X6= PTR. TO IDENTIFIER. 9?BQ SMO FX2 9?WB STO 6 AWORK2 [ST. PTR. TO IDENT. IN AWORK2 9#B2 CALL 6 XYATIP [CALL ROUTINE TO OUTPUT ATTACHED MESS 9#TL BRN W2W 9**= XYATIP 9*SW SBX 6 FX1 9B#G SMO FX2 9BS6 STO 6 AWORK3 [SAVE LINK 9C?Q ... LDN 5 2 [HELP POSITION ALONG LINE. 9CRB BRN XYATI 9D?2 ...XCONCEP 9DQL ... ACROSS LISTCONK,1 9F== ...# 9FPW ...# *TW= WRITE *W*W SBX 0 FX1 *WTG LDX 2 FX2 *X*6 STO 0 AWORK4(2) [STO LINK *XSQ APPEND 2,XREFU *Y#B TESTREP REFUSED,XREFU *YS2 VFREE FILE,FAPB [FREE BLOCK *^?L LDX 0 AWORK4(2) [RELOAD LINK *^R= ADX 0 FX1 B2=W EXIT 0 0 B2GN ... B2QG XMXB SBX 7 FX1 B3=6 LDX 2 FX2 B3PQ MXB 2 B49B ADX 7 FX1 B4P2 MHUNTW 1,FILE,FAPB [HUNT FOR BLOCK DUE TO POSSIBLE COOR B58L EXIT 7 0 B5DD ... B5S7 ...XREFU ACROSS LISTSTAR,30 B67W ... B9K= XHUNT B=4W SBX 0 FX1 B=JG LDX 2 FX2 B?46 STO 0 AWORK4(2) [STO LINK B?HQ SMO FX1 B#3B ANDX 6 MASK B#H2 SRL 6 9 B*2L STO 6 ACOMMUNE3(2) B*G= CALL 7 XMXB B*^W ANDN 3 #777 BBFG SMO FX2 BB^6 LDX 0 AWORK4 [RELOAD L9NK BCDQ ADX 0 FX1 BCYB EXIT 0 0 BD88 ... BDD2 SETUP BDXL SBX 0 FX1 BFC= LDX 2 FX2 BFWW STO 0 AWORK4(2) [STORE LINK BGBG SETNCORE 26,1,FILE,FAPB [SETUP AN APPEND BLOCK BGW6 SMO FX1 BH*Q LDX 4 MASK+1 BHTB STO 4 A1+2(1) [SPACEFIL THE DATA AREA. BJ*2 LDN 4 A1+2(1) BJSL LDN 5 A1+3(1) BK#= MOVE 4 24 BKRW LDN 4 26 BL?G STO 4 A1(1) [STORE CT. OF NO. OF WDS. BLR6 LDN 4 #41 BM=Q STO 4 A1+1(1) [ST. PFCC. BMQB LDX 0 AWORK4(2) BN=2 ADX 0 FX1 BNPL EXIT 0 0 BN^D ... BP9= XCBD [CONVERT BINARY TO DECIMAL BPNW LDN 6 0 BQ8G LDN 4 4 BQN6 SMO FX1 BR7Q DVD 5 XMAJ [MAKE A FRACTION. BRMB LDX 5 6 BS72 ADN 5 1 BSLL LDN 6 0 BT6= MODE 1 BTKW XUSA BW5G CBD 5 0(1) [CONVERT FRACTION BWK6 BCHX 1 £ BX4Q BCT 4 XUSA [J. IF CONVERSION NOT FINISHED. BXJB SBN 1 1 BY42 EXIT 7 0 [EXIT. C8T= #END ^^^^ ...22503774000600000000