(George Source)
Macros used: ACROSS, COOR1, DATECON, DCA, DISENGPER, DOWN, ENGPER, ENRING, FLENME, FREECORE, FREELINK, FSHACTPR, FSHCODE, FSHENTRY, GPERI, HUNT, HUNTW, INFORM, JBS, LADDP, LFBBS, LFBITSET, LFEND, LOCKC, LTYPE, MHUNT, MHUNTW, ON, OUTPACK, OUTPARAM, OUTPARN, OUTPER, OUTPERA, POINTACT, RESTART, RIGHT, SEGENTRY, SETENTRY, SETNCORE, SETWTBWR, STEP, TESTCODE, TIMECON, TRACE, TRANSBEG, UNLOCK, UP
22FL #OPT K0LISTINTC=0 22^= #LIS K0LISTINTC>K0LISTFILE>K0ALLGEO>K0GREATGEO>K0COMMAND 23DW ...#SEG LISTINTC 23YG 8HLISTINTC 24D6 [ HERE ARE A LIST OF ENTRY POINTS AND BRANCHES 24XQ ... SETENTRY LISTINTC,POINT,8 25CB ... FSHENTRY K20LISTINTC,POINT20,,POINT20 25X2 [ 26BL [THIS SEGMENT CONTAINS THE ROUTINES FOR GETTING THE FILE AND OUTPUT 26W= [PERIPHERAL READY FOR LISTTPCP(CARD PUNCH AND TAPE PUNCH) 27*W [*********************************************************************** 27TG [DATA AREA 28*6 [HEADINGS USED BY LISTFILE 28SQ [ 29#B SMLP +7036875 29S2 THEAD 2=?L 12HPRODUCED ON 2=R= 12H AT 2?=W SHEAD 2?QG 4H#OUT 2#=6 SEGENTRY K40LISTINTC 2#PQ 24HPUT BY LISTFILE IN ': 2*9B ONAT 16H' ON AT 2*P2 SDOC 12HDOCUMENT 2B*R RCON 16H#CONTINUATION OF 2BCG RFOL 28H FOLLOWING RESTART ACTION OF 2BF9 RPAGE 8H 'ALL' 2BGY 8H 'PAGE' 2BLB UNLFON 8H USING 2CMG [ 2D76 [HEADING FOR ONLINE OBJECT PROGRAM PERIPHERAL 2DLQ [ 2F6B OHEAD 2FL2 4H#OUT 2G5L 24HPUT ON-LINE BY JOB ': 2GK= N31 #60000001 2H4W PRINT +1 2H?H RESTARTBIT #4000 [RESTART TAKING PLACE 2H*Q RESTACTN #300000 [RESTART ACTION SPECIFIED 2HC^ #200000 [PAGES 2HJG [ 2J46 [TABLE OF JUMPS FOR PERI SUBROUTINE 2JHQ [ 2K3B STABLE 2KH2 BRN YAB [INTERUPT DURING HEADINGS 2L2L BRN SBRK2 [INTERUPT DURING TERMINATORS 2LG= BRN YABANL [INTERUPT OTHERWISE 2L^W [*********************************************************************** 2MFG [SUBROUTINE AREA 2M^6 [THIS ROUTINE SETS UP THE CONTROL AREA DETAILS AS NECESSARY 2NDQ [ 2NYB SETCA LDN 4 0 [SET MODE FOR TRANSFER 2PD2 DCA ,DSA,4,MODE 2PXL LDN 4 1 [SET B A MODIFIER FOR CP AND TP 2QC= TLPN DCA ,STO,4,CTSA 2QWW EXIT 0 0 2RBG [ 2RW6 [THIS ROUTINE PUNCHES THREE BLANKS ON A PAPER TAPE 2S*Q [ 2STB RUNOUT 2T*2 LDN 4 3 2TSL RUNOUTX 2W#= SBX 6 FX1 2WRW DCA ,STO,4,COUNT 2X?G LDN 4 #20 2XR6 DCA ,DSA,4,MODE 2Y=Q CALL 5 PERI2 [DO PERI 2YQB ADX 6 FX1 [READJUST LINK 2^=2 EXIT 6 0 [EXIT 2^PL SLOCKC 329= [FOR USE BY LOCKC ROUTINE 32NW LDX 2 FX2 338G EXIT 1 0 33N6 [ 347Q [THIS ROUTINE PERFORMS THE PERI ON THE DEVICE AND CHECKS THE REPLY FOR 34MB [DISENGAGED AND INOPERABLE STATES 3572 [IN THE PERI2 ROUTINE WE MUST NOT CORRUPT X6 AS THIS IS USED 35LL [BOTH TO THE THROW SUBROUTINE FROM K1LISTINIT(WHICH IN TURN 366= [CALLS PERI2) AND IS ALSO USED BY LISTHEAD 36KW [ 375G PERI2 SBX 5 FX1 37K6 BRN SNPT 384Q PERI 38JB STO 3 EXEC1(2) [REMEMBER EXIT SWITCH 3942 SBX 5 FX1 [ADJUST LINK 39HL BNZ 7 SNPT [J NOT PAPER TAPE 3=3= DCA ,LDX,3,COUNT 3=GW SRC 3 2 [TAPE 3?2G LDN 4 #76 3?G6 ADX 2 3 3?^Q DCH 4 GZDATA+1(2) 3#FB BCHX 2 £ 3#^2 LDN 4 #32 3*DL DCH 4 GZDATA+1(2) 3*Y= LDN 4 2 [UPDATE OUTPUT CHARACTER COUNT 3BCW LDX 2 FX2 3BXG DCA ,ADS,4,COUNT 3CC6 LDX 3 EXEC1(2) [RELOAD EXIT SWITCH 3CWQ SNPT 3DBB RPTPERI 3DW2 LDX 0 FINISH 3F*L SLL 0 2 3FT= BNG 0 SFINI 3G#W ERX 0 FINISH 3GSG SLL 0 1 3H#6 BPZ 0 NFIN 3HRQ SFINI 3J?B TXU 3 PRINT(1) 3JR2 BCS SBRKIN [J IF NOT TERMINATORS 3K=L NFIN 3KQ= LOCKC FX2,SLOCKC 3L9W LDN 4 GZDATA(2) 3LPG DCA ,ADS,4,CTSA 3M96 GPERI ,2 3MNQ COOR1 3N8B DCA ,SBS,4,CTSA 3NN2 UNLOCK 2 3P7L LDCT 4 #50 3PM= ANDX 4 CPRW1(2) 3Q6W BNZ 4 NOTENG 3QLG STEP ADX 5 FX1 [READJUST LINK AND EXIT 3R66 EXIT 5 0 3RKQ NOTENG 3RPM SMO FX2 3RTJ LDX 0 AWORK1 3R^F BZE 0 TIDYPER [ J IF EB PATH 3S5B ENGPER SBRKIN,,SBRKIN 3SK2 #SKI K6LISTLOOP>199-199 3T4L TRACE 5,LENGAGE 3TJ= BRN RPTPERI 3W3W SBRKIN 3WHG LDX 4 FX1 [OBEY MODIFIED EXIT TO SWITCH TABLE 3X36 ADX 4 3 3XGQ EXIT 4 STABLE 3Y2B [ 3YG2 [THIS IS A SUBROUTINE TO OUTPUT PAPER RUN OUT PAPER THROWS OR BLANK 3Y^L [CARDS AS APPROPRIATE IT EXPECTS A5(2) ONWARDS TO HAVE TWENTY WORDS 3^F= [OF BUFFER SPACE AND THE PERIPHERAL TYPE TO BE IN CA1(2) 3^YW [ 42DG THROW 42Y6 SBX 6 FX1 [ADJUST LINK 43CQ LDN 4 80 [SET CHAR COUNT FOR CARDS 43XB PAT BNZ 7 PTNO [J IF NOT PAPER TAPE 44C2 LDN 4 #20 [SET RUN OUT MODE FOR PT 44WL DCA ,DSA,4,MODE 45B= LDN 4 128 [SET CHAR COUNT FOR PT 45TW PTNO DCA ,STO,4,COUNT 46*G PTAPE 46T6 CALL 5 PERI2 47#Q LDN 4 1 [RESET CA4-NOTE FX2 COULD HAVE BEEN 47SB DCA ,STO,4,CTSA 48#2 CALL 5 PERI2 48RL PYES ADX 6 FX1 [READJUST LINK 49?= EXIT 6 0 [EXIT 49QW [ 4==G [THIS SUBROUTINE SPACE FILLS THE BUFFER ACCORDING TO THE LOGICAL LENGTH 4=Q6 [OF THE ACTIVITY BLOCK 4?9Q [ 4?PB SPFL LDX 4 ACES 4#92 SPFL2 LDX 3 ALOGLEN(2) 4#NL SBN 3 GZDATA-A1+1 4*8= STO 4 GZDATA+1(2) 4*MW LDN 4 GZDATA+1(2) 4B7G LDN 5 GZDATA+2(2) 4BM6 MOVE 4 0(3) 4C6Q EXIT 0 0 [EXIT 4CLB [THIS ROUTINE ABANDONS AN OPERATOR TERMINATED LISTING 4D62 [ 4DKL TIDY 4F5= HUNTW 1,ADATA,CREADL 4FJW BNG 1 X1 4G4G FREECORE 1 4GJ6 X1 HUNTW 1,FILE,ENT 4H3Q BNG 1 X3 4HHB FREECORE 1 4J32 ...X3 HUNT 1,GOUT,INFOLIST 4JGL BNG 1 X4 4K2= FREECORE 1 4KFW ...X4 HUNT 1,GOUT,INFOSET 4K^G BNG 1 X5 4LF6 FREECORE 1 4LYQ X5 EXIT 3 0 4L^H ...# 4M2# ... FSHCODE B,NOPAIR 4M35 ...( 4M3W ...SFSHACTPR 4M4M ...# 4M5D ...# ON THE 'B' MACHINE, WE ARE GOING TO NEED A PAIRED ACTIVITY 4M69 ...# ON 'A' SOONER OR LATER. THIS S/R CREATES THE PAIR 4M72 ...# 4M7R ... LFBBS A,2,PAIRED [JIF ALREADY PAIRED ON 'A' 4M8J ... LFBITSET A,2 [ELSE SET THE 'PAIRED' MARKER 4M9* ... SBX 7 FX1 4M=6 ... FSHACTPR [CREATE THE PAIRED ACTIVITY 4M=X ... ADX 7 FX1 4M?N ...# 4M#F ...PAIRED 4M*= ... EXIT 7 0 4MB3 ...# 4MBS ...NOPAIR 4MCK ...) 4MDB [*********************************************************************** 4MY2 [MAIN BODY OF SEGMENT 4NCL [*********************************************************************** 4NX= POINT1 4PBW [ 4PWG [*********************************************************************** 4QB6 POINT2 4QTQ [THESE ENTRY POINTS GO TOGETHER 4R=Q ...[CONTROL FOR OUTPUT OF INITIAL BLANK TAPE OR 4RMQ ...[BLANK CARDS 4S4S STO 2 AWORK1(2) [ NOT EB PATH 4S#L ... MHUNT 1,GOUT,INFO 4SJD ... LDCH 7 GOPTY(1) 4SS= ... SBN 7 1 [ 0 -> TP 3 -> CP 4T44 ... STO 7 AWORK4(2) 4T?W CALL 0 SETCA 4T#^ #UNSET JSKI38 4TB4 ( 4TC7 [ GLASGOW SP. CODE...B10 OF GMODE INDICATES EBCDIC 4TD= [ IF SET WE MUST USE MODE 1 PERIS!! 4TF* ... MHUNTW 3,GOUT,INFO 4TGD LDX 0 GMODE(3) 4THH SLL 0 10 4TJL STO 0 AWORK2(2) 4TKP BPZ 0 SGINT1 4TLS LDN 4 1 4TMX DCA ,DSA,4,MODE 4TP2 SGINT1 4TQ5 ) 4TRG CALL 0 SPFL 4W?6 LDN 3 0 [SET SWITCH TO "DURING HEADINGS" 4WQQ STO 3 AWORK3(2) 4X=B CALL 6 THROW [DO START PERIS 4XQ2 YES BNZ 7 XLP9 [SET NO OF CHARS TO TRANSFER FOR PT 4Y9L LDN 6 84 4YP= DCA ,STO,6,COUNT 4^8W XLP9 4^NG [ 5286 [CONTROLS PRINTING OF FIRST HEADING,IE'PRODUCED ON' ETC 52MQ [ 537B ... MHUNTW 3,GOUT,INFO 53M2 LDX 4 GMODE(3) 546L BNG 4 TMARY 54L= MHUNTW 3,ADATA,CREADL [FIND BLOCK WITH'#LISTING ETC' 555W LDX 1 A1+FRH(3) 55KG LDX 5 1 [LOAD N0 OF CHARS 5656 ANDN 5 3 56JQ ERN 5 3 574B ADN 5 1 [X5 IS COMPLEMENT WRT 4 57J2 SRC 1 2 583L LDN 0 #20 58H= XSP SMO 3 592W DCH 0 CPDATA(1) 59GG BCHX 1 £ 5=26 BCT 5 XSP 5=FQ LDN 5 CPDATA(3) 5=^B LDN 6 GZDATA+1(2) 5?F2 MOVE 5 0(1) 5?YL SMO FX1 5#D= LDN 5 THEAD 5#XW ADX 6 1 5*CG MOVE 5 6 [MOVE'PRODUCED ETC'TO BUFFER 5*X6 ADN 6 3 [POSITION AFTER'ON ' 5BBQ SBX 6 FX2 5BWB MHUNTW 3,FILE,ENT 5CB2 LDX 4 EWRITDAY(3) [GET DATE AND TIME FILE LAST WRITTEN 5CTL LDX 5 EWRITTIME(3) [FOR HEADING 5D*= FREECORE 3 5DSW DATECON 4 5F#G LDX 1 ACOMMUNE1(2) 5FS6 ADX 6 FX2 5G?Q SMO 6 5GRB STO 1 0 [STORE BEFORE'AT' 5H?2 ADN 6 1 5HQL LDX 1 ACOMMUNE2(2) 5J== SMO 6 5JPW STO 1 0 [STORE BEFORE'AT' 5K9G SBX 6 FX2 5KP6 TIMECON 5 5L8Q ADX 6 FX2 5LNB ADX 6 N31(1) [ADD 1 WORD AND 3 CHARACTERS 5M82 LDN 5 ACOMMUNE1(2) 5MML MVCH 5 8 [STORE AFTER'AT ' 5N7= CALL 0 SETCA 5N8S #UNSET JSKI38 5N=B ( 5N?Y [AGAIN ... MODE 1 IF EBCDIC TO CP !! 5N*G LDX 0 AWORK2(2) 5NC4 BPZ 0 SGINT2 5NDL LDN 4 1 5NG8 DCA ,DSA,4,MODE 5NHQ SGINT2 5NK# ) 5NLW RZY 5P6G LDX 2 FX2 5PL6 LDN 3 0 [SET SWITCH TO'DURING HEADINGS' 5Q5Q CALL 5 PERI [PRINT HEADING 5QKB BNZ 7 NREQD 5R52 CALL 6 RUNOUT 5RJL NREQD 5S4= [ 5SHW [CONTROLS PRINTING OF SECOND HEADING,IE 'OUTPUT BY' ETC 5T3G [ 5TH6 N2 CALL 0 SPFL [SPACE FILL BUFFER 5W2Q LDX 3 2 [DUMP FX2 5WGB ... MHUNTW 2,GOUT,INFO 5X22 LDN 4 SHEAD(1) [STORE NEXT HEADING 5XFL SEC LDN 5 GZDATA+1(3) 5X^= MOVE 4 6 5YYG LDN 7 GZDATA+6(3) 5^D6 FLENME GUSER,GJOBN,2 [EXTRACT USER NAME JOB NAME 5^XQ [AND STORE IN ACT.BLK 62CB LDX 1 FX1 62X2 LDX 4 GMODE(2) 63BL BNG 4 ZON 63W= LDX 4 SHEAD+5(1) 64*W BRN XBAC 64TG ZON LDX 4 OHEAD+5(1) 65*6 XBAC 65SQ STO 4 GZDATA+6(3) [OVERWRITE RECORD HEADER 66#B LDN 6 ONAT(1) [STORE REST OF HEADING 66S2 MVCH 6 16 67?L LDX 4 CLEANCT [GET TIME 67R= SBX 7 FX2 68=W TIMECON 4 [CONVERT TIME 68QG ADX 7 FX2 69=6 LDN 6 ACOMMUNE1(2) [PUT TIME IN HEADING 69PQ MVCH 6 8 6=9B SBX 7 FX2 6=P2 DATECON EDATE [GET DATE 6?8L ADX 7 FX2 6?H2 STO 7 ACOMMUNE4(2) [RETAIN BUFFER POINTER 6?N= LDN 6 ACOMMUNE1(2) [PUT DATE IN HEADING 6#7W SLC 7 2 [SET POINTER TO CORRECT POS. 6#MG SBN 7 19 6*76 SRC 7 2 6*LQ MVCH 6 7 6*PF LDN 6 UNLFON(1) 6*QB LDX 7 ACOMMUNE4(2) 6*R? MVCH 6 8 [MOVE IN 'USING' 6*S8 LDN 5 JSOURCE1(2) [MOVE JSOURCE WORDS TO ACOM 1 AND 2 6*T5 LDN 6 ACOMMUNE1(2) 6*W2 MOVE 5 2 6*WX SBX 7 FX2 6*XS OUTPERA [GET UNIT NO. IN ACOM2 6*YP ADX 7 FX2 6*^L LDN 6 ACOMMUNE2(2) [AND NO. OF CH. IN 'UNIT NO' IN AC1 6B2H LDX 5 ACOMMUNE1(2) 6B3D SMO 5 6B4* MVCH 6 0 [MOVE IN UNIT NO. 6B*L LDX 7 AWORK4(2) [RELOAD X7 6BL2 BNZ 7 S13 [J NOT PT 6CD2 LDN 6 85 [INCREASE POSSIBLE LENGTH FOR UNITE 6CK= DCA ,STO,6,COUNT 6D4W S13 LDN 3 0 [SET SWITCH TO "DURING HEADINGS" 6DJG CALL 0 SETCA [SET UP CONTROL AREA 6DL4 #UNSET JSKI38 6DML ( 6DP8 [ MODE 1 IF EBCDIC TO CP ! 6DQQ LDX 0 AWORK2(2) 6DS# BPZ 0 SGINT3 6DTW LDN 4 1 6DXD DCA ,DSA,4,MODE 6D^2 SGINT3 6F2J ) 6F46 LDN 5 #42 6FHQ STO 5 GZDATA(2) 6G3B LDX 2 FX2 6GH2 CALL 5 PERI [OUTPUT HEADING 6H2L BNZ 7 NREQD1 6HG= CALL 6 RUNOUT 6H^W NREQD1 6JFG [ 6J^6 [CONTROLS OUTPUT OF THIRD HEADING,IE 'DOCUMENT' OR 'CONTINUATION' ETC 6KDQ [ 6KYB CALL 0 SPFL [SPACE FILL BUFFER 6KYY ... MHUNTW 3,GOUT,INFO [CONTINUATION CODE!!!! 6K^G [START OF CONTINUATION CODE!!! 6K^R LDX 0 RESTARTBIT(1) 6L24 ANDX 0 GMODE(3) 6L2* BZE 0 NOTRESTA [ J IF NOT RESTART 6L2L BNZ 7 RNOTTP [SET NEW COUNT FOR TP 6L2X LDN 5 60 [TO AVOID PRINTING SPACES 6L38 DCA ,STO,5,COUNT 6L3F RNOTTP 6L3Q LDN 4 RCON(1) 6L43 LDN 5 GZDATA+1(2) 6L4# MOVE 4 4 [MOVE 'CONTINUATION' INTO BUFFER 6L4K MHUNTW 2,ADATA,CREADL 6L4W LDX 4 A1+FRH(2) [NO. OF CH. IN FILENAME+12 6L57 LDCT 5 #600 6L5D ADN 5 CPDATA+2(2) 6L5P LDX 2 FX2 6L62 LDN 6 GZDATA+5(2) 6L6? SBN 4 11 [REMOVE #LISTING OF 6L6J SMO 4 6L6T MVCH 5 0 [MOVE FILENAME IN BUFFER 6L76 LDX 0 GMODE(3) 6L7C ANDX 0 RESTACTN(1) 6L7N BZE 0 NORESACT [ J IF NO RESTART ACTION SPEC. 6L7^ BNZ 7 RNCP [RESET COUNT FOR TP TO AVOID 6L8= LDN 5 96 [PRINTING SPACES 6L8H DCA ,STO,5,COUNT 6L8S RNCP 6L95 LDN 5 RFOL(1) 6L9B ADN 6 1 6L9M [X6 STILL CONTAINS BUFFER POINTER 6L9Y MOVE 5 7 [MOVE 'FOLLOWING' ETC IN BUFFER 6L=9 ANDX 0 RESTACTN+1(1) 6L=G ADN 6 7 [RESET BUFFER POINTER 6L=R SRL 0 15 [ J IF ALL SPECIFIED 6L?4 SMO 0 6L?* LDN 5 RPAGE(1) 6L?L MOVE 5 2 [MOVE IN 'PAGE OR 'ALL' 6L?X NORESACT 6L#8 LDN 3 0 [SET SWITCH TO 'DURING HEADINGS' 6L#F CALL 0 SETCA [RESET CONTROL AREA 6L#Q CALL 5 PERI 6L*3 BNZ 7 RNREQ 6L*# CALL 6 RUNOUT 6L*K RNREQ 6L*W CALL 0 SPFL 6LB7 NOTRESTA 6LBD [END OF CONTINUATION CODE!!! 6LC9 ... MHUNTW 3,GOUT,INFO 6LD2 LDN 4 SDOC(1) 6LXL LDN 5 GZDATA+1(2) 6MC= MOVE 4 3 6NBG LDEX 4 GSUSE(3) [LOAD SIZE OF USER'S HEADER 6NW6 ADN 4 3 6P*Q SRL 4 2 6PTB ADN 4 GZDATA-A1+4 6Q*2 TXU 4 ALOGLEN(2) [TEST AND J IF BUFFER LARGE ENOUGH 6QSL BCC RIGHT 6R#= TXL 4 ALOGLEN(2) 6RRW BCS RIGHT 6S?G LDX 6 ALOGLEN(2) 6SR6 SBN 6 GZDATA-A1+4 6T=Q SLL 6 2 6TQB BRN RIG 6W=2 RIGHT LDEX 6 GSUSE(3) 6WPL RIG LDX 4 GMODE(3) 6X9= BNG 4 TMARY3 6XNW LDN 4 GHEAD(3) [COPY ACROSS USER'S HEADER 6Y8G TAG2 LDN 5 GZDATA+4(2) 6YN6 SMO 6 6^7Q MVCH 4 0 6^MB [ 7272 BNZ 7 S14 [J NOT PT 72LL LDEX 4 GSUSE(3) [LOAD SIZE OF USER'S HEADER 736= ADN 4 GZDATA-A1+4*4+7 73KW [+1 FOR TXL 745G SRL 4 2 74K6 TXL 4 ALOGLEN(2) 754Q BCS XRIGH 75JB LDX 6 ALOGLEN(2) 7642 SBN 6 GZDATA-A1+4 76HL SLL 6 2 773= BRN XRIG 77GW XRIGH LDEX 6 GSUSE(3) 782G XRIG 78G6 LDN 0 126 [MAKE SURE NOT TOO MANY CHARACTERS 78^Q ADN 6 12 79FB TXL 6 0 [FOR PAPER TAPE PUNCH REMEMBERING 79^2 BCS XSTO [TWO CHARACTERS WILL BE ADDED FOR 7=DL LDN 6 126 [NEW LINE 7=Y= XSTO 7?CW DCA ,STO,6,COUNT 7?XG S14 7#C6 LDX 2 FX2 7#WQ LDN 3 0 [SET SWITCH TO 'DURING HEADINGS' 7*BB CALL 0 SETCA 7*CY #UNSET JSKI38 7*FG ( 7*H4 [ MODE 1 IF EBCDIC TO CP ! 7*JL LDX 0 AWORK2(2) 7*L8 BPZ 0 SGINT4 7*MQ LDN 4 1 7*P# DCA ,DSA,4,MODE 7*QW SGINT4 7*SD ) 7*W2 CALL 5 PERI [PRINT HEADING 7B*L BNZ 7 NOMORE [J NOT PAPER TAPE 7BT= LDN 4 128 7C#W CALL 6 RUNOUTX 7CSG [ 7D#6 [HAVING OUTPUT THE HEADINGS J FOR ONLINE PERIPHERAL OR SET UP THE 7DRQ [SHORT INFORMATION BLOCK FOR LISTFILE 7F?B [ 7FR2 NOMORE 7G=L HUNTW 1,ADATA,CREADL 7GQ= BNG 1 NFR 7H9W FREECORE 1 7HJ? ...NFR MHUNTW 3,GOUT,INFO 7HWN ... JBS XFRTOERR,3,BLFFRTOER [ J IF ERROR FOUND 7J96 LDX 4 GMODE(3) 7JNQ BPZ 4 XCROSS [J IF NOT OL 7K8B ...XFRTOEXIT 7KN2 LFEND 7L7L XCROSS 7LM= ACROSS LISTPREP,1 7M6W [ 7MLG [THIS ENTRY POINT IS FOR OUTPUTTING THE HEADINGS FOR THE ON LINE 7N66 [COMMAND FOR ON LINE OUTPUT PERIPHERALS 7NKQ [ 7P5B TMARY 7PK2 LDN 4 OHEAD(1) [SET ADDRESS OF HEADING 7Q4L LDX 2 3 7QJ= LDX 3 FX2 7R3W BRN SEC [J TO OUTPUT IT 7RHG [*********************************************************************** 7S36 POINT3 7SGQ [THIS ENTRY OUTPUTS THE TERMINATING PERIS AFTER A LISTING IS COMPLETE 7SQJ STO 2 AWORK1(2) [ NOT EB PATH 7T2B SPT3 7TG2 LDN 3 1 7T^L SUP CALL 0 SPFL [SPACE FILL BUFFER 7WF= CALL 0 SETCA [SET UP CONTROL AREA 7WYW LDN 3 1 7X2D #UNSET JSKI38 7X42 ( 7X5J BNG 6 PFLOC 7X76 SLL 6 1 7X8N BPZ 6 SGINT5 7X== LDN 4 1 7X?S DCA ,DSA,4,MODE 7X*B SGINT5 7XBY ) 7XDG BNZ 7 PFLOC [J IF NOT P.T. 7XY6 LDN 4 2 [THIS ROUTINE 7YCQ DCA ,STO,4,COUNT 7YXB LDN 4 #7624 [CHARACTER ONTO 7^C2 SLL 4 12 [PAPER TAPE 7^WL STO 4 GZDATA+1(2) 82B= CALL 5 PERI2 82TW PFLOC CALL 6 THROW 83*G SBRK2 83T6 LDX 0 AWORK1(2) 84#Q BZE 0 TIDYPER [J IF ENGAGE BUTTON INTERRUPT 84SB DISENGPER 84TR ... MHUNTW 3,GOUT,INFO 84X8 ... BNG 3 SOLDC 84YK ... OUTPARAM GSUSE(3),GHEAD,GOUT,INFO 8522 OUTPER 853C ...NCOOR MHUNTW 3,GOUT,INFO 854S OUTPACK GUSER(3),3,USERNAME,NCOOR 8569 ... OUTPARN 12,GJOBN,GOUT,INFO 857L INFORM ,JZXUNLD,1 [ENHANCED UNLOAD MESSAGE 8585 ... MHUNT 1,GOUT,INFO 858J ... JBS XFRTOEXIT,1,BLFFRTOER [ J IF FROM/TO ERROR 8593 UP 85=D SOLDC 85#2 OUTPER 85RL INFORM ,JZXLOAD,1 [OUTPUT UNLOAD MESSAGE ON 86?= [OPERATORS CONSOLE 86QW UP 87=G TIDYPER 87Q6 LDX 0 FINISH 889Q SLL 0 1 88PB BPZ 0 NFINISH 8992 ACROSS LISTNEXT,6 89NL NFINISH 89P7 ... FSHCODE B,XNOTB1 89PN ...( 89Q9 ...# 89QQ ...# THERE IS NO LF SCHEDULER ON THE 'B' M/C SO AT THIS POINT, WE 89R? ...# HAD BETTER GO TO 'A', BEFORE WE LOOK FOR THE SCHEDULER. WE 89RS ...# ALREADY HAVE A PAIR ON THE OTHER M/C SO A SIMPLE TRANSBEG WILL DO 89S* ...# 89SW ...# TO REDUCE THE TRAFFIC ON THE IPB, WE ALSO TAKE WITH US A COPY 89TC ...# OF OUR ENTRY IN THE 'APIA' 89TY ...# 89WF ...#DEF XAPIALEN=BOLEN>BLLEN+1 89X2 ...# 89XH ... HUNTW 3,FSH,FSHAPIA [LOOK FOR EXISTING 'APIA' COPY BLOCK 89Y4 ... BPZ 3 XNOGETCORE [JIF THERE IS A BLOCK ALREADY 89YK ... SETNCORE XAPIALEN,3,FSH,FSHAPIA [ELSE GET A BLOCK 89^6 ...# 89^M ...XNOGETCORE 8=28 ... STOZ A1(3) [CLEAR 'WAITING-TO-BE-WRONGED' MARKER 8=2P ... ADN 3 A1+1 8=3= ... LADDP ,2 [COPY APIA AREA INTO THE BLOCK 8=3R ... MOVE 2 XAPIALEN-1 [AND TRANSFER TO THE OTHER MACHINE 8=4# ... TRANSBEG FSHACTLFID,LISTINTC,20,,,ACOMMUNE1 8=4T ...# 8=5B ...XNOTB1 8=5X ...) 8=6D ...# 8=6^ ...POINT20 8=7G ...# 8=8= LFBITSET F,2 8=MW LDN 1 JOBRING(2) 8?7G POINTACT OUT,2 8?M6 ADN 2 JOBRING 8#6Q ENRING 1,2 8#LB LFEND EB 8*62 [ 8*KL [THIS ROUTINE ABANDONS AN OPERATOR TERMINATED LISTING 8B5= [ 8BJW YABANL 8C4G FREELINK 8CJ6 YAB 8D3Q LDN 4 0 8DHB CALL 3 TIDY 8F32 LFEND CD 8HF6 [ 8HYQ [*********************************************************************** 8JDB POINT4 8JY2 [ENTRY FROM LISTHEAD 8K7S STO 2 AWORK1(2) [ NOT EB PATH 8KCL LDN 5 1 8KX= LDN 3 0 [HEADINGS 8LBW DCA ,STO,5,CTSA 8LWG CALL 5 PERI2 8MB6 UP 8MTQ [*********************************************************************** 8N*B POINT5 8NT2 [THIS IS THE ENTRY POINT FROM ENGAGE 8NW8 ...# 8NXB ... FSHCODE B,XNOTB2 8NYJ ...( 8N^Q ...# 8P2Y ...# FOR 'B' MACHINE DEVICES WE ARE GOING TO NEED A PAIRED ACTLF IN 8P46 ...# 'A'. THIS IS CREATED WHEN THE DEVICE IS ENGAGED. 8P5# ...# 8P6G ... CALL 7 SFSHACTPR 8P7N ...# 8P8W ...XNOTB2 8P=4 ...) 8P?= ...# 8P#L STOZ AWORK1(2) [ENTRY POINT SWITCH 8PS= LTYPE ,7 8Q?W SRL 7 1 8QRG BRN SPT3 8R?6 [*********************************************************************** 8RQQ POINT6 8S=B ...[THIS ENTRY POINT IS NOW REDUNDANT 8SQ2 ... BRN (GEOERR) 8T9L ...[ 8TP= ...[ 8W8W ...[ OUTPUT MESSAGE SETUP BY CENTRAL ROUTINES 8WNG ...[ 984M XFRTOERR 985Q CALL 0 SPFL 986H ... MHUNTW 3,ADATA,HEADING 987# ... LDN 4 HEADDATA(3) 9885 ... LDN 5 GZDATA+1(2) 988W ... LDX 6 HEADCNT(3) 989M ... SBN 6 1 [ PFCC 98=D ... SMO 6 98?9 MVCH 4 0 98?X FREECORE 3 98#? ... LDX 2 FX2 98#M ... LDX 7 AWORK4(2) 98*3 ... BNZ 7 XFRTOERR1 [ J IF NOT *TP 98*C ... DCA ,STO,6,COUNT 98*R ...XFRTOERR1 98B7 ... CALL 0 SETCA 98BH ... LDN 3 1 98BX ... CALL 5 PERI 98C? ... BNZ 7 XFRTOERR2 [ J IF NOT *TP 98CM ... CALL 6 RUNOUT 98D3 ...XFRTOERR2 98DC ... BRN POINT3 [ TERMINATE THE LISTING 98F2 [ 98YL [*********************************************************************** 99D= POINT7 99XW [ENTRY FROM LISTHEAD TO PRINT 30" OF PT RUNOUT 99YC STO 2 AWORK1(2) [ NOT EB PATH 99YN ... LDN 7 0 [ TP 99Y^ #UNSET JSKI38 9=24 ( 9=37 [ FOR GLASGOW SPECIALS WE MUST CHECK APIA FOR RR OF TP 9=4= [ AND PUT OUT APPROP. MESSAGE IF IT IS NOT SWITCHED CORRECTLY 9=5* ... MHUNTW 2,GOUT,INFO 9=6D LDX 6 GMODE(2) 9=7H LDX 2 FX2 9=8L SLL 6 9 9=9P TESTCODE ,,TNSETR,TSETR 9==S TSETR 9=?X BPZ 6 SNOTR 9=*2 TGOKL 9=B5 ) 9=CG CALL 0 SETCA 9=X6 LDN 3 0 9?BQ CALL 6 THROW 9?WB UP 9#B2 TMARY3 9#TL LDN 4 GHEAD(3) 9**= BRN TAG2 9*** ...[ 9**D ...[*********************************************************** 9**H ...[ 9**L ...POINT8 9**P ...[ENTRY FROM FREEPER AFTER AN ONLINE HAS FINISHED 9**R ...# 9**T ... FSHCODE B,XNOTB3 9**X ...( 9**^ ...# 9*B3 ...# ON THE 'B' MACHINE, THE NEW ACTLF FROM FREEPER IS GOING 9*B5 ...# TO NEED A PAIR ON 'A'. IT IS CREATED HERE. 9*B7 ...# 9*B9 ... CALL 7 SFSHACTPR 9*B? ...# 9*B* ...XNOTB3 9*BC ...) 9*BF ... LTYPE ,7 [LD. TYPE OF PERIPHERAL REQD. IN X7 9*BH ... SRL 7 1 9*BK ... DOWN LISTINTC,3 [TO DISENGAGE PERIPHERAL & TIDYUP 9*BM ... BRN TIDYPER [TO GET NEXT LISTING 9*BP ...[ 9*BR ...#UNSET JSKI38 9*C8 ( 9*D7 [ HERE WE PUT OUT ANY NECC. MESSAGE TO OP'S CONSOLE 9*F6 TNSETR 9*G5 BPZ 6 TGOKL 9*H4 OUTPER 9*J3 INFORM ,JTPBIN,1 9*K2 TGWRNG 9*K^ SETWTBWR 9*LY BRN YABAN 9*MX SNOTR 9*NW OUTPER 9*PT INFORM ,JTPSTD,1 9*QS BRN TGWRNG 9*RR ) 9*SW #END ^^^^ ...50641221000100000000