{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: ASSIGN860)}}
====== ASSIGN860 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ADDINMODE|ADDINMODE]], [[george:macro:ADDMODE|ADDMODE]], [[george:macro:ASTABLES|ASTABLES]], [[george:macro:ASTYPE|ASTYPE]], [[george:macro:BS|BS]], [[george:macro:BXE|BXE]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:COMBRKIN|COMBRKIN]], [[george:macro:COMERRX|COMERRX]], [[george:macro:CREATEB|CREATEB]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:FINDACTFB|FINDACTFB]], [[george:macro:FNORM|FNORM]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GETACTX|GETACTX]], [[george:macro:GSCAN|GSCAN]], [[george:macro:HUNTW|HUNTW]], [[george:macro:JBC|JBC]], [[george:macro:JMBAC|JMBAC]], [[george:macro:LEGALLEV|LEGALLEV]], [[george:macro:LINK|LINK]], [[george:macro:LINKSET|LINKSET]], [[george:macro:LOCK|LOCK]], [[george:macro:MBS|MBS]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAMETOP|NAMETOP]], [[george:macro:OPEN|OPEN]], [[george:macro:OWNERCHE|OWNERCHE]], [[george:macro:P|P]], [[george:macro:PARANUMB|PARANUMB]], [[george:macro:PERCON|PERCON]], [[george:macro:READ|READ]], [[george:macro:REPERR|REPERR]], [[george:macro:RINGACT|RINGACT]], [[george:macro:ROLPA|ROLPA]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETMODE|SETMODE]], [[george:macro:SPARAPAS|SPARAPAS]], [[george:macro:T|T]], [[george:macro:TESTMAINMODE|TESTMAINMODE]], [[george:macro:TESTMODE|TESTMODE]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:TESTRPN2|TESTRPN2]], [[george:macro:TOPFCA2|TOPFCA2]], [[george:macro:TOPFCB|TOPFCB]], [[george:macro:TOPFCB2|TOPFCB2]], [[george:macro:TRACE|TRACE]], [[george:macro:TREP|TREP]], [[george:macro:UNLOCK|UNLOCK]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|UPPLUS]], [[george:macro:USEROPEX|USEROPEX]], [[george:macro:WIND|WIND]]
22FL ... SEG ASSIGN,860,FILESTORE,OLP
22^= SEGENTRY K1ASSIGN,ZASSIGN
23DW SEGENTRY K10ASSIGN,ZASSILO
23YG SEGENTRY K11ASSIGN,ZONLINEC
24D6 [
24XQ # THIS SEGMENT IMPLEMENTS THE ASSIGN COMMAND
25CB ZJPARMIS +JPARMIS
25X2 ZMISSING +APER
26BL +APER
26W= +JFENTRANT
27*W +APER
27TG ZASSIGNER1 +ASSIGNER1
28*6 ZJTOOMANY +JTOOMANY
28SQ ZINCOMQU +INCOMQU
29#B ZILLQUAL +ILLQUAL
29S2 ZASSIGNER2 +ASSIGNER2
2=?L OLPLUSEX #20040000
2=HD ...YFILEHAN #46400000
2=R= ...YFILEREAD #46200000
2?34 ...YFILEWRITE #46300000
2?=W ZEROAPPE #77770777
2?QG # FOR MASK FOR *FH
2#=6 XSER #00040000
2#PQ XDAFILE #77717637
2*9B XDIRS #26000120
2*P2 XINDE #20400100
2*YS ...XNIND #40000000
2B8L XONLI #47600160
2BN= XMULT #47600000
2C7W XCOMM #07400160
2CMG XGDR #47600160
2D76 #
2DLQ # THE FOLLOWING MACRO SETS UP AN EMPTY TABLE OF 64 CHARACTERS ( 1 FOR
2F6B # EACH PERIPHERAL TYPE). EACH CHARACTER WILL EVENTUALLY CONTAIN
2FL2 # EITHER -
2G5L # A) ZERO, INDICATING THE PERIPH. TYPE CANNOT BE ASSIGNED; OR
2GK= # B) A POINTER (PLUS 1) TO THE APPROPRIATE ENTRY IN THE PERIPHERAL
2H4W # DATA TABLE.
2HJG #
2J46 PERMITTED
2JHQ ASTABLES
2K3B #
2KH2 # NOW WE FILL IN THE ABOVE TABLE AND SET UP THE PERIPHERAL DATA TABLE
2L2L # WHICH CONSISTS OF ENTRIES OF THE FOLLOWING FORMAT :-
2LG= #
2L^W # WD 0 FILE TYPE/MODE ASSOCIATED WITH PERIPHERAL (AS ETM)
2MFG #
2M^6 # WD 1 B0=1 DON'T FREE FILE/ENT BLOCK AFTER USEROPEN
2NDQ # B1=0 SERIAL ACCESS PERIPHERAL
2NYB # B2=1, CR
2PD2 # B3=1, TR
2PXL # B1=1 RANDOM ACCESS PERIPHERAL (INCLUDING MT)
2QC= # B2=1, MT
2QWW # B3=1, DR
2RBG # B5=1 LIMIT ADJUNCT APPLICABLE
2RW6 # B7-13 AOLPT LENGTH
2S*Q # B14-23 ADDRESS OF ANALYSIS ROUTINE FOR MODES
2STB #
2T*2 # WD 2 INITIAL LINK FOR AOLPT ACTIVITY
2TSL #
2W#= PDATA
2WRW ASTYPE 0,READ,#400:#2,ASERLEN,TROBJ,1,3
2X?G ASTYPE 1,OUTPUTP,#400:#12,ASERLEN,TPOBJ,1,5
2XR6 ASTYPE 2,OUTPUTLP,#400:#12,ASERLEN,LPOBJ,1,5
2Y=Q ASTYPE 3,READ,#400:#12,ASERLEN,CROBJ,1,2
2YQB ASTYPE 4,OUTPUT,#400:#12,ASERLEN,CPOBJ,1,5
2^=2 ASTYPE 5,MAGNETIC,#405:0,AMTLEN,MTSTART,1,1,2,5
2^PL ASTYPE 6,RANDOM,#406:0,ARANLEN,EDSTART,1,0,1
329= ASTYPE 9,RDRUM,#411:0,ADRLEN,DRSTART,1,1,3
32NW ... ASTYPE 50,READ,#462:0,ASERLEN,FHOBJ,1,0
338G ... ASTYPE 51,NFILEHND,#463:0,ASERLEN,FHOBJ,1,5,0
33N6 ASTYPE 52,NFHANDLE,#464:0,ASERLEN,FHOBJ,1,5,0
347Q ASTYPE 60,PCI,0,ABEXLEN,BEXTRA,1
34MB TSIM LINK SIMULPTR,1
3572 TPTYPE +1:0
35LL TLO [THIS TABLE GIVES THE TYPE OF PERIPH.
366= [TO BE ASSIGNED, DEPENDING ON THE FIL
36KW [TYPE. #77 MEANS CANNOT BE ASSIGNED.
375G #00007703
37K6 #03050677
384Q #77777777
38JB #77067777
3942 TLO1
39HL #DEF TLOLEN=TLO-TLO1*4M^#400
3=3=
3=GW ZASSILO [ENTRY FROM LOADFIN (DOWN) - ASSILO MACRO
3?2G
3?G6 LDX 0 GSIGN
3?^Q STO 0 AWORK4(2) [ENTRY SWITCH
3#FB MHUNTW 3,FILE,ENT
3#^2 LDCT 1 TLOLEN
3*DL ANDX 1 ETM(3)
3*Y= BPZ 1 TLOUP [J IF NO PERI-TYPE
3BCW ERX 1 GSIGN
3BXG BNZ 1 TLOUP
3CC6 LDCT 1 #77
3CWQ ANDX 1 ETM(3) [TYPE
3DBB SLC 1 7 [CHAR. PTR.
3DW2 SMO FX1
3F*L ADN 1 TLO
3FT= LDCH 0 0(1) [PICK UP PERIPH. TYPE
3G#W SBN 0 #77
3GSG BNZ 0 TLOOK [OK UNLESS #77
3H#6 TLOUP
3HRQ UP [ERROR EXIT
3J?B TLOOK
3JR2 ADN 0 #77
3K=L SRC 0 9
3KQ= STO 0 AWORK3(2) [SET TYPE (UNIT NO. ZERO)
3L9W SETMODE 6,GIVE [SET GIVE
3LPG ORX 6 GSIGN [ BUT INDICATE NO ADJUNCTS BLOK
3M96 BRN W2 [JOIN MAIN PART OF ROUTINE
3MNQ
3N8B ZONLINEC [ENTRY FROM ONLINEC (ACROSS) TO FINISH SETTING UP THE
3NN2 [AOLPT FOR PSEUDO ONLINE SLOW PERIPHERALS.
3P7L
3PM= LDCT 0 #200 [B1 INDICATES O-L
3Q6W STO 0 AWORK4(2) [ENTRY INDICATOR
3QLG NGNC 3 1
3R66 ANDX 3 AWORK1(2)
3RKQ STO 3 AWORK3(2) [PERIPHERAL TYPE/UNIT NO.
3S5B SRL 3 15 [ISOLATE TYPE &
3SK2 SRC 3 2 [ CONVERT TO CHAR POINTER
3T4L SMO FX1
3TJ= LDCH 0 PERMITTED(3) [GET POINTER TO PDATA TABLE ENTRY
3W3W SBN 0 1
3WHG BZE 7 WILCH [JIF M/F OPEN
3X36 ORX 0 GSIGN [REMEMBER NOT TO DO CHANGESTREAM
3XGQ WILCH
3Y2B LDX 7 0
3YG2 LDN 4 0 [USEROPEN MODES (N/A)
3Y^L LDCT 0 #400
3^F= STO 0 AWORK2(2) [INDICATE NO ADJUNCTS
3^YW LDX 0 HLINK+2*2+PDATA(1)
42DG STO 0 AWORK1(2) [FILE TYPE/MODE = *LP = GRAPHIC
42Y6 SMO 7
43CQ LDX 6 PDATA+1(1) [SWITCH WD
43XB FINDACTF 3,2,AOLPT,,,BPTR [LOCATE AOLPT CONCERNED
44C2 BXE 3 BPTR(2),W4 [JIF IT'S NEXT TO THIS ACT.
44WL LDN 1 ACTRING(3)
45B= BXE 1 ACTRING+BPTR(2),NORERING [JIF NEXT IN ACT RING
45TW CHAIN 1,ACTRING+BPTR(2) [ OTHERWISE RERING IT &
46*G NORERING
46T6 CHAIN 3,BPTR(2) [ RECHAIN IT
47#Q BRN W4 [JOIN MAIN PART OF ROUTINE
47SB
48#2 ZASSIGN [THE COMMAND ENTRY
48RL PARANUMB 7 [GET NO.OF PARAMS
49?= SBN 7 1
49QW BNZ 7 XMEN
4==G ACROSS ONLINEA,1
4=Q6 XMEN
4?9Q ADN 7 1 [ENTRY MARKR
4?PB STOZ AWORK4(2)
4#92 LDN 3 0
4#NL SBN 7 2
4*8= BNG 7 NJPARMIS
4*MW BNZ 7 NJTOOMANY
4B7G LDN 7 2
4BM6 P
4C6Q SPARAPAS [GET A PARAM
4CLB MHUNT 1,CPB,CUNI
4D62 LDX 4 ANUM(1)
4DKL BZE 4 P2 [JIF NULL
4F5= LDCH 4 APARA(1)
4FJW ERN 4 #32
4G4G BNZ 4 P1 [JIF DOESN'T BEGIN WITH '*'
4GJ6 ORN 3 1 [INDICATE PERIPH. PARAM
4H3Q BRN P3
4HHB P2
4J32 ORX 7 GSIGN [ NOT SET IN ADJUNCTS BLK
4JGL P1
4K2= ORN 3 2 [INDICATE ENTRANT PARAM
4KFW NAMETOP 1,FILE,FNAME [RENAME CUNI FOR FNORM
4K^G P3
4LF6 BCT 7 P
4LYQ ERN 3 #3
4MDB BNZ 3 NJPARMIS1 [JIF PARAM(S) MISSING
4MY2
4NCL PERCON [CONVERT PERIPH. PARAM
4NX= TESTREP2 PARERR,XEND
4PBW MHUNTW 3,CPAR,GPERCON
4PWG NGNC 5 1
4QB6 ANDX 5 GPER1(3)
4QTQ STO 5 AWORK3(2) [PERIPH. TYPE & UNIT NO.
4R*B SRL 5 15
4RT2 BZE 5 YTRLP [J IF TR
4S#L ... SBN 5 2
4SS= BNZ 5 NOTLP
4T?W YTRLP
4TRG LEGALLEV 3,WRONGQUAL,ANYCOMMON,1 [CHECK QUALS. FOR *LP,*TR
4W?6 LDX 0 GPER2(3)
4WQQ ORS 0 AWORK4(2)
4X=B LDCT 0 #401
4XQ2 SRL 0 1
4Y9L ANDX 0 AWORK4(2)
4YP= SMO FX1
4^8W BXE 0 OLPLUSEX,WRONGQUAL
4^NG BRN OKAUT
5286 NOTLP
52=4 ... SBN 5 50
52#2 ... BNZ 5 NOTLPA
52*Y ... MHUNT 1,FILE,FNAME
52CW ... LDCT 5 #400
52FS ... ORS 5 A1(1)
52GR ... LDX 1 FX1
52HQ ...NOTLPA
52KN ...
52MQ LEGALLEV 3,WRONGQUAL,ANYCOMMON [CHECK QUALS. FOR OTHERS
537B OKAUT
53M2 MFREE CPB,CUNI [ & CUNI
546L RELPEREN AWORK3(2) [DELETE ANY EXISTING ENTRY
54L= BPZ 7 PHNORM
555W LDX 3 AWORK3(2)
55KG STO 3 AWORK1(2)
5656 SRL 3 15
56JQ LDX 7 3
574B SBN 7 5
57J2 BNG 7 YMEN
57M6 ... SBN 7 45
57Q= ... BNG 7 YYMEN
57TB ... SBN 7 3
57YG ... BPZ 7 YYMEN
583L ... ADN 7 3
586Q ... BZE 7 ZMEN
589W ... LDN 7 1
58*2 ... BRN ZMEN
58D6 ...YYMEN LDN 3 2
58H= BRN NJPARMIS1
592W YMEN
59GG ADN 7 2
5=26 BZE 7 ZMEN
5=FQ ADN 7 3
5=^B BZE 7 ZMEN
5?F2 LDN 7 1
5?YL ZMEN
5#D= ACROSS ONLINEC,2
5#XW PHNORM
5*CG
5*X6 FNORM 3
5BWB MHUNT 3,FILE,FNAME
5BY# ... LDCT 6 #400
5C2= ... LDX 5 A1(3)
5C48 ... ANDX 5 6
5C66 ... BPZ 5 W5
5C84 ... ERS 6 A1(3)
5C=2 ...W5
5C?Y ... TESTREP2 NAMEFORM,XEND
5CB2 NAMETOP 3,CPB,CUNI
5D*= TESTRPN2 ADJUNCTS,W1
5DSW MHUNTW 3,FILE,ADJUNCTS
5F#G LDX 6 A1+1(3) [MODE WD
5FS6 LDX 5 A1+4(3) [GET 2ND MODE WD
5G?Q STO 5 AWORK1(2)
5GRB W1
5H?2 #SKI K6ASSIGN>699-699
5HQL TRACE 6,ADJUNCTS
5J== CREATEB 3
5JPW #SKI K6ASSIGN>699-699
5K9G TRACE AWORK3(2),ASSPERTY
5KP6 W2
5L8Q STO 6 AWORK2(2) [PRESERVE ADJUNCTS INDICATOR/MODE WD
5LNB LDCT 1 #777
5M82 ANDX 1 AWORK3(2)
5MML SLC 1 7 [FORM CHAR POINTER FROM TYPE
5N7= ADX 1 FX1
5NLW LDCH 7 PERMITTED(1) [PICK UP MODIFIER CHAR.
5P6G LDX 1 FX1
5PL6 BZE 7 WRONGDEVICE [JIF TYPE CAN'T BE ASSIGNED
5Q5Q SBN 7 1
5QKB LDXC 0 AWORK4(2)
5R52 BCS W3 [JIF ASSILO
5RJL SMO 7
5S4= LDX 0 PDATA(1) [TYPE/MODE
5SHW STO 0 CETM(3)
5T3G W3
5TH6 SETMODE 4,COMMUNE,NOWAIT,REPLY
5W2Q ANDX 4 6
5WGB SMO 7
5X22 LDX 0 PDATA+1(1)
5XFL ANDN 0 #1777
5X^= ADX 0 1
5YDW BRN (0) [J TO MODE ANALYSIS
5YYG NFHANDLE
5^D6 BNG 6 READ [J IF NO ADJUNCTS
5^XQ MHUNTW 2,FILE,ADJUNCTS
62CB LDX 0 A1+2(2) [TYPE ADJUNCT
62X2 BZE 0 NOTNONSER [J IF NONE
63BL SRL 0 15
63W= ANDN 0 #77 [X0=TYPE NO
64*W SBN 0 5
64TG BPZ 0 NONSERFH [J IF NOT SERIAL TYPE
65*6 NOTNONSER
65SQ LDX 0 6
66#B ANDN 0 #7000
66S2 SBN 0 #4000
67?L BNZ 0 MCHAPQ [J IF NOT WRITE
67R= #SKI AMULTUSER
68=W ... ADDMODE 4,GENERAL,CREATE,STREAMS,FILE
68QG #SKI AMULTUSER<1$1
69=6 ... ADDMODE 4,GENERAL,CREATE,STREAMS
69PQ BRN T
6=9B MCHAPQ
6=P2 ADN 0 #1000
6?8L BZE 0 OUTPUTP [J IF APPEND
6?N= BRN READ
6#7W NONSERFH [*FH WITH NONSERIAL FILE. WE USE
6#MG [READR,WRITE AND EMPTY,OR WRITE
6*76 [EMPTY AND CREATE AS APPROPRIATE.
6*LQ [WE ALSO SET UP THE CREATE BLOCK WITH
6B6B [THE RIGHT TYPE MODE AND WITH THE
6BL2 [MAG TAPE FILE BIT IF ITS MT.
6C5L BNZ 0 NOTMTFH [J IF NOT MT
6CK= BS 3,CEMT [SET MT BIT IN CREATE
6D4W NOTMTFH
6DJG LDX 0 A1+2(2)
6F46 ORX 0 GSIGN
6FHQ STO 0 CETM(3) [SET UP TYPE MODE
6G3B TESTMAIN 6,WRITEDAFH,,WRITE [J IF WRITE MODE
6GH2 ADDMODE 4,READR [ELSE USE READR
6H2L BRN OPEN
6HG= WRITEDAFH
6H^W ADDMODE 4,WRITE,EMPTY [USE THESE MODES FOR WRITE CASE
6JFG JBC OPEN,3,CEMT [PLUS CREATE IF MT
6J^6 ADDMODE 4,CREATE
6KDQ BRN OPEN
6KYB NFILEHND
6LD2 OUTPUTP
6LXL T
6MC= BNG 6 OUTPUT
6MWW MHUNTW 2,FILE,ADJUNCTS
6NBG LDCT 0 #777
6NW6 SMO 7
6P*Q ANDX 0 PDATA(1)
6PTB BXU 0 YFILEHAN(1),XCONT
6Q*2 LDN 0 4
6QSL ANDX 0 6
6R#= SBN 0 4
6RRW BNZ 0 XCONT
6S?G LDX 0 ZEROAPPE(1)
6SR6 ANDS 0 A1+1(2)
6T=Q XCONT
6TQB LDX 0 A1+2(2)
6W=2 BZE 0 OUTPUT
6WPL SRL 0 15
6X9= ANDN 0 #77
6XNW BNZ 0 OUTPUT
6Y8G LDX 0 A1+2(2)
6YN6 ORX 0 GSIGN
6^7Q STO 0 CETM(3)
6^MB OUTPUT
7272 LDX 2 FX2
72LL LDX 0 GSIGN
736= ORS 0 CEINF1(3)
73KW TESTMAINMODE 4,QDEST,,GENERAL
745G #SKI AMULTUSER
74K6 ADDMODE 4,APPEND,EMPTY,CREATE,FILE,MULT
754Q #SKI AMULTUSER<1$1
75JB ADDMODE 4,APPEND,EMPTY,CREATE,STREAMS
7642 BRN QDEST
76HL READ
773= #SKI AMULTUSER
77GW ADDMODE 4,READ,FILE,MULT
782G #SKI AMULTUSER<1$1
78G6 ADDMODE 4,READ,STREAMS
78^Q QDEST
79FB BNG 6 OPEN [JIF NO ADJUNCTS BLOK
79^2 LDX 5 4 [SAVE X4
7=DL LDN 4 14
7=Y= CALL 6 XADJ [LOOK FOR DESTCOMM ADJUNCT
7?CW BRN NDEST [NOT FOUND
7?XG DSA 4 CEINF3(3) [DESTCOMM VALUE
7#C6 SETMODE 4,DESTRUCT,COMMUNE
7#WQ NDEST
7*BB ORX 4 5
7*W2 SETUPMOD ,5,GDR
7B5S ... LDX 2 FX2
7B*L ANDX 5 AWORK1(2)
7BT= BRN OPEN2
7C#W OUTPUTLP
7CSG LDX 0 BIT9
7D#6 ANDX 0 AWORK4(2)
7DRQ BZE 0 NOTEXTEN
7F?B LDN 0 #22
7FR2 ORX 0 GSIGN
7G=L STO 0 CETM(3)
7GQ= NOTEXTEN
7H9W LDEX 0 AWORK4(2)
7HPG BZE 0 OUTPUT
7J96 LDX 0 GSIGN
7JNQ ORS 0 CEINF1(3) [SERIAL BIT
7K8B BNG 6 NCOMMS [JIF NO ADJUNCTS
7KN2 TESTMODE 6,NOTCOMM,,COMMUNE [JIF COMMUNE GIVEN WITH AUTO
7L7L TESTMODE AWORK1(2),NOTCOMM,,GDR [JIF GDR GIVEN WITH AUTO
7LM= LDN 4 14
7M6W CALL 6 XADJ
7MLG BRN NCOMMS
7N66 LDX 1 FX1
7NKQ BRN NOTCOMM [JIF DESTCOMM GIVEN WITH AUTO
7P5B NCOMMS
7PK2 SETMODE 4,NOWAIT,REPLY
7Q4L ANDX 4 AWORK2(2)
7QJ= #SKI AMULTUSER
7R3W ADDMODE 4,GENERAL,EMPTY,CREATE,FILE,MULT
7RHG #SKI AMULTUSER<1$1
7S36 ADDMODE 4,GENERAL,EMPTY,CREATE,STREAMS
7SGQ LDN 6 #7000
7T2B ANDX 6 AWORK2(2)
7TG2 ORS 6 AWORK4(2) [REMEMBER IF APPEND
7T^L BRN OPEN
7WF= MAGNETIC
7WYW LDXC 0 AWORK4(2)
7XDG BCS MAGAS
7XY6 LDCT 0 4
7YCQ ORS 0 CEINF1(3) [MT FILE
7YXB MAGAS
7^C2 SETMODE 4,EMPTY
7^WL ANDX 4 6
82B= ANDN 6 #7000 [ISOLATE MAIN MODE
82TW BZE 4 MAG1 [J IF NOT EMPTY
83*G SETMODE 0,READ
83T6 BXE 6 0,XMODES [JIF CLASH
84#Q MAG0
84SB ADDMODE 4,WRITE,CREATE
85#2 BRN OPEN
85RL MAG1
86?= SETMODE 0,WRITE
86QW BXE 6 0,MAG0 [JIF WRITE
87=G ADDMODE 4,READR
87Q6 BRN OPEN
889Q RDRUM LDN 4 1
88PB BRN RA
8992 RANDOM
89NL LDN 4 0
8=8= RA
8=MW ANDN 6 #7000 [ISOLATE MAIN MODE
8?7G SETMODE 5,EMPTY
8?M6 ANDX 5 AWORK2(2)
8#6Q BNZ 4 NOVER [JIF DRUM
8#LB SETMODE 4,OVERLAY
8*62 BXE 6 4,WRDA [JIF OVERLAY
8*KL SETMODE 4,OFFSET
8B5= ANDX 4 AWORK2(2)
8BJW BZE 4 NOVER [JIF NOT OFFSET
8C4G ADDMODE 4,WRITE
8CJ6 BRN USRCLN
8D3Q NOVER
8DHB SETMODE 4,WRITE
8F32 BXE 6 4,MPTY [JIF WRITE
8FGL SETMODE 4,READ
8G2= BXE 6 4,RDDA [JIF READ
8GFW BZE 5 RDDA2 [JIF NOT EMPTY
8G^G WRDA
8HF6 SETMODE 4,WRITE
8HYQ MPTY
8JDB ORX 4 5 [ADD IN EMPTY IF PRESENT
8JY2 BRN USRCLN
8KCL RDDA
8KX= BNZ 5 XMODES [JIF EMPTY & READ
8LBW RDDA2
8LWG SETMODE 4,READR
8MB6 USRCLN
8MTQ SETMODE 0,USERCLEAN
8N*B ANDX 0 AWORK2(2)
8NT2 ORX 4 0
8P#L BRN OPEN
8PS= PCI
8Q?W SETMODE 4,GENERAL
8QRG OPEN
8R?6 LDN 5 0 [2ND MODE WD
8RQQ OPEN2
8S=B LDX 2 FX2
8SQ2 ADDMODE 4,LEAVE
8T9L LDCT 0 #777
8TP= LDX 1 FX1
8W8W SMO 7
8WNG ANDX 0 PDATA(1)
8X86 BXU 0 YFILEHAN(1),U
8XMQ TESTMAIN 4,U,NOT,GENERAL
8Y7B ADDINMODE ,5,USERCARE
8YM2 U
8^6L LDX 0 AWORK4(2)
8^L= BNG 0 USE1 [J IF ASSILO
925W USEROPEX OPBI,4,5
92KG REPERR OPOK [REPORT ERROR (IF ANY)
9356 BRN XEND [ & JIF THERE WAS
93JQ OPOK
944B MFREE CPB,CUNI
94J2 TREP STREAM,USE1 [KEEP FABSNB IF MULTIFILE
953L MFREE FILE,FABSNB
95H= USE1
962W LDX 1 FX1
96GG MHUNTW 3,FILE,ENT
9726 LDX 0 ETM(3) [KEEP IN CASE TR
97FQ STO 0 AWORK1(2)
97^B SMO 7
98F2 LDXC 6 PDATA+1(1)
98YL BCS NOFREA
99D= FREECORE 3 [FREE ENT IF NOT NEEDED
99XW NOFREA
9=CG #
9=X6 # X1=FX1, X2=FX2, X4=USEROPEN MODES, X7=PDATA TABLE MODIFIER
9?BQ # AWORK1=FILE T/M, AWORK2=ADJUNCTS BLOCK MODE WD., AWORK3=PERIPHERAL T/M
9?WB # AWORK4(B0)=ENTRY SWITCH
9#B2 #
9#TL LDX 3 6
9**= SRL 3 10
9*SW ANDN 3 #177 [AOLPT LENGTH
9B#G LDCT 5 AOLPT/8 [AOLPT TYPE
9BS6 GETACTX 5,3,1
9C?Q LDX 3 BPTR(2)
9CRB W4
9D?2 LDX 0 JOBNO(2)
9DQL STO 0 JOBNO(3)
9F== LDCT 0 #400
9FPW STO 0 FRECHADD(3)
9G9G STO 4 FSCMODE(3) [MODE WD FOR COMPCHAN
9GP6 #SKI AMULTUSER
9H8Q SETMODE 0,FILE,MULT,MULTEL,LEAVE,UNTRAP
9HNB #SKI AMULTUSER<1$1
9J82 SETMODE 0,STREAMS,STREAMCOMP,LEAVE
9JML ERS 0 FSCMODE(3)
9K7= LDX 0 AWORK1(2)
9KLW STO 0 FSCTM(3) [TYPE/MODE
9L6G LDCT 0 #400
9LL6 ORS 0 GIVE(3) [SET BIT FOR ADLOT
9M5Q LDX 0 AWORK3(2)
9MKB STO 0 FTYPNO(3)
9N52 ADXC 6 6
9NJL BCC SIMU [JIF NOT RANDOM OR MT
9P4= SETMODE 0,GIVE
9PHW ANDX 0 AWORK2(2)
9Q3G BNZ 0 NORA1
9QH6 LDCT 0 #400
9R2Q ERS 0 GIVE(3) [VNSET ALLOT BIT
9RGB NORA1
9S22 ADXC 6 6
9SFL BCS WAJ2 [JIF MT
9S^= SETMODE 0,MAYBE
9TDW ANDX 0 AWORK2(2)
9TYG BZE 0 NORA2
9WD6 STO 0 ABITS(3)
9WXQ NORA2
9XCB ADXC 6 6
9XX2 BCS WAJ2 [JIF DRUM
9YBL MHUNTW 1,FILE,ENT
9YW= #
9^*W # SET UP INFO FROM FILE/ENT IN AOLPT
9^TG #
=2*6 LDX 0 ERET(1) [ERET HAS NO MEANING FOR FILES AT
=2SQ SLL 0 12 [PRESENT BUT DOING THIS DOESN'T UPSET
=3#B ORX 0 ERET(1) [ANYONE
=3S2 STO 0 AERET(3) [DATA & FILE RETENTION
=4?L LDX 0 EKEY(1)
=4R= STO 0 AEKEY(3) [KEY DETAILS
=5=W LDX 0 EFLOW(1)
=5QG STO 0 AEFLOW(3) [2ND LEVEL O'FLOW BKT
=6=6 LDCT 0 #600
=6PQ ANDX 0 EINF3(1)
=79B STO 0 AEINF3(3) [INTEGRITY CODE (B0&1)
=7P2 LDX 0 EWRITDAY(1)
=88L STO 0 AEWRITDAY(3) [DATE WRITTEN
=8N= LDX 0 EORG(1)
=97W STO 0 AEORG(3) [FILE ORGANISATION
=9MG ANDN 0 #77
==76 LDN 6 7
==LQ SLOG SRL 0 1
=?6B BZE 0 WLOG
=?L2 BUX 6 SLOG
=#5L WLOG STO 6 ALOG(3) [LOG2 OF BKT SIZE IN WDS
=#K= NGS 6 EDPTIME(3) [INITIALISE PERI TIMER
=*4W FREECORE 1 [ENT NO LONGER NEEDED
=*JG TOPFCA2 1
=B46 STOZ FREADWORD(1)
=BHQ JBC WAJ,1,BAMWRITE [JIF NOT OPEN IN WRITE MODE
=C3B TOPFCB2 1
=CH2 MBS 1,BFALTR,BFALTB ['COS FVERSION (& FENDBUCK) WILL BE
=D2L LDX 0 FVERSION(1) [ CHANGED
=DG= ADN 0 1
=D^W DSA 0 FVERSION(1) [UPDATE VERSION FOR OVERLAY & OFFSET
=FFG LDN 6 #7000
=F^6 ANDX 6 AWORK2(2)
=GDQ SETMODE 0,OVERLAY
=GYB BXE 6 0,WAJ [JIF OVERLAY
=HD2 SETMODE 0,OFFSET
=HXL ANDX 0 4
=JC= BZE 0 NOFFS [JIF NOT OFFSET
=JWW LDX 0 FENDBUCK(1)
=KBG SMO FILERING(2)
=KW6 STO 0 FREADWORD [END OF FILE BKT FOR EDOBJ
=L*Q SMO ALOG(3)
=LTB SLL 0 0
=M*2 SRL 0 GSBSLOG
=MSL DEX 0 EDBUFR(3)
=N#= BRN WAJ
=NRW NOFFS
=P?G STOZ FVERSION(1) [ZEROISE VERSION
=PR6 STOZ FENDBUCK(1) [ & E.O.F. BKT IF WRITE ONLY
=Q=Q BRN WAJ
=QQB SIMU
=R=2 # SET UP MASK FOR *FH
=RPL LDCT 0 #777
=S9= SMO 7
=SNW ANDX 0 PDATA(1)
=SW4 ... BXE 0 YFILEREAD(1),MASKSET
=T3= ... BXE 0 YFILEWRITE(1),MASKSET
=T8G BXU 0 YFILEHAN(1),U1
=TD# ...MASKSET
=TN6 #
=W7Q ...# FOR *FH,*FR,*FW WE ASSEMBLE A MASK OF FORBIDDEN MODES IN X4 AND A SET
=WMB # SWITCHES IN X5. THESE ARE PUT IN AWORK3 AND 4 OF THE OLPA RESPECTIVEL
=X72 # WE ALSO FREE THE ENT IN THE SERIAL FILE CASE.
=XLL #
=Y6= LDN 4 0 [CLEAR MASKS
=YKW LDN 5 0
=^5G TOPFCA2 2 [X2->FCA
=^K6 JBC NFHCOMM,2,BACOMM [J IF NOT COMMUNE
?24Q ORX 4 XCOMM(1) [ADD FORBIDDEN MODES
?2JB NFHCOMM
?342 JBC NFHMULT,2,BAMULT [J IF NOT MULTIFILE
?3HL ORX 4 XMULT(1) [ADD FORBIDDEN MODES
?43= NFHMULT
?4GW TOPFCB 2 [X2->FCB OF FILE
?52G LDN 0 #77
?5G6 ANDX 0 FINFC(2)
?5^Q BZE 0 NFHIND [J IF NOT INDEXED
?6FB ORX 4 XINDE(1) [ADD FORBIDDEN MODES
?6^2 ... JBC YFHIND,2,BFDIR [J IF NOT DIR
?7DL ORX 4 XDIRS(1) [ADD FORBIDDEN MODES
?7Y= OWNERCHE [DOES USER OWN FILES IN DIR
?8CW TESTRPN2 OK,NOTOWNDIR
?8XG LDN 5 #40 [SET A SWITCH IF SO
?9C6 NOTOWNDIR
?9HJ ... FINDACTFB 3,2,AOLPT,,,BPTR [X3->OLPA
?9N2 ... BXE 3 BPTR(2),NONEWACT [IF OWNERCHE HAS SET UP AN AUTOCLOSE
?9SD ... RINGACT 3,2 [BETWEEN CPA AND OLPA WE MUST
?9YW ... [RECHAIN THE OLPA TO AVOID BREAKING T
?=5# ... [ROLPA MACRO BELOW
?=9Q ...NONEWACT
?=BB TOPFCB2 2 [X2->FCB AGAIN
?=L8 ... BRN YFHIND
?=W2 NFHIND
?=^X ... ORX 4 XNIND(1) [ADD FORBIDDEN MODE FOR
??5S ... [NONINDEXED FILES.
??9P ...YFHIND
??*L JMBAC NFHDEST,2,BFGDR,BFDCF [ J IF NOT DESTRUCTIVE ACCESS
??T= ORX 4 XGDR(1) [ADD FORBIDDEN MODES
?##W NFHDEST
?#SG JBC NFHSERIAL,2,BFSER [J IF NOT SERIAL FILE
?*#6 ORX 4 XSER(1) [ADD IN FORBIDDEN MODE
?*RQ LDX 2 FX2
?B?B LDCT 0 #200 [IF SERIAL MAY BE OL *FH
?BR2 ANDX 0 AWORK4(2) [IN WHICH CASE MORE FORBIDDEN MODES
?C=L BNZ 0 YFHOL [AND NO FILE ENT BLOCK TO FREE
?CQ= MFREEW FILE,ENT
?D9W BRN NFHOL
?DPG YFHOL
?F96 ORX 4 XONLI(1) [ADD IN ONLINE FORBIDDEN MODES
?FNQ BRN NFHOL
?G8B NFHSERIAL
?GN2 LDN 5 #100 [SET SWITCH TO SHOW NONSERIAL
?H7L ORX 4 XDAFILE(1) [ADD IN NONSER FORBIDDEN MODES
?HM= LDX 2 FX2
?J6W NFHOL
?JLG STO 4 AWORK3(3) [STORE MASKS
?K66 STO 5 AWORK4(3)
?KKQ U1
?L5B ADXC 6 6
?LK2 BCC NOTCR [JIF NOT CR
?M4L LDN 4 1
?MJ= TPCHEK
?N3W LDCT 0 #377
?NHG ANDX 0 AWORK1(2)
?P36 BXU 0 TPTYPE(1),WAJ2 [JIF NOT TP FILE
?PGQ STO 4 AWORK2(3) [FOR SIMULPTR
?Q2B BRN WAJ2
?QG2 NOTCR
?Q^L ADXC 6 6
?RF= BCC NOTTR [JIF NOT TR
?RYW LDN 4 0
?SDG LDX 0 AWORK4(2)
?SY6 ANDX 0 BIT10
?TCQ STO 0 AWORK4(3)
?TXB BRN TPCHEK
?WC2 NOTTR
?WWL LDEX 0 AWORK4(2)
?XB= BZE 0 MCHEXT
?XTW SRL 0 2
?Y*G STO 0 AWORK2(3)
?YT6 BRN MCHAPP
?^#Q MCHEXT
?^SB LDX 0 BIT9
#2#2 ANDX 0 AWORK4(2)
#2RL BZE 0 WAJ2
#3?= STO 0 AWORK2(3)
#3QW BRN WAJ2
#4=G MCHAPP
#4Q6 LDN 0 #7000
#59Q ANDX 0 AWORK4(2)
#5PB BZE 0 WAJ2 [JIF NOT APPEND CASE
#692 #SKI CLINK<1$1
#6NL SBX 5 FX1
#78= WIND [HAVE TO DO WIND 'COS OPEN IN GENERAL
#7MW #SKI CLINK<1$1
#87G ADX 5 1
#8M6 LDX 3 BPTR(2)
#96Q BRN WAJ2
#9LB WAJ
#=62 LDX 1 FX1
#=KL WAJ2
#?5= LDCT 0 #10
#?JW SMO 7
##4G ANDX 0 PDATA+1(1)
##J6 BZE 0 PLINK [JIF LIMIT ADJUNCT NOT APPLICABLE
#*3Q LDXC 0 AWORK2(2)
#*HB BCS NLIM [JIF NO ADJUNCTS BLOK
#B32 LDN 4 18
#BGL CALL 6 XADJ [LOOK FOR LIMIT ADJUNCT
#C2= NLIM [NOT FOUND
#CFW LDX 4 AZVOLUME
#C^G LDCT 6 #200
#DF6 ANDX 6 AWORK4(2)
#DYQ BZE 6 VOL
#FDB LDX 4 BITS22LS [ NO LIMIT FOR O-L CASE
#FY2 VOL
#GCL STO 4 ALIMEY(3)
#GX= PLINK
#HBW LDX 1 FX1
#HWG SMO 7
#JB6 LDX 5 PDATA+2(1)
#JTQ LDCT 0 #377
#K*B ANDX 0 AWORK1(2)
#KT2 BXU 0 TPTYPE(1),NTPTYPE [J UNLESS *TP TYPE FILE
#L#L LDX 5 TSIM(1) [LINK FOR TP SIMULATOR
#LS= NTPTYPE
#M?W LINKSET 3,5
#MRG LDX 5 AWORK3(2)
#N?6 PUTPEREN 5,GSIGN [INSERT PERIPH. ENTRY
#NQQ ROLPA [CHAIN AOLPT IN PCA CHAIN
#P=B HUNTW 3,FILE,ENT [IF ENT LEFT GIVE IT TO OLPA
#PQ2 BNG 3 NOENTLEFT
#Q9L CHAIN 3,6
#QP= NOENTLEFT
#R8W BNG 7 NOCH [JIF NO M/F TO CHANGESTREAM
#RNG LOCK 6
#S86 CHANGEST 6 [PASS FILE TO OLPA
#SMQ UNLOCK 6
#T7B NOCH
#TM2 LDX 4 JOBNO(2)
#W6L GSCAN 4,JOB ASTU,2
#WL= LDX 0 AWORK4(2)
#X5W BPZ 0 XEND [J IF COMMAND
#XKG UPPLUS 1
#Y56 XEND
#YJQ ENDCOM
#^4B XADJ
#^J2 MHUNTW 1,FILE,ADJUNCTS
*23L LDX 0 A1(1) [REC HDDR
*2H= SBN 0 ADPAIR-A1 [WORD PAIRS START AT ADPAIR
*32W BNG 0 X [?
*3GG SRL 0 1
*426 BZE 0 X [BLOCK EMPTY
*4FQ X2
*4^B BXE 4 ADPAIR(1),X1 [JIF THIS IS REQD. ADJUNCT TYPE
*5F2 ADN 1 2
*5YL BCT 0 X2
*6D= X LDN 4 0
*6XW EXIT 6 0 [NOT FOUND X4=0
*7CG X1
*7X6 #SKI K6ASSIGN>199-199
*8BQ TRACE 4,ADJ TYPE
*8WB LDX 4 ADPAIR+1(1) [ADJUNCT VALUE
*9B2 #SKI K6ASSIGN>199-199
*9TL TRACE 4,ADJ VALU
*=*= EXIT 6 1 [FOUND X4=ADJUNCT VALUE
*=SW OPBI
*?#G COMBRKIN [USEROPEN BREAK-IN LABEL
*?S6 NJPARMIS1
*#?Q LDX 1 FX1
*#RB NJPARMIS
**?2 ADX 3 1
**QL COMERRX ZJPARMIS(1),ZMISSING(3)
*B== WRONGDEVICE
*BPW LDX 6 ZASSIGNER1(1)
*C9G NASSILO
*CP6 LDXC 0 AWORK4(2)
*D8Q BCS TLOUP [JIF ASSILO
*DNB NCOMERRX1
*F82 COMERRX 6
*FML NJTOOMANY
*G7= LDX 6 ZJTOOMANY(1)
*GLW BRN NCOMERRX1
*H6G XMODES
*HL6 LDX 6 ZINCOMQU(1)
*J5Q BRN NASSILO
*JKB WRONGQUAL
*K52 LDX 6 ZILLQUAL(1)
*KJL BRN NCOMERRX1
*L4= NOTCOMM
*LHW LDX 6 ZASSIGNER2(1)
*M3G BRN NCOMERRX1
*MH6 [
*N2Q MENDAREA AOLPGAP,K99ASSIGN
*NGB #END
^^^^ ...162146070014