{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: ALLOCATE867)}}
====== ALLOCATE867 ======
(George Source)
**Macros used:** [[george:macro:BACKSPACE|BACKSPACE]], [[george:macro:BBS|BBS]], [[george:macro:BXU|BXU]], [[george:macro:CHNUMCON|CHNUMCON]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:COMBRKIN|COMBRKIN]], [[george:macro:COMERRX|COMERRX]], [[george:macro:COPYFILE|COPYFILE]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:ERRORX|ERRORX]], [[george:macro:ERRTEST|ERRTEST]], [[george:macro:FJOCA|FJOCA]], [[george:macro:FNORM|FNORM]], [[george:macro:GEOERR|GEOERR]], [[george:macro:JBC|JBC]], [[george:macro:MFREE|MFREE]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUT|MONOUT]], [[george:macro:NAMETOP|NAMETOP]], [[george:macro:OPENDIR|OPENDIR]], [[george:macro:OUTNUM|OUTNUM]], [[george:macro:RESQUERY|RESQUERY]], [[george:macro:REWRITE|REWRITE]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SPARAPAS|SPARAPAS]], [[george:macro:TESTHOOK|TESTHOOK]], [[george:macro:TESTNAMX|TESTNAMX]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TRACE|TRACE]], [[george:macro:UP|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