{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: LISTDEV866)}}
====== LISTDEV866 ======
(George Source)
**Macros used:** [[george:macro:ALTLEND|ALTLEND]], [[george:macro:APPEND|APPEND]], [[george:macro:CHNUMCOD|CHNUMCOD]], [[george:macro:CLOSE|CLOSE]], [[george:macro:COOR1|COOR1]], [[george:macro:CREATEB|CREATEB]], [[george:macro:CREATEWF|CREATEWF]], [[george:macro:DCA|DCA]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:ENDLIST|ENDLIST]], [[george:macro:ENGPER|ENGPER]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FREEPER|FREEPER]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GPERI|GPERI]], [[george:macro:ISSUCOMB|ISSUCOMB]], [[george:macro:JFREE|JFREE]], [[george:macro:JRIGHT|JRIGHT]], [[george:macro:LADDP|LADDP]], [[george:macro:LGEOG|LGEOG]], [[george:macro:LOCK|LOCK]], [[george:macro:LTYPE|LTYPE]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUT|MONOUT]], [[george:macro:MONOUTX|MONOUTX]], [[george:macro:ON|ON]], [[george:macro:OPENWORK|OPENWORK]], [[george:macro:OUTPARAM|OUTPARAM]], [[george:macro:PARAPASS|PARAPASS]], [[george:macro:PERCON|PERCON]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETALLOC|SETALLOC]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETWTBWR|SETWTBWR]], [[george:macro:TESTREP|TESTREP]], [[george:macro:UNLOCK|UNLOCK]], [[george:macro:VFREE|VFREE]]
22FL ...#SEG LISTDEV [LEN WAGSTAFF
22KH ...#
22PD ...# MODIFIED APRIL 82 TO OUTPUT A LISTFILE IF NO LP FREE
22T* ...#
22^= #OPT K0LISTDEV=0
23DW #LIS K0LISTDEV
23YG ... 8HLISTDEV
24D6 #DEF XZ=CPATLEN+A1
24XQ #
25CB #
25X2 SEGENTRY K1LISTDEV,X1LISTDEV
26BL #
26W= #
26^B ...XER1 20HINVALID PARAMETER
274G ...XER2 32HDEVICE NOT ON THIS INSTALLATION
277L ...XER3 20HDEVICE NOT AVAILABLE
27=Q ...XDV 12HDEVICELIST
27*W PTI 4HPTI
27TG XBDT 4HBDT
28*6 TYPE 4HTYPE
28SQ UNIT 4HUNIT
29#B XFOUR +4
29S2 SFOUR +64
2=?L XCON +10000
2=R= XCHERR +CHNUMERR
2?=W XJNOPER +JNOPER
2?QG XJPERNA +JPERNA
2#=6 XAPIALEN
2#PQ +BILEN [TR
2#WY ...#UNS JSKI38
2*46 ...#SKI
2*9B +BOLEN [TP
2*?5 ...#UNS JSKI38 [GLASGOW SPECIALS
2*#S ... +BTLEN [TP
2*BJ ...#UNSET JSKI24 [PRE VARIABLE WIDTH LPS
2*HQ ...#SKI
2*P2 +BOLEN [LP
2*W8 ...#UNSET JSKI24 [POST VARIABLE WIDTH LPS
2B3B ... +BLLEN
2B8L +BILEN [CR
2BN= +BOLEN [CP
2C7W +BMTLEN [MT
2CMG +BUDASLEN [EDS
2D76 +BUDASLEN [MCF
2DLQ +0 [DS
2F6B +BDRLEN [DR
2FL2 +COMLEN [UX
2G5L +COMLEN [MX
2GK= +0 [CT
2H4W +BUDASLEN [FDS
2HJG +0 [AD
2J46 +0 [TYPE 15
2JHQ +0 [TYPE 16
2K3B +0 [TYPE 17
2KH2 +0 [TYPE 18
2L2L +0 [TYPE 19
2LG= +0 [GP
2L^W +0 [GD
2MFG +0 [DXC
2M^6 +0 [UD
2NDQ +COMLEN [IPB
2NYB +BDRLEN [FASTDRUM
2PD2 +BUDASLEN [EDS(30) - (MEDS)
2PXL +0 [TYPE 27
2QC= +0 [TYPE 28
2QWW +0 [TYPE 29
2RBG +0 [TYPE 30
2RW6 +0 [TYPE 31
2S*Q +0 [TYPE 32
2STB +0 [TYPE 33
2T*2 +0 [TYPE 34
2TSL +0 [TYPE 35
2W#= +0 [TYPE 36
2WRW +0 [TYPE 37
2X?G +0 [TYPE 38
2XR6 +0 [TYPE 39
2Y=Q +0 [TYPE 40
2YQB +0 [TYPE 41
2^=2 +0 [TYPE 42
2^PL +0 [TYPE 43
329= +0 [TYPE 44
32NW +0 [TYPE 45
338G +0 [TYPE 46
33N6 +0 [TYPE 47
347Q +0 [TYPE 48
34MB +0 [CD
3572 +0 [IP
35LL +0 [OP
366= +0 [GE
36KW +0 [CO
375G +0 [EM
37K6 +0 [OI
384Q +0 [OO
38JB +0 [CS
3942 +0 [RR
39HL +0 [ET
3=3= +0 [TYPE RESERVED FOR OBJ PROG PERIS
3=GW +0 [TYPE 61
3?2G +0 [TYPE 62
3?G6 +CONSLEN [OPERATOR'S CONSOLE
3?K= ...
3?NB ...#
3?RG ...QLF 8HLF !,*LP
3?WL ...#
3?^Q X1LISTDEV [COMMAND PROCESSOR ENTRY-POINT
3#FB STOZ AWORK2(2) [ZEROISE SWITCH WORD
3#^2 STOZ AWORK1(2) [ENTRY POINT MARKER
3*8S ... STOZ AWORK4(2)
3*DL CALL 7 XGETLP [GET A LINEPRINTER
3*Y= PARAPASS [ACCESS PARAMETER
3BCW MHUNT 3,CPB,CUNI [FIND THE CPB/CUNI
3BDX ... LDN 4 XDV(1)
3BFY ... LDN 5 XZ+12(2)
3BG^ ... MOVE 4 3 [DEVICELIST
3BJ2 ... LDX 0 ANUM(3) [LOOK AT PARAM LENGTH
3BK3 ... BNG 0 XHEAD
3BL4 ... BZE 0 XHEAD [JUMP IF NONE OR NULL
3BM5 ... ANDN 0 #7777
3BN6 ... LDN 4 APARA(3)
3BP7 ... LDN 5 XZ+15(2)
3BQ8 ... SMO 0
3BR9 ... MVCH 4 0 [COMMAND PARAM
3BS= ...XHEAD LDN 0 #51
3BT? ... STO 0 XZ(2) [NEW PAGE PFCC
3BW# ... CALL 7 WRITE [PRINT HEADING
3BXG LDX 0 ANUM(3)
3CC6 BNG 0 XALL [BR IF NULL PARAMETER
3CWQ BZE 0 XALL [...OR IF NON-EXISTENT
3DBB ANDN 0 #7777
3DW2 TXL 0 XFOUR(1)
3F*L BCC PFERR [ERROR IF PARAMETER TOO LONG
3FT= LDCH 0 APARA(3) [1ST CHARACTER OF PARAMETER
3G#W BZE 0 PFERR [BR IF PARAMETER = 0
3GSG SBN 0 #12
3H#6 BNG 0 XNUMB [BR IF GEOG NO PARAMETER
3HRQ SBN 0 #20
3J?B BZE 0 XTYPE [BR IF TYPE NO PARAMETER
3JR2 SBN 0 7
3K=L BZE 0 XALL [BR IF PARAMETER "ALL"
3KQ= SBN 0 #23
3L9W BZE 0 XTW [BR IF PARAMETER "TW"
3LPG BRN PFERR [NONE OF THESE - ERROR
3M96 XNUMB [GEOG NO PARAMETER
3MNQ LDCT 0 #400
3N8B ERS 0 AWORK2(2) [SET GEOG NO PARAMETER MARKER
3NN2 CHNUMCOD 1,3 [CONVERT PARAMETER
3P7L TESTREP CHNUMERR,PFERR [...AND TEST REPLY
3PM= LDX 4 ACOMMUNE1(2) [GEOG NO TO X4
3P^M ... FINDPERE 3,APGEOG,4,,AV7900,XN1 [FIND DEVICE LIST POINTER
3Q#4 ...XN1
3QLG BNG 3 XNPERR [ERROR IF NOT FOUND
3R66 LTYPE 3,4
3RKQ BRN PRINT
3S5B XTYPE [TYPE NO PARAMETER
3SK2 LDCT 0 #200
3T4L ERS 0 AWORK2(2) [SET TYPE NO PARAMETER MARKER
3TJ= PERCON [CONVERT PARAMETER (*LP ETC)
3W3W ... TESTREP PARERR,XEND [TEST REPLY
3WHG MHUNTW 3,CPAR,GPERCON
3X36 LDX 4 GTYPE(3) [LOAD PERIPHERAL TYPE
3XGQ FREECORE 3 [FREE CPAR/GPERCON BLOCK
3Y2B SRL 4 15
3YG2 BRN YTYPE
3Y^L XTW [TYPEWRITER PARAMETER
3^F= LDN 4 63 [CONSOLE TYPE
3^YW LDCT 0 #300
42DG ERS 0 AWORK2(2) [SET "TW" PARAMETER MARKER
42Y6 BRN YTYPE
43CQ XALL ["ALL" PARAMETER
43XB LDCT 0 #40
44C2 ERS 0 AWORK2(2) [SET "ALL" PARAMETER MARKER
44QP ... STO 0 AWORK4(2)
456D ... LDN 0 #42
45G7 ... STO 0 XZ(2) [STORE DOUBLE LINE PFFC
45TW LDX 0 PTI(1)
46*G STO 0 XZ+7(2) [STORE "PTI" IN BUFFER
46T6 LDX 0 XBDT(1)
47#Q STO 0 XZ+20(2) [STORE "BDT" IN BUFFER
47SB CALL 7 WRITE [PRINT LINE
48#2 LDN 0 #42
48RL STO 0 XZ(2) [STORE DOUBLE LINE THROW PFFC
49?= LDN 4 0 [INITIALISE X4 FOR TYPE NUMBER
49QW LDN 5 JPTI [LOAD BASE OF PTI
4==G LDX 6 BDTP [LOAD POINTER TO BDT
4=Q6 SLOOP
4?9Q ADN 2 XZ+4 [X2 HOLDS DESTINATION ADDRESS
4?PB CALL 7 XCBD [CONVERT TO DECIMAL AND STORE
4#92 LDN 0 3
4#NL ADS 0 XZ+5(2) [STORE # IN BUFFER
4*8= LDN 3 8
4*MW SMO 5
4B7G LDX 0 0 [LOAD NEXT WORD OF PTI
4BM6 ZIM
4C6Q LDN 7 0
4CLB SLL 70 3 [CONVERT CONTENTS TO OCTAL
4D62 DCH 7 XZ+6(2) [... AND STORE IN BUFFER
4DKL BCHX 2 £
4F5= BCT 3 ZIM
4FJW LDX 2 FX2
4G4G SBX 6 BDTP [CHECK FOR END OF BDT
4GJ6 TXL 6 BDTL
4H3Q BCC RR [BR IF END OF BDT REACHED
4HHB ADX 6 BDTP
4J32 LDN 0 3
4JGL ADS 0 XZ+19(2) [STORE "#" IN BUFFER
4K2= LDN 3 8 [CHARACTER COUNT
4KFW SMO 6
4K^G LDX 0 0 [NEXT WORD OF PTI
4LF6 ZJM
4LYQ LDN 7 0
4MDB SLL 70 3 [CONVERT IT TO OCTAL
4MY2 DCH 7 XZ+20(2) [AND STORE IT IN BUFFER
4NCL BCHX 2 £
4NX= BCT 3 ZJM
4PBW RR
4PWG ADN 4 1
4QB6 ADN 5 1 [UPDATE POINTERS
4QTQ ADN 6 1
4R*B LDX 2 FX2
4RT2 CALL 7 WRITE [WRITE LINE AWAY
4S#L TXL 4 SFOUR(1) [TEST IF END OF PTI REACHED
4SS= BCS SLOOP [AND BR IF NOT
4T?W LDN 4 0 [INITIALISE TYPE NO FOR LOOP
4TRG YTYPE [TYPE NO PARAMETER - ENTRY TO
4W?6 # PRINTING ROUTINE
4WKH ... FINDPERE 3,APFOTY,4,THO,AV7900,YT1,YT1 [GET DEVICE LIST POINT
4WXY ...YT1
4X=B BPZ 3 PRINT [BR IF FOUND
4XQ2 ... LDCT 0 #50
4Y9L ANDX 0 AWORK2(2)
4YP= BZE 0 XNPOTT [BR IF TYPE PARPMETER ERROR
4^8W LDCT 0 #40
4^NG ANDX 0 AWORK2(2)
5286 BZE 0 XEND [BR IF END AND NOT "ALL" PARAMETER
52MQ ADN 4 1 [UPDATE TYPE NO FOR LOOP
537B TXL 4 SFOUR(1)
53M2 BCC XIT [BR IF END (TYPE COUNT = 64)
546L BRN YTYPE
54L= # THIS IS THE MAIN PRINTING ROUTINE
555W PRINT
55KG STO 3 XZ+31(2) [PRESERVE DEVICE LIST POINTER
5656 LDCT 0 #10
56JQ ORS 0 AWORK2(2) [SET PERIPHERAL ACCESSED MARKER
574B LDX 3 XZ+31(2) [RESTORE D/L POINTER OF DEVICE
57J2 XGOTLP
583L LDN 0 #51
586Q ... LDX 7 AWORK4(2) [DOUBLE LINE PFCC FIRST TIME THRO
589W ... BNZ 7 XLP1
58*2 ... LDN 0 #42
58D6 ...XLP1
58H= STO 0 XZ(2) [NEW PAGE PFFC
592W LDX 0 UNIT(1)
59GG STO 0 XZ+7(2) [STORE "UNIT" IN BUFFER
5=26 LDX 0 TYPE(1)
5=FQ STO 0 XZ+10(2) [STORE "TYPE" IN BUFFER
5=^B LDX 6 4 [PRESERVE TYPE NO
5?F2 LGEOG 3,4 [LOAD GEOG NO FOR CONVERSION
5?YL ADN 2 XZ+8
5#D= CALL 7 XCBD [CONVERT GEOG NO TO DECIMAL & STORE
5#XW LDX 4 6 [RESTORE TYPE NO
5*CG ADN 2 XZ+11
5*X6 CALL 7 XCBD [CONVERT TYPE NO AND STORE
5BBQ CALL 7 WRITE [PRINT LINE
5BWB LDN 5 8
5CB2 LDX 4 6
5CTL SMO 4
5D*= LDX 0 XAPIALEN(1) [LOAD LENGTH OF APIA
5DSW STO 0 AWORK3(2) [AND REMEMBER IT
5F#G CALL 7 XLENDV [SET AWORK4 POINTING TO START OF
5FS6 # [NEXT DEVICE LIST
5N7= XPLP
5NLW LDX 2 FX2
5P6G LADDP 3,1 [LOAD ADDRESS OF APIA
5PL6 XNORM
5Q5Q STO 1 AWORK1(2) [STORE START ADDRESS OF APIA
5QKB LDN 1 0 [INITIALISE APIA WORD COUNT
5R52 V3 LDN 0 3
5RJL ADS 0 XZ+6(2) [STORE "#" IN BUFFER
5S4= LDX 0 0(3) [LOAD NEXT WORD OF DEVICE LIST
5SHW LDN 5 8
5T3G ZKM
5TH6 LDN 7 0
5W2Q SLL 70 3 [CONVERT IT TO OCTAL
5WGB DCH 7 XZ+7(2)
5X22 BCHX 2 £
5XFL BCT 5 ZKM
5X^= ADN 2 XZ+3
5YDW LDX 5 4 [PRESERVE X4
5YYG LDX 4 1 [CONVERT WORD NUMBER TO DECIMAL
5^D6 CALL 7 XCBD [AND STORE
5^XQ LDX 4 5 [RESTORE TYPE NO
62CB LDX 0 AWORK3(2) [LENGTH OF APIA
62X2 BZE 0 NMAPIA [BR IF ZERO LENGTH
63BL TXL 1 AWORK3(2)
63W= BCC NMAPIA [BR IF NO MORE APIA TO PRINT
64*W LDN 0 3
64TG ADS 0 XZ+18(2) [STORE "#" IN BUFFER
65*6 SMO AWORK1(2)
65SQ LDX 0 0(1) [LOAD NEXT WORD OF APIA
66#B LDN 5 8
66S2 ZLM
67?L LDN 7 0
67R= SLL 70 3 [CONVERT IT TO OCTAL
68=W DCH 7 XZ+19(2) [AND STORE
68QG BCHX 2 £
69=6 BCT 5 ZLM
69PQ LDX 2 FX2
6=9B LDX 0 XZ+5(2) [LOAD WORD NUMBER
6=P2 STO 0 XZ+17(2)
6?8L NMAPIA
6?N= CALL 7 WRITE [PRINT LINE
6#7W LDX 1 XZ+32(2) [RESTORE X1
6#MG ADN 1 1
6*76 ADN 3 1 [UPDATE POINTERS
6*LQ TXL 3 AWORK4(2) [TEST IF END OF D/L REACHED
6B6B BCS V3 [.. BR IF NOT
6BL2 # COMPLETED PRINTING A DEVICE LIST
6C5L LDX 3 XZ+31(2) [RESTORE DEVICE LIST POINTER
6CK= LDX 1 FX1
6D4W LDX 0 AWORK2(2)
6DJG BPZ 0 THO [BR IF MORE TO DO
6F46 XIT
6FHQ ...XEND
6G3B ... LDX 0 XZ+34(2)
6GH2 ... BNZ 0 XCLWF [JUMP IF USING WORKFILE
6S?G XNOTP
6SR6 FREEPER [FREE THE LINEPRINTER
6T=Q XOVER
6TCY ... LDX 0 XZ+33(2) [RESET CPAT'S CPPTR
6TK6 ... STO 0 CPPTR(2)
6TQB ENDCOM [AND PACK UP
6TR? ...#
6TS8 ...# CODE INSERTED TO CLOSE WORKFILE
6TT5 ...# AND ISSUE LISTFILE
6TW2 ...#
6TWX ...XCLWF
6TXS ... CLOSE
6TYP ... SETNCORE 4,3,ADATA,CREADL
6T^L ... LDN 0 8 [NO OF CHS IN COMMAND
6W2H ... STO 0 A1(3)
6W3D ... LDX 0 QLF(1)
6W4* ... STO 0 CPDATA(3) [MOVE COMMAND
6W5= ... LDX 0 QLF+1(1)
6W67 ... STO 0 CPDATA+1(3)
6W74 ... ISSUCOMB XOVER,XOVER [ISSUE LISTFILE COMMAND
6W7^ ... BRN XOVER [WRAP UP
6W8W ...#
6W=2 PFERR
6WPL LDX 1 FX1
6WWS ... LDN 4 XER1(1)
6X42 ... LDN 6 5
6X9= LDX 7 XCHERR(1) [PARAMETER FORMAT ERROR
6XNW BRN XOUT [BR TO OUTPUT MESSAGE
6Y8G XNPERR
6YN6 LDX 1 FX1
6YT# ... LDN 4 XER2(1)
6^2G ... LDN 6 8
6^7Q LDX 7 XJNOPER(1) [NO SUCH UNIT
6^MB BRN XOUT
7272 XNPOTT
736= LDX 1 FX1
73?D ... LDN 4 XER3(1)
73DL ... LDN 6 5
73KW LDX 7 XJPERNA(1) [NO SUCH TYPE
745G XOUT
747P ... LDN 5 XZ+1(2)
749Y ... SMO 6
74#7 ... MOVE 4 0
74BB ... STO 7 5
74DK ... CALL 7 WRITE [SEND ERROR MESSAGE TO PRINTER
74GS ... LDX 7 5
74K6 MHUNT 3,CPB,CUNI
754Q LDX 4 ANUM(3)
75JB ANDN 4 #7777 [CHARACTER COUNT
7642 OUTPARAM 4,APARA,CPB,CUNI [SET UP MESSAGE PARAMETER
76HL MONOUTX 7 [OUTPUT THE MESSAGE
773= ... BRN XEND
77GW #
782G # END OF MAIN ROUTINE
78G6 #
78^Q # SUBROUTINES FOLLOW
79FB #
79^2 XCBD
7=DL # CONVERT NUMBER IN X4 TO DECIMAL AND STORE IN WORD POINTED TO BY
7=Y= # X2.X5 IS PRESERVED, X2 = FX2 ON EXIT. LINK IN X7
7?CW #
7?XG SMO FX2
7#C6 STO 5 ACOMMUNE1 [PRESERVE X5
7#WQ SMO FX2
7*BB STO 4 ACOMMUNE2 [PRESERVE X4
7*W2 LDN 5 0
7B*L SMO FX1
7BT= DVR 4 XCON
7C#W LDX 4 5
7CSG LDCT 5 #200
7D#6 MODE 1 [SET ZERO SUPPRESSION MODE
7DRQ LDN 0 3
7F?B XCDB
7FR2 CBD 4 0(2) [DESTINATION ADDRESS IN X2
7G=L BCHX 2 £
7GQ= BCT 0 XCDB [4 CHARACTERS TO CONVERT
7H9W MODE 0 [RESET MODE FOR LAST CHARACTER
7HPG CBD 4 0(2)
7J96 LDX 2 FX2
7JNQ LDX 5 ACOMMUNE1(2) [RESTORE X5
7K8B LDX 4 ACOMMUNE2(2) [RESTORE X4
7KN2 EXIT 7 0
7L7L XGETLP
7LM= # TO GET A LINEPRINTER BY WHATEVER MEANS NECESSARY
7M6W # LINK IN X7
7MLG #
7N66 SBX 7 FX1
7NKQ LDX 2 FX2
7P5B STOZ ACOMMUNE1(2)
7PK2 ... ALTLEND 2,XZ+34 [EXTEND CPAT FOR BUFFER
7Q4L LDX 0 ACES
7QJ= STO 0 XZ+1(2)
7R3W LDN 0 XZ+1(2)
7RHG LDN 1 XZ+2(2)
7S36 MOVE 0 29 [AND SPACEFILL IT
7S8# ... LDX 0 CPPTR(2) [PRESERVE CPAT'S CPPTR
7S*G ... STO 0 XZ+33(2)
7SD6 ... STOZ XZ+34(2) [SET NON ZERO IF WORKFILE USED
7SGQ LDN 6 2 [LP TYPE
7T2B FINDPERE 3,APFOTY,6,RTRY [GET LP D/L POINTER IN X3
7TG2 BNG 3 XNOTFOUND [BR IF NOT FOUND
7T^L JFREE 3,XFREE [BR IF DEVICE FREE
7WF= ... BRN RTRY [TRY FOR ANOTHER ONE
7WYW ...#
7XDG ...# CODE INSERTED TO WARN OPERATOR IF NO LP FREE
7XY6 ...# AND OPEN A WORKFILE FOR OUTPUT
7YCQ ...#
7YXB ...XNOTFOUND
7^C2 ... MONOUT ANOLP [SEND WARNING TO CONSOLE
7^WL ... CREATEWF
82B= ... CREATEB 1 [CREATE WORKFILE
82TW ... LDN 0 #12
83*G ... ORX 0 GSIGN
83T6 ... STO 0 CETM(1) [MARK GRAPHIC FILE
84#Q ... OPENWORK XFLOP,APPEND,EMPTY [OPEN IT
84SB ... TESTREP OK,WFOK
85#2 ...XFLOP GEOERR 1,IDFWFILE [CANT OPEN FILE
85RL ...WFOK NGN 0 1
86?= ... STO 0 XZ+34(2) [MARK IN CPAT THAT WORKFILE IN USE
86QW ... BRN XEX
8G^G XFREE [FREE LP FOUND
8HF6 JRIGHT 3,XALLOC [BR IF LP RIGHT
8KX= BRN RTRY [TRY FOR ANOTHER ONE
8LBW XALLOC
8LWG SETALLOC 3 [MARK DEVICE ALLOCATED
8MB6 STO 3 CPPTR(2) [TO THIS ACTIVITY
8MKY ...XEX
8MTQ LDX 1 FX1
8N*B ADX 7 FX1
8NT2 EXIT 7 0
8P#L WRITE
8PS= # SUBROUTINE PRINTS THE LINE HELD IN THE EXTENSION OF THE CPAT
8Q?W # AND THEN CLEARS IT. LINK IN X7
8QRG #
8R?6 STO 1 XZ+32(2) [PRESERVE X1
8RQQ SBX 7 FX1
8RXY ... LDX 0 XZ+34(2)
8S56 ... BNZ 0 WRITEWF [JUMP IF USING WORKFILE
8S=B TFAIL
8SQ2 LDN 0 0
8T9L DCA ,DLA,0,MODE [INSERT MODE
8TP= LDN 0 121
8W8W DCA ,STO,0,COUNT [STORE CHARACTER COUNT
8WNG LDN 0 XZ(2)
8X86 BCHX 0 £
8XMQ BCHX 0 £
8Y7B BCHX 0 £
8YM2 DCA ,STO,0,CTSA [CORE TRANSFER START ADDRESS
8^6L LOCK 2 [LOCK ACTIVITY BLOCK
8^L= GPERI ,2, [ISSUE PERI
925W COOR1 [WAIT FOR IT TO FINISH
92KG UNLOCK 2
9356 LDX 0 CPRW1(2) [LOAD REPLY WORD
93JQ SLL 0 5
944B BPZ 0 TOK [BR IF OK
94J2 ENGPER XOXER,,XOXER,1 [OTHERWISE ENGAGE PRINTER
953L BRN TFAIL
954H ...#
955D ...# CODE INSERTED TO COPY PRINT LINE
956* ...# FROM CPAT BUFFER TO FILE,FAPB IF USING WORKFILE
957= ...#
9587 ...WRITEWF
9594 ... SETNCORE 32,1,FILE,FAPB
959^ ... LDN 0 32
95=W ... STO 0 A1(1) [PUT COUNT INTO HEADER
95?R ... LDX 0 2
95#N ... ADN 0 XZ
95*K ... ADN 1 A1+1
95BG ... MOVE 0 31 [MOVE PRINT LINE TO FAPB
95CC ... APPEND 0,XEND [WRITE TO WORKFILE
95D# ... TESTREP REFUSED,XEND
95F9 ... VFREE FILE,FAPB
95G6 ...
95H= TOK
962W LDX 0 ACES
96GG STO 0 XZ+1(2)
9726 LDN 0 XZ+1(2) [SPACEFILL BUFFER BLOCK
97FQ LDN 1 XZ+2(2)
97^B MOVE 0 29
98F2 LDN 0 #41
98YL STO 0 XZ(2) [SINGLE LINE PFFC
99D= LDX 1 FX1
99XW ADX 7 FX1
9=CG EXIT 7 0
9=X6 XOXER [CD ENGAGE LABEL
9?BQ SETWTBWR [SET WAITING TO BE WRONGED
9?WB BRN XEND [AND CLOSEDOWN
9#B2 XLENDV
9#TL # STORE IN AWORK4 A POINTER TO THE DEVICE LIST IMMEDIATELY AFTER
9**= # THAT POINTED AT BY X3 LINK IN X4
9*SW #
9B#G STO 4 ACOMMUNE1(2) [PRESERVE X4
9BS6 LDX 0 BITS22LS
9C?Q STO 0 AWORK4(2) [A4 = 4M ODD
9CRB LDX 0 BDTP [X0 POINTS TO BASIC DEVICE TABLE
9D?2 LDX 1 BDTL
9DQL SBN 1 1 [X1 = COUNT
9F== XDOWN
9FPW SMO 0
9G9G LDX 4 0(1) [LOAD NEXT WORD OF BDT
9GP6 TXL 4 3
9H8Q BCS XUP [BR IF GREATER THAN X3
9HNB TXU 4 3
9J82 BCC XUP [OR IF EQUAL
9JML TXL 4 AWORK4(2)
9K7= BCC XUP [BR IF > AWORK4
9KLW STO 4 AWORK4(2)
9L6G XUP
9LL6 BCT 1 XDOWN
9M5Q ENDLIST 4 [LOAD POINTER TO END OF DEVICE LISTS
9MKB TXL 4 AWORK4(2)
9N52 BCC YEND [BR IF >= AWORK4
9NJL STO 4 AWORK4(2)
9P4= YEND
9PHW LDX 4 ACOMMUNE1(2) [RESTORE X4
9Q3G LDX 1 FX1
9QH6 EXIT 7 0
9R2Q #
9RGB MENDAREA 40,K100LISTDEV
9S22 #END
^^^^ ...76715037000300000000