(George Source)
Macros used: ACROSS, DCA, DOWN, FLENME, FREECORE, MENDAREA, MHUNTW, SEGENTRY, SETUPCORE, TAB, TRACE
22FL #OPT K0LISTHEAD=0 22^= #LIS K0LISTHEAD>K0LISTFILE>K0ALLGEO>K0GREATGEO>K0COMMAND 23DW #SEG LISTHEAD7 [BOB SEWELL 23YG 8HLISTHEAD 24D6 SEGENTRY K1LISTHEAD,POINT1 24XQ MENDAREA 40,K95LISTHEAD 25CB [THIS SEGMENT CONTAINS THE ROUTINES FOR PRINTING 25X2 [OUT LEGIBLE HEADINGS ON PAPER TAPE 26BL [ 26W= [*********************************************************************** 27*W [DATA AREA 27TG OCTAL #40404040 28*6 PHEAD 10H FROM JOB 28SQ STOP #36202020 29#B TAB #7566161,#56404040 [0 29S2 #4774040,#40404040 [1 2=?L #7536165,#51404040 [2 2=R= #7526165,#56404040 [3 2?=W #10465262,#47424040 [4 2?QG #7727161,#66404040 [5 2#=6 #7566565,#42404040 [6 2#PQ #7606164,#70404040 [7 2*9B #7526565,#52404040 [8 2*P2 #7516565,#56404040 [9 2B8L #4454040,#40404040 [: 2BN= #5414640,#40404040 [; 2C7W #6445261,#40404040 [< 2CMG #7464646,#46404040 [= 2D76 #6615244,#40404040 [> 2DLQ #7506364,#50404040 [? 2F6B #10404040,#40404040 [SPACE 2FL2 #4754040,#40404040 [! 2G5L #5707040,#40404040 [" 2GK= #10527752,#77524040 [# 2H4W #7455765,#61404040 [£ 2HJG #11416244,#40516040 [% 2J46 #7536552,#45404040 [& 2JHQ #4704040,#40404040 [APOSTROPHE 2K3B #5566140,#40404040 [( 2KH2 #5615640,#40404040 [) 2L2L #6474747,#40404040 [* 2LG= #10444457,#44444040 [+ 2L^W #5414240,#40404040 [, 2MFG #7444444,#44404040 [- 2M^6 #4414040,#40404040 [. 2NDQ #11414244,#40506040 [/ 2NYB #11506265,#67615640 [@ 2PD2 #10576464,#64574040 [A 2PXL #11776565,#65554240 [B 2QC= #10566161,#61614040 [C 2QWW #10776161,#61564040 [D 2RBG #7776565,#61404040 [E 2RW6 #7776464,#60404040 [F 2S*Q #11566161,#63634240 [G 2STB #10774444,#44774040 [H 2T*2 #6617761,#40404040 [I 2TSL #11426161,#76606040 [J 2W#= #7774452,#61404040 [K 2WRW #7774141,#41404040 [L 2X?G #10775044,#50774040 [M 2XR6 #10775044,#42774040 [N 2Y=Q #10566565,#65564040 [O 2YQB #7776464,#50404040 [P 2^=2 #11566161,#65564140 [Q 2^PL #10776464,#52414040 [R 329= #10425165,#65424040 [S 32NW #10606077,#60604040 [T 338G #10764141,#41764040 [U 33N6 #10704441,#44704040 [V 347Q #10774244,#42774040 [W 34MB #11615244,#44526140 [X 3572 #10605047,#50604040 [Y 35LL #11416365,#61716140 [Z 366= #6776161,#40404040 [[ 36KW #10425177,#65424040 [$ 375G #6616177,#40404040 [] 37K6 #6507750,#40404040 [^ 384Q #10424742,#42424040 [_ 38JB [ 3942 [*********************************************************************** 39HL [MAIN BODY OF SEGMENT 3=3= [*********************************************************************** 3=GW POINT1 3?2G DOWN LISTINTC,7 [THIS PRINT5 OUT 30 INCHES OF 3?G6 [RUNOUT TO PAPER TAPE 3?^Q TRACE 4,LHRUNOUT 3#FB LDN 7 GZDATA(2) [X7-> BUFFER 3#^2 ... MHUNTW 2,GOUT,INFO [THIS PUT USER NAME.JOB NAME,SPACES 3*DL LDX 3 GMODE(2) [OBTAIN GMODE 3*GT #UNSET JSKI38 3*K4 ( 3*M? [ CODE FOR GLASGOW SPECIALS!! 3*PG SLL 3 9 3*RP BNG 3 SBIN 3*TY ) 3*Y= FLENME GUSER,GJOBN 3BCW LDX 4 3 3BXG LDX 2 FX2 3CC6 LDX 3 GZDATA(2) 3CWQ BNG 4 ONL [J IF ONLINE 3DBB MHUNTW 1,ADATA,CREADL [TO GET FILENAME LENGTH 3DW2 LDEX 6 A1+FRH(1) [=NO.OF CHARS. IN ADATA/CREADL 3F*L LDX 5 6 3FT= ADX 5 3 [FOR USERNAME.JOBNAME CHARACTERS 3G#W SBN 5 12-10 [AS 12 CHARS. TOO MANY IN 3GSG [ADATA/CREADL AND ACCOUN FOR 3H#6 ['FROM JOB' 3HRQ STO 5 AWORK3(2) [TOTAL CHAR.COUNT 3J?B ADN 5 4+3 [ARGNO+EXTRA FOR CONVERSION TO FIND 3JR2 [MINIMUM NUMBER OF WORDS NEEDED 3K=L SRL 5 2 [X5 CONTAINS LEAST NO. OF WORDS 3KQ= [ 3L9W [WE SET UP A GOUT INFO BLOCK TO HOLD'FILENAME FROM JOB' 3LPG [USER NAME.JOBNAME 3M96 [ 3MNQ SETUPCORE 5,3,GOUT,INFO5 [TO HOLD REQUIRED NO OF CHARS. 3N8B CALL 4 SETUP 3NN2 LDN 5 A1(3) [AWORK1 CONTAINS ADDRESS OF CHAR. 3P7L STO 5 AWORK1(2) [WE ARE POINTING TO IN GOUT INFO5 3PM= LDX 2 6 3Q6W SBN 2 12 [X2 CONTAINS NO.OF CHARS.IN FILENAME 3QLG MHUNTW 1,ADATA,CREADL [AS LOST DURING SETUPCORE 3R66 LDN 4 CPDATA+3(1) 3RKQ MVCH 4 0(2) [PUTS FILENAME AT START OF GOUT.INFO5 3S5B LDX 2 FX2 3SK2 NONL LDX 1 FX1 3T4L LDN 4 PHEAD(1) [PICK UP 'FROM JOB ' 3TJ= MVCH 4 10 [PUT IN GOUT INFO5 3W3W ADN 2 GZDATA 3WHG LDX 3 0(2) [X3 CONTAINS CHAR.COUNT FOR U.NAME. 3X36 [JOB NAME 3XGQ ADN 2 1 3Y2B LDX 4 2 [X4 IS ADDRESS A5+1(2) 3YG2 MVCH 4 0(3) [PUT U.NAME,J.NAME IN GOUT INFO5 3Y^L SBN 2 GZDATA+1 3^F= [ 3^YW [WE CONVERT THE'GOUT INFO5'CHARACTERS INTO LEGIBLE HEADINGS 42DG [FORMAT AND PUT THEM INTO THE ACTLF BUFFER WHEN THIS IS FULL OR WE 42Y6 [HAVE CONVERTED ALL THE CHARACTERS,GO DOWN TO LISTINIT,4 IN ORDER 43CQ [TO PRINT THEM OUT 43XB [ 4478 STOZ 7 [TO ENSURE B6 IS ZERO 44C2 PHE LDX 4 AWORK1(2) 44WL LDX 6 4 [IN CASE WE HAVE TO J TO NACTLF 45B= LDN 5 7 45TW MVCH 4 1 [X5 CONTAINS FIRST CHAR. 46*G STO 4 AWORK1(2) 46T6 SRL 7 17 [FOR ADRESSING TAB 47#Q ADX 1 7 [MODIFY X1 FOR ADDRESSING RIGHT PLACE 47SB LDX 4 TAB(1) 48#2 LDX 5 TAB+1(1) 48RL SBX 1 7 [RESET X1 TO PT.TO FX1 49?= LDN 7 4 49QW LDN 0 3 4==G MVCH 7 1 4=Q6 SRL 3 18 4?9Q LDX 0 ACOMMUNE2(2) [PICK UP QTY. OF ACTLF BUFFER LEFT 4?PB SBX 0 3 [IS IT TOO FULL FOR ANY MORE 4#92 BNG 0 NACTLF [J IF IT IS 4#NL STO 0 ACOMMUNE2(2) [STORE NEW VALUE 4*8= LDX 6 OCTAL(1) [FOLLOW CHAR. REP BY #40404040 4*MW LDX 0 ACOMMUNE1(2) [MOVE REPRESENTATION 4B7G MVCH 7 0(3) [INTO ACTLF BUFFER 4BM6 STO 0 ACOMMUNE1(2) [STORE NEW VALUE 4C6Q LDX 0 AWORK3(2) 4CLB SBN 0 1 [SUBTRACT ONE FROM CHAR.COUNT FOR 4D62 STO 0 AWORK3(2) [CONVERSION-STORE NEW COUNT 4DKL BNZ 0 PHE [J BACK IF MORE CHARS. TO CONVERT 4F5= CALL 6 PERI 4FJW MHUNTW 2,GOUT,INFO5 4G4G FREECORE 2 4GJ6 ACROSS LISTINTC,1 4H3Q NACTLF 4HHB MHUNTW 3,GOUT,INFO5 [REMEMBER WE ARE CO-ORDINATING 4J32 SBX 6 3 [BLOCKS MIGHT BE MOVED 4JGL STO 6 AWORK1(2) 4K2= CALL 6 PERI 4KFW MHUNTW 3,GOUT,INFO5 [RESET AWORK1 TO POINT TO NEXT CHAR. 4K^G ADS 3 AWORK1(2) [TO BE PROCESSED 4LF6 CALL 4 SETUP 4LYQ BRN PHE 4MDB PERI SBX 6 FX1 4MY2 LDN 5 8 4NCL DCA ,DSA,5,MODE 4NX= LDX 4 ACOMMUNE2(2) 4PBW LDN 5 128 4PWG SBX 5 4 4QB6 DCA ,STO,5,COUNT 4QTQ LDN 3 2 [ERROR SWITCH FOR LISTINIT 4R*B LDN 7 0 [SET X7=0 FOR PAPER TAPE 4RT2 TRACE 5,LHPRINT 4S#L DOWN LISTINTC,4 4SS= ADX 6 FX1 [RESET X6.VALUE WAS SAVED DURING DOWN 4T?W [TO LISTINIT,4 4TRG EXIT 6 0 4W?6 [ 4WQQ [THIS CATERS FOR THE ONLINE CASE WHERE WE PRINT OUT THE 4X=B [DOCUMENT NAME INSTEAD OF THE FILENAME 4XQ2 [ 4Y9L ...ONL MHUNTW 1,GOUT,INFO 4YP= LDX 6 GSUSE(1) [CHAR.COUNT FOR DOC.NAME 4^8W LDX 7 6 4^NG ADN 7 10 [FOR 'FROM JOB' 5286 ADX 7 3 [FOR USENAME.JOBNAME CHARACTERS 52MQ STO 7 AWORK3(2) [SAVE TOTAL CHAR. COUNT 537B ADN 7 7 [ARGNO+MIN WORDS NEED CT. 53M2 SRL 7 2 [NO.OF WORDS TO HOLD THESE CHARS. 546L SETUPCORE 7,3,GOUT,INFO5 54L= CALL 4 SETUP 555W ... MHUNTW 1,GOUT,INFO [AS LOST DURING SETUPCORE 55KG LDN 4 GHEAD(1) 5656 LDN 5 A1(3) 56JQ STO 5 AWORK1(2) 574B SMO 6 57J2 MVCH 4 0 [PUT DOC.NAME IN GOUT.INFO5 583L BRN NONL 58H= SETUP LDN 0 GZDATA+1(2) [WE WILL KEEP ADDRESS OF PART OF 592W STO 0 ACOMMUNE1(2) [ACTLF WE ARE ADDRESSING IN ACOMMUNE1 59GG LDN 0 128 [ACOMMUNE2 CONTAINS NO OF P.T. 5=26 STO 0 ACOMMUNE2(2) [CHARS.WE CAN PUT IN ACTLF BUFFER 5=FQ EXIT 4 0 5=LY #UNSET JSKI38 5=S6 SBIN ACROSS LISTPREP,1 5=^B #END ^^^^ ...42113173000100000000