{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: WHATPERA867)}}
====== WHATPERA867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:APROPNAME|APROPNAME]], [[george:macro:CLOSE|CLOSE]], [[george:macro:CONSERNO|CONSERNO]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:FINDLINK|FINDLINK]], [[george:macro:FLENME1|FLENME1]], [[george:macro:FON|FON]], [[george:macro:GFCBC|GFCBC]], [[george:macro:HUNT|HUNT]], [[george:macro:HUNTW|HUNTW]], [[george:macro:JALLOC|JALLOC]], [[george:macro:JDISENG|JDISENG]], [[george:macro:JENG|JENG]], [[george:macro:JENVNOT|JENVNOT]], [[george:macro:JFAIL|JFAIL]], [[george:macro:JFREE|JFREE]], [[george:macro:JJOBLMT|JJOBLMT]], [[george:macro:JONL|JONL]], [[george:macro:JSWOUT|JSWOUT]], [[george:macro:JWPR|JWPR]], [[george:macro:JWRONG|JWRONG]], [[george:macro:LGEOG|LGEOG]], [[george:macro:LJOBNO|LJOBNO]], [[george:macro:LMODEQ|LMODEQ]], [[george:macro:LPROP|LPROP]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUT|MONOUT]], [[george:macro:MONOUTX|MONOUTX]], [[george:macro:OFF|OFF]], [[george:macro:OUTBLOCK|OUTBLOCK]], [[george:macro:OUTBLOCN|OUTBLOCN]], [[george:macro:OUTMESS|OUTMESS]], [[george:macro:OUTMESSX|OUTMESSX]], [[george:macro:OUTMOND|OUTMOND]], [[george:macro:OUTNULL|OUTNULL]], [[george:macro:OUTNUM|OUTNUM]], [[george:macro:OUTPARAM|OUTPARAM]], [[george:macro:OUTPARN|OUTPARN]], [[george:macro:PROPNAME|PROPNAME]], [[george:macro:REWIND|REWIND]], [[george:macro:RIGHT|RIGHT]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SIX|SIX]], [[george:macro:STEP|STEP]], [[george:macro:STEPAGAIN|STEPAGAIN]], [[george:macro:XYZ|XYZ]]
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