WHATPERA867
(George Source)
Macros used: ACROSS, APROPNAME, CLOSE, CONSERNO, ENDCOM, FINDLINK, FLENME1, FON, GFCBC, HUNT, HUNTW, JALLOC, JDISENG, JENG, JENVNOT, JFAIL, JFREE, JJOBLMT, JONL, JSWOUT, JWPR, JWRONG, LGEOG, LJOBNO, LMODEQ, LPROP, MENDAREA, MHUNTW, MONOUT, MONOUTX, OFF, OUTBLOCK, OUTBLOCN, OUTMESS, OUTMESSX, OUTMOND, OUTNULL, OUTNUM, OUTPARAM, OUTPARN, PROPNAME, REWIND, RIGHT, SEG, SEGENTRY, SETNCORE, SIX, STEP, STEPAGAIN, XYZ
- WHATPERA867.txt
22FL #LIS K0WHATPERA>K0ALLGEO>K0GREATGEO>K0COMMAND 22LS ... SEG WHATPERA,,,,G203 [N.R.BOULT 22S2 ...[ 22^8 ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 236B ...[ THIS EXCLUDES CODE UNDER #SKI G203 23?J ...[ 23DQ ...#OPT G203 = 0 23KY ...#SKI G203&1 23R6 ...# WITH UGUG EDIT M203 (ALLOW WHATPER FOR REMOTE DEVICES) 23YG SEGENTRY K1WHATPERA,QK1WHATPERA 24D6 # THIS SEG CONTINUES THE IMPLEMENTATION OF THE WHATPER COMMAND. FOR 24XQ # EACH RECORD IN THE BLOCK SET UP BY SEG WHATPER, IT ANALYSES THE INFO 25CB # AND OUTPUTS THE APPROPRIATE MESSAGE(S), READING ANY FILES (SYS.DOC OR 25X2 # SYS.SERIAL) IF RELEVANT. 26BL # 26W= # THE FILES REFERENCED ARE OPEN AS FOLLOWS:- 27*W # DOCUMENT : LEVEL -1 27TG # SERIAL : LEVEL -2 (ONLY OPEN IF DOCUMENT OPEN) 28*6 # PROPERTY : LEVEL 0 28SQ # 29#B TEMP 4HTEMP 29S2 4HPERM 2=?L XINCL 4HINCL 2=R= 4HEXCL 2?=W XCR +3 2?QG MTNO +5 2#=6 SIX +6 2BN= XCAT #10000 2C7W XQEND +FLOWQ 2C=R XMES1 2C*N XFUSSY +FUSSY 2CDK XFLOUNUS +FLOUNUS 2CHG XFRESUNEN +FRESUNEN 2CLC XFRONG +FWRONG 2CP# XFIDLE +FIDLE 2CS9 XFONLINE +FONLINE 2CX6 XMES2 2D23 XFUSSYA +FUSSYA 2D4Y XFLOUNUSA +FLOUNUSA 2D7T XFRESUNENA +FRESUNENA 2D=Q XFRONGA +FWRONGA 2D*M XFIDLEA +FIDLEA 2DDJ XFONLINEA +FONLINEA 2DHF XFOLJOB +FOLJOB 2DLQ XFDOC +FDOC 2H4W XFTINS +FINS 2HJG XFFAIL +FFAIL 2J46 XFTWRONG +FTWRONG 2J?Y XFSWO +JUNITSWO 2JHQ XFUSEWT +FUSEWTXX 2K3B XFTNO +FTNO 2KH2 XFNFD +FNFD 2L2L XFENG +FENG 2LG= #SKI IPCV1 2L^W ( 2MFG XFUNOP +FUNOP 2M^6 XFUSIN +FUSIN 2NDQ XFLINK +FLINKUS 2NYB ) 2PD2 XHDDR 4HHDDR 2PXL YFILE +HFILE 2QC= XBIT #37777777 2QWW # S/R TO CLOSE UP USER AND LOCAL NAMES 2RBG # X3 -> USER NAME 2RW6 # X4 LINK 2S*Q UPCLOSE 2STB SBX 4 FX1 2T*2 LDN 7 ACOMMUNE1(2) 2TSL FLENME1 0,3,5 2W#= SBN 7 ACOMMUNE1(2) 2WRW SLC 7 2 2X?G LDN 0 24 2XR6 SBX 0 7 2Y=Q BPZ 0 NOT25 [J IF < 25 CHARS 2YQB HUNTW 3,ADATA,CSTORE 2^=2 BPZ 3 PHOUND1 2^PL SETNCORE 7,3,ADATA,CSTORE 329= PHOUND1 32NW ADN 2 ACOMMUNE1 [THIS NECESSARY AS 338G ADN 3 A1 33N6 MVCH 2 26 [OUTPARAM USES ACOMMUNE7 347Q OUTPARAM 7,A1,ADATA,CSTORE 34MB BRN XIT 3572 NOT25 35LL OUTPARAM 7,ACOMMUNE1 366= XIT 36KW ADX 4 FX1 375G EXIT 4 0 3768 # 376W XOUTBLK 377J SBX 7 FX1 378= OUTBLOCK 0 378Y ADX 7 FX1 379L EXIT 7 0 37=# # 37?2 XSTEP 37?* SBX 7 FX1 37?N STEP 0(3) 37#3 ADX 7 FX1 37#B EXIT 7 0 37*4 # 37*Q XOUTPRM 37BD SBX 7 FX1 37C6 OUTPARAM 0,A1,ADATA,AWDOC 37CS ADX 7 FX1 37DG EXIT 7 0 37F8 # 37FW XHTAWP 37GJ MHUNTW 3,ADATA,AWPER 37H= EXIT 7 0 37HY # 37K6 QK1WHATPERA 384Q STO 5 AWORK2(2) [SAVE PER TYPE 38JB CALL 7 XHTAWP 3942 LDX 2 3 [SAVE X3 39HL LDN 4 A1+5 3=3= STO 4 A1(3) [INTERNAL POINTER 3=GW ADN 3 A1+5 [INT PTR TO FIRST REC HDDR 3?2G BRN ST1 3?G6 UPD LDX 2 FX2 3?^Q LDX 3 AWORK1(2) 3#FB REWX SBN 3 1 3#^2 BNG 3 NO [J IF NO MORE 3*DL REWIND 0(3) [REWIND ANY FILES OPEN 3*Y= BRN REWX 3BCW NO LDX 5 AWORK2(2) [RESTORE PER TYPE 3BXG CALL 7 XHTAWP 3CC6 LDX 2 3 [SAVE X3 3CWQ LDX 4 A1+1(3) 3DBB SBN 4 1 3DW2 BZE 4 NOUGH [J IF NO MORE RECS IN BLK 3F*L STO 4 A1+1(3) [UPDATE COUNT OF RECS 3FT= LDN 4 K54-K50+14 [LENGTH OF THIS RECORD 3G#W ADS 4 A1(3) [POINTER SET TO NEXT RECORD 3GSG ADX 3 A1(3) [ABSOLUTE POINTER TO NEXT RECORD 3H#6 ST1 3HD3 ... JENVNOT ST2,CME 3HHY JSWOUT 3,SWITOUT [J IF SWITCHED OUT 3HXM ...ST2 LGEOG 3,0 3J?B SMO FX2 3JR2 STO 0 AWORK3 3K=L LDX 0 5 3KQ= SBN 0 28 3Q6W BZE 0 PB [J IF IPB TYPE 28 3QLG JWRONG 3,WRONGED [J IF WRONGED 3R66 JONL 3,ONLINE [J IF ONLINE 3RKQ LDX 0 5 3S5B SBN 0 9 3SK2 BZE 0 TABLA 3T4L SBN 0 16 3YG2 BZE 0 TABLA 3Y^L JALLOC 3,OWNED 3^F= LDX 0 5 3^YW SBN 0 5 42DG BNZ 0 XIDLE [J IF NOT MAG TAPE 42Y6 LDX 0 K54-K50+8(3) 43CQ ANDN 0 #10 43XB BZE 0 XIDLE [J IF TAPE NOT LOADED 44C2 CALL 7 OUTNUM 44WL LDN 0 1 45B= BRN MTINFO [BRN TO OUTPUT MT INFO 66S2 #SKI IPCV1 67?L ( 67R= PB LDX 6 K54-K50+8(3) 68=W BNZ 6 PBAL [J IF ANY LINKS 68QG JENG 3,UNOP 69=6 BRN XIDLE 69PQ PBAL JDISENG 3,USIN 6=9B CALL 7 OUTNUM 6=P2 LDX 0 6 6?8L CALL 7 OUTNUM2 6?N= LDX 7 XFLINK(1) [ALLOCATED & OPERABLE 6#7W BRN MONOUTX 6#MG UNOP CALL 7 OUTNUM 6*76 LDX 7 XFUNOP(1) [NOT ALLOCATED BUT OPERABLE 6*LQ BRN MONOUTX 6B6B USIN CALL 7 OUTNUM 6BL2 LDX 0 6 6C5L CALL 7 OUTNUM2 6CK= LDX 7 XFUSIN(1) [ALLOCATED BUT INOPERABLE 6D4W BRN MONOUTX 6DJG ) 6F46 TABLA 6FHQ JFREE 3,XIDLE 6G3B CALL 7 OUTNUM 6GH2 LDX 7 XFUSSY(1) 6H2L BRN MONOUTX 6H5Q SWITOUT 6H8W CALL 7 OUTNUM 6H#2 LDX 7 XFSWO(1) 6HC6 BRN MONOUTX 6HG= WRONGED 6H^W CALL 7 OUTNUM [OUTPUT OPERATORS NO. 6JFG LDN 0 3 6J^6 BRN XMONTX 6KDQ XIDLE 6KYB CALL 7 OUTNUM [OUTPUT OPERATORS NO. 6LD2 LDN 0 4 6LXL BRN XMONTX 6MC= OWNED 6MWW LDX 0 5 6NBG SBN 0 5 6NW6 BZE 0 OWNTP 6P*Q JENG 3,USSY [J IF NOT "RESERVED & UNENGAGED" 6PTB BRN RESNE 6Q*2 OWNTP LDX 0 K54-K50+8(3) 6QSL ANDN 0 #10 6R#= BNZ 0 USSY [J IF TAPE LOADED 6RCT RESNE 6RHD CALL 7 OUTNUM [OUTPUT OPERATORS NO. 6RM3 LDN 0 2 6RQL XMONTX 6RW9 LDX 4 5 6R^S SBN 4 5 6S5C BZE 4 XMONMT 6S92 SMO 0 6S#K LDX 7 XMES1(1) 6SD8 BRN MONOUTX 6SHR XMONMT 6SMB CALL 4 XMODE 6SR6 BRN MONOUTX 6T=Q # 6TQB UNMT LGEOG 3,6 [OPS NO TO X6 6W4R LDN 0 9 6WC8 CALL 7 XOUTBLK 6WPL LDX 0 6 6X9= CALL 7 OUTNUM2 [O/P UNIT NUMBER 6XNW CALL 7 XHTAWP 6Y8G ADX 3 A1(3) 6YN6 JJOBLMT 3,XJOBL 6^7Q STEP3 LDX 2 FX2 6^MB LDX 3 AWORK1(2) [TO REF :SYS.DOC =LOWEST FILE OPENED 7272 SBN 3 1 [BY COMMAND 72LL CALL 7 XSTEP 736= BZE 3 XJOBL [J IF END OF FILE 73KW LDX 2 1(3) 745G TXU 2 XHDDR(1) [J IF MT RECORD 74K6 BCC STEP3 754Q BZE 2 STEP3 [J IF NONS-TAPE REC 75JB SRL 2 12 [POINTER TO 1ST PERIPHERAL WORD 7642 ADX 2 3 [DATUMISE POINTER 76HL SBN 2 A1 773= LDX 4 1(2) [2ND PERIPHERAL WORD 77GW ANDN 4 #777 782G TXU 4 6 78G6 BCS STEP3 78^Q LDX 1 2(3) [CH COUNT 79FB ADN 3 3 79^2 HUNT 2,ADATA,AWDOC 7=DL LDN 4 A1(2) 7=Y= MVCH 3 0(1) [COPY DOCUMENT NAME 7?=M LDX 0 1 7?K4 CALL 7 XOUTPRM 7?XG LDX 7 XFDOC(1) 7#C6 BRN MONOUTX 7#WQ # SLOW INPUT PER : JOBLIMIT REACHED 7*BB # THIS SECTION SEARCHES THE QUEUE FOR ACTS WAITING IN STYLES #6 OR 7*W2 # #44 AS THESE HAVE DIFFERENT MESSAGES 7B*L XJOBL LDN 7 FLOWQ 7BT= XLP LDX 3 7 7C#W LDX 3 FPTR(3) 7CSG TXU 3 XQEND(1) 7D#6 BCC XJOBL1 7DHY NOTEND 7DRQ LDX 7 3 7F?B SBN 3 CHAINADD 7HPG LDN 4 1 7J96 LDEX 0 ATYPE(3) [CHECK FOR 7JNQ SBN 0 IWTDEST [WAITING STYLE 7K8B BZE 0 XDRED [IWTDEST 7KN2 LDEX 0 ATYPE(3) 7L7L SBN 0 6 7LM= BZE 0 XYZ 7M6W SBN 0 #36 7MLG BNZ 0 XLP 7N66 LDN 4 0 7N=J XYZ 7NC2 LDX 0 JSOURCE1(3) [CHECK 7NHD ANDN 0 #777 [FOR 7NMW TXU 6 0 [GEOGRAPHIC 7NS# BCS XLP [NUMBER 7NYQ BNZ 4 XFILE 7P5B CALL 7 OUTMESS 7PK2 +FJOBLIM 7Q4L XJOBL1 7QJ= LDX 7 XFUSSY(1) 7R3W BRN MONOUTX 7R8# XDRED 7R#Q LDX 0 JSOURCE1(3) [CHECK 7RF8 ANDN 0 #777 [FOR 7RKL TXU 6 0 [GEOGRAPHIC 7RQ4 BCS XLP [NUMBER 7RWG CALL 7 OUTMESS 7S36 +FDRED 7SGQ BRN XJOBL1 7T2B # THIS SECTION SEARCHES FILE CHAIN FOR FILE FOR WHICH ACT WAITS. 7TG2 XFILE 7T^L FINDLINK 3,3 7WF= # THIS CASE OF WAITING STYLE 6: X5 & X6 HAVE BACK1 & BACK2 7WYW LDX 6 ACC5(3) 7XDG LDX 7 ACC6(3) [SEARCH FOR FCB 7XY6 GFCBC 7,3,ZNOT 83*G ADN 3 FUSE1 [SET X3 -> USER NAME 83T6 CALL 4 UPCLOSE 84#Q ZNOT LDX 7 YFILE(1) 84SB BRN MONOUTX 85#2 # PERIPHERAL BEING USED BY SYSTEM 85RL USSY 86?= BZE 5 UNMT [BRN IF TR 86QW TXU 5 XCR(1) 87=G BCC UNMT [BRN IF C.R. 87Q6 CALL 7 OUTNUM [O/P GEOG NO 889Q LDX 7 XFUSSY(1) 88PB TXU 5 MTNO(1) 8992 BCS MONOUTX 89DS LDN 0 0 89NL BRN MTINFO 8=8= # 8=MW # DEVICE ONLINE TO A JOB 8?7G # 8?M6 ONLINE 8?NC CALL 7 OUTNUM 8?PN LDX 0 5 8?Q^ SBN 0 5 8?S= BZE 0 XOLA [J IF MT 8?TH LDX 7 XFONLINE(1) 8?WS BRN XOLB 8?Y5 XOLA 8?^B LDN 0 5 8#2M CALL 4 XMODE [OUTPUT TAPE MODE 8#3Y XOLB 8#59 MONOUTX 7 8#5P CALL 7 XHTAWP 8#69 ADX 3 A1(3) 8#6Q LJOBNO 3,4 8*KL LDX 0 4 8B5= CALL 7 OUTNUM2 [OUTPUT JOB NO. 8BJW CALL 7 XHTAWP 8C4G SMO A1(3) 8CJ6 LDN 3 K54-K50+1(3) 8D3Q CALL 4 UPCLOSE 8DHB OUTOL 8F32 CALL 7 XHTAWP 8FGL LDX 7 XFOLJOB(1) 8G2= ADX 3 A1(3) [X3 IS ABSOLUTE POINTER 8GFW JFAIL 3,PHAIL 8G^G BRN NOTFAIL 8HF6 PHAIL 8HYQ MONOUTX 7 8JDB LDX 7 XFFAIL(1) 8JY2 NOTFAIL 8KCL LDX 5 AWORK2(2) 8KX= TXU 5 MTNO(1) 8LBW BCS MONOUTX [J IF NOT MT 8LLN BRN MTINFX 8LWG # 8MB6 # ON ENTRY TO THIS SECTION X7 CONTAINS MESSAGE FOR OUTPUT 8MTQ # 8N*B MTINFO 8NGJ CALL 4 XMODE 8NMQ MTINFX 8NT2 MONOUTX 7 [OUTPUT MESSAGE IN X7 8P#L CALL 7 XHTAWP 8PS= ADX 3 A1(3) 8Q?W LDX 6 K54-K50+7(3) [GET TSN 8QRG LDX 5 K54-K50+8(3) 8R?6 ANDN 5 1 8RQQ BZE 5 WTEST 8S=B NGN 5 1 [SET X5=-1 IF NONS TAPE 8SQ2 WTEST JWPR 3,WPR1 8T9L LDN 4 1 [SET X4=1 IF NO WPR 8TP= BRN TNONS 8W8W WPR1 STOZ 4 [SET X4=0 IF WPR 8WNG TNONS BPZ 5 NOTNS [J IF STANDARD 8X86 CALL 7 MONOUT 8XMQ +FNONS [OUTPUT MESSAGE-NO TSN FOR NON STAN 8Y7B BRN STEPX 8YM2 NOTNS BZE 6 NFD [J IF NO STN=INTERMEDIATE STATE 8Y^C LDN 0 12 8^?S CALL 7 XOUTBLK 8^L= LDX 5 6 [THIS WILL UNSET BIT 0 AS XENO TAPE 925W ANDX 6 XBIT(1) [MARKER IS THIS 92KG CALL 7 OUTOCT [CONVERT TSN 9356 LDX 6 5 93JQ LDN 5 0 944B BZE 4 WPR [J IF WPR 94J2 OUTNULL 953L BRN NOWPR 95H= WPR CALL 7 OUTMESS 962W +FWPR [OUTPUT WPR INFORMATION 96*? NOWPR 96MN CALL 7 XHTAWP 9726 ADX 3 A1(3) 97FQ JONL 3,ONL 97^B STOZ 4 98F2 BRN NONL 98YL ONL LDN 4 1 99D= NONL 99XW LDX 7 K54-K50+8(3) 9=CG ANDN 7 2 9=X6 BNZ 7 UWT [J IF WORKTAPE 9?BQ # 9?WB # THIS SECTION INVOLVES A SEARCH THRO :SYS.SER 9#B2 # IN CASE THE TAPE SHOULD BE A USED WORKTAPE 9#TL # 9**= SERCH STOZ AWORK4(2) 9*SW LDX 3 AWORK1(2) 9B#G SBN 3 2 9BS6 CALL 7 XSTEP 9C?Q BZE 3 NOTWT [J IF END OF FILE 9CRB TXU 6 1(3) 9D?2 BCS SERCH [J IF NO TSN MATCH 9DQL LDX 7 5(3) 9F== SLL 7 1 9FPW BPZ 7 NOTWT [J IF NOT WORKTAPE 9G9G LDN 7 1 9GP6 STO 7 AWORK4(2) [SET WORKTAPE MARKER 9H8Q LDX 7 2(3) 9HNB BZE 7 UWT [J IF UNUSED WORKTAPE 9J82 BNZ 4 UWT [J IF O/L TO A PROGRAM 9JML # 9K7= # FOR A WORKTAPE IN USE BY BUT NOT O/L TO A PROGRAM 9KLW # THIS ROUTINE TRUNCATES TRAILING SPACES FROM USER NAME FOR O/P 9L6G # 9LL6 LDX 4 3 9M5Q SLC 3 2 9MKB ADN 3 11 9N52 SRC 3 2 [X3-> END OF USERNAME IN :SYS.SER REC 9NJL RND LDCH 0 2(3) 9P4= SBN 0 #20 9PHW BNZ 0 OUT 9Q3G SLC 3 2 9QH6 SBN 3 1 9R2Q SRC 3 2 9RGB BRN RND 9S22 OUT SLC 3 2 9SFL SLC 4 2 9S^= SBX 3 4 9TDW ADN 3 1 [X3 CONTAINS NO OF CHARS FOR O/P 9TYG LDX 7 3 9WD6 SRC 4 2 9WXQ LDX 3 4 [RESTORE :SYS.SER REC POINTER 9XCB MHUNTW 2,ADATA,AWDOC [FIND /AWDOC BLK FOR USERNAME 9XX2 LDN 4 2(3) 9YBL LDN 5 A1(2) 9YW= SMO 7 9^*W MVCH 4 0 [MOVE USER NAME INTO STORAGE BLOCK 9^N? LDX 0 7 =22N CALL 7 XOUTPRM =2*6 CALL 7 MONOUT =2SQ +FUSEWTXX =3#B LDN 5 1 [SET STAN TAPE MARBER =3S2 BRN STEPX =4?L UWT CALL 7 OUTMESS =4R= +FWTAPE =5=W LDN 5 1 [SET STAN TAPE MARKER =5QG STO 5 AWORK4(2) [SET WORKTAPE MARKER =6=6 BRN STEP1 =6PQ NOTWT =79B BPZ 6 NOTX [J IF NOT A XENOTAPE =7P2 CALL 7 OUTMESS =88L +FXEN =8N= LDN 5 1 [SET XEN MARKER =97W BRN STEP1 =9G? NOTX =9SN CALL 7 XHTAWP ==76 ADX 3 A1(3) ==LQ LDX 3 K54-K50+8(3) =?6B ANDN 3 4 =?L2 BZE 3 STEP1 [J IF NOT POOL TAPE =#5L CALL 7 OUTMESS [OUTPUT MESS =#K= +FPTAPE =*4W STEP1 =*JG CALL 7 MONOUT [OUTPUT TSN ETC =B46 +FTNO =BHQ STEPX LDX 3 AWORK1(2) =C3B BZE 3 UPD =CH2 SBN 3 1 =D2L CALL 7 XSTEP =DG= BZE 3 NFD [J IF END OF FILE =D^W LDX 0 1(3) =FFG BZE 0 NONST [J IF NONS TAPE =F^6 TXU 0 XHDDR(1) =GDQ BCS STEPX [J IF NOT MT RECORD =GYB NONST LDX 0 23(3) =HD2 ANDN 0 #777 =HXL TXU 0 AWORK3(2) =JC= BCS STEPX =JWW LDX 7 21(3) =KBG STO 7 AWORK3(2) [SAVE WORD 21 =KW6 MHUNTW 2,ADATA,AWDOC =L*Q LDN 4 A1(2) =LTB ADN 3 3 =M*2 MOVE 3 6 [MOVE IN NAME AND REEL INFO =MSL BPZ 5 STAN [J IF NOT NONSTANDARD =N#= NSTAN OUTMOND 12,A1,XCAT(1),ADATA,AWDOC =NRW BZE 6 UPD [J IF NONS TAPE =P?G BNG 6 UPD [J IF XENOTAPE =PR6 BRN TSTIN [OUTPUT TAPE NAME =Q=Q STAN =QQB MHUNTW 2,ADATA,AWDOC =R=2 LDX 7 A1+3(2) [REEL =RPL LDX 4 A1+4(2) [FGN =S9= LDX 3 A1+5(2) [RET PERIOD =SNW LDX 0 7 =T8G ANDN 3 #7777 =TN6 ADX 0 3 =W7Q ANDN 4 #7777 =WMB ADX 0 4 =X72 BZE 0 NSTAN [J IF ALL ZERO =XCX LDX 6 7 =XNS LDN 0 10 =X^P CALL 7 XOUTBLK =Y=L LDN 0 12 =YHH CALL 7 XOUTPRM =YSD LDX 0 6 =^5G CALL 7 OUTNUM2 =^K6 LDX 0 4 ?24Q CALL 7 OUTNUM2 ?2JB LDX 0 3 ?342 CALL 7 OUTNUM2 ?3HL CALL 7 MONOUT ?43= +FMTI [OUTPUT MESS ?4GW TSTIN LDCT 7 #200 ?52G ANDX 7 AWORK3(2) ?5G6 BNZ 7 TINS [J IF INSECURE TAPE ?5^Q NOXEN LDX 7 AWORK4(2) ?6FB BNZ 7 PROP [J IF WORKTAPE ?6^2 LDX 3 AWORK1(2) ?7DL SBN 3 2 ?7Y= STEPAGAIN 0(3) ?8CW BZE 3 NFD ?8XG LDX 4 5(3) [SET UP X4 IN CASE NOT OWNED ?9C6 LDX 0 2(3) ?9WQ BZE 0 XDEAD [J IF NOT OWNED ?=BB MHUNTW 2,ADATA,AWDOC ?=W2 LDN 4 A1(2) ??*L ADN 3 2 ??T= MOVE 3 4 ?##W LDX 4 3(3) [WORD 5 OF RECORD ?#M? LDN 0 12 ?#^N CALL 7 XOUTPRM ?*#6 BPZ 4 NULL [J IF NOT TO BE RETURNED ?*RQ CALL 7 OUTMESS ?B?B +FGOING ?BR2 NULL CALL 7 MONOUT ?C=L +FLTAPE ?CQ= ANDN 4 #7777 [CT OF USERS WAITING ?D9W BZE 4 XDEAD [J IF NO ONE USING OR WAITING ?DPG SBN 4 1 ?F96 BZE 4 XDEAD [J IF NO USERS WAITING ?FNQ LDX 0 4 ?G8B CALL 7 OUTNUM2 ?GN2 CALL 7 MONOUT ?H7L +FNUS ?HM= XDEAD LDCT 0 #100 ?J6W ANDX 0 4 ?JLG BZE 0 XLIVE [J IF NOT TO BE DEADED ?K66 CALL 7 MONOUT ?KKQ +FDEAD ?L5B XLIVE LDCT 0 #20 ?LK2 ANDX 0 4 ?M4L BZE 0 XOP [J IF NOT WRONGED BY USER ?MJ= CALL 7 OUTMESS ?N3W +JCOM ?NHG BRN RIGHT ?P36 XOP LDCT 0 #10 ?PGQ ANDX 0 4 ?Q2B BZE 0 PROP [J IF NOT WRONGED BY OPS ?QG2 CALL 7 OUTMESS ?Q^L +JOPCON ?RF= RIGHT LDX 7 XFTWRONG(1) ?RYW BRN MONOUTX ?SDG TINS LDX 7 XFTINS(1) ?SY6 MONOUTX ?TCQ MONOUTX 7 ?TXB # THIS SECTION ANALYSES AND O/P INFOR ON PROPERTIES ?WC2 PROP LDN 6 1 [MARKER ?WWL LDN 7 ATTMAX ?XB= ROUN MHUNTW 3,ADATA,AWPER ?XTW ADX 3 A1(3) [X3->RECORD BEING PROC ?Y*G ROUND SMO 7 ?YT6 LDX 4 K54-K50+8(3) ?^#Q BNZ 4 PHOUND [FOUND A PROP ATTRIBUTED ?^SB BCT 7 ROUND #2#2 BRN UPD #2RL PHOUND #3?= BZE 6 OPDON [J IF NOT 1ST PROP FOUND #3QW MONOUT HPROPS #3Y4 OPDON #45= #UNS HWATIDY #4=D APROPNAME 4,0 #4CL #UNS HWATIDY #4JS #SKI #4Q6 PROPNAME 4 [GET PROPERTY NAME #59Q OUTBLOCN 8 [SET UP O/P PARAM BLOCK #5PB # #692 # ACOMMUNE4 IS SET THUS:- #6NL # B0=1 => EXCL #78= # B1=1 => PERM #7MW OUTPARN 12,ACOMMUNE1 #8M6 LDX 6 XINCL+1(1) #96Q LDXC 4 ACOMMUNE4(2) #9LB BCS PERM [J IF EXCLUSIVE #=62 LDX 6 XINCL(1) #=KL PERM STO 6 ACOMMUNE2(2) #?5= LDX 6 TEMP+1(1) #?JW ADXC 4 4 [THIS SETS C IF B1 IS SET ##4G BCS NOTTP [J IF PERM ##J6 LDX 6 TEMP(1) #*3Q NOTTP STO 6 ACOMMUNE1(2) #*HB OUTPARN 4,ACOMMUNE1 #B32 OUTPARN 4,ACOMMUNE2 #BGL MONOUT HPROPS1 #C2= LDN 6 0 #CFW BCT 7 ROUN #C^G BRN UPD #DF6 NOUGH LDX 2 FX2 #DYQ LDX 3 AWORK1(2) [NO OF FILES OPEN #FDB BZE 3 RONG1 #FY2 WC1 CLOSE [CLOSE ALL FILES #GCL WC2 BCT 3 WC1 #GH5 RONG1 #H?B OFF AWHATBIT [GIVE THE ALL CLEAR #H#= ...#SKI G203&1 #H*6 ... ACROSS WHATPER,7 #HB2 ...#SKI G203&1$1 #HBW FON #114 #HSL TOENDCOM #HWG ENDCOM #JB6 NFD LDX 7 XFNFD(1) #JTQ BRN MONOUTX #K*B # SUBROUTINES TO OUTPUT MESS IN LOCN FOLLOWING CALL #KT2 MONOUT #L#L LDX 1 7 #LS= SBX 7 FX1 #M?W MONOUTX 0(1) #MRG ADX 7 FX1 #N?6 EXIT 7 1 *4FQ OUTMESS *4^B LDX 1 7 *5F2 SBX 7 FX1 *5YL OUTMESSX 0(1) *6D= ADX 7 FX1 *6XW EXIT 7 1 *7CG # SUBROUTINE TO OUTPUT DECIMAL NO IN X0 *7X6 OUTNUM *8BQ LGEOG 3,0 [GET OPS NO *8WB OUTNUM2 *9B2 SBX 7 FX1 *9TL OUTNUM 0,0 *=*= ADX 7 FX1 *=SW EXIT 7 0 *?#G # *?S6 # SUBROUTINE TO OUTPUT AN OCTAL NO. IN X6 *#?Q # *#RB OUTOCT **?2 SBX 7 FX1 **QL CONSERNO 6 [CONVERT SERIAL NUMBER *B== MHUNTW 2,FLIB,FTSN *BPW OUTPARAM A1(2),A1+1,FLIB,FTSN *C9G ADX 7 FX1 *CP6 EXIT 7 0 *CPF # *CPS # *CQ7 # SUBROUTINE TO OUTPUT RECORDING MODE *CQG # *CQT XMODE *CR8 STO 0 AWORK4(2) [SAVE MESSAGE *CRH SBX 4 FX1 *CRL CALL 7 XHTAWP *CRP ADX 3 A1(3) *CRW LPROP 3,0 *CS9 SRC 0 8 *CSJ BNG 0 XMD9 [J IF 9TRACK *CSX LMODEQ 3,0 *CT= CALL 7 OUTNUM2 *CTK BRN XMDEND *CTY XMD9 *CW? SLC 0 5 *CWL BPZ 0 XMDENDA [J IF NOT SWITCHABLE *CW^ SLL 0 1 *CX# BNG 0 XMD1 *CXM CALL 7 OUTMESS *CY2 +FNRZI *CY* BRN XMDEND *CYN XMD1 *C^3 SLL 0 1 *C^B BNG 0 XMD2 *C^P CALL 7 OUTMESS [JMODE IS PE *D24 +FPE *D2C BRN XMDEND *D2Q XMD2 *D35 CALL 7 OUTMESS [MODE IS GCR *D3D +FGCR *D3R XMDEND *D46 LDX 0 AWORK4(2) *D4F SMO 0 *D4S LDX 7 XMES2(1) *D57 BRN XMDENDB *D5G XMDENDA *D5T LDX 0 AWORK4(2) *D68 SMO 0 *D6H LDX 7 XMES1(1) *D6W XMDENDB *D79 ADX 4 FX1 *D7J EXIT 4 0 *D7X # *D8= # *D8Q MENDAREA 50,K99WHATPERA *DNB #END ^^^^ ...55745236000200000000