(George Source)
Macros used: ALTLEN, COOR1, DCA, DISENGPER, DOWN, ENGPER, FREECORE, GEOERR, GPERI, JUNBUSY, LFBBS, LFBBUS, LFBITCLR, LFBITSET, LFEND, LOCKC, MHUNTW, OUTPER, PHOTO, SETENTRY, SETUPCORE, STEP, STEPAGAIN, TESTMOVE, TRACE, UNLOCK
22FL #OPT K0LISTTPCP=0 22PD ...#OPT JMIXEDTP=0 22^= #LIS K0LISTTPCP>K0LISTFILE>K0ALLGEO>K0GREATGEO>K0COMMAND 23DW #SEG LISTTPCP 23YG 8HLISTTPCP 248# ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1983 24D6 SETENTRY LISTTPCP,POINT,1 25CB [THIS SEGMENT IS ENTERED FROM LISTINTC TO IMPLEMENT CENTRAL 25X2 [CARD PUNCH OR TAPE PUNCH FILE LISTINGS 26BL [ 26W= [ 27*W [*********************************************************************** 27TG [DATA AREA 28*6 NUMCA +10000 [CARD MAXIMUM LINE NUMBER 28SQ XCONT 4H - [CONTINUATION LINE MARK-OUTPUT AT 29#B [END OF EACH LINE(EXCEPT LAST) OF 29S2 [MULTILINE RECORD 2=R= XFULLREC +2000 2?=W [MAX NUMBER OF CHARACTERS IN RECORD 2?QG TPLEN +128 [ 2#=6 NEWRUN #76327620 [NEWLINE AND 2#PQ RUN #76207620 [RUNOUTS FOR TP 2*9B SMLP +7036875 [MAGIC CONVERSION NUMBER 2*P2 [ 2B8L [*********************************************************************** 2BN= [SUBROUTINE AREA 2C7W [ 2CMG [THIS SUBROUTINE TIDIES UP WHEN A LISTING IS TO END 2D76 [ 2DLQ TIDYUP 2F6B LFBBUS K,2,NOADATA [J IF NO CONVERSION BLOCK 2FL2 MHUNTW 1,ADATA,ACONV 2G5L FREECORE 1 2GK= LFBITCLR K,2 [CLEAR CONVERSION FLAG 2H4W NOADATA 2HJG ... MHUNTW 1,GOUT,INFOLIST 2J46 LDX 4 GREST(1) 2JHQ FREECORE 1 2K3B EXIT 3 0 2KH2 [ 2L2L [THIS SUBROUTINE IS USED BY THE LOCK MACRO TO SET X2=FX2 2LG= [ 2L^W SLOCKC 2MFG LDX 2 FX2 2M^6 EXIT 1 0 2NDQ [ 2NYB [THIS SUBROUTINE CONVERTS THE BINARY NUMBER IN X5 TO DECIMAL 2PD2 [CHARACTERS STORING THE RESULT IN THE LOCATION WHOSE ADDRESS IS IN X2 2PXL [ 2QC= SEQUENCE 2QWW MODE 1 [ZERO SUPPRESS 2RBG SCBD CBD 4 0(2) 2RW6 BCHX 2 £ 2S*Q BCT 3 SCBD 2STB MODE 0 [DON'T SUPPRESS ZEROES 2T*2 CBD 4 0(2) [FOR LAST CHARACTER 2TSL BCHX 2 £ 2W#= DCH 1 0(2) 2WRW LDX 1 FX1 2X?G LDX 2 FX2 2XR6 EXIT 0 0 2Y=Q [ 2YQB [THIS SUBROUTINE PERFORMS THE PERI ON THE DEVICE AND CHECKS 2^=2 [THE REPLY FOR DISENGAGED AND INOPERABLE STATUS 2^PL [ 329= PERI 32NW SBX 5 FX1 338G REP 33N6 DCA ,LDX,4,COUNT 347Q BZE 4 NOT 34MB LDX 1 FX1 3572 LOCKC 2,SLOCKC 35LL LDN 4 GZDATA+1(2) [STORE BUFFER ADDRESS 366= DCA ,STO,4,CTSA [IN CONTROL AREA 36KW GPERI ,2 375G COOR1 37K6 UNLOCK 2 384Q LDX 4 FINISH 38JB SLL 4 2 3942 BNG 4 STOP ['FINISH NOW' 39HL LDCT 4 #50 3=3= ANDX 4 CPRW1(2) 3=GW BNZ 4 NOTENG [J IF FAIL OR DISENGAGED 3?2G LDN 0 1 3?G6 ADS 0 ALFTRANS(2) [UPDATE COUNT OF TRANSFERS 3?^Q DCA ,LDX,4,COUNT 3#FB SRL 4 2 3#^2 ADS 4 ALFWORDS(2) [UPDATE COUNT OF WORDS 3*DL NOT 3*Y= ADX 5 FX1 3BCW EXIT 5 0 3BXG [ 3CC6 [THIS SUBROUTINE TRANSFERS DATA FROM FILE TO BUFFER 3CWQ [ 3DBB TRANSFER 3DW2 SLL 3 2 3F*L ADX 3 GZPOINT(2) 3FT= SRC 3 2 3G#W LDN 4 GZDATA+1(2) 3GSG SLL 4 2 3H#6 ADX 4 GZDUMP(2) 3HRQ SRC 4 2 3J?B LDX 2 GZTRANS(2) 3JR2 BZE 2 NODATA 3K=L SMO 2 3KQ= MVCH 3 0 3L9W NODATA 3LPG LDX 2 FX2 3M96 EXIT 0 0 3MNQ [ 3N8B [THIS CODE IS USED BY THE PERI SUBROUTINE WHEN PERIPHERAL 3NN2 [FAIL OR DISENGAGED STATUS IS DETECTED 3P7L [ 3PM= NOTENG 3Q6W LDCT 0 #40 3QLG ANDX 0 CPRW1(2) 3R66 BNZ 0 XERREST [J IF TRANSFER ERROR 3RKQ ENGPER SBRKIN,,STOP 3S5B BRN REP 3SK2 STOP CALL 3 TIDYUP 3T4L LDCT 0 #600 3TJ= ANDX 0 4 3W3W BNZ 0 NOTLINER 3WHG SBN 4 1 [GREST=GNUM 3X36 NOTLINER 3XGQ ANDX 4 BITS22LS 3Y2B LFEND CD,4 3YG2 XERREST 3Y^L ENGPER SBRKIN,,STOP 3^F= TRACE 5,ENGAGE 3^YW ... MHUNTW 1,GOUT,INFOLIST 42DG LDCT 4 #200 42Y6 ADX 5 FX1 43CQ ANDX 4 GREST(1) 43XB BZE 4 PERI [J IF LINE RESTART 44C2 BRN STOP [ALL RESTART=CANTDO 44WL SBRKIN 45B= CALL 3 TIDYUP 45TW LFEND TE 46*G [ 46C2 [ 46CG [ THE FOLL. S/R IS PART OF THE LISTFILE ENHANCEMENT TO 46D2 [ READ ERROR RESILIENCE. 46DG [ THE S/R IS CALLED IF STEP ENCOUNTERS A CORRUPT BLOCK 46F2 [ (INDICATED BY FLAG 'M' BEING SET IN THE ACTLF) 46FG [ THE DEVICE IS DISENGAGED WITH THE MESSAGE :- 46G2 [ 'PSE ENGAGE UNIT N IF COMPLETION OF CORRUPT LISTING REQUIRED ' 46GG [ 46H2 [ 46HG SRER 46J2 SBX 5 FX1 46JG XBSY JUNBUSY ,NOTBSY [WAIT UNTIL DEVICE NOT BUSY 46K2 BRN XBSY 46KG NOTBSY 46L2 DISENGPER [THEN DISENGAGE IT 46LG OUTPER [PSE ENGAGE MESSAGE 46M2 ENGPER SBRKIN,,SCDE,5 [APP. JUMPS IF TERM OR CDE 46MG ADX 5 FX1 46N2 EXIT 5 0 46NG [ 46P2 [ IF CANTDO REPLY GIVEN WE RE-SCHEDULE REQUEST FROM BEGINNING 46PG [ 46Q2 SCDE 46QG CALL 3 TIDYUP [FREE BLOCKS ETC 46R2 LFEND CD 46RG [ 46T6 [*********************************************************************** 47#Q [MAIN BODY OF SEGMENT 47SB [*********************************************************************** 48#2 [THIS IS THE ENTRY POINT FOR LISTING A FILE TO A TAPE PUNCH(X7=0) 48RL [OR A CARD PUNCH(X7=2) 49?= [ 49QW POINT1 4=34 ... MHUNTW 3,GOUT,INFOLIST 4=?= [ CODE FOR RER ENHANCEMENT...B11 SET IN GMODE 4=?G [ MEANS CORR. WAS DETECTED DURING CONTEXT SEARCH 4=?Q [ IF SO WE MUST DISENGAGE DEVICE ETC... 4=#2 LDX 0 GQUAL(3) 4=#= ANDX 0 BIT11 4=#G BZE 0 NOERR [J IF NO READ ERROR 4=#Q CALL 5 SRER 4=*2 NOERR 4=Q6 LDX 0 GQUAL(3) 4?9Q STO 0 AWORK1(2) 4?PB LDCT 6 #177 [SET UP X6 WITH MAXIMUM 4#92 ANDX 6 AWORK1(2) [NUMBER OF CHARACTERS PERMITTED 4#NL SRL 6 15 [FOR ONE TRANSFER 4*8= BNZ 7 TUPT [J IF NOT PAPER TAPE 4*MW LDN 6 48 4B7G TUPT ADN 6 80 4C^# STEPAGAIN 4MDB [WE ARE NOW POSITIONED ON CORRECT RECORD 4MY2 LDX 4 FRH+1(3) 4NCL STOZ GZDUMP(2) 4NX= BNZ 7 NOTP1 [J IF NOT PT 4PBW LDN 5 #10 [INITIALISE MODE TO GRAPHIC 4PWG LDX 0 AWORK1(2) [COPY OF GMODE 4QB6 ... ANDN 0 #300 4QTQ ... BZE 0 XDMODE 4R*B ... LDN 5 4 53M2 XDMODE 546L DCA ,DSA,5,MODE 54L= NOTP1 55KG BRN STARTED 5656 START 56JQ STEP 56PX LFBBUS M,2,NOCOR3 [J IF NO READ ERROR 56RL LFBITCLR M,2 56T* CALL 5 SRER 56X4 STEPAGAIN 56YR NOCOR3 574B BZE 3 TEND [J IF EOF 57J2 STARTED 583L LDEX 5 FRH(3) [PICK UP NUMBER OF WORDS IN RECORD 58H= LDN 4 4 [INITIALISE PICKUP ADDRESS 58ND ...#UNS JMIXEDTP 58TL ...#SKI 592S ... LDN 0 #40 5982 ...#UNS JMIXEDTP 59*8 ... LDN 0 #440 59GG ANDX 0 AWORK1(2) 5=26 BZE 0 OK1 [J IF NOT BASIC PERIPHERAL FILE 5=FQ LDN 0 #700 5=^B ANDX 0 AWORK1(2) 5?F2 BZE 0 NOCONV [J IF NOT SHIFT FILE 5?GF ... BNZ 7 RU3 [J IF *CP 5?HY ... LDN 4 #7700 5?KC ... ANDX 4 FRH+1(3) 5?LW ... SRL 4 6 5?N* ...#UNS JMIXEDTP 5?PS ...( 5?R? ... ANDN 0 #400 [THESE 4 LINES 5?SQ ... BZE 0 RU1 [IMPLEMENT 5?W9 ... DCA ,DSA,4,MODE [OLD-STYLE 5?XN ... BRN NOCONV [MIXED *TP FILES 5?^7 ...RU1 5#2L ...) 5#45 ... LDN 0 #75 [IF PREVIOUS SHIFT BETA LEAVE 5#5J ... TXU 0 4 [ALONE,ELSE RESET TO ALPHA 5#73 ... SBN 0 0 [(#74) IN CASE IT WAS INVALID 5#8G ... DCH 0 GZDATA+1(2) 5#9^ ... LDN 0 1 5#?D ... STO 0 GZDUMP(2) 5##X ... BRN NOCONV 5#BB ...RU3 5#D= LFBBS K,2,OLDCONV [J IF ALREADY AN ACONV BLOCK 5#XW SETUPCORE 5,3,ADATA,ACONV [BLOCK FOR SHIFT CONVERSION 5*CG LFBITSET K,2 5*X6 PHOTO 7 5BBQ LDN 4 A1(3) 5BWB STEPAGAIN 5CB2 BRN TMOVEMENT 5CTL OLDCONV [HISTORIC CODE HERE I GUESS! 5D*= MHUNTW 3,ADATA,ACONV 5DSW LDN 4 A1(3) 5F#G PHOTO 7 5FS6 ALTLEN 3,5,ADATA,ACONV 5G?Q STEPAGAIN 5GRB TMOVEMENT [MUST WE REHUNT? 5H?2 TESTMOVE 7,NOMOVE1 [J IF NOT 5HQL MHUNTW 1,ADATA,ACONV 5J== LDN 4 A1(1) 5JPW NOMOVE1 5K9G SMO 5 5KP6 MOVE 3 0 [MOVE IN DATA 5L8Q LDN 7 1 [RESET TO INDICATE CP 5LNB LDN 1 #26 [SET MODES FOR ALLCHAR TO 5M82 LDX 0 AWORK1(2) 5MML ANDN 0 #100 5N7= BZE 0 NOTNORM 5NLW LDN 1 6 5P6G NOTNORM 5PL6 LDN 2 #10 [GRAPHIC CONVERSION 5Q5Q TRANSFOR 1,2 5QKB MHUNTW 3,ADATA,ACONV 5R52 ADN 3 A1-FRH [X3->RECORD HEADER 5RJL LDEX 5 FRH(3) [RESET LENGTH OF RECORD 5S4= NOCONV 5SHW LDN 4 8 [SET PICKUP ADDRESS 5T3G LDEX 0 FRH(3) [CHECK FOR EMPTY RECORD 5TH6 SBN 0 2 5W2Q BZE 0 OK2 [AND J IF EMPTY 5WGB LDX 0 FRH+1(3) [CALCULATE NUMBER OF CHARACTERS 5X22 SLC 0 2 [IN LAST WORD OF RECORD 5XFL ANDN 0 3 5X^= BZE 0 OK2 5YDW SBN 5 1 [ADJUST CHARACTER COUNT 5YYG BRN OK2 5^D6 OK1 5^XQ LDN 0 0 [NO ADJUSTMENT NECESSARY 62CB OK2 [CONVERT TO CHARACTERS 62X2 SLL 5 2 63BL ADX 5 0 [ADJUST IF NECESSARY 63W= SBX 5 4 [SUBTRACT PICKUP ADDRESS TO GIVE 64*W [NUMBER OF CHARACTERS OF DATA IN X5 64TG STO 5 GZLENGTH(2) [DATA LENGTH 65*6 STO 4 GZPOINT(2) [PICKUP ADDRESS 65SQ BZE 7 TOTP [J IF TO TP 66#B [ 66S2 [ 67?L [THIS CODE DEALS WITH PERIS TO THE CARD PUNCH 67R= [ 68=W TWCP 68QG LDN 4 80 [COUNT 69=6 TXL 4 GZLENGTH(2) [IF WE ARE DEALING WITH A 69PQ BCS TOBI [MULTILINE RECORD,JUMP 6=9B LDX 4 GZLENGTH(2) 6=P2 TOBI 6?8L STO 4 GZTRANS(2) [COUNT OF CHARACTERS FOR PERI 6?N= LDX 0 ACES [NOW 6#7W STO 0 GZDATA+1(2) [SPACEFILL 6#MG LDN 0 GZDATA+1(2) [ACTLF 6*76 LDN 1 GZDATA+2(2) [DATA 6*LQ MOVE 0 19 [BUFFER 6B6B LDX 1 FX1 6BL2 CALL 0 TRANSFER [TRANSFER DATA FROM FILE TO BUFFER 6C5L LDN 0 2 6CK= ANDX 0 AWORK1(2) 6D4W BZE 0 NONUM [J IF NO SEQUENCING 6DJG ... MHUNTW 3,GOUT,INFOLIST 6F46 LDX 4 GNUM(3) 6FHQ TXL 4 NUMCA(1) 6G3B BCC NONUM [J IF LINE NO EXCEEDS MAXIMUM 6GH2 LDN 3 3 6H2L MPY 4 SMLP(1) 6HG= CBD 4 1 6H^W CBD 4 1 6JFG CBD 4 1 6J^6 LDN 1 0 6KDQ LDCT 2 384 6KYB ADN 2 GZDATA+19 6LD2 ADX 2 FX2 6LXL CALL 0 SEQUENCE 6MC= NONUM 6MWW CALL 5 PERI 6NBG ...REPT MHUNTW 3,GOUT,INFOLIST 6NW6 LDN 4 1 6P*Q ADS 4 GNUM(3) 6PTB LDX 4 GLNO(3) [TEST AND J IF LAST LINE OUTPUT 6Q*2 BNG 4 TOEND 6QSL SBN 4 1 6R#= STO 4 GLNO(3) 6RRW BZE 4 TEND [LAST LINE OUTPUT 6S?G TOEND 6SR6 LDCT 4 #200 [J IF 6T=Q ANDX 4 GREST(3) [ALL 6TQB BNZ 4 SPLIT [RESTART 6W=2 LDX 4 GNUM(3) [ELSE SET LINE NUMBER 6WPL STO 4 GREST(3) [FOR RESTART 6X9= SPLIT BRN START 6XNW [ 6Y8G [THIS PART OF THE CODE DEALS WITH PERIS TO A TAPE PUNCH 6YN6 [THE AMOUNT OF SUPERVISORY COUNTROL DEPENDS ON THE TYPE OF DATA 6^7Q [IF THE DATA IS ALLCHAR WE DO NOT SUPPLY RECORD TERMINATIORS 6^MB [IF-THE DATA IS GRAPHIC OR NORMAL,THEN NULL AND THREE RUNOUTS ARE 7272 [APPENDED TO EACH RECORD 72LL [IF THE FILE IS AN OLD FASHIONED 'TAPE PUNCH FILE' THEN THERE IS NO 736= [TERMINATION OF RECORDS 73KW [IF THE RECORD CONSISTS OF EXACTLY 2000 CHARACTERS THEN IT WAS CREATED 745G [BY INPUTTING A RECORD OF EITHER A.EXACTLY 2000 CHARACTERS 74K6 [ OR B.MORE THAN 2000 CHARACTERS 754Q [IN CASE A.'INPUT'WILL HAVE CREATED A SUBSEQUENT DUMMY RECORD 75JB [SO IN EITHER CASE NO RECORD TERMINATORS ARE SUPPLIED BY US 7642 [THE FLAG 'L' IN THE ACTLF IS SET WHEN A COUNT OF 2000 IS DETECTED 76HL TOTP 76RD LDX 1 FX1 773= LDN 5 1 [NON ZERO SWITCH 77GW LDN 6 0 [INITIALISE RUNOUT MARKER 782G LDX 0 GZLENGTH(2) [RECORD LENGTH 78G6 TXU 0 XFULLREC(1) [IS IT 2000 CHARACTERS? 78^Q BCS NOT2000 [J IF NOT 79FB LFBITSET L,2 [ELSE SET FLAG 79^2 BRN TPF1 [AND TREAT AS GRAPHIC 7=DL NOT2000 7=Y= DCA ,LDEX,0,MODE 7?CW SBN 0 #10 7?XG BZE 0 TPF1 [J IF GRAPHIC 7#C6 LDX 0 AWORK1(2) 7#WQ SLL 0 15 7*BB BNG 0 TPF1 7*W2 SLL 0 1 7B*L BNG 0 YALCH [J IF ALLCHAR DATA 7BT= ADN 6 6 [FOR RUNOUT 7C#W YALCH ADN 6 2 [FOR NEWLINE 7CSG TPF1 LDX 0 TPLEN(1) [MAX TRANSFER COUNT 7D#6 SBX 0 GZDUMP(2) [SET UP X0 WITH MAXIMUM 7DRQ SBX 0 6 [ROOM FOR DATA 7F?B TXL 0 GZLENGTH(2) [CAN WE ACCOMODATE ALL? 7FR2 BCS XLTP [IF NOT,J 7G=L LDX 0 GZLENGTH(2) [YES WE CAN 7GQ= NGX 5 2 [RUNOUT SWITCH 7H9W BRN TRANS 7HPG XLTP ADX 0 6 [IS THERE ROOM IF WE FORGET 7J96 TXL 0 GZLENGTH(2) [NEWLINE AND RUNOUT 7JNQ BCS TRANS [J IF NOT 7K8B LDX 0 GZLENGTH(2) [ELSE TRANSFER ALL DATA 7KN2 LDN 5 0 [ALL WE NEED IS RUNOUT 7L7L TRANS 7LM= STO 0 GZTRANS(2) 7LX4 ... ADX 0 GZDUMP(2) 7M6W DCA ,STO,0,COUNT 7MLG CALL 0 TRANSFER [MOVE DATA TO BUFFER 7N66 BZE 6 NOXT [NO N/L OR R/O THIS TIME 7NKQ BPZ 5 NOXT 7P5B XGN LDN 3 NEWRUN 7PK2 ADX 3 FX1 7Q4L SMO 6 7QJ= MVCH 3 0 [MOVE IN EXTRA CHARACTERS 7R3W DCA ,ADSC,6,COUNT [IGNORE BO 7RHG BCS £ 7S36 NOXT STO 5 AWORK3(2) 7SGQ CALL 5 PERI 7T2B DCA ,STOZ,,COUNT 7TG2 STOZ GZDUMP(2) 7T^L LDX 0 GZTRANS(2) 7WF= SBS 0 GZLENGTH(2) 7WYW ADS 0 GZPOINT(2) 7XDG LDX 5 AWORK3(2) 7XY6 BZE 5 XGNA 7YCQ BNG 5 XFINIS 7YXB STEPAGAIN 7^C2 BRN TPF1 7^WL XFINIS 82B= LDXC 6 6 [TEST IF WE HAVE JUST DONE 'NORMAL' 82TW STEST BCC NOGRUN [PERI FOR RUNOUT IN GRAPHIC DATA 83*G DCA ,STO,6,MODE [IF SO,RESET MODE TO GRAPHIC 83T6 BRN REPT [NEXT RECORD 84#Q NOGRUN 84SB LFBBS L,2,XFINL [J IF 2000 CHAR RECORD 85#2 DCA ,LDEX,0,MODE [IF GRAPHIC THEN WE MUST DO 85RL SBN 0 #10 [SHIFT MODE PERI FOR 86?= BNZ 0 REPT [R/O AND N/L 86QW LDN 0 4 [PREVIOUS MODE 87=G DCA ,STO,0,MODE 87Q6 LDN 6 8 889Q ORX 6 GSIGN [TEST AT STEST 88PB XGNA NGN 5 1 [SWITCH 8992 LDN 4 GZDATA+1(2) [BUFFER ADDRESS 89NL BRN XGN 8=8= [ 8=MW [ 8BJW TEND 8C4G CALL 3 TIDYUP 8CJ6 STO 2 AWORK1(2) [SWITCH 8D3Q DOWN LISTINTC,3 [TERMINATORS 8DHB LFEND 8F32 XGEOR 8FGL GEOERR 1,BREAK IN 8G2= [ 8GFW [THIS CODE DEALS WITH MONFILE PARAMETER 8G^G [THIS CODE MAY NEVER BE USED,BUT IT IS INCLUDED IN CASE LOGANAL 8HF6 [WISHES TO LIST MONITORING FILES TO OTHER SLOW PERIPHERALS BESIDES PRINT 8HYQ [ 8JDB ADN 4 4 [ALLOW FOR CATEGORY WORD 8JY2 LDX 0 FRH+1(3) [PICK UP CATEGORY WORD 8KCL ANDX 0 AWORK3(2) 8KX= BNZ 0 OK1 [J IF THIS CATEGORY TO BE LISTED 8LBW ... MHUNTW 1,GOUT,INFOLIST 8LWG LDN 0 1 8MB6 ADS 0 GNUM(1) [UPDATE CURRENT LINE NUMBER 8MTQ LDX 2 GLNO(1) 8N*B BNG 2 START [J IF LIST TO EOF 8NT2 SBS 0 GLNO(1) 8P#L BRN START [TRY NEXT RECORD 8PS= [ 8Q?W [LONG RECORD PATH 8QRG [ 8R?6 XFINL 8RQQ LFBITCLR L,2 [CLEAR 2000 CHAR RECORD MARKER 8S=B LFBITCLR H,2 [UNSET LONG RECORD MARKER 8SQ2 BRN REPT 8W8W #END ^^^^ ...31772643000100000000