{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: LISTPREP865)}}
====== LISTPREP865 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLEND|ALTLEND]], [[george:macro:CHAIN|CHAIN]], [[george:macro:COOR1|COOR1]], [[george:macro:DCA|DCA]], [[george:macro:DISENGPER|DISENGPER]], [[george:macro:ENGPER|ENGPER]], [[george:macro:FCAJO|FCAJO]], [[george:macro:FILEMOVE|FILEMOVE]], [[george:macro:FINDLINK|FINDLINK]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FREELINK|FREELINK]], [[george:macro:HUNTW|HUNTW]], [[george:macro:JOBLOCK|JOBLOCK]], [[george:macro:JUNBUSY|JUNBUSY]], [[george:macro:KEEPREP|KEEPREP]], [[george:macro:LDBIT|LDBIT]], [[george:macro:LFBBS|LFBBS]], [[george:macro:LFBBUS|LFBBUS]], [[george:macro:LFBITCLR|LFBITCLR]], [[george:macro:LFBITSET|LFBITSET]], [[george:macro:LFEND|LFEND]], [[george:macro:LONGON1|LONGON1]], [[george:macro:LPROP|LPROP]], [[george:macro:LPSET|LPSET]], [[george:macro:LPUNSET|LPUNSET]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:NOTBUSY|NOTBUSY]], [[george:macro:OUTPER|OUTPER]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETENTRY|SETENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:TRACEVER|TRACEVER]], [[george:macro:UP|UP]], [[george:macro:VFREEW|VFREEW]]
22FL #OPT K0LISTPREP=0
22^= ...#OPT ATPOLTR=0
23YG #LIS K0LISTPREP>K0LISTFILE>K0ALLGEO>K0GREATGEO>K0COMMAND
24D6 #SEG LISTPREP
24XQ 8HLISTPREP
25CB ... SETENTRY LISTPREP,POINT,4
26BL [
26W= [THIS SEGMENT IS ENTERED FROM LISTINIT.IT SETS UP THE SHORT GOUT INFO
27*W [BLOCKS.IT OUTPUTS THE 'PLEASE LINE UP MESSAGE' FOR SPEC STATIONERY
27TG [
28*6 [***********************************************************************
28SQ [DATA AREA
29#B TLP2 +2 [FILE TYPE FOR LP
29S2 TLP [COMPARISON WORD FOR LP
2=?L PRINT +1
2=R= SETUPBIT #10000000
2?=W [TABLE OF LP WIDTHS
2?QG PP96 #2000000
2#=6 PP120 #5000000
2#PQ PP132 #6400000
2*9B PP160 #12000000
2*9H ...[
2*9N ...[
2*9T ...[***********************************************************************
2*=2 ...[
2*=7 ...[ SUBROUTINE AREA
2*=# ...[
2*=F ...[***********************************************************************
2*=L ...[
2*=R ...#SKI ANIP
2*=Y ...(
2*?5 ...[
2*?= ...[
2*?C ...SCHKBREAK
2*?J ...[
2*?P ...[***********************************************************************
2*?W ...[
2*#3 ...[ TO CHECK FOR THE BREAKIN BIT BEING SET
2*#8 ...[ IF SET THEN WAKE CPAT FOR JOB IF WAITING
2*#* ...[ ON RETURN CHECK WHETHER NIPREL MACRO IS FORCING CLOSEDOWN
2*#G ...[
2*#M ...[ CALLED ON X7
2*#S ...[
2*#^ ...[ EXPECTS X2 = FX2
2**6 ...[
2**? ... SBX 7 FX1
2**D ...SCHK2 LFBBS B,2,SBSET [J IF BREAKIN
2**K ... ADX 7 FX1
2**Q ... EXIT 7 0
2**X ...[
2*B4 ...SBSET LFBITCLR B,2 [CLEAR BREAKIN BIT
2*B9 ... LONGON1 ANIPBRK,JOBNO(2) [WAKE WAITING CPAT
2*BB ... COOR1 [WAIT FOR NEXT MACRO
2*BH ...[
2*BN ... LFBBUS R,2,SCHK2 [NIPREL NOT FORCING CLOSEDOWN
2*BT ...[ ENTRY FROM OTHER PARTS OF SEGMENT
2*C2 ...SRSET LFBITCLR R,2 [ILLEGAL USE OF BIT R - CLEAR IT
2*C7 ... FINDLINK 3 [FIND LISTLOOP OR LISTINIT DATA
2*C# ... LDX 5 ACC5(3)
2*CF ... BZE 5 SHEAD [OUTPUTTING HEADINGS
2*CL ... SBN 5 1
2*CR ... BZE 5 STERM [OUTPUTTING TERMINATORS
2*CY ... SBN 5 1
2*D5 ... BNZ 5 SLOOP [DURING LISTLOOP
2*D= ...[ LISTINIT HAD BEEN ENTERED BY A DOWN - FREE THE LINK
2*DC ...STRM FREELINK
2*DJ ...[
2*DP ...SLOOP
2*DW ...SHEAD FREELINK [FREE LINK FROM LISTLOOP/LISTINIT
2*F3 ...[ TIDY UP
2*F8 ... VFREEW ADATA,CREADL
2*F* ... VFREEW FILE,ENT
2*FG ... VFREEW GOUT,INFOLIST
2*FM ... VFREEW GOUT,INFOLIST [SETUP FILE
2*FS ... VFREEW GOUT,INFOSET
2*F^ ... VFREEW GOUT,GLINES
2*G6 ... LFEND CD [STOP LISTFILE
2*G? ...[
2*GD ...STERM LDX 0 AWORK1(3)
2*GK ... SBN 0 1
2*GQ ... BZE 0 SLOOP [ERROR IN FROM/TO
2*GX ... BRN STRM [OUTPUTTING TERMINATORS
2*H4 ...[
2*H9 ...[
2*HB ...[**********************************************************************
2*HH ...[
2*HN ...[
2*HT ...SPASSLINES
2*J2 ...[
2*J7 ...[
2*J# ...[**********************************************************************
2*JF ...[
2*JL ...[ SUBROUTINE TO PASS ACROSS GOUT/GLINES BLOCK AND/OR SET REPLY IN CPAT
2*JR ...[ CALLED ON X7
2*JY ...[ X6 - REPLY FOR CPAT
2*K5 ...[
2*K= ... SBX 7 FX1
2*KC ... JOBLOCK JOBNO(2),3
2*KJ ... BNG 3 (GEOERR) [IF BREAKIN BIT CLEAR MUST EXIST
2*KP ... FCAJO 3
2*KW ... BNG 3 (GEOERR) [IF BREAKIN BIT CLEAR MUST EXIST
2*L3 ... HUNTW 1,GOUT,GLINES
2*L8 ... BNG 1 SPASS
2*L* ... LDN 0 GFIRSTL
2*LG ... STO 0 GNEXTL(1) [FINISH INITIALISING BLOCK
2*LM ... CHAIN 1,3 [CHAIN GLINES AFER CPAT
2*LS ...SPASS STO 6 EXEC3(3) [SET REPLY IN CPAT
2*L^ ... LONGON1 AWAITNIP,JOBNO(2) [WAKE UP CPAT
2*M6 ... COOR1 [WAIT FOR NEXT MACRO
2*M? ...[
2*MD ... ADX 7 FX1
2*MK ... EXIT 7 0
2*MQ ...[
2*MX ...[
2*N4 ...)
2*N9 ...[
2*P2 [***********************************************************************
2B8L [MAIN BODY OF SEGMENT
2BN= [***********************************************************************
2BRB ...[
2BWG ...[
2B^L ...[ ENTRY POINT FROM LISTINIT
2C4Q ...[
2C7W POINT1
2CMG LFBITCLR I,2 [LINE-UP MESSAGE SWITCH
2D76 LDN 6 0 [SWITCH FOR FIRST TIME ROUND
2DLQ ... MHUNTW 3,GOUT,INFO
2F6B LDCH 7 GOPTY(3) [GET PERIPHERAL TYPE
2FL2 SRL 7 1
2G5L STOZ AWORK4(2)
2GK= LDX 0 SETUPBIT(1)
2H4W ANDX 0 GMODE(3)
2HJG BZE 0 NSETP
2J46 LDX 0 GSIGN
2JHQ ORS 0 AWORK4(2)
2K3B NSETP LDX 5 GMODE(3)
2KH2 BNG 5 XBUFFER [J IF ONLINE
2L2L NOFAB
2LG= ... MHUNTW 2,GOUT,INFO
2L^W LDN 5 1 [INITIAL VALUE FOR SETUPCORE
2MFG LDCT 4 2
2M^6 ANDX 4 GMODE(2)
2NDQ BZE 4 NOPAGE [J NOT PAGE RESTART
2NG^ ...#SKI ANIP
2NK8 ...(
2NMC ... SMO FX2
2NPL ... LDX 0 CPPTR
2NRT ... BZE 0 NOPAGE [J IF NIP-NO PAGE RESTART
2NW4 ...)
2NYB SMO FX2
2PD2 ANDX 5 AWORK4
2PXL BNZ 5 NOPAGE [J IF FOR SETUP FILE
2QC= LDX 5 IPAGE [LOAD INSTALLATION PARAMETER
2QWW NOPAGE
2RBG ADN 5 GREST-GNUM
2RW6 ... SETUPCORE 5,3,GOUT,INFOLIST [SET UP SHORT INFORMATION BLOCK
2S*Q SBN 5 GREST-GNUM+1
2STB STO 5 GLEN(3) [STORE IPAGE-1
2T*2 STOZ GNEXT(3) [ZEROISE GOUT FROM GNEXT
2TSL STOZ GREST(3)
2W#= BZE 5 NOIP
2WRW LDN 4 GREST(3)
2X?G LDN 5 GREST+1(3)
2XR6 SMO GLEN(3)
2Y=Q MOVE 4 0
2YQB ...NOIP MHUNTW 2,GOUT,INFO
2^=2 LDN 5 1
2^PL SMO FX2
329= ANDX 5 AWORK4
32NW BZE 5 MAINGOUT [J NOT SETUP GOUT REQD.
338G STOZ GNUM(3)
33N6 STOZ GREST(3)
347Q STOZ GQUAL(3)
34MB LDX 5 GSIGN
3572 STO 5 GLNO(3)
35LL BRN SETUPGOUT
366= MAINGOUT
36KW LDX 4 GFLI(2) [COPY START LINE NO.
375G STO 4 GREST(3)
37K6 STO 4 GNUM(3)
384Q LDX 4 GNLI(2) [LOAD NO OF LINES FOR O/P AND J
38JB BNZ 4 STORE [NOT TO END OF FILE
3942 LDCT 4 256 [SET END OF FILE MARKER
39HL STORE STO 4 GLNO(3) [STORE IN REMAINING LINES WORD
3=3= LDCT 4 3 [LOAD AND STORE RESTART TYPE MARKER
3=GW ANDX 4 GMODE(2)
3=JD ...#SKI ANIP
3=L2 ...(
3=MJ ... SMO FX2
3=P6 ... LDX 0 CPPTR
3=QN ... BNZ 0 STORT
3=S= ...[ ONLY ALL RESTART ON NIP
3=TS ... LDCT 4 1
3=XB ...STORT
3=YY ...)
3?2G SLL 4 7
3?G6 ORS 4 GREST(3)
3?^Q STOZ GQUAL(3)
3#FB BZE 7 SEGOUT [J IF TAPE PUNCH
3#^2 TXU 7 PRINT(1) [J IF CARDS
3*DL BCS TCAR
3*Y= LDX 4 GMFMSK(2)
3BCW STO 4 GCATBITS(3)
3BXG LDN 0 10 [INITIALISE PAGE LINE COUNT
3CC6 [!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3CWQ [SPECIAL DEBATCHERS FACILITY
3DBB [S71831Q
3DNR ... SEGENTRY K50LISTPREP
3F38 ... BRN SNODEBS
3F*L ADN 0 8 [ALLOW FOR DEBATCHERS
3FT= SEGENTRY K60LISTPREP
3G#W SNODEBS
3GSG [!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3H#6 STO 0 GPREM(3)
3HRQ SEGOUT
3J?B LDX 4 GMODE(2) [UNPACK AND STORE SEQUENCING AND
3JR2 ANDN 4 7 [MONFILE AND SPECIAL LISTING BITS
3K=L ORS 4 GQUAL(3)
3KBT [ IF A CORRUPT BLK WAS DETECTED WHILST DOING
3KD= [ A CONTEXT SEARCH IN LISTOPEN ..B 11 IN GMODE WILL BE SET
3KFM [ IF SO WE MUST TRANSFER THIS FLAG INTO GQUAL AND CHK.
3KH4 [ FOR IT IN LISTLOOP AND LISTTPCP
3KJF LDBIT 11,0
3KKW ANDX 0 GMODE(2)
3KM? ORS 0 GQUAL(3) [SET B11 IF SET IN GMODE
3KQ= SETUPGOUT
3L9W LDN 4 #17
3LPG SMO FX2
3M96 LDX 5 AWORK4
3MNQ ANDN 5 1
3N8B BZE 5 NSE1
3NN2 SLL 4 4
3P7L NSE1 ANDX 4 GFTY(2)
3PM= BZE 5 NSE2
3Q6W SRL 4 4
3QLG NSE2 SLL 4 5
3R66 ORS 4 GQUAL(3)
3RKQ TXU 7 PRINT(1)
3S5B BCS XBUFFER
3SK2 SMO FX2
3T4L LDX 0 CPPTR
3T9S ...#SKI ANIP
3TC2 ... BZE 0 XBUFFER [J IF NIP
3TJ= LPROP 0,4
3W3W LDN 5 #140
3WHG ANDX 5 4
3X36 SBN 5 #140
3XGQ BZE 5 P1933 [J IF BUFFERED PRINTER
3YG2 LDN 5 #20
3Y^L ORS 5 GQUAL(3)
3^F= P1933
3^YW [
42DG SRC 4 5
42Y6 BNG 4 TO160 [J IF 160 PRINT POSITION
43CQ SLC 4 3
43XB BNG 4 TO132 [J IF 132PP
44C2 SRC 4 2
44WL BNG 4 TO120 [J IF 120PP
45B= LDX 5 PP96(1)
45TW BRN SETPW
46*G TO120
46T6 LDX 5 PP120(1)
47#Q BRN SETPW
47SB TO132
48#2 LDX 5 PP132(1)
48RL BRN SETPW
49?= TO160
49QW LDX 5 PP160(1)
4==G SETPW
4=Q6 #SKI ATPOLTR
4?9Q TRACEVER 5,PREPWID
4?PB ORS 5 GQUAL(3)
4#92 XBUFFER
4#NL SMO FX2
4*8= LDX 4 AWORK4
4*MW BPZ 4 NOTSE [J NOT SETUP
4B7G LDN 5 1
4BM6 ANDX 4 5
4C6Q BNZ 4 TWICE [J TWICE MARKER SET FOR GOUT
4CLB SMO FX2
4D62 ADS 5 AWORK4
4DKL BRN NOFAB [J IF 2ND GOUT REQD
4F5= TWICE SMO FX2
4FJW SBS 5 AWORK4
4G4G NOTSE
4GJ6 LDX 5 GMODE(2)
4HHB BRN PLOOP1
4J32 [
4JGL [ THIS ENTRY POINT IS USED AFTER A TESTPATTERN FILE HAS BEEN LISTED
4K2= [
4KFW [
4K^G [***********************************************************************
4LF6 POINT2
4LYQ LDN 7 1 [LP KEY
4NCL LDX 0 AWORK1(2)
4NX= ANDN 0 #1000
4PBW BZE 0 PLOOP1 [J IF NOT EXTENDED ACTLF
4PWG ALTLEND FX2,100 [ELSE REDUCE ACTLF LENGTH
4QB6 LDN 0 0
4QTQ DCA ,DEX,0,MODE [AND ZEROISE MODE
4RT2 PLOOP1
4S#L LDX 2 FX2
4SS= LDX 4 AWORK4(2)
4T?W BZE 4 PLOOP [J IF NOT SETUP
4TRG BZE 6 PLOOP [J FIRST TIME THROUGH
4W?6 XISBY JUNBUSY ,NOTBUSY
4WQQ BRN XISBY
4X=B NOTBUSY
4XQ2 DISENGPER
4Y9L LFBBS I,2,NOINITMSG [J IF MESSAGE ALREADY OUTPUT
4YP= LFBITSET I,2
4^8W OUTPER
4^NG ENGPER TERM,,XOUT,2 [PLEASE LINE UP
5286 NOINITMSG
52MQ ENGPER TERM,,XOUT,3
537B PLOOP
53M2 TXU 7 PRINT(1)
546L BCS NOTLP
54L= ACROSS LISTLOOP,1
555W NOTLP ACROSS LISTTPCP,1
55KG ...XOUT HUNTW 1,GOUT,INFOLIST
5656 BNG 1 XOUT1
56JQ FREECORE 1
574B BRN XOUT
57J2 XOUT1 LFEND CD
583L [
58H= [***********************************************************************
592W POINT3
59GG [THIS IS THE ENTRY POINT FROM LISTLOOP WHEN SET_P IS TERMINATED
5=26 TERM LPSET
5=FQ LDX 0 AWORK2(2)
5=^B BNG 0 OLEND
5?F2 LDX 0 GSIGN
5?YL ERS 0 AWORK4(2)
5#D= FILEMOVE 1,0
5#XW ... MHUNTW 1,GOUT,INFOLIST
5*CG ... NAME 1,GOUT,INFOSET
5*X6 ACROSS LISTLOOP,1
5BBQ TERM2 LPUNSET
5BWB OLEND LFEND
5CB2 [
5CTL [
5D*= [FOR PAPER TAPE OUTPUT
5DSW [
5F#G [FOR CARD PUNCH OUTPUT
5FS6 [
5G?Q TCAR LDN 4 2 [TEST FOR CARD SEQUENCING
5GRB ANDX 4 GMODE(2)
5H?2 BZE 4 NONUM [J NONE
5HQL LDCT 4 256 [SET SEQUENCING MARKER
5J== ORS 4 GQUAL(3)
5JPW NONUM
5K9G LDN 4 #20 [SHOW SPACE FILLING MAY BE REQUIRED
5KP6 ORS 4 GQUAL(3)
5L8Q BRN SEGOUT
5L8X ...[
5L94 ...[
5L99 ...[***********************************************************************
5L9B ...[
5L9H ...POINT4
5L9N ...[
5L9T ...[***********************************************************************
5L=2 ...
5L=7 ...[
5L=# ...[ ENTRY POINT FROM LISTINIT OR LISTLOOP TO DO A 'PERI' FOR NIP
5L=F ...[ THIS INVOLVES MOVING THE LINE FOR OUTPUT INTO A GOUT GLINES BLOCK
5L=L ...[ AND WHEN THE BLOCK IS FULL (SEVERAL PERIS) PASSING IT TO THE
5L=R ...[ WAITING CPAT AND WAKING UP THE CPAT
5L=Y ...[ CHECKING FOR BREAKIN AND FINISH NOW IS NECESSARY
5L?5 ...[ ON ENTRY GZDUMP IN THE ACTIVITY BLOCK MAY HAVE THESE VALUES:
5L?= ...[ +VE - A LINE OF DATA IS BEING PASSED
5L?C ...[ ZERO- END OF LISING IS TO BE PASSED
5L?J ...[ -VE - THE FILE IS CORRUPT,THE CURRENT GLINES BLOCK
5L?P ...[ IS TO BE PASSED AND THEN A CORRUPT REPLY
5L?W ...[
5L#3 ...[
5L#8 ... LDX 0 GZDUMP(2)
5L#* ...#SKI ANIP
5L#G ...(
5L#M ... BPZ 0 XHNT [NORMAL ENTRY OR END OF LISTING
5L#S ...[ CORRUPT OR CHANGED REPLY - IS THERE A GLINES BLOCK TO PASS
5L#^ ... HUNTW 3,GOUT,GLINES
5L*6 ... BPZ 3 XNORM
5L*? ... BRN XBRK [NO BLOCK - GO TO SET REPLY
5L*D ...[
5L*K ...XHNT HUNTW 3,GOUT,GLINES
5L*Q ... BPZ 3 XIST
5L*X ...[ NO BLOCK EXISTS - CREATE ONE
5LB4 ... SETNCORE 512,3,GOUT,GLINES
5LB9 ... STOZ GTOTLIN(3)
5LBB ... STOZ GUSELIN(3)
5LBH ... LDN 0 GFIRSTL
5LBN ... STO 0 GNEXTL(3)
5LBT ...[ BLOCK SET UP AND INITIALISED
5LC2 ...XIST LDX 0 GZDUMP(2)
5LC7 ... BZE 0 ZERO [ONLY ONE WORD NEEDED
5LC# ... ADN 0 2
5LCF ... SRL 0 2 [GET WORDS NEEDED
5LCL ... ADN 0 1 [ADD FOR PFCC
5LCR ... LDX 4 0
5LCY ...ZERO ADN 0 1 [ADD FOR CHAR COUNT WORD
5LD5 ... ADX 0 GNEXTL(3) [WORDS USED SO FAR
5LD= ... SBN 0 A1 [LOGICAL LENGTH
5LDC ... SBN 0 513
5LDJ ... BPZ 0 XNORM [NO ROOM
5LDP ... LDX 5 GZDUMP(2)
5LDW ... SMO GNEXTL(3)
5LF3 ... STO 5 0(3) [STORE CHAR COUNT
5LF8 ... LDN 0 1
5LF* ... ADS 0 GTOTLIN(3)
5LFG ... BZE 5 XENDL [END OF LISTING
5LFM ... LDN 6 GZDATA(2)
5LFS ... SMO GNEXTL(3)
5LF^ ... LDN 7 1(3)
5LG6 ... SMO 4
5LG? ... MOVE 6 0 [MOVE IN LINE
5LGD ... ADN 4 1
5LGK ... ADS 4 GNEXTL(3)
5LGQ ... UP
5LGX ...[
5LH4 ...[ END OF LISTING
5LH9 ...XENDL CALL 7 SCHKBREAK
5LHB ... LFBITSET R,2
5LHH ... KEEPREP 6,OK
5LHN ... CALL 7 SPASSLINES
5LHT ...[
5LJ2 ...[ NIPREL WILL FORCE CANTDO IN THIS CASE BY CLEARING FLAG R
5LJ7 ... LFBBUS R,2,SRSET
5LJ# ... UP
5LJF ...[
5LJL ...[ NO ROOM IN GLINES BLOCK -PASS IT TO CPAT
5LJR ...XNORM CALL 7 SCHKBREAK
5LJY ... KEEPREP 6,OK
5LK5 ... LDX 0 FINISH
5LK= ... SLL 0 2
5LKC ... BPZ 0 XNFIN
5LKJ ...[ FINISH NOW - WARN PROGRAM
5LKP ... KEEPREP 6,STOP
5LKW ...XNFIN CALL 7 SPASSLINES
5LL3 ... LFBBS R,2,SRSET [NIPREL FORCING CLOSEDOWN
5LL8 ... LDX 0 GZDUMP(2)
5LL* ... BPZ 0 XHNT
5LLG ...[ CORRUPT OR CHANGED REPLY
5LLM ...XBRK CALL 7 SCHKBREAK
5LLS ... LDX 6 GZDUMP(2)
5LL^ ... ERX 6 GSIGN
5LM6 ... CALL 7 SPASSLINES [PASS REPLY TO CPAT
5LM? ... LFBBS R,2,SRSET [NIPREL FORCING CLOSEDOWN
5LMD ... UP
5LMK ...[
5LMQ ...[
5LMX ...)
5LNB #END
^^^^ ...56510163000200000000