(George Source)
Macros used: BACKSPACE, BBS, BXU, CHNUMCON, CLOSETOP, COMBRKIN, COMERRX, COPYFILE, ENDCOM, ERRORX, ERRTEST, FJOCA, FNORM, GEOERR, JBC, MFREE, MHUNT, MHUNTW, MONOUT, NAMETOP, OPENDIR, OUTNUM, RESQUERY, REWRITE, SEG, SEGENTRY, SETNCORE, SPARAPAS, TESTHOOK, TESTNAMX, TESTREP, TRACE, UP
226D ... SEG ALLOCATE,6,SECTION FILE,FILESTORE,G400 22=W ...[ 22C# ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 22HQ ...[ 22N8 ...#UNS G400 22SL ...# THIS CHAPTER IS FOR G3PLUS-IH MK2 22^= SEGENTRY K1ALLOCATE,X1ALLOCATE 23DW SEGENTRY K2ALLOCATE,X2ALLOCATE 23YG SEGENTRY K3ALLOCATE,X3ALLOCATE 24D6 [THIS SEGMENT ENABLES THE INSTALLATION MANAGER TO INSIST THAT A 24XQ [SPECIFIED FILESTORE FILE BE PUT ON A SPECIAL SPECIFIED FILESTORE 25CB [RESIDENCE. ALTERNATIVELY HE CAN ALSO INSIST THAT A FILE BE NO LONGER 25X2 [KEPT ON A SPECIAL RESIDENCE. FINALLY THIS SEGMENT CAN BE USED TO 26BL [SPECIFY RENT FREE FILES AND TO UPDATE THE APPROPRIATE DIRECTORY 26W= [ENTRIES ACCORDINGLY. 27*W [ THERE ARE THREE ENTRY POINTS 27TG [ 1) X1ALLOCATE -: ALLOCATING FILES TO SPECIFIED RES. 28*6 [ 2) X2ALLOCATE -:CANCEL ALLOCATE 28SQ [ 3) X3ALLOCATE -: ALLOCATE WHILE FILE BEING RETRIEVEC 29#B 29S2 2=?L [ PRESET CONSTANTS-: 2=R= 2?=W NOUSER #2 2?QG NOUSEMOP #10 2#=6 PUBLIC 8HPUBLIC 2*HQ ...MASTER 16H:MASTER MASTER 2*P2 MLOCAL #40000 2B8L ZMANG 12HMANAGER 2B*S ...#SKI IPL 2BH2 ...ZWWXAS 12HWWXAS 2BN= 2C7W [ MONITORING FILE MESSAGES 2CMG 2D76 XINCDUMP +INCDUMP 2DLQ XALLERX +ALLERX 2F6B XALLERZ +ALLERZ 2FL2 XERENT +ERENTTYPE 2FTS ...XERNOMULTS +ERNOMULTS 2G5L XAMISS +AMISS 2GK= XJUSE +JUSNA 2H4W 2HJG [ MCONERR 2J46 [ ONERR 2JHQ [ TWONER -: 2K3B 2KH2 [ THESE ARE SUBROUTINES FOR OUTPUTTING THE COMMAND ERRORS 2L2L 2LG= 2L^W MCONERR 2MFG SBX 6 FX1 [SUBROUTINE FOR OUTPUTTING 2M^6 SMO FX1 [ COMMAND ERRORS 2NDQ LDX 1 0(1) 2NYB COMERRX 1 [NEVER COME BACK SINCE FATAL 2PD2 2PXL ONERR 2QC= SBX 6 FX1 [ SUBROUTINE FOR OUTPUTTING 2QWW SMO FX1 [ COMMAND ERRORS WHICH ARE 2RBG LDX 1 0(1) [ NOT FATAL TO THE COMMAND 2RW6 ERRORX 1 2S*Q ADX 6 FX1 2STB EXIT 6 0 2T*2 2TSL TWONER 2W#= SBX 6 FX1 2WRW SMO FX1 2X?G LDX 1 0(1) [ USER NAME MISSING 2XR6 SMO FX1 2Y=Q LDX 2 0(2) 2YQB ERRORX 1,2 2^=2 ADX 6 FX1 2^PL EXIT 6 0 329= 32=4 ...[ THIS SUBROUTINE ATTEMPTS TO COPYFILE THE FILE DEFINED 32=W ...[ BY THE FIRST FABSNB. THIS FABSNB IS ALWAYS REMOVED BY THE ROUTIN 32?N ...NOWCOPY 32#G ... SBX 6 FX1 32*# ... LDX 2 FX2 32B6 ... LDX 0 AWORK1(2) [RES NO TO COPY TO 32BY ... BZE 0 XITOK [CC AO 32CQ ... SBN 0 1 32DJ ... BZE 0 XITOK [AO PUBLIC 32FB ... ADN 0 1 [RESTORE RES NO 32G8 ... RESQUERY 0,XITUG [J IF RESIDENCE DOESN'T EXIST 32GK ... LDX 2 FX2 32H2 ...XITOK 32HS ... COPYFILE AWORK1(2) [COPYFILE THE FILE 32JL ...XIT ADX 6 FX1 32KD ... EXIT 6 0 32L= ...XITUG 32M4 ... MFREE FILE,FABSNB 32MW ... BRN XIT 32NW 338G [ THE FILE RESIDENCE NUMBER IS STORED IN AWORK1 WORD 33N6 [ FOR CANCEL ALLOCATE AWORK1=0 347Q [ FOR ALLOCATE AWORK1= 48 GE (FRN) LE 63 34MB [ FOR RENT FREE FILES AWORK1=+1 3572 35LL 366= X2ALLOCATE 36KW LDX 2 FX2 [ENTRY POINT FOR CANCEL ALLOCATE 375G STOZ AWORK1(2) [AWORK1 = 0 37K6 BRN XA1 384Q 38JB 3942 X1ALLOCATE 39HL NGN 0 1 [ENTRY POINT FOR ALLOCATE 3=3= LDX 2 FX2 [AWORK1 -VE I.E FSN NOT SPECIFIED YET 3=GW STO 0 AWORK1(2) 3?2G STOZ AWORK2(2) [AWK2 FLAGS IF AN ACCEPTABLE FILE 3?G6 [NAME HAS BEEN SPEC. IN THE COMMAND 3?^Q [ X7 KEEPS A COUNT OF THE NUMBER OF FILES SPECIFIED IN THE COMMAND 3#FB [ (PLUS ONE ) UP TO THE POINT WHERE THE SPECIAL FILE RESIDENCE 3#^2 [ NUMBER IS SPECIFIED. X7 SHOULD NOT BE OVERWRITTEN 3*DL XA1 LDX 3 CONTEXT(2) [TESTING FOR NO-USER CONTEXT 3*Y= STOZ 7 [ZEROISE FILE COUNT 3B5D ...#UNS G400 3B=L ... TESTHOOK STRT [J IF IN A HOOK 3BCW LDX 1 FX1 3BXG ANDX 3 NOUSER(1) 3CC6 BZE 3 USER [J IF IN USER CONTEXT 3CWQ LDX 3 CONTEXT(2) 3DBB ANDX 3 NOUSEMOP(1) 3DW2 BZE 3 STRT [J IF IN NO-USER CONTEXT 3F*L BRN MCOMX1 [J IF IN NO-USER +MOP CONTEXT 3FT= USER 3G#W FJOCA 2 [X2=JOB CONTROL BLOCK 3GSG ... TESTNAMX 3,JUSER(2),ZMANG(1),MNOTMAN,3 [J IF JOB NOT UNDER MAN 3H#6 3HRQ STRT 3J?B SPARAPAS [ PICK UP A PARAMETER 3JR2 3K=L MHUNT 2,CPB,CUNI 3KQ= LDX 3 ANUM(2) 3L9W BZE 3 STRT1 [J IF PARAMETER IS NULL 3LPG BNG 3 NONE [J IF PARAMETER IS MISSING 3M96 CHNUMCON 1 [TEST IF PARAMETER IS ANUMBER 3MNQ MHUNT 3,CPB,CUNI 3N8B TESTREP CHNUMERR,NOTNUM [J IF NOT A NUMBER 3NN2 3P7L LDX 0 AWORK1(2) 3PM= TRACE AWORK1(2),ALLFRN 3Q6W BNG 0 XA2 [J IF RESIDENCE NO. HAS NOT BEEN SPEC 3QLG MFREE CPAR,GNUMCON 3R66 BRN XA3 3RKQ XA2 MHUNTW 1,CPAR,GNUMCON 3S5B LDX 3 A1+1(1) [X3 CONTAINS FRN 3SK2 SBN 3 3 3T4L BNG 3 MCOMX2 [ERROR IF FRN <3 3TJ= SBN 3 61 3W3W BPZ 3 MCOMX2 [ERROR IF FRN > 63 3WHG ADN 3 64 3X36 STO 3 AWORK1(2) [KEEP FRN IN AWORK1 3XGQ MFREE CPAR,GNUMCON 3Y2B MFREE CPB,CUNI 3YG2 BRN STRT 3Y^L 3^F= 3^YW # THIS CODING IS ENTERED WHEN THE PARAMETER PICKED UP IS NOT A NUMBER 42DG # A TEST IS MADE ON THE FORMAT OF THE FILENAME 42Y6 43CQ 43XB NOTNUM 442G ... LDX 0 ANUM(3) 445L ... ANDN 0 #7777 448Q ... SBN 0 9 [CANT BE 'PUBLIC' OR ':MASTER' IF >8 44?W ... BPZ 0 XA4 [CHARS SPECIFIED. J IF SO. 44C2 LDX 4 APARA(3) [1ST WORD OF PARAMETER 44WL TRACE 4,ALLNOPB 45B= LDX 2 FX1 45TW BXU 4 PUBLIC(2),XA3 [ J IF 1ST WORD.NE.TO PUBL 46*G LDX 4 APARA+1(3) 46T6 BXU 4 PUBLIC+1(2),XA3 [J IF 2ND WORD .NE. TO IC 47#Q 47SB 48#2 # ENTRY HERE IF ALLOCATE PUBLIC COMMAND IS GIVEN 48RL # AWORK1 WORD IS SET EQUAL TO ONE 49?= 49QW 4==G LDX 4 JPARNUM(3) [NO. OF PAR. IN CPB/CALAS 4=Q6 SBN 4 1 4?9Q BNZ 4 XA3 [J IF NOT FIRST PARAMETER 4?PB LDN 2 1 4#92 SMO FX2 4#NL LDX 4 AWORK1 [J IF 1ST. PAR. OF 4*8= BPZ 4 XA3 [CANCEL COM. IS PUBLIC 4*MW SMO FX2 4B7G STO 2 AWORK1 ["ALLOCATE PUBLIC"HAS BEEN GIVEN 4BM6 BRN STRT1 4C6Q 4CLB 4D62 # ENTRY: THE PARAMETER IS TESTED AT THIS POINT FOR FILE NAME 4DKL 4F5= 4F6H ...XA3 4F7S ...# TEST FOR MASTER(SPECIAL CASE) 4F95 ... LDX 4 APARA(3) 4F=B ... BXU 4 MASTER(2),XA4 [:MAST 4F?M ... LDX 4 APARA+1(3) 4F#Y ... BXU 4 MASTER+1(2),XA4 [ER 4FCG ... SETNCORE 4,1,FILE,FABSNB 4FDR ... LDN 0 0 [A1 IS A FLAG TO INDCATE :MASTER 4FG4 ... STO 0 A1(1) [SET UP MASTER'S FABSNB 4FH* ... SMO FX1 [A1 IS SET TO 4 LATER 4FJL ... LDX 0 MASTER+2 4FKX ... STO 0 A1+1(1) 4FM8 ... SMO FX1 4FNF ... LDX 0 MASTER+3 4FPQ ... STO 0 A1+2(1) 4FR3 ... LDX 0 ACES 4FS# ... STO 0 A1+3(1) 4FTK ... BRN XUSER 4FWW ... 4FY7 ... [NOT :MASTER 4F^D ... 4G2P ...XA4 NAMETOP 3,FILE,FNAME [RENAME CUNI BLK F/FNAME 4G4G FNORM [CHANGE FNAME INTO FABSNB 4GJ6 MHUNT 3,FILE,FNAME 4H3Q NAMETOP 3,CPB,CUNI 4HHB TESTREP NAMEFORM,STRT1 [J IF ERROR IN NAME ENTRANT 4J32 4JGL MHUNT 1,FILE,FABSNB 4K2= BBS 13,ATYPE(1),MERRX2 [J IF NOT A FILE (MT ENTRANT ETC.) 4KFW BBS 16,ATYPE(1),MERRX2 [J IF FILE IS A WORKFILE 4K^G BBS 14,ATYPE(1),MERRX3 [J IF LOCAL NAME ONLY 4LF6 LDX 0 A1+1(1) [ TESTING FOR SPECIAL LOCAL 4LYQ BZE 0 MERRX3 [ NAME CASE 4MDB XUSER 4MY2 ADN 7 1 [UPDATE COUNT OF FILENAMES 4NCL LDX 3 AWORK1(2) 4NX= BNG 3 STRT [J IF FRN NOT YET SPECIFIED 4PBW 4PWG XLOOP SBN 7 1 [SUBTRACT ONE FROM COUNT 4P^L ... MHUNT 1,FILE,FABSNB 4Q2W ... LDX 3 A1(1) [TEST FOR SPECIAL CASE 4Q46 ... BZE 3 MASALL [JI F MASTER'S FABSNB 4Q5B ... LDN 4 1 [MARKER ZERO IF ;LOCAL NAME WITHOUT G 4Q6L ... [ DETAILS" SPECIFIED 4Q7W ... SBN 3 4 4Q96 ... BZE 3 XOPEN1 [J IF JUST ONE DIR. SPECIFIED 4Q=B ... SMO 3 4Q?L ... LDX 4 A1+2(1) [ X4= GEN. NO. SPECIFIED 4Q#W ...XOPEN1 4QB6 4QTQ OPENDIR MBRK2,GENERAL,QUERY [OPEN DIR. FILE 4R*B [ 4RT2 TESTREP OK,OK1 4S#L [ 4SS= ERRTEST 3,STRT2,NAME,NOFILE,NOUSER,WRGEN,VRYWRONG 4T?W [ 4TRG [ GEOERR IF UNEXPECTED REPLY IS GIVEN 4W?6 [ 4WQQ GEOERR 1,ALLOCATE 4X=B [ 4XQ2 OK1 MHUNTW 2,FILE,ENT [F/FABSNB PUT DIR. ENT. IN F/ENT 4Y9L 4YP= 4^5Q ... JBC XNOTMDF,2,BEMDF [J IF NOT MDF 4^G= ... BZE 4 XAB [ERROR IF TRYING TO ALLOCATE COMPLETE 4^WQ ... [ MULTIFILE 52?= ...XNOTMDF 52MQ SMO FX2 537B LDX 3 AWORK1 53K^ ... NGN 0 #100 53LF ... ANDS 0 EALLOC(2) 53M2 ... ORS 3 EALLOC(2) [UPDATE EALLOC WITH AWK1 53WS ...NSPEC 546L LDEX 3 ECOPS(2) 54L= BZE 3 NOCOPIES [J IF NO COPIES RECORD 555W BACKSPACE [POSITION AFTER NAME RECORD 55KG MHUNT 2,FILE,ENT 5656 [ 56JQ NOCOPIES 574B [ 57J2 NAMETOP 2,FILE,FWB 583L REWRITE [REWRITE DIR. ENTRY 58H= MHUNT 2,FILE,FWB 592W NAMETOP 2,FILE,ENT [RENAME FILE ENT 6#MG LDEX 3 ECOPS(2) [ IS THE CPIES REC =0 6*76 TRACE 3,OFFLINE 6*LQ ... BZE 3 MFREEFAB [J IF OFFLINE 6B6B ONLINE 6BL2 ...[ COPY FILE IF POSSIBLE,FABSNB REMOVED 6C5L ... CALL 6 NOWCOPY 6H^W XA7A CLOSETOP 6JFG 6J^6 OFFLINE1 6K3P ... BNG 7 UPRT [J IF ENTERED FROM RETRIEVE 6K6# ... MFREE FILE,ENT 6K?G ...MASFIN 6KDQ NGN 0 1 [FLAGS THAT AT LEAST ONE FILE HAS 6KYB STO 0 AWORK2(2) [ BEEN OPENED 6LD2 6MWW MFREE CPB,CUNI 6NBG NOTHR 6NW6 BZE 7 STRT [J IF COUNT IS ZERO 6P*Q BRN XLOOP 6PFM ...MFREEFAB 6PKJ ... MFREE FILE,FABSNB 6PPF ... BRN XA7A 6PTB [ 6Q*2 [ ENTRY POINT FROM RETRIEVE COMMAND (DTREST SEGMENT).ENTERED 6QSL [ WHENEVER A FILE IS ALLOCATED DURING THE TIME THAT THE 6R#= [ FILE IS BEING COPIED FROM TAPE 6RRW [ 6S?G X3ALLOCATE 6SR6 NGN 7 1 [X7 NORMALLY USED AS A COUNT HERE 6T=Q LDX 2 FX2 [NEW FILE RES. NO. IS PASSED 6TQB LDX 3 ACOMMUNE1(2) [DOWN BY RETREIVE 6W=2 TRACE 3,FRNRET 6WPL STO 3 AWORK1(2) 6X9= BRN ONLINE [IT INDICATES ENTRY FROM RETREIVE 6XNW UPRT 6Y8G UP 6Y=P ...MNOTMAN 6Y#Y ...#SKI IPL 6YC7 ...( 6YFB ... TESTNAMX 3,JUSER(2),ZWWXAS(1),MCOMX1,3 [J IF JOB NOT UNDER USER W 6YHK ... BRN STRT 6YKS ...) 6YN6 MCOMX1 6^7Q LDN 1 XINCDUMP [ THIS COMMAND IS NOT FOR 6^MB CALL 6 MCONERR [ GENERAL USE 7272 72LL NONE 736= 73KW MFREE CPB,CUNI 745G LDX 3 AWORK1(2) 74K6 BPZ 3 MFINI [J IF COMMAND HAS FINISHED 754Q LDN 1 XALLERX [SPECIAL RESIDENCE 75JB CALL 6 MCONERR [ NUMBER NOT SPECIFIED 7642 76HL MERRX2 773= MFREE FILE,FABSNB 77GW 782G LDN 1 XERENT [COMM. ERR.= ENTRANT DESCRIPTION 78=# ...MERRX1 78G6 CALL 6 ONERR [ FORMAT INDICATES WRG. ENTRANT TYP 78^Q BRN STRT1 79FB 79^2 XAB 7=DL MFREE FILE,ENT 7=ND ... MFREE FILE,FABSNB 7=Y= CLOSETOP 7?=M ... LDN 1 XERNOMULTS 7?K4 ... BRN MERRX1 7?XG STRT2 7#C6 MFREE FILE,FABSNB 7#WQ STRT1 7*BB MFREE CPB,CUNI 7*W2 BRN STRT 7B*L MCOMX2 7BT= 7C#W LDN 1 XALLERZ [%C IS NOT A VALID SPECIAL 7CSG CALL 6 MCONERR [ RESIDENCE NUMBER 7D#6 7DRQ MERRX3 7F?B 7FR2 LDX 3 CONTEXT(2) [TEST IF IN USER CONTEXT 7G=L SMO FX1 7GQ= ANDX 3 NOUSER 7H9W BZE 3 XUSER [J IF IN USER CONTEXT 7HPG LDN 1 XAMISS 7J96 LDN 2 XJUSE 7JNQ CALL 6 TWONER [USER NAME MISSING 7K8B 7KN2 7L7L BRN STRT2 7LM= 7M6W MFINI 7MLG 7N66 BNZ 7 XLOOP [COUNT REDUCED TO ZERO 7NKQ SBN 3 1 7P5B BZE 3 UP [J IF ALLOCATE PUBLIC 7PK2 BNG 3 UP [J IF CANCEL ALLOCATE 7Q4L ADN 3 1 7QJ= RESQUERY 3,MERRX4 [J IF FR DOES NOT EXIST 7R3W UP 7RHG ENDCOM [END OF COMMAND 7S36 MBRK2 7SGQ BPZ 7 XCOMB [J IF NOT ENTERED FROM RETREIVE 7T2B CLOSETOP 7TG2 XCOMB 7T^L COMBRKIN [COMMAND HAS BEEN BRKN INTO 7WF= MERRX4 7WYW [ A TEST IS MADE HERE TO ENSURE THAT ALLOCATE HAS BEEN APPLIED 7XDG [ SUCCESSFULLY TO AT LEAST ONE FILE BEFORE ANY MESSAGE IS OUTPUT 7XY6 SMO FX2 7YCQ LDX 2 AWORK2 7YXB BPZ 2 UP [J IF A FILE HAS BEEN OPENED 7^C2 OUTNUM 3,0 [CONVERTS BINARY NO. TO CHARACTER 7^WL MONOUT ALLERY 82B= BRN UP 82G7 ...MASALL [ALLOCATE :MASTER 82L4 ... CALL 6 NOWCOPY [COPYFILE MASTER 82P^ ... BRN MASFIN 83*G #END ^^^^ ...74141424000100000000