{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: DICTWELL867)}}
====== DICTWELL867 ======
(George Source)
**Macros used:** [[george:macro:ALTLENG|ALTLENG]], [[george:macro:BXE|BXE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:DOWN|DOWN]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FSHENTRY|FSHENTRY]], [[george:macro:GETJOB|GETJOB]], [[george:macro:HUNT2J|HUNT2J]], [[george:macro:LOSEPARS|LOSEPARS]], [[george:macro:MFREE|MFREE]], [[george:macro:OPENSYS|OPENSYS]], [[george:macro:POP|POP]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETMODE|SETMODE]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SKIP|SKIP]], [[george:macro:STEP|STEP]], [[george:macro:STEPAGAIN|STEPAGAIN]], [[george:macro:STEPREWRITE|STEPREWRITE]], [[george:macro:STEPWRITE|STEPWRITE]], [[george:macro:TESTRPN2|TESTRPN2]], [[george:macro:UP|UP]], [[george:macro:USEROPEX|USEROPEX]], [[george:macro:VOP|VOP]]
22FL #OPT K0DICTWELL=0
22^= #LIS K0DICTWELL
23=L ... SEG DICTWELL,867,SECTION CENT
23J2 ...[
23TB ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982
246Q ...[
24D6 SEGENTRY K1DICTWELL,XK1
24XQ SEGENTRY K2DICTWELL,XK2
25CB SEGENTRY K3DICTWELL,XK3
25X2 SEGENTRY K4DICTWELL,XK4
26BL SEGENTRY K5DICTWELL,XK5
26D9 SEGENTRY K7DICTWELL,XK7
26FS [
26HC [ THE FOLLOWING ENTRY POINTS BELONG TO A SECTION OF
26K2 [ DICTWELL WHICH IS ENTERED DOWN TO UPDATE THE JOBLISTS
26LK [ (THIS SECTION WAS PREVIOUSLY IN SEGMENT REGEN, THEN IN
26N8 [ JWELLONE.)
26PR [
26RB SEGENTRY K8DICTWELL,PRIVON
26S^ SEGENTRY K9DICTWELL,PRIVOFF
26WJ FSHENTRY K10DICTWELL,,PRIVUPD,PRIVUPD
26Y7 FSHENTRY K11DICTWELL,XK11,,XK11
26^Q [
27*W #
27TG # THIS SEGMENT IMPLEMENTS THE DICTWELL AND DICTJL MACROS.
28*6 # IT IS ENTERED WHEN A USER :-
28SQ # 1, BECOMES OVERDRAWN OR SOLVENT (K2)
29#B # 2. GAINS A PRIVILEGE (K3)
29S2 # 3. LOSES A PRIVILEGE (K4)
2=?L # 4. BECOMES FROZEN (K5)
2=R= # 5. BECOMES THAWED (K7)
2?=W #
2?QG # IT IS ALSO ENTERED AT K1 BY DICTJL TO DECANT THE JWELL/ADICTWELL
2#=6 # BLOCK.
2#PQ #
2*9B #
2*P2 XDWTYPE
2B8L #HAL +JWELL+ADICTWELL,0
2BN= #
2C7W # SUBROUTINE TO HUNT FOR A DICTWELL BLOCK. ENTRY AT XHUNT HUNTS ALL
2CMG # MISCELLANEOUS CHAIN FOR BLOCK WITH CURRENT ACTIVITY'S JOB NO
2D76 # ENTRY AT XHUNTNEXT FINDS NEXT BLOCK FROM POINTR IN X3.
2DLQ XHUNTNEXT
2F6B BVCI XHNT1 [SET V AS MARKER
2FL2 XHUNT LDN 3 BMISC
2G5L XHNT1 LDX 3 BPTR(3)
2GK= BXE 3 CXMI,XHNT2 [J IF END OF CHAIN
2H4W LDX 0 ATYPE(3)
2HJG SMO FX1
2J46 BXU 0 XDWTYPE,XHNT1
2JHQ BVSR (4) [NO JOBNO CHECK IF XHUNTNEXT
2K3B LDX 0 ADWJOBNO(3)
2KH2 BXE 0 JOBNO(2),(4)
2L2L BRN XHNT1
2LG= XHNT2 NGN 3 #7777
2L^W BVSR £
2MFG EXIT 4 0
2M^6 #
2NDQ # REFIND SUBROUTINE FOR ALTLENG
2NYB REFIND
2PD2 CALL 4 XHUNT
2PXL LDX 2 3
2QC= EXIT 1 0
2QWW #
2RBG # SUBROUTINE TO LOOK FOR THE USER SPECIFIED IN ACOMMUNE1,2,3 IN THE
2RW6 # ADICTWELL BLOCK WHOSE ADDRESS IS IN X3
2S*Q UFIND STO 5 ACOMMUNE4(2)
2STB STO 6 ACOMMUNE5(2)
2T*2 STO 7 ACOMMUNE6(2)
2TSL LDX 1 3
2W#= SBN 1 ADWELEMENT
2WRW ULOOP ADN 1 ADWELEMENT
2X?G LDX 5 ADWUSER(1)
2XR6 BZE 5 UXIT1 [J IF END OF BLOCK REACHED
2Y=Q LDX 6 ADWUSER+1(1)
2YQB LDX 7 ADWUSER+2(1)
2^=2 TXU 5 ACOMMUNE1(2)
2^PL TXU 6 ACOMMUNE2(2)
329= TXU 7 ACOMMUNE3(2)
32NW BCS ULOOP [J IF NO MATCH
338G UXIT LDX 5 ACOMMUNE4(2)
33N6 LDX 6 ACOMMUNE5(2)
347Q LDX 7 ACOMMUNE6(2)
34MB EXIT 0 0
3572 UXIT1 ORX 1 GSIGN [X1=-VE IF USER NOT FOUND
35LL BRN UXIT
366= #
36KW # FREEZE ENTRY
36N5 #
36Q# XNOTINB
36WQ XK5
37GP LDCT 7 #100
37K6 BRN XDRWN
384Q # CANCEL FREEZE ENTRY
385R #
386S XNOTINBA
388W XK7
38H8 LDCT 7 #40
38JB BRN XDRWN
3942 # OVERDRAWN/SLOVENT ENTRY
3964 #
3986 XNOTINBB
39#= XK2
39YW LDCT 7 #400
3=3= ANDX 7 ACOMMUNE4(2)
3=GW BNG 7 XDRWN [J IF OVERDRAWN
3?2G LDCT 7 #200
3?G6 XDRWN LDN 5 0
3?^Q LDN 6 0
3#FB BRN MAIN
3#^2 # ENTRY FOR GAINING PRIVILEGE
3*34 #
3*56 XNOTINBC
3*9= XK3
3*TW LDX 5 ACOMMUNE4(2)
3*Y= LDN 6 0
3BCW BRN PRIV
3BXG # ENTRY FOR LOSING PRIVILEGE
3B^J #
3C3L XNOTINBD
3C7Q XK4
3CSB LDN 5 0
3CWQ LDX 6 ACOMMUNE4(2)
3DBB PRIV LDN 7 0
3DW2 MAIN CALL 4 XHUNT [LOOK FOR EXISTING ADICTWELL BLOCK
3F*L BPZ 3 XFND [J IF ONE FOUND
3FT= SETNCORE ADWUSER+ADWELEMENT+1-A1,3,JWELL,ADICTWELL
3G#W LDX 0 JOBNO(2)
3GSG STO 0 ADWJOBNO(3)
3H#6 STOZ ADWUSER(3)
3HRQ CHAIN 3,BMISC+1
3J?B XFND CALL 0 UFIND [LOOK FOR REQUESTED USER
3JR2 BPZ 1 SETBITS [J IF FOUND
3K=L ERX 1 GSIGN
3KQ= SBX 1 3
3L9W ADN 1 ADWUSER+ADWELEMENT+1-A1
3LPG BXL 1 ALOGLEN(3),XADD
3M96 BXE 1 ALOGLEN(3),XADD
3MNQ STO 1 AWORK1(2)
3N8B ALTLENG 3,AWORK1(2),REFIND
3NN2 CALL 4 XHUNT
3P7L LDX 1 AWORK1(2)
3PM= XADD SBN 1 ADWUSER+ADWELEMENT+1-A1
3Q6W ADX 1 3
3QLG STOZ ADWUSER+ADWELEMENT(1)
3R66 LDX 0 ACOMMUNE1(2)
3RKQ STO 0 ADWUSER(1)
3S5B LDX 0 ACOMMUNE2(2)
3SK2 STO 0 ADWUSER+1(1)
3T4L LDX 0 ACOMMUNE3(2)
3TJ= STO 0 ADWUSER+2(1)
3W3W STOZ ADWPRIVG(1)
3WHG STOZ ADWPRIVT(1)
3X36 STOZ ADWMNYFZ(1)
3X6= SETBITS
3X9B ORS 5 ADWPRIVG(1)
3X#G ORS 6 ADWPRIVT(1)
3XCL ORS 7 ADWMNYFZ(1)
3XGQ #
3Y2B # NOW CLEAR THE OPPOSITE BITS IN ALL THE ELEMENTS FOR THE SAME USER
3YG2 #
3Y^L LDCT 0 #500
3^F= ANDX 0 7
3^YW SRL 0 1
42DG LDCT 4 #240
42Y6 ANDX 7 4
43CQ SLL 7 1
43XB ORX 7 0
44C2 LDN 3 BMISC
44WL XLOOP CALL 4 XHUNTNEXT
45B= BNG 3 XEND [J IF NO MORE ADICTWELL'S
45TW CALL 0 UFIND [LOOK FOR REQUESTED USER
46*G BNG 1 XLOOP
46T6 ORS 6 ADWPRIVG(3)
47#Q ERS 6 ADWPRIVG(3)
47SB ORS 5 ADWPRIVT(3)
48#2 ERS 5 ADWPRIVT(3)
48RL ORS 7 ADWMNYFZ(3)
49?= ERS 7 ADWMNYFZ(3)
49QW BRN XLOOP
4==G XEND UP
4=Q6 #
4?9Q # ENTRY FOR DICTJL
4??S #
4?*W XNOTINBE
4?G2 XK1
4#6L CALL 4 XHUNT
4#92 BNG 3 XEND [NOTHIG TO DO IF NO BLOCK
4#DS
4#NL POPC POP POPC,,JWACCESS
4#R9 CALL 4 XHUNT
4#TS BNG 3 XVEND
4#YD PP LDN 7 0
4*8= XK1LP SMO 7
4*MW LDX 4 ADWUSER(3)
4B7G BNZ 4 MORE [J IF NOT AT END OF BLOCK
4BM6 FREECORE 3
4BWY XVEND
4C6Q VOP ,JWACCESS
4CLB UP
4D62 MORE SMO 7
4DKL LDN 4 ADWUSER(3)
4F5= LDN 5 ACOMMUNE1(2)
4FJW MOVE 4 3
4G4G SMO 7
4GJ6 LDX 4 ADWPRIVG(3)
4H3Q BZE 4 PRIVT
4HHB STO 4 ACOMMUNE4(2)
4J32 DOWN DICTWELL,8
4JGL CALL 4 XHUNT
4K2= PRIVT SMO 7
4KFW LDX 4 ADWPRIVT(3)
4K^G BZE 4 MONEY
4LF6 STO 4 ACOMMUNE4(2)
4LYQ DOWN DICTWELL,9
4MDB CALL 4 XHUNT
4MY2 MONEY SMO 7
4NCL LDX 4 ADWMNYFZ(3)
4NX= BZE 4 NEXT
4PBW STO 4 ACOMMUNE4(2)
4PWG DOWN REGEN,2
4QB6 CALL 4 XHUNT
4QTQ NEXT ADN 7 ADWELEMENT
4R*B BRN XK1LP
4RB5 #
4RBS XNOTINBF
4S?B [
4SR2 [
4T=L [
4TQ= #
4W9W #
4WPG # THIS SECTION IMPLEMENTS THE WKP ON/OFF PART OF THE DICTWELL
4X96 # MACRO
4XNQ #
4Y8B #
4YN2 #DEF SIZELIST=10
4^7L #
4^M= #
526W XJOBLIST +SIZELIST
52LG 12H
5366 12HJOBLIST
53KQ +1
545B +1
54K2 4H****
55PD [N.B. THE FOLLOWING 2 SUBROUTINES CAN'T BE COMBINED
55WL [ DUE TO FORM OF PARAM FOR STEPREWRITE MACRO
563W STEPWRT1
582B SBX 4 FX1
58G2 LDX 3 ACOMMUNE2(2) [POINTER TO RECORD
58^L STEPREWRITE 1 [UPDATE RECORD
5=Y6 #
5?CQ POPX ADX 4 FX1
5?XB EXIT 4 0
5?^K [
5#3S STEPWRITE
5#63 SBX 4 FX1
5#8= LDX 3 ACOMMUNE2(2) [POINTER TO RECORD
5#=F STEPREWRITE 0 [UPDATE RECORD
5##N BRN POPX
5#C2 [
5#WL STEP LDN 3 1
5*B= SBX 4 FX1
5*TW STEP 0(3)
5B5N STO 3 ACOMMUNE2(2) [PRESERVE POINTER TO RECORD
5B*G BRN POPX
5BT6 [
5C#Q STEPAGAIN
5CSB LDN 3 0
5D#2 SBX 4 FX1
5DRL STEPAGAIN 0(3)
5F3D STO 3 ACOMMUNE2(2) [PRESERVE POINTER TO RECORD
5F?= BRN POPX
5FQW [
5G=G PENDP CLOSETOP
5GQ6 CLOSETOP
5H9Q UP2 LDCH 0 ATYPE(2)
5HPB SBN 0 CPAT/64
5J92 BNZ 0 UP1
5JNL LDX 0 AWORK4(2)
5K8= STO 0 JOBEVENTS(2) [RESTORE BREAK IN BITS
5KMW UP1 LOSEPARS
5L7G UP
5LM6 [
5MLB [
5N62 [
5NKL PRIVON
5P5= LDN 7 0
5PJW BRN PRIVUPD
5Q4G PRIVOFF
5QJ6 LDX 7 ACOMMUNE4(2)
5R3Q PRIVUPD
5RHB LDX 6 ACOMMUNE4(2)
5S32 LDN 0 BJOBQ
5SGL STO 0 AWORK1(2)
5T2= LDN 0 JUSER
5TFW STO 0 AWORK2(2)
5T^G LDN 0 JPRIV
5WF6 STO 0 AWORK3(2)
5WYQ CALL 0 SETWKP
5YCL LDN 0 BHLSQ
5YX= STO 0 AWORK1(2)
5^BW LDN 0 HLSUNAM
5^WG STO 0 AWORK2(2)
62B6 LDN 0 HLSPRIV
62TQ STO 0 AWORK3(2)
63*B CALL 0 SETWKP
63T2 #
64#L XNOTB1
65?W LDX 3 ACOMMUNE1(2)
65RG LDX 4 ACOMMUNE2(2)
66?6 LDX 5 ACOMMUNE3(2)
66QQ NXTC LDX 2 ACTRING(2)
67=B SBN 2 ACTRING
67Q2 BXE 2 FX2,NJL [J IF END OF ACTIVITY RING
689L LDCH 0 ATYPE(2)
68P= SBN 0 CPAT/64
6BJQ BNZ 0 NXTC [IGNORE NON-CPATS
6C4B XHUNTB
6CJ2 HUNT2J 1,JWELL,COPYSYS,2,NXTC
6D3L ADN 1 A1
6DH= TXU 3 JLUSER(1)
6F2W TXU 4 JLUSER+1(1)
6FGG TXU 5 JLUSER+2(1)
6G26 BCS NXTC
6GFQ ADX 1 JOBDATASIZE
6G^B ORS 6 JLBUDGETS(1)
6HF2 ERS 7 JLBUDGETS(1)
6HYL BRN NXTC
6JD= NJL
78YG OPENJLS
79D6 [ SET UP FABSNB TO OPEN USER JOBLIST
79XQ SETNCORE SIZELIST,3,FILE,FABSNB
7=CB LDN 5 A1(3)
7=X2 LDN 4 XJOBLIST(1)
7?BL MOVE 4 SIZELIST
7?W= LDN 4 ACOMMUNE1(2)
7#*W LDN 5 A1+1(3)
7#TG MOVE 4 3
7**6 SETMODE 5,GENERAL,UNTRAP,NOERREP
7*SQ LDCH 0 ATYPE(2)
7B#B SBN 0 CPAT/64
7BS2 BNZ 0 NCPA [J IF NOT CPAT
7C?L LDX 0 JOBEVENTS(2)
7CR= STO 0 AWORK4(2)
7D=W LDCT 0 #40
7DQG STO 0 JOBEVENTS(2) [FIDDLE BREAK IN BITS
7F=6 NCPA
7FPQ [ OPEN USER JOBLIST
7G9B SETUPMOD ,4,FROZEN
7GP2 USEROPEX (GEOERR),5,4
7H8L MFREE FILE,FABSNB
7HN= TESTRPN2 OK,UP2
7J7W [
7JMG [ OPEN SYSTEM JOBLIST
7K76 OPENSYS (GEOERR),JOBLIST,GENERAL
7KLQ [
7L6B PNXT CALL 4 STEP
7LL2 BZE 3 PENDP
7M5L LDX 5 JLJOBNO(3)
7MK= ADX 3 JOBDATASIZE
7N4W ORS 6 JLBUDGETS(3)
7NJG ERS 7 JLBUDGETS(3)
7P46 CALL 4 STEPWRT1
7PHQ GETJOB 5,SYSTEM
7Q3B TESTRPN2 OK,PSKP
7QH2 CALL 4 STEPAGAIN
7R2L ADX 3 JOBDATASIZE
7RG= ORS 6 JLBUDGETS(3)
7R^W ERS 7 JLBUDGETS(3)
7SFG CALL 4 STEPWRITE
7S^6 PSKP
7TDQ SKIP 1,3
7TYB BRN PNXT
7WD2 #
7WXL XNOTB3
7XWW [
7YBG SETWKP
7YW6 STO 0 GL2
7^*Q LDX 3 AWORK1(2) [CHAIN TO SEARCH
7^TB SNXT LDX 3 0(3)
82*2 BXE 3 AWORK1(2),(GL2) [RETURN IF END OF CHAIN
82SL LDX 4 AWORK2(2) [POSITION OF USERNAME
83#= ADN 4 2
83RW LDN 5 3
84?G XLP SMO 5
84R6 LDX 0 ACOMMUNE1-1(2)
85=Q SMO 4
85QB TXU 0 0(3)
86=2 BCS SNXT [J IF NAMES DON'T MATCH
86PL SBN 4 1
879= BCT 5 XLP
87NW SMO AWORK3(2) [POSITION OF PRIV WORD
888G LDN 1 0(3)
88N6 ORS 6 0(1)
897Q ERS 7 0(1) [SET/CLEAR BIT
89MB BRN SNXT
8=72 [
8=LL [
8?6= [
8?KW #END
^^^^ ...075163260001