(George Source)
Macros used: ACROSS, ALTLEND, CHAIN, COOR1, DCA, DISENGPER, ENGPER, FCAJO, FILEMOVE, FINDLINK, FREECORE, FREELINK, HUNTW, JOBLOCK, JUNBUSY, KEEPREP, LDBIT, LFBBS, LFBBUS, LFBITCLR, LFBITSET, LFEND, LONGON1, LPROP, LPSET, LPUNSET, MHUNTW, NAME, NOTBUSY, OUTPER, SEGENTRY, SETENTRY, SETNCORE, SETUPCORE, TRACEVER, UP, 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