File: CCLSB2.MA of Disk: V50/Source/Source-Listing-2
(Source file text) 

/CCL SUBROUTINES 2 FOR KBM V40
/
/
/
/
/
/	CCL SUBROUTINES PART 2
/	VERSION=4B


	.ENTRY	  OPNSUB,CLOSUB
	.EXTERNAL DVICE
	.EXTERNAL ERROR,PRWD,PRINT,LEAVE

	.NOLIST
	.INCLUDE OUT:CCLDEF.MA
	.LIST

	SDNAME=564	/V40
	SDVHND=772	/V40
	USRDIR=1400
	DKUSED=4000
	M8BITS=7667
	UDNAME=7741
	DCB=7760
	OLDT9=7

	OFLAG=NAME1
	WOPTION=NAME2
	HASH=NAME3

	.RSECT CCLSB2
	FIELD 1
OPNSUB,	0
	CLA IAC
	DCA	OFLAG	/SHOW IT'S OPEN
	TAD	OPNSUB
	DCA	CLOSUB
	JMP	CLOSUB+2
CLOSUB,	0
	DCA	OFLAG
	SM8
CLOSEX,	JMP I	CLOSUB
	TAD I	(MOFILE+6
	SZA CLA
CLERR,	JMS I	(ERROR
	   9.		/"#Illegal Syntax"
	DCA	CHANL
	DCA	TASK
	DCA	TYPE	/SET SOME DEFAULTS
	JMS I	(USREAD	/READ FRESH USR PART
	TAD	DEV1
	DCA	HASH
	TAD	HASH
	SNA CLA
	JMP I	(ALL	/NO DEV MEANS 'ALL'
	TAD	DEV2
	SNA
	JMP	SHDV$
	TAD	HASH
	RAL
	STL RAR
	DCA	HASH
SHDV$:	CLA STL RAR	/=4000
	TAD I	(7741	/ASS NAME FOR SYS: = KIT7 ?
	SZA CLA
	JMP	NOWR$	/NO, ONLY SPECIALISTS
	TAD I	(MPARAM+1
	AND	(42	/CHECK /W AND /S OPTIONS
NOWR$:	DCA	WOPTION
	TAD I	(DVICE	/DID WE DECODE A DEVICE ?
	SZA CLA
	 JMP I (FOUND	/YES
	TAD	OFLAG	/NO,
	SNA CLA		/OPENING ?
	 JMP	CLERR	/NO, CAN'T CLOSE
	TAD	(SDNAME+17-1
	DCA	T
	TAD I	T	/GET LAST ENTRY OF LIST
	SNA CLA		/CHANNEL 1 FREE ?
	 JMP	CHAN1	/YES
	TAD	(SDNAME+16-1
	DCA	T
	TAD I	T	/CHANNEL 2 FREE ?
	SNA CLA
	 JMP	CHAN2	/YES
	TAD	(SDNAME+15-1
	DCA	T
	TAD I	T
	SZA CLA		/CHANNEL 3 FREE ?
	JMS I	(ERROR
	   28.		/"All Channels used"
	CLA IAC
CHAN2,	IAC
CHAN1,	IAC
	DCA	CHANL	/CHANNEL NUMBER
	TAD	(-<SDNAME-1>
	TAD	T
	DCA I	(DVICE	/OS8 DEVICE NUMBER
	JMP I	(LOOK	/GO LOOKUP NAME IN OPEN TABLE
CALLOP,	0
	TAD	(5
	GIOT
	JMP	.+4
CHANL,	0
TASK,	0
TYPE,	0
	CLA CLL
	JMP I	CALLOP
PAGE
FOUND,	TAD I	(DVICE
	TAD	(-15	/SHOULD BE 15, 16 OR 17
	SPA CLA
	 JMP 	NCHERR	/NOT A CHANNEL
	TAD I	(DVICE
	CIA
	TAD	(20	/COMPUTE CHANNEL NUMBER
	DCA I	(CHANL
LOOK,	JMS I	(LOOKUP	/SEARCH NAME IN CHANNEL TABLE
	TAD I	(DVICE
	TAD	(DCB-1
	DCA	T
	TAD I	(TYPE
	AND	(7770
	DCA I	T	/SET DEVICE TYPE
	TAD	(SDNAME-1
	TAD I	(DVICE
	DCA	T
	TAD	OFLAG
	SZA CLA		/IF 'OPEN',
	TAD	HASH
	DCA I	T	/SET DEVICE NAME IN USR
	TAD I	(DVICE
	TAD	(DVHNDL-1
	DCA	T
	TAD	OFLAG
	SNA CLA		/CLOSE?
	 JMP	ZERO	/YES, ZERO ENTRYPOINT
	TAD I	(CHANL
	CLL RAL
	TAD I	(CHANL
	TAD (7607
ZERO,	DCA I	T	/SET/ZERO ENTRYPOINT
	JMS I	(CALLOP	/PASS ARGUMENTS TO FOREGROUND
	UOFFS=USRDIR-7600
EXIT,	CLA STL RAR	/4000 FOR WRITE
	JMS	USREAD	/WRITE USR TO SYS
	DCA	OLDT9	/ZAP USR DIRECTORY
	CIF 0
	JMS I	(7607	/UPDATE BOOTBLOCK
	0210
	USRDIR		/USR DIR BUFFER
	0000
	JMS I	(ERROR
	0.
	TAD I (DVHNDL+15-1
	DCA I (DVHNDL+15-1+UOFFS
	TAD I (DVHNDL+16-1
	DCA I (DVHNDL+16-1+UOFFS
	TAD I (DVHNDL+17-1
	DCA I (DVHNDL+17-1+UOFFS
	TAD I (DCB+15-1
	DCA I (DCB+15-1+UOFFS
	TAD I (DCB+16-1
	DCA I (DCB+16-1+UOFFS
	TAD I (DCB+17-1
	DCA I (DCB+17-1+UOFFS
	CIF 0
	JMS I (7607
	4210
	1400
	0000
	JMS I	(ERROR
	0.
	JMP I	(CLOSEX	/DONE
USREAD,	0
	TAD	(410	/AC MAY HAVE 4000 FOR WRITE
	DCA	CTLW$
	CIF 0
	JMS I	(7607
CTLW$:	0410
	0400
	0014
	JMS I	(ERROR
	0.
	JMP I	USREAD

NCHERR,	TAD	('#@
	JMS I	(PRWD
	TAD	DEV1
	JMS I	(PRWD
	TAD	DEV2
	JMS I	(PRWD
	JMS I	(PRINT
	CHERR
	JMP I	(LEAVE
PAGE
LOOKUP,	0
	CDF 0
	TAD I	(M8BITS
	CDF 10
	AND	(DKUSED
	SNA CLA
	TAD	(TABLE2-TABLE1
	TAD	(TABLE1-1
LOOK1,	DCA	XR
	TAD I	XR
	SNA
	 JMP I	(NCHERR
	CIA
	TAD	DEV1
	SZA CLA
	 JMP	LOOK2
	TAD I	XR
	CIA
	TAD	DEV2
	SZA CLA
	 JMP	LOOK3
	TAD	OFLAG
	SNA CLA 	/CLOSING ?
	 JMP I	LOOKUP	/YES, KEEP TYPE AND TASK ZERO
	TAD I	XR
	DCA I	(TASK
	TAD	WOPTION	/WRITE OPTION ?
	SZA CLA
	TAD	(-2000
	TAD	(7777
	AND I	XR
	DCA I	(TYPE
	TAD I	(TYPE
	AND	(770
	TAD	(-230	/IS IT RK8E?
	SZA CLA
	JMP I	LOOKUP	/NO MUST BE OK
	TAD	(DCB
	6264		/PEEK
	CDF	10	/AT TYPE WORD OF OS/8 SYSTEM HANDLER
	AND	(770	/PICK OUT DEVICE TYPE
	MQL
	TAD	(770
	CMA		/7007 MASK
	AND I	(TYPE
	MQA		/MERGE IN OS/8 DEVICE TYPE
	DCA I	(TYPE
	JMP I	LOOKUP
LOOK2,	CLA IAC
LOOK3,	TAD	(2
	TAD	XR
	JMP	LOOK1

TABLE1,			/VIRTUAL DISK FILES
	DEVICE DSK0;"S^100+"Y&3777;6500
	DEVICE DSK1;"D^100+"K&3777;6511
	DEVICE DSK2;"D^100+"K&3777;6522
	DEVICE DSK3;"D^100+"K&3777;6533
	DEVICE DSK4;"D^100+"K&3777;6544
	DEVICE DSK5;"D^100+"K&3777;6555
	DEVICE DSK6;"D^100+"K&3777;6566
	DEVICE DSK7;"D^100+"K&3777;6577
	0	/END OF TABLE1
.ENABLE ASCII
.IF NDF GERMAN <
CHERR,	TEXT	/: not a Multi-8 Channel/ >
.IF DF GERMAN  <
CHERR,	TEXT	/: ist kein Multi-8 Bereich/ >
.ENABLE SIXBIT

PAGE
ALL,	TAD I	(OFLAG
	SZA CLA		/OPEN OR CLOSE ?
	 JMP I	(CLERR	/OPEN: THATS DIFFICULT
	CLA CLL IAC RAL	/2
	DCA I	(CHANL
	JMS I	(CALLOP	/CLOSE CHANNEL 2
	ISZ I	(CHANL
	JMS I	(CALLOP	/CLOSE CHANNEL 3
	TAD	(SDNAME+15-1
	DCA	T
	TAD I	(DVHNDL+15-1	/HANDLER ENTRY POINT
	TAD	(-7620
	SZA
	 TAD	(7620-7615
	SZA CLA		/IS THIS REALY A CHANNEL ?
	 JMP	ALL0	/NO
	DCA I	T	/YES, ZERO NAME ENTRY
	DCA I	(DCB+15-1	/ZERO TYPE WORD
	DCA I	(DVHNDL+15-1	/ZERO ENTRY POINT
ALL0,	ISZ	T	/NEXT CHANNEL
	TAD I	(DVHNDL+16-1
	TAD	(-7620
	SZA
	 TAD	(7620-7615
	SZA CLA		/REALY A CHANNEL ?
	 JMP	ALL4	/NO
	DCA I	T	/ZERO NAME ENTRY
	DCA I	(DCB+16-1	/ZERO TYPE WORD
	DCA I	(DVHNDL+16-1	/ZERO ENTRY POINT
ALL4,	ISZ	OFLAG	/NOW FAKE OPEN MYSELF
	TAD	('DS
	DCA	DEV1
	TAD	('K0
	DCA	DEV2	/FAKE DSK0
	TAD	(6003	/HASH FOR DSK0:
	DCA	HASH
	TAD	(17
	DCA I	(DVICE	/WE MAY WIPE OUT AN OS/8 HANDLER
	DCA	WOPTION	/BE SURE NO /W
	CLA IAC
	DCA I	(CHANL	/CHANNEL 1 IS DSK0:
	JMP I	(LOOK	/GO OPEN DSK0: AND END PROPERLY
TABLE2,			/USER DISKS
	DEVICE DSK0;"S^100+"Y&3777;6230
	DEVICE DSK1;"S^100+"Y&3777;6231
	DEVICE DSK2;"S^100+"Y&3777;6232
	DEVICE DSK3;"S^100+"Y&3777;6233
	DEVICE DSK4;"S^100+"Y&3777;6234
	DEVICE DSK5;"S^100+"Y&3777;6235
	DEVICE DSK6;"S^100+"Y&3777;6236
	DEVICE DSK7;"S^100+"Y&3777;6237
	0	/END OF TABLE1
PAGE