LISTMOP867
(George Source)
Macros used: ABANDCOM, ALTLEN, BITDEFS, BS, BXE, BXL, CATMASK, CLOSE, ENDCOM, FREECORE, JBC, JBS, MFREE, MFREEW, MHUNTW, OPEN, OUTMON, OUTMONX, PHOTO, PROPAGANDA, READY, RV, SEG, SEGENTRY, SETNCORE, STEP, STEPAGAIN, TESTMOVE, TESTRPN2, TOPFCB, TRF, UP
- LISTMOP867.txt
22FL #OPT K0LISTMOP=0 22^= #LIS K0LISTMOP>K0LISTFILE>K0COMMAND>K0GREATGEO>K0ALLGEO 234B ... SEG LISTMOP,,,,G501,G502,G503 237G ...[ 23=L ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 23*Q ...[ THIS EXCLUDES CODE UNDER #SKI G501 23DW ...[ AND UNDER #SKI G502 23J2 ...[ AND UNDER #SKI G503 23M6 ...[ 23Q= ...#OPT G501 = 0 23TB ...#OPT G502 = 0 23YG ...#SKI G502&1 243L ...# WITH UGUG EDIT M502 (SHIFT AND GRAPHICS OUTPUT ON MOP) 246Q ...#OPT G503 = 0 249W ...#SKI G503&1 24*2 ...# WITH UGUG EDIT M503 (PAGING AND FRAMING ON MOP LISTFILES) 24D6 # 24XQ # 25CB # THIS ENTRY POINT LISTS A FILE TO THE MONITORING FILE 25M8 # AND/OR A MOP TERMINAL 25X2 # 26BL SEGENTRY K1LISTMOP,Z1LISTMOP 26W= # 27*W # 27TG # 28*6 # 28SQ # THIS ENTRY POINT IS CALLED FROM K8IPBMOPB JUST BEFORE THE 'CLOSED DOWN 29#B # MESSAGE IS SENT TO A VDU, PROVIDED THE PROPAGANDA RESTORE TIME MAC 29S2 # HAS BEEN INVOKED. 2=?L # IT OPENS (IF AVAILABLE) A FILE CONTAINING PROPAGANDA TO BE OUTPUT 2=R= # TO THE IDLE DISPLAY, AND USES THE NORMAL MOP CONSOLE LISTFILE CODE 2?=W # TO OUTPUT THE CONTENTS OF THE FILE TO THE SCREEN. 2?QG # 2#=6 SEGENTRY K2LISTMOP,Z2LISTMOP 2#PQ # 2*9B # 2*P2 # 2B8L 2BN= SEGENTRY K60LISTMOP [ USED BY PROPAGANDA MACRO TO RESET 2C3^ PROPAGANDA 2CCN 10,24HOPERATORS PROPAGANDA [ THE USERNAME AND FILENAME 2CRC 1,0,4H [ OTHER DETAILS 2D76 # 2DLQ PCONVERT 2F6B +7036875 2FL2 PCATEGORY 2G5L CATMASK LS [ GATEGORY FOR OUTPUT 2GK= # 2H4W # 2HJG # 2J46 # 2J?Y Z2LISTMOP 2JHQ LDN 0 1 2JRJ STO 0 AWORK1(2) [ ENTRY POINT SWITCH 2K3B SETNCORE 10,2,FILE,FABSNB [ OPEN PROPAGANDA FILE. 2KH2 ADN 1 PROPAGANDA 2L2L ADN 2 A1 2LG= MOVE 1 10 2L^W OPEN XBRK,READ,NOWAIT,QUERY,REPLY [ J. TO END IF BREAK IN. 2MFG TESTRPN2 OK,NOTOK [ J. IF NO FILE, IN USE, OFFLINE, ETC 2M^6 MFREEW FILE,FABSNB [ NO LONGER NEEDED. 2NDQ TOPFCB 3 [ GET FILE CONTROL BLOCK. 2NYB JBS NOTOX,3,BFDIR [ CHECK FILE IS LISTABLE, I.E. SERIAL 2PD2 JBC NOTOX,3,BFSER [ AND NOT A DIRECTORY. 2PK8 STEP 2PQB BZE 3 NOTOX [ AND IS NOT EMPTY 2PXL # 2QC= # NOW WE'VE OPENED THE FILE ALL WE HAVE TO DO IS LISTFILE THE CONTENTS. 2QWW # 2RBG MHUNTW 3,AMXOR,ADCB [ MUST BE ONE OR WE WOULDN'T BE HERE. 2RW6 LDEX 4 ICHARS(3) [ GET DISPLAY SCREEN WIDTH. 2S9T STO 4 AWORK1(2) 2SKJ SETNCORE GHEAD-A1,3,GOUT,INFO [ SET UP/INITIALISE PARAMETER BLOCK. 2S^? STOZ GFLI(3) [ START OUTPUT FROM LINE 0. 2T*2 LDN 0 16 [ OUTPUT 16 LINES MAX. SO WE DON'T GE 2TSL STO 0 GNLI(3) [ INVOLVED WITH CTRL+3 PROBLEMS. 2W#= STOZ GFTY(3) 2WJ4 STOZ GMODE(3) STOZ GCOUNT(3) 2WRW BS 3,BLFBASIC [ BASIC FILE : NOT NUMBERING OR SPECI 2XR6 # 2Y=Q BRN XCOMMON 2YQB # 2^=2 Z1LISTMOP 2^PL STOZ AWORK1(2) [ ZERO IF K1 (NORMAL) ENTRY POINT. 329= XCOMMON 32NW LDX 6 ALOGLEN(2) 338G STO 6 EXTPS(2) 33N6 ... ADN 6 ALFMOPLEN+1 347Q ALTLEN FX2,6 [ EXTEND ACT. BL. FOR OUTPUT LINE 34MB MHUNTW 1,GOUT,INFO 34X8 JBS ZERROR,1,BLFFRTOER 34Y3 ...#SKI G503&1 34YW ... STOZ GSUSE(1) [ LINES OUTPUT IN THIS FRAME 34^P ...#SKI G502&1 352J ...( 353C ... BITDEFS 4,17,RECBETA [ BETA SHIFT WHEN RED TAPE IN X4 354= ... TRF 1,FLFXTRAPICT,2,G502SHIFTF 3555 ...# COPIES SHIFT,NOLF,NOBC BITS FROM GMODE TO CPAT FOR IPBMOP TO SEE 355Y ...) 3572 JBS XAMORPH,1,BLFBASIC 35LL BS 1,BLFSPECIAL 366= XAMORPH 36KW LDN 0 1 375G SBS 0 GFLI(1) [ DECREASE GFLI BY 1 FOR LINE NUMBER 37K6 STEPAGAIN 384Q BZE 3 ZERROR [ J IF ERROR FOUND BY CENTRAL ROUTINE 38JB BRN START2 3942 START 39HL STEP 3=3= BZE 3 OUT [ J IF END OF FILE 3=GW START2 3=S= MHUNTW 1,GOUT,INFO 3?5L LDEX 7 0(3) 3?C2 JBC STARTNS,1,BLFSPECIAL 3?NB ADN 7 1 3?^Q STARTNS 3#?6 JBC STARTNN,1,BLFNUMBER 3#JG ADN 7 2 3#TW STARTNN 3*7= SBN 7 1 [ BUFFER LENGTH REQUIRED 3*DL [ 3*Y= [ INCREASE LENGTH OF CPAT AS NECESSARY 3BCW [ DECREASE LENGTH IF 3BXG ...[ BUFFER > ALFMOPLEN*2 AND BUFFER > REQUIRED LENGTH + ALFMOPLEN 3CC6 [ 3F*L LDX 4 ALOGLEN(2) 3FT= SBX 4 EXTPS(2) [ LENGTH OF BUFFER 3G6L BXL 4 7,XINC [ J IF INCREASE REQUIRED 3GD2 BXE 4 7,OKLEN [ J IF OK 3GQY ... SBN 4 ALFMOPLEN*2+1 3H5W ... BNG 4 OKLEN [ J IF < ALFMOPLEN*2 3HDS ... ADN 4 ALFMOPLEN 3HRQ SBX 4 7 3J7F ... BNG 4 OKLEN [ J IF < REQUIRED LENGTH + ALFMOPLEN 3JH8 XINC 3JR2 LDX 4 7 3KQ= ADX 4 EXTPS(2) [ X4 CONTAINS NEW LENGTH REQD. 3L9W PHOTO 5 3LPG ALTLEN FX2,4 3M96 TESTMOVE 5,OKLEN1 [ J IF NO BLOCKS MOVED 3MNQ STEPAGAIN 3N8B OKLEN1 3NN2 MHUNTW 1,GOUT,INFO 3P7L OKLEN 3PM= SBN 7 1 [ DATA LENGTH 3Q6W JBS NPFCC,1,BLFSPECIAL 3QLG LDX 4 1(3) [ OTHERWISE CHECK IF PRINTING REQD. 3QRN ...#SKI G502&1 3QYW ... TRF ,RECBETA,2,G502BETA [ SET ALPHA/BETA BIT FOR IPBMOP 3R66 ANDN 4 #40 [ AND 3RKQ BNZ 4 NPFCC [ J IF SO 3S5B JBC RNONU,1,BLFNUMBER 3SK2 LDN 0 7 [ ELSE PUT 7 INTO CHARACTER 3T4L SMO EXTPS(2) [ COUNT AND J 3TJ= STO 0 A1(2) 3W3W BRN NMV 3WHG RNONU 3X36 SMO EXTPS(2) 3XGQ STOZ A1(2) [ ZEROISE COUNT FOR NULL RECORD 3Y2B BRN NMV 3YG2 NPFCC 3YH8 ...#SKI G503&1 3YJB ...( 3YKJ ... [ VDU PAGING CODE ACL0057 3YLQ ... JBC XACL5,1,BLFXTRASTOP [ CONTEXT STOP NOT SET 3YMY ... LDX 4 2(3) [ CHECK CONTEXT FIRST WORD 3YP6 ... TXU 4 GHEAD(1) 3YQ# ... BCS XACL5 [ J NO MATCH 3YRG ... CALL 4 READY [ PAUSE 3YSN ... STEPAGAIN 3YTW ... MHUNTW 1,GOUT,INFO 3YX4 ...XACL5 3YY= ...) 3Y^L LDX 4 0(3) [ NO. OF WDS. IN RECORD 3^F= SBN 4 3 3^YW BNG 4 NCHANGE [ J IF ZERO RECORD 42DG BZE 4 NCHANGE [ OR SINGLE WORD RECORD 42Y6 LDX 5 4 43CQ TSPACES 43XB SMO 4 44C2 LDX 0 2(3) [ GET NEXT WD. STARTING FROM END 44WL TXU 0 ACES 45B= BCS NSPACES [ J IF NOT SPACES 45TW BCT 4 TSPACES 46*G ADN 4 1 [ OUTPUT 1 WD. IF ALL SPACES 46T6 NSPACES 47#Q TXU 5 4 47SB BCC NCHANGE [ J IF NO SPACES REMOVED 48#2 SBX 5 4 [ NO. OF WDS. TRUNCATED IN X5 48RL SBX 7 5 [ SUB. THIS FROM TOTAL 49?= LDX 5 7 49QW BRN T1 4==G NCHANGE 4=Q6 LDX 5 7 4?9Q ADN 4 1 4?PB BZE 4 T1 4#92 JBC T1,1,BLFBASIC 4#NL LDCT 4 #600 [ ISOLATE CHARACTER BITS. 4*8= ANDX 4 1(3) 4*MW BZE 4 T1 [ J IF NO ODD CHS. 4B7G SBN 5 1 4BM6 ORX 5 4 4C6Q T1 4CLB SLC 5 2 4D62 LDX 0 AWORK1(2) [ J. UNLESS K2 ENTRY. 4DKL BZE 0 T2 4F5= BXL 5 AWORK1(2),T2 [ IN WHICH CASE TRUNCATE RECORDS TO 4FJW LDX 5 AWORK1(2) [ DISPLAY WIDTH, TO STOP CONTINUATION 4G4G T2 4GJ6 SMO EXTPS(2) 4H3Q STO 5 A1(2) [ STORE NO. CHS. IN RECORD 4HHB JBS SPEC,1,BLFSPECIAL 4J32 ADN 3 1 4JGL SPEC 4K2= ADN 3 1 4KFW SMO EXTPS(2) 4K^G LDN 4 A1+1(2) 4LF6 JBC XDONE,1,BLFNUMBER 4LYQ ADN 4 2 [ LEAVE GAP FOR NUMBER 4MDB SBN 7 2 4MY2 XDONE 4NCL BZE 7 NMV [ J IF NO WDS. TO MOVE 4NX= SMO 7 4PBW MOVE 3 0 [ MOVE MESSAGE TO ACT. BL. 4PWG NMV 4QB6 LDN 4 1 4QTQ ADS 4 GFLI(1) [ INCREASE LINE COUNT 4R*B SBS 4 GNLI(1) [ UPDATE NO. OF LINES LEFT 4RT2 LDX 4 GFLI(1) 4S#L LDX 7 GNLI(1) [ NO. OF LINES LEFT ( -VE IF LIST TO 4SS= JBC NNUM,1,BLFNUMBER 4WQQ LDX 1 FX1 4X=B LDN 3 6 4XQ2 MPY 4 PCONVERT(1) 4Y9L SMO EXTPS(2) 4YP= LDN 2 A1+1(2) 4^8W LDN 1 #20 4^NG MODE 1 5286 NCBD 52MQ CBD 4 0(2) [ CONVERT LINE NO. TO DEC. 537B BCHX 2 £ 53M2 BCT 3 NCBD 546L MODE 0 [ SWITCH OFF ZERO SUPPRESSION 54L= CBD 4 0(2) [ FOR LAST CHARACTER 555W BCHX 2 £ 55KG DCH 1 0(2) 5656 LDX 2 FX2 56JQ NNUM 574B LDX 4 EXTPS(2) 57J2 TESTBRKI XBI 583L ADX 2 4 [ X2 PTS. TO COUNT WD. - A1 58H= ADN 4 A1+1 [ X4 PTS. TO START OF MESSAGE AREA 592W OUTMONX A1(2),4,PCATEGORY(1) 59GG BZE 7 OUT [ J IF NO MORE LINES REQUIRED 59HN ...#SKI G503&1 59JW ...( 59L4 ... JBC START,2,CXTMOP [ AVOID HUNT IF NOT MOP 59M= ... MHUNTW 1,GOUT,INFO 59ND ... LDN 7 1 59PL ... ADS 7 GSUSE(1) [ LINES DISPLAYED ON THIS PAGE 59QS ... LDX 0 GCOUNT(1) 59S2 ... TXU 0 GSUSE(1) 59T8 ... BCS START [ PAGE NOT FILLED 59WB ... STOZ GSUSE(1) 59XJ ... CALL 4 READY 59YQ ...) 5=26 BRN START 5=FQ # 5=G# ...#SKI G503&1 5=GW ...( 5=HD ...READY 5=J2 ... SBX 4 FX1 5=JJ ... READY XBI 5=K6 ... MHUNTW 1,FILE,FRB 5=KN ... LDEX 0 A1(1) 5=L= ... SBN 0 2 5=LS ... BZE 0 NOREP 5=MB ...#SKI G501&G502&1 5=MY ...( 5=NG ... JBC TESTC,2,G501SHIFT 5=P4 ... LDCH 0 A1+2(1) [ IF POSSIBILITY OF SHIFT INPUT, 5=PL ... ERN 0 #75 [ ALLOW BIG OR LITTLE 'C' 5=Q8 ... BNZ 0 TESTC 5=QQ ... BCHX 1 £ 5=R# ...) 5=RW ...TESTC LDCH 0 A1+2(1) 5=SD ... ERN 0 #43 [ UNLESS 'C', 5=T2 ... BNZ 0 OUT [ ASSUME 'QUIT', 'STOP' OR W.H.Y. 5=TJ ...#SKI G501&G502&1 5=W6 ... LDN 1 0(1) [ CLEAR CHARACTER BITS 5=WN ...NOREP FREECORE 1 5=X= ... SMO FX1 5=XS ... EXIT 4 0 [ CONTINUE IF NULL OR 'C' REPLY 5=YB ...) 5=^B # 5?F2 XBI 5?YL LDCT 0 #400 [ MARK THAT BREAK IN HAS OCURRED. 5#D= ORS 0 AWORK1(2) 5#XW OUT 5*CG LDX 4 EXTPS(2) 5*X6 ALTLEN FX2,4 5BBQ MFREEW GOUT,INFO 5BWB NOTOX 5CB2 CLOSE 5CTL LDXC 0 AWORK1(2) [ J. IF NOT BROKEN IN. 5D*= BCC X1FIN 5DSW BNZ 0 XBRK [ J. IF K2 ENTRY. 5F#G ABANDCOM 5FS6 # 5G?Q X1FIN 5GRB BNZ 0 X2FIN [ J. IF K2 ENTRY. 5H?2 ENDCOM 5HQL # 5J== # 5JPW # 5K9G ZERROR 5KP6 [ 5L8Q [ ERROR FOUND BY CENTRAL ROUTINES 5LNB [ LIST ERROR LINE 5M82 [ 5MCS LDX 1 FX1 5MML MHUNTW 3,ADATA,HEADING 5N3* LDX 4 HEADCNT(3) 5NC4 SBN 4 1 [ PFCC 5NQR OUTMON 4,HEADDATA,PCATEGORY(1),ADATA,HEADING 5P6G MFREEW ADATA,HEADING 5PL6 BRN OUT 5Q5Q [ 5QKB NOTOK 5R52 [ 5RJL [ FAILED TO OPEN PROPAGANDA FILE 5S4= [ 5SHW TESTRPN2 MAG,NOTOK1 [ J. OUT UNLESS FILE IS OFFLINE. 5T3G RV 5TH6 NOTOK1 5W2Q MFREE FILE,FABSNB 5WGB XBRK 5X22 X2FIN 5XFL UP [ RETURN TO IPBMOPB. 5X^= # 5YDW # 5YYG #END 5^D6 # ^^^^ ...462776340003