(George Source)
Macros used: ALTLENG, CHAIN, CHECKLFN, COMERR, COOR3, DOFINDGV, DOFINDJV, DOHUNTGV, DOHUNTJV, ENDCOM, ERROR, FREECORE, LONGON1, MFREE, MHUNT, OUTPAR, PARAFREE, PARALYSE, PARAPASS, SEG, SEGENTRY, SETNCORE, SETUPCORE, SHORTEN, SPARANXT, TESTHOOK, 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