{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: LISTINTC865)}}
====== LISTINTC865 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:COOR1|COOR1]], [[george:macro:DATECON|DATECON]], [[george:macro:DCA|DCA]], [[george:macro:DISENGPER|DISENGPER]], [[george:macro:DOWN|DOWN]], [[george:macro:ENGPER|ENGPER]], [[george:macro:ENRING|ENRING]], [[george:macro:FLENME|FLENME]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FREELINK|FREELINK]], [[george:macro:FSHACTPR|FSHACTPR]], [[george:macro:FSHCODE|FSHCODE]], [[george:macro:FSHENTRY|FSHENTRY]], [[george:macro:GPERI|GPERI]], [[george:macro:HUNT|HUNT]], [[george:macro:HUNTW|HUNTW]], [[george:macro:INFORM|INFORM]], [[george:macro:JBS|JBS]], [[george:macro:LADDP|LADDP]], [[george:macro:LFBBS|LFBBS]], [[george:macro:LFBITSET|LFBITSET]], [[george:macro:LFEND|LFEND]], [[george:macro:LOCKC|LOCKC]], [[george:macro:LTYPE|LTYPE]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:ON|ON]], [[george:macro:OUTPACK|OUTPACK]], [[george:macro:OUTPARAM|OUTPARAM]], [[george:macro:OUTPARN|OUTPARN]], [[george:macro:OUTPER|OUTPER]], [[george:macro:OUTPERA|OUTPERA]], [[george:macro:POINTACT|POINTACT]], [[george:macro:RESTART|RESTART]], [[george:macro:RIGHT|RIGHT]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETENTRY|SETENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETWTBWR|SETWTBWR]], [[george:macro:STEP|STEP]], [[george:macro:TESTCODE|TESTCODE]], [[george:macro:TIMECON|TIMECON]], [[george:macro:TRACE|TRACE]], [[george:macro:TRANSBEG|TRANSBEG]], [[george:macro:UNLOCK|UNLOCK]], [[george:macro:UP|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