{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: GLOBALS867)}}
====== GLOBALS867 ======
(George Source)
**Macros used:** [[george:macro:ALTLENG|ALTLENG]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CHECKLFN|CHECKLFN]], [[george:macro:COMERR|COMERR]], [[george:macro:COOR3|COOR3]], [[george:macro:DOFINDGV|DOFINDGV]], [[george:macro:DOFINDJV|DOFINDJV]], [[george:macro:DOHUNTGV|DOHUNTGV]], [[george:macro:DOHUNTJV|DOHUNTJV]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:ERROR|ERROR]], [[george:macro:FREECORE|FREECORE]], [[george:macro:LONGON1|LONGON1]], [[george:macro:MFREE|MFREE]], [[george:macro:MHUNT|MHUNT]], [[george:macro:OUTPAR|OUTPAR]], [[george:macro:PARAFREE|PARAFREE]], [[george:macro:PARALYSE|PARALYSE]], [[george:macro:PARAPASS|PARAPASS]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:SHORTEN|SHORTEN]], [[george:macro:SPARANXT|SPARANXT]], [[george:macro:TESTHOOK|TESTHOOK]], [[george:macro:TESTREP|TESTREP]]
22FL ... SEG GLOBALS,,CENT(INSTALLATION HOOKS),,G400
22^= [
23DW [ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982
23YG [
24D6 #
24XQ # THIS CHAPTER IMPLEMENTS THE SETGLOBAL COMMAND,
25CB # WHICH IS PART OF THE GLOBAL VARIABLE FACILITY
25X2 # OF G3+INSTALLATION HOOKS (MARK 2)
26BL #
26W= # IT ALSO IMPLEMENTS THE SP *JBV FACILITY
27*W #
27TG ... SEGENTRY K1GLOBALS,START [SETGLOBAL COMMAND
28*6 ... SEGENTRY K2GLOBALS,STARTJB [FROM SETPB - FOR SP *JBV
28SQ #
29#B # PRELIMINARIES
29S2 #
2=?L # VARIABLE TABLE FORMAT
2=R= #DEF VLOCK=A1+1 [LOCKOUT WORD
2?=W #DEF VDATALEN=A1+2 [POINTER TO END OF USED SPACE,RELAT
2?QG # ENTRY FORMAT
2#=6 #DEF VHEADER=0 [ENTRY HEADER
2#PQ #DEF REDTAPE2=1 [2ND WORD OF RED TAPE
2*9B #DEF VNAME=2 [3 WORD VARIABLE NAME
2*P2 #DEF VDATA=5 [VALUE DATA
2B8L #
2BN= # LOCATE ENTRY
2C7W #
2CMG RLOCA
2D76 LDX 0 AWORK4(2)
2DLQ BNZ 0 RLOCA1
2F6B DOHUNTGV 1
2FL2 BRN RLOC
2G5L RLOCA1
2GK= DOHUNTJV 1
2H4W RLOC
2HJG LDX 0 AWORK4(2)
2J46 BNZ 0 RLOC1 [JIF JV
2JHQ DOFINDGV AWORK1(2),3,1 [ELSE LOCATE GV
2K3B EXIT 7 0
2KH2 RLOC1
2L2L DOFINDJV AWORK1(2),3,1
2LG= EXIT 7 0
2L^W #
2MFG # LOCATE BLOCK
2M^6 #
2NDQ SLOC
2NYB SMO FX2
2PD2 LDX 0 AWORK4
2PXL BNZ 0 SLOC1
2QC= DOHUNTGV 1
2QWW EXIT 7 0
2RBG SLOC1
2RW6 DOHUNTJV 1
2S*Q EXIT 7 0
2STB #
2T*2 # DELETE RECORD
2TSL #
2W#= SDEL
2WRW STO 7 GEN3
2X?G CALL 7 SLOC [X1->VAR BLK
2XR6 LDX 7 VHEADER(3)
2Y=Q LDX 6 3 [END ADDR FOR MOVE
2YQB LDX 5 3
2^=2 ADX 5 7
2^PL LDX 0 VDATALEN(1)
329= ADN 0 A1(1)
32NW SBX 0 3
338G SBS 7 VDATALEN(1) [UPDTE POINTER
33N6 CALL 7 SMOVE
347Q LDX 7 GEN3
34MB EXIT 7 0
3572 #
35LL # APPEND RECORD TO BLOCK
366= #
36KW SAPPD
375G STO 7 GEN3
37K6 LDX 5 ANUM(2)
384Q LDX 0 5
38JB ANDN 0 #7777 [COUNT
3942 ADN 0 3
39HL SRL 0 2 [COUNT IN WORDS
3=3= ADN 0 VDATA-VHEADER [RED TAPE
3=GW SMO VDATALEN(1)
3?2G STO 0 A1+VHEADER(1) [HEADER
3?G6 ANDN 5 3
3?^Q LDN 6 4
3#FB SBX 6 5
3#^2 ANDN 6 3 [SPARE CHARS
3*DL SMO VDATALEN(1)
3*Y= STOZ A1+REDTAPE2(1)
3BCW SMO VDATALEN(1)
3BXG DCH 6 A1+REDTAPE2(1) [2ND WD OF RED TAPE
3CC6 SMO FX2
3CWQ LDN 5 AWORK1 [POINTER TO NAME
3DBB SMO VDATALEN(1)
3DW2 LDN 6 A1+VNAME(1)
3F*L MOVE 5 3 [INSERT NAME
3FT= LDN 5 APARA(2)
3G#W SMO VDATALEN(1)
3GSG LDN 6 A1+VDATA(1)
3H#6 ADS 0 VDATALEN(1)
3HRQ SBN 0 VDATA-VHEADER
3J?B CALL 7 SMOVE
3JR2 LDX 7 GEN3
3K=L EXIT 7 0
3KQ= #
3L9W # EXTEND ENTRY,IF REQUIRED
3LPG #
3M96 SEXT
3MNQ BPZ 5 SEXTX [NO EXTENSION REQUIRED
3N8B LDX 5 6
3NN2 ADN 5 50
3P7L ADX 5 ALOGLEN(1)
3PM= LDX 6 7
3Q6W SBX 6 FX1
3QLG ALTLENG 1,5,SLOCA
3R66 LDX 7 6
3RKQ ADX 7 FX1
3S5B SEXTX
3SK2 EXIT 7 0
3T4L #
3TJ= # SHORTEN BLOCK
3W3W #
3WHG SHORTEN
3X36 LDX 5 VDATALEN(1)
3XGQ ADN 5 50
3Y2B ALTLENG 1,5
3YG2 EXIT 7 0
3Y^L SLOCA
3^F= SMO FX2
3^YW LDX 0 AWORK4
42DG BNZ 0 SLOCA1
42Y6 DOHUNTGV 2
43CQ EXIT 1 0
43XB SLOCA1
44C2 DOHUNTJV 2
44WL EXIT 1 0
45B= #
45TW # CONTRACT ENTRY & INSERT NEW VALUE
46*G # X1->GV BLOCK
46T6 # X3->ENTRY TO BE CONTRACTED
47#Q # X4=AMOUNT BY WHICH TO CONTRACT
47SB # LINK X7
48#2 SCONT
48RL STO 7 GEN3
49?= BZE 4 SCONT1
49QW LDX 5 3
4==G ADX 5 VHEADER(3) [FROM ADDRESS=FOLLOWING ENTRY
4=Q6 LDX 6 5
4?9Q SBX 6 4 [TO ADDRESS=END OF THIS ENTRY
4?PB LDX 0 VDATALEN(1)
4#92 ADN 0 A1(1)
4#NL SBX 0 5 [LENGTH OF MOVE
4*8= CALL 7 SMOVE [DO MOVE
4*MW SBS 4 VDATALEN(1) [UPDATE DATA COUNT
4B7G SBS 4 VHEADER(3) [AND ENTRY HEADER
4BM6 SCONT1
4C6Q LDX 5 2
4CLB ADN 5 APARA
4D62 LDN 6 VDATA(3)
4DKL LDX 0 VHEADER(3)
4F5= SBN 0 VDATA-VHEADER
4FJW CALL 7 SMOVE
4G4G LDX 0 ANUM(2)
4GJ6 ANDN 0 3
4H3Q LDN 7 4
4HHB SBX 7 0
4J32 ANDN 7 3
4JGL DCH 7 REDTAPE2(3) [STORE SPARE CHAR CT
4K2= LDX 7 GEN3
4KFW SCONTX
4K^G EXIT 7 0
4LF6 #
4LYQ # MOVE,POSSIBLY > 512 WORDS
4MDB #
4MY2 SMOVE
4NCL STO 0 GEN0
4NX= SMO FX1
4PBW LDX 0 X512
4PWG SMOVE2
4QB6 TXL 0 GEN0
4QTQ BCC SMOVE1 [J IF 1 MOVE ENOUGH
4R*B SBS 0 GEN0 [REDUCE COUNT BY 512
4RT2 MOVE 5 0
4S#L ADX 5 0
4SS= ADX 6 0
4T?W BRN SMOVE2
4TRG SMOVE1
4W?6 LDX 0 GEN0
4WQQ BZE 0 SMOVEX
4X=B SMO 0
4XQ2 MOVE 5 0
4Y9L SMOVEX
4YP= EXIT 7 0
4^8W X512 +512
4^NG #
5286 # #############################################################
52MQ #
537B # K K 1
53M2 # K K 11
546L # K K 1
54L= # K K 1
555W # KKK 1
55KG # K K 1
5656 # K K 1
56JQ # K K 1
574B # K K 1
57J2 #
583L # #############################################################
58H= #
592W START
59GG ... SEGENTRY K80GLOBALS
5=26 TESTHOOK SGALL [ JUMP IF IN HOOK
5=FQ ... COMERR HOOKONLY [ERROR SG ONLY ALLOWED IN A HOOK
5=^B #
5?F2 ... SEGENTRY K81GLOBALS
5?YL SGALL
5#D=
5#XW #
5*CG # ENTRY POINT FROM COMMAND PROCESSOR
5*X6 # TO IMPLEMENT COMMAND
5BBQ #
5BWB STOZ AWORK4(2) [MARK GV
5CB2 #
5CTL # A - OBTAIN AND CHECK THE COMMAND PARAMETERS
5D*= #
5DSW PARAPASS [1ST PARAM
5F#G CHECKLFN XMISS,XERR [CHECK NAME FORMAT
5FS6 #
5G?Q # SAVE NAME IN AWORK WORDS
5GRB #
5H?2 LDX 0 ACES [SPACEFILL AWORK AREA
5HQL STO 0 AWORK1(2)
5J== STO 0 AWORK2(2)
5JPW STO 0 AWORK3(2)
5K9G MHUNT 3,CPB,CUNI
5KP6 LDN 4 APARA(3) ['FROM' ADDRESS
5L8Q LDN 5 AWORK1(2) [TO ADDRESS
5LNB LDX 2 ANUM(3)
5M82 ANDN 2 #7777 [CHARACTER COUNT
5MML MVCH 4 0(2) [MOVE VARIABLE NAME
5N7= #
5NLW FREECORE 3 [FREE PARAMETER BLOCK(1ST PARAM)
5P6G LDN 4 3
5PL6 SPARANXT ,,4 [NEW VALUE=3RD PARAM
5Q5Q TESTREP UNPAIR,XERR
5QKB PARAFREE
5R52 LDN 4 2
5RJL SPARANXT ,,4 [OLD VALUE=2ND PARAM
5S4= TESTREP UNPAIR,XERR
5SHW #
5T3G #
5TH6 # B - SET UP VARIABLE TABLE IF NOT ALREADY PRESENT
5W2Q #
5WGB #
5X22 DOHUNTGV 3 [SEARCH FOR VT BLOCK
5XFL BPZ 3 PC [JIF PRESENT
5X^= SETNCORE 50,3,IUSER,G400BLK
5YDW LDN 0 9
5YYG STO 0 A1(3)
5^D6 STOZ VLOCK(3) [LOCKOUT WORD
5^XQ LDN 0 VDATALEN+1-A1
62CB STO 0 VDATALEN(3) [END OF USED SPACE POINTER
62X2 DOHUNTGV 1 [CHECK IF BLOCK NOW PRESENT
63BL BPZ 1 PB1
63W= LDX 2 BMISC+1 [MISC CHAIN PTR
64*W LDX 2 BPTR(2)
64TG CHAIN 3,2 [CHAIN IN
65*6 BRN PC
65SQ PB1
66#B FREECORE 3
66S2 #
67?L # C - UPDATE VARIABLE TABLE
67R= #
68=W PC
68QG #
69=6 # C1/C2 - SET LOCKOUT FOR UPDATE
69PQ PC1
6=9B DOHUNTGV 3 [LOCATE BLOCK
6=P2 LDX 0 VLOCK(3)
6?8L BPZ 0 PC2 [J IF ALREADY LOCKED
6?N= ... COOR3 #41
6#7W BRN PC1
6#MG #
6*76 PC2
6*LQ LDX 0 GSIGN
6B6B ORS 0 VLOCK(3) [SET LOCK
6BL2 #
6C5L # C3 - DO UPDATE ITSELF
6CK= #
6D4W #
6DJG # C3A - CHECK OLD VALUE
6F46 #
6FHQ CALL 7 RLOCA [FIND RECORD
6G3B BNG 3 PC3A1 [NOT PRESENT
6GH2 MHUNT 2,CPB,CUNI [FIND OLD VALUE
6H2L LDX 0 ANUM(2)
6HG= ANDN 0 #7777 [CHAR COUNT
6H^W LDX 4 VHEADER(3) [RECORD COUNT
6JFG SBN 4 VDATA-VHEADER [- RED TAPE
6J^6 SLL 4 2 [RECORD CHAR COUNT
6KDQ LDCH 5 REDTAPE2(3) [UNUSED CHARS
6KYB SBX 4 5
6LD2 TXU 4 0 [COMPARE COUNTS
6LXL BCS XVCH [J IF COUNTS DISAGREE
6MC= PC3A2
6MWW LDCH 7 VDATA(3) [CHAR FROM VARIABLE
6NBG LDCH 1 APARA(2) [CHAR FROM OLD VALUE
6NW6 TXU 1 7
6P*Q BCS XVCH [J IF DISCREPANCY
6PTB BCHX 2 £
6Q*2 BCHX 3 £
6QSL BCT 0 PC3A2 [LOOP FOR NEXT COMPARISON
6R#= BRN PC3B
6RRW # SPECIAL CASE : ENTRY NOT PRESENT
6S?G PC3A1
6SR6 MHUNT 2,CPB,CUNI
6T=Q LDX 0 ANUM(2)
6TQB BNG 0 PC3B [OLD VALUE NOT GIVEN-NULL BY DEFA
6W=2 ANDN 0 #7777
6WPL BZE 0 PC3B [OLD VALUE NULL
6X9= BRN XVCH [NOT NULL ---ERROR
6XNW #
6Y8G # C3B - INSERT NEW VALUE
6YN6 #
6^7Q PC3B
6^MB MFREE CPB,CUNI [GET RID OF OLD VALUE
7272 MHUNT 2,CPB,CUNI [LOCATE NEW VALUE
72LL LDX 0 ANUM(2)
736= BNG 0 PC3B1 ['NON-EXISTENT'
73KW ANDN 0 #7777
745G BNZ 0 PC3B2
74K6 PC3B1
754Q LDX 2 FX2
75JB CALL 7 RLOCA
7642 BNG 3 PC4 [JIF NO RECORD
76HL CALL 7 SDEL [DELETE RECORD
773= BRN PC4 [FINISH(NULL VALUE)
77GW PC3B2
782G LDX 6 0
78G6 ADN 6 3
78^Q SRL 6 2 [WORD COUNT FOR NEW VALUE
79FB LDX 2 FX2
79^2 CALL 7 RLOCA [LOCATE RECORD
7=DL BNG 3 PC3B3 [NOT PRESENT
7=Y= LDX 5 6
7?CW SBX 5 VHEADER(3)
7?XG ADN 5 VDATA-VHEADER
7#C6 BNG 5 PC3B4 [J IF SPACE IN ENTRY
7#WQ BZE 5 PC3B4 [J IF JUST ENOUGH ROOM
7*BB SMO FX2
7*W2 STO 6 ACOMMUNE1
7B*L CALL 7 SDEL [DELETE RECORD
7BT= SMO FX2
7C#W LDX 6 ACOMMUNE1
7CSG PC3B3
7D#6 DOHUNTGV 1 [LOCATE BLOCK
7DRQ LDX 5 ALOGLEN(1) [CALCULATE SPACE AVAILABLE
7F?B SBX 5 6
7FR2 SBX 5 VDATALEN(1)
7G=L SBN 5 VDATA-VHEADER
7GQ= CALL 7 SEXT [EXTEND BLOCK
7H9W LDX 2 FX2
7HPG CALL 7 RLOCA
7J96 MHUNT 2,CPB,CUNI
7JNQ CALL 7 SAPPD [APPEND RECORD
7K8B BRN PC3B5
7KN2 #
7L7L # CONTRACT RECORD
7LM= #
7M6W PC3B4
7MLG NGX 4 5
7N66 MHUNT 2,CPB,CUNI
7NKQ CALL 7 SCONT [CONTRACT & PUT DATA
7P5B #
7PK2 # REMOVE EXCESS SPACE FROM BLOCK
7Q4L #
7QJ= PC3B5
7R3W DOHUNTGV 1
7RHG LDX 6 ALOGLEN(1)
7S36 SBX 6 VDATALEN(1)
7SGQ SBN 6 50
7T2B BNG 6 PC4 [FINISHED THIS BIT
7TG2 CALL 7 SHORTEN
7T^L #
7WF= PC4
7WYW DOHUNTGV 1
7XDG LDX 0 GSIGN
7XY6 ERS 0 VLOCK(1) [UNSET LOCKOUT
7YCQ #
7YXB # WAKE UP ACTIVITIES ON WT GLV
7^C2 #
7^WL LDX 2 FX2
82B= LDX 4 AWORK1(2)
82TW ADX 4 AWORK2(2)
83*G ADX 4 AWORK3(2)
83T6 LONGON1 G400GVWT,4
84#Q #
84SB # FINISHED======RETURN TO COMMAND PROCESSOR
85#2 #
85RL PEND
86?= ENDCOM
86QW XMISS
87=G COMERR JPARMIS
87Q6 XERR
889Q COMERR APFERR
88PB XVCH
8992 CALL 7 OUTPAR
89NL +XMESSVC
8=8= ERROR GENERR
8=MW LDX 0 AWORK4(2)
8?7G BZE 0 PC4
8?M6 BRN PEND
8#6Q #
8#LB XMESSVC +6
8*62 24HVALUE ALREADY CHANGED
8*KL OUTPAR
8B5= SMO 7
8BJW LDX 6 0 [LOAD ADDRESS OF TEXT
8C4G SBX 7 FX1
8CJ6 LDX 1 FX1
8D3Q SMO 6
8DHB LDX 5 0(1)
8F32 ADN 5 APARA-A1
8FGL SETUPCORE 5,3,CPB,CUNI
8G2= SBN 5 APARA-A1
8GFW SLL 5 2
8G^G STO 5 ANUM(3)
8HF6 LDN 2 2
8HYQ STO 2 JPARNUM(3)
8JDB SMO 6
8JY2 LDN 2 1(1)
8KCL ADN 3 APARA
8KX= SMO 5
8LBW MVCH 2 0
8LWG ADX 7 FX1
8MB6 EXIT 7 0
8MTQ #
8N*B # #############################################################
8NT2 #
8P#L # K K 222
8PS= # K K 2 2
8Q?W # K K 2
8QRG # K K 2
8R?6 # KKK 2
8RQQ # K K 2
8S=B # K K 2
8SQ2 # K K 2
8T9L # K K 2222222
8TP= #
8W8W # #############################################################
8WNG #
8X86 STARTJB
8XMQ #
8Y7B # ENTRY POINT FOR JOB VARIABLES FROM SETPB
8YM2 #
8YPK ... SEGENTRY K82GLOBALS
8YS8 ... TESTHOOK XJBVALL
8YWR ... COMERR HOOKONLY [ERROR *JBV ONLY ALLOWED IN A HOOK
8Y^B ... SEGENTRY K83GLOBALS
8^42 ...XJBVALL
8^6L LDN 0 1
8^L= STO 0 AWORK4(2) [MARK JV
925W LDN 4 1
92KG LDN 5 0
9356 PARALYSE ,5,4
93JQ LDN 5 2
944B PARALYSE ,4,5
94J2 PARAPASS
953L CHECKLFN XMISS,XERR [CHECK NAME FORMAT
95H= #
962W # SAVE NAME IN AWORK WORDS
96GG #
9726 LDX 0 ACES [SPACEFILL AWORK AREA
97FQ STO 0 AWORK1(2)
97^B STO 0 AWORK2(2)
98F2 STO 0 AWORK3(2)
98YL MHUNT 3,CPB,CUNI
99D= LDN 4 APARA(3) ['FROM' ADDRESS
99XW LDN 5 AWORK1(2) [TO ADDRESS
9=CG LDX 2 ANUM(3)
9=X6 ANDN 2 #7777 [CHARACTER COUNT
9?BQ MVCH 4 0(2) [MOVE VARIABLE NAME
9?WB CALL 7 SLOC
9#B2 BPZ 1 QA1
9#TL SETNCORE 50,1,IUSER,G400BLK
9**= LDN 0 10
9*SW STO 0 A1(1)
9B#G STOZ VLOCK(1)
9BS6 LDN 0 VDATALEN+1-A1
9C?Q STO 0 VDATALEN(1)
9CRB LDX 2 ACTRING(2)
9D?2 SBN 2 ACTRING
9DQL CHAIN 1,BPTR(2)
9F== QA1
9FPW MHUNT 2,COMDAT,CSETP [LOCATE NEW VALUE
9G9G LDX 0 ANUM(2)
9GP6 BNG 0 QB1 ['NON-EXISTENT'
9H8Q ANDN 0 #7777
9HNB BNZ 0 QB2
9J82 QB1
9JML LDX 2 FX2
9K7= CALL 7 RLOCA
9KLW BNG 3 PEND
9L6G CALL 7 SDEL [DELETE RECORD
9LL6 BRN PEND [FINISH(NULL VALUE)
9M5Q QB2
9MKB LDX 6 0
9N52 ADN 6 3
9NJL SRL 6 2 [WORD COUNT FOR NEW VALUE
9P4= LDX 2 FX2
9PHW CALL 7 RLOCA [LOCATE RECORD
9Q3G BNG 3 QB3 [NOT PRESENT
9QH6 LDX 5 6
9R2Q SBX 5 VHEADER(3)
9RGB ADN 5 VDATA-VHEADER
9S22 BNG 5 QB4 [J IF SPACE IN ENTRY
9SFL BZE 5 QB4 [J IF JUST ENOUGH ROOM
9S^= SMO FX2
9TDW STO 6 ACOMMUNE1
9TYG CALL 7 SDEL [DELETE RECORD
9WD6 SMO FX2
9WXQ LDX 6 ACOMMUNE1
9XCB QB3
9XX2 DOHUNTJV 1 [LOCATE BLOCK
9YBL LDX 5 ALOGLEN(1) [CALCULATE SPACE AVAILABLE
9YW= SBX 5 6
9^*W SBX 5 VDATALEN(1)
9^TG SBN 5 VDATA-VHEADER
=2*6 CALL 7 SEXT [EXTEND BLOCK
=2SQ LDX 2 FX2
=3#B CALL 7 RLOCA
=3S2 MHUNT 2,COMDAT,CSETP
=4?L CALL 7 SAPPD [APPEND RECORD
=4R= BRN QB5
=5=W #
=5QG # CONTRACT RECORD
=6=6 #
=6PQ QB4
=79B NGX 4 5
=7P2 MHUNT 2,COMDAT,CSETP
=88L CALL 7 SCONT [CONTRACT RECORD
=8N= #
=97W # REMOVE EXCESS SPACE FROM BLOCK
=9MG #
==76 QB5
==LQ DOHUNTJV 1
=?6B LDX 6 ALOGLEN(1)
=?L2 SBX 6 VDATALEN(1)
=#5L SBN 6 50
=#K= BNG 6 PEND [FINISHED THIS BIT
=*4W CALL 7 SHORTEN
=*JG BRN PEND
=B46 #END
^^^^ ...156463710003