DataMuseum.dk

Presents historical artifacts from the history of:

Philips Data Systems

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Philips Data Systems

Excavated with: AutoArchaeologist - Free & Open Source Software. 

top - metrics - download

⟦bc32f1fde⟧ 

    Length: 52550 (0xcd46)
    Notes: pts_type(SC)
    Names: »DRFD02.SC«

Derivation

└─⟦13e5fd45a⟧ Bits:30009699 Philips computer tape "600507"
    └─⟦this⟧ »TOSSWORK/DRFD02.SC«

PTS(SC)

	IDENT DRFD02 	REL 11.0 81-08-24 870105041100 

			=5, REL 11.0 81-02-27
			=5, DON'T HANDLE READY INTERRUPT 
			=5, UNTIL TIMEOUT ROUTINE IS READY 
			=4, REL 11.0 81-02-18
			=4, CRN UPDATED FOR SEQ READ IF ERROR
			=3, REL 11.0 81-01-27
			=3, DATA SET NBR IN ECBCW1 
			=2, REL 11.0 81-01-26
			=2, NOT OP. IF WRONG CH. UNIT
			=1, PRR 11.0 80-11-19 ,ATTACH BIT CLEARED BY RECOVERY AND
			=1, NOT IBM NOT WORKING
* 
**********************************************
* 
*  PHILIPS TERMINAL SYSTEM PTS
* 
*  DRFD02 = DRIVER FOR FLEXIBLE DISK
* 
* 
* 
* 
* 
* 
********************************************* 
* 
* 
*  THIS DISK DRIVER HANDLES UP TO FOUR DAISY
*  CHAINED FLEXIBLE DISK DRIVES PTS 6879 OR PTS 6791
*  CONNECTED TO CPU VIA CHANNEL UNIT F1MZ/B   ON
*  MULTIPLEX CHANNEL
* 
* 
	EJECT			DRFD02 
* 
*  ORDERS:
* 
*  /00   TEST STATUS
*  /01   PHYSICAL READ
*  /02   SEQUENTIAL READ                       -IBM DISC ONLY-
*  /05   BASIC WRITE
*  /06   SEQUENTIAL WRITE                       -IBM DISC ONLY- 
*  /11   PHYSICAL READ
*  /15   PHYSICAL WRITE 
*  /1F	FORMAT VOLUME
*  /24   WRITE DELETED DATA 
*  /26   LOCK 
*  /31   REWIND                                 -IBM DISC ONLY- 
*  /37   LOAD 
*  /38   UNLOAD 
* 
*  ENTRY PARAMETERS:
* 
*   A5   STACK BASE 
*   A6   DWT-ADDRESS
*   A7   ORDER
*   A8   ECB-ADDRESS
	EJECT			DRFD02 
* 
*********** 
*         * 
* ENTRIES * 
*         * 
*********** 
* 
	ENTRY 	FDADR	ACTIVATION ADDRESS
	ENTRY	IHFD	INTERRUPT HANDLER 
	ENTRY	FDON	RECOVERY ROUTINE
	ENTRY	DWFD01	DWT-ADDRESS 
	EJECT			DRFD02 
* 
************* 
*           * 
* EXTERNALS * 
*           * 
************* 
* 
	EXTRN	INXDWT	INDEXED DISPLACEMENT IN DWT 
	EXTRN	TDISP	DISPATCHER 
	EXTRN	TENDIO	ENDIO 
	EXTRN	DISIOE	REQUEST ERROR 
	EXTRN	DISEND	PERFORM TENDIO AND TDISP
	EXTRN	VOLCLR	CLEAR VOLUME NAME 
	EXTRN	VOLNAM	VOLUME NAME ADDRESS 
	EXTRN	VOLGET	VOLUME NAME TO DWT AND SET NVL
	EXTRN	NVLCHK	CHECK FOR NEW VOLUME LOADED 
	EXTRN	DWTST	STATUS 
	EXTRN	DWTECB	ECB ADDRESS 
	EXTRN	DWTOR	DWT INDEX AND ORDER
	EXTRN	DWTORD	ORDER/INDEX SAVE AREA 
	EXTRN	DWTSB2	STACK BASE 2 IN DWT 
	EXTRN	SAVE8	SAVE A1-A8 ON A15 STACK
	EXTRN	SETIMP	TIMER 
	EXTRN	PFPOST	PWF POST PROC. FLAG 
	EXTRN	TASCII	EBCDIC TO ASCII TAB 
	EXTRN	TEBCDIC	ASCII TO EBCDIC TAB
	EXTRN	ECBBA	ECB BUFFER ADDRESS 
	EXTRN	ECBRL	ECB REQUESTED LENGTH 
	EXTRN	ECBEL	ECB EFFECTIVE LENGTH 
	EXTRN	ECBCW1	ECB CONTROL WORD 1
	EXTRN	ECBCW2	ECB CONTROL WORD 2
	EJECT			DRFD02 
* 
************************
*                      *
* CONDITIONAL ASSEMBLY *
*                      *
************************
* 
* 
*	A PROGRAM VERSION INCLUDING TOSS DISC FORMAT
*	IS OBTAINED BY SETTING TOSS EQU 1.
* 
X:A	EQU	1 
TOSS	EQU	X:A
* 
*	A PROGRAM VERSION INCLUDING IBM DISC FORMAT 
*	IS OBTAINED BY SETTING IBM EQU 1. 
* 
X:B	EQU	0 
IBM	EQU	X:B 
* 
*        A PROGRAM VERSION LEAVING OUT THE CODE CONVERSION
*        ASCII-EBCDIC IS OBTAINED BY SETTING ASCEBC EQU 0 
* 
X:C	EQU	1 
ASCEBC	EQU	X:C
* 
*	A PROGRAM VERSION USING TOSS MMU PAGING 
*	IS OBTAINED BY SETTING MMUPAG EQU 1.
* 
MMUPAG	EQU	0
* 
	EJECT		DRFD02
* 
* 
* 
*	A PROGRAM VERSION USING THE EXTENDED INSTRUCTION
*	SET IS OBTAINED BY SETTING CPU852 EQU 0.
* 
CPU852	EQU	1
* 
* 
*   ANTI ASCEBC CONDITIONAL ASSEMBLY
* 
	IFT	ASCEBC=1 
EBCASC	EQU	0
	XIF
	IFT	ASCEBC=0 
EBCASC	EQU	1
	XIF
* 
	EJECT			DRFD02 
* 
************* 
*           * 
* CONSTANTS * 
*           * 
************* 
* 
DEVIND	EQU	10	DEVICE INDEX
CUADR	EQU	09	CONTROL UNIT ADDRESS 
MUXADR	EQU	CUADR+CUADR	MUX-ADDRESS
BOE	EQU	28	BEGIN OF EXTENT POSITION 
EOE	EQU	34	END OF EXTENT POSITION 
EOD	EQU	74	END OF DATA POSITION 
TIME	EQU	20	DELAY - POWER ON
* 
* 
*   ORDERS
* 
OR:TES	EQU	0	TEST STATUS
OR:BAR	EQU	/01	BASIC READ 
OR:SER	EQU	/02	SEQUENTIAL READ
OR:BAW	EQU	/05	BASIC WRITE
OR:SEW	EQU	/06	SEQUENTIAL WRITE 
OR:PHR	EQU	/11	PHYSICAL READ
OR:PHW	EQU	/15	PHYSICAL WRITE 
OR:FOV	EQU	/1F	FORMAT VOLUME
OR:DDW	EQU	/24	WRITE DELETED DATA 
OR:LCK	EQU	/26	LOCK 
OR:REW	EQU	/31	REWIND 
OR:LOD	EQU	/37	LOAD 
OR:ULD	EQU	/38	UNLOAD 
* 
	EJECT		DRFD02
* 
* 
*   RETURN CODES
* 
* 
RC:RET	EQU	/100	RETRIES PERFORMED 
RC:NOD	EQU	/804	NO DATA 
RC:NOP	EQU	1	NOT OPERABLE 
RC:ILE	EQU	/8008	ILLEGAL LENGTH 
RC:REQ	EQU	/8000	REQUEST ERROR
RC:IBM	EQU	/400	IBM DISC
RC:EOD	EQU	/1000	END OF DATA
RC:EOE	EQU	/2000	END OF EXTENT
RC:WRP	EQU	/240	WRITE PROTECTED 
RC:FOR	EQU	/800	FORMAT
RC:IDS	EQU	/10	ILLEGAL DATA SET LABEL 
MS:128	EQU	2002	MAX SECTOR NUMBER FORMAT (128-1)
MS:256	EQU	4004	MAX SECTOR NUMBER FORMAT (256-2D) 
IN:WE1	EQU	/8080	1ST WER INSTRUCTION
IN:LCK	EQU	/4	LOCK BIT INDICATOR
IN:ULC	EQU	/FB	UNLOCK INDICATOR 
IN:IBM	EQU	/1	IBM INDICATOR 
IN:TOS	EQU	/FE	TOSS INDICATOR 
EBC:VO	EQU	/E5D6	EBCDIC FOR 'VO'
EBC:L1	EQU	/D3F1	EBCDIC FOR 'L1'
	EJECT			DRFD02 
* 
**********
*        *
* TABLES *
*        *
**********
* 
	DATA	0 
	DATA	DEVIND	DEVICE INDEX 
FDADR	DATA	FDAD	ACTIVATION ADDRESS
	DATA	0	ABORT ROUTINE ADDRESS 
* 
	EJECT			DRFD02 
* 
**********
* TESTST *
**********
* 
*   TEST STATUS ORDER 
* 
* 
TESTST	EQU	*
	CF	A15,NVLCHK
	ORS	A1,DWTRC,A6	NVL INDICATOR
	CM	DWTSEC,A6	READ SECTOR 0 
	CF	A5,REAPRB	PREPARE FOR READ TO BUFFER
	CF	A5,CIOI00	READ
	CF	A5,WRIPRE	PREPARE CIO WRITE TO BUFFER 
	CF	A5,CIOI00 
	ANKL	A1,/200 
	ORS	A1,DWTRC,A6	WRITE PROTECTED
	LDK	A1,/80	INDICATE TEST STATUS
	SC	A1,DWT:FC,A6
	CF	A5,VO:NAM	GET VOLUME NAME AND STATUS
	ORS	A1,DWTRC,A6	FORMAT TO RC 
	ANK	A1,/7
	RF(NZ)	TEST50	ERROR
	CF	A15,VOLNAM	VOLUME NAME TO BUFFER IF REQUESTED 
	LDK	A1,0	RESET RETURN CODE 
TEST50	EQU	*
	ABL	END:IO	END REQUEST 
* 
	EJECT			DRFD02 
* 
**************
*            *
* ACTIVATION *
*            *
**************
* 
FDAD	EQU	*	ACTIVATION ENTRY 
	CM	DWTRC,A6	CLEAR RC ACCUMELATOR 
	CF	A5,GETPAR	GET DEVICE DEPENDENT PARAMETERS 
	IFT	MMUPAG=1 
	MLR	2,A8	BUFFER ADDRESS
	SLC	A1,4 
	ANK	A1,/3
	SRL	A2,1	WORD MODE 
	MS	2,DWTBA,A6	18 BIT BUFFER ADDRESS
	XIF
	IFT	MMUPAG=0 
	LD	A1,ECBBA,A8	BUFFER ADDRESS
	ST	A1,DWTBA,A6 
	XIF
	LD	A2,DWTOR,A6	SAVE INDEX AND ORDER
	ST	A2,DWTORD,A6
	LDKL	A1,IN:WE1-/80	1ST WER INSTRUCTION 
* 
	EJECT		DRFD02
* 
* 
	LDR	A3,A7	ORDER
	RB(Z)	TESTST	TEST STATUS 
	IFT	TOSS=1 
	IFT	IBM=0
	SUK	A3,OR:BAR-OR:TES 
	RF(Z)	READ	BASIC READ
	SUK	A3,OR:BAW-OR:BAR 
	RF(Z)	WRITE	BASIC WRITE
	SUK	A3,OR:PHR-OR:BAW 
	RF(Z)	READ	PHYSICAL READ 
	SUK	A3,OR:PHW-OR:PHR 
	RF(Z)	WRITE	PHYSICAL WRITE 
	SUK	A3,OR:FOV-OR:PHW 
	ABL(Z)	FORMAT	FORMAT VOLUME
	SUK	A3,OR:DDW-OR:FOV 
	RF(Z)	DDWRIT	WRITE DELETED DATA
	SUK	A3,OR:LCK-OR:DDW 
	ABL(Z)	LOCKDO	LOCK 
	SUK	A3,OR:LOD-OR:LCK 
	ABL(Z)	LOAD	LOAD 
	SUK	A3,OR:ULD-OR:LOD 
	ABL(Z)	UNLOAD	UNLOCK 
	XIF
* 
	IFT	IBM=1
	SUK	A3,OR:BAR-OR:TES 
	RF(Z)	READ	BASIC READ
	SUK	A3,OR:SER-OR:BAR 
	ABL(Z)	SQREAD	SEQUENTIAL READ
	SUK	A3,OR:BAW-OR:SER 
	RF(Z)	WRITE	BASIC WRITE
	SUK	A3,OR:SEW-OR:BAW 
	ABL(Z)	SQWRIT	SEQUENTIAL WRITE 
	SUK	A3,OR:PHR-OR:SEW 
	RF(Z)	READ	PHYSICAL READ 
	SUK	A3,OR:PHW-OR:PHR 
	RF(Z)	WRITE	PHYSICAL WRITE 
	SUK	A3,OR:FOV-OR:PHW 
	ABL(Z)	FORMAT	FORMAT VOLUME
	SUK	A3,OR:DDW-OR:FOV 
	RF(Z)	DDWRIT	WRITE DELETED DATA
	SUK	A3,OR:LCK-OR:DDW 
	ABL(Z)	LOCKDO	LOCKDO 
	SUK	A3,OR:REW-OR:LCK 
	ABL(Z)	REWIND	REWIND 
	SUK	A3,OR:LOD-OR:REW 
	ABL(Z)	LOAD	LOAD 
	SUK	A3,OR:ULD-OR:LOD 
	ABL(Z)	UNLOAD	UNLOAD 
	XIF
* 
	EJECT		DRFD02
* 
* 
REQERR	EQU	*
	ABL	DISIOE	REQUEST ERROR 
ER:ILE	EQU	*
	LDKL	A1,RC:ILE 
	ABL	DISEND 
* 
	EJECT			DRFD02 
* 
* 
**********
* DDWRIT *
* WRITE  *
* READ   *
**********
* 
*  WRITE DELETED DATA , WRITE AND READ
* 
* 
DDWRIT	EQU	*
	LDKL	A3,/800	CIO REGISTER
WRITE	EQU	* 
	ADK	A3,/1	CIO REGISTER 
	ADKL	A1,/4000	1ST WER REGISTER 
READ	EQU	*
	CF	A5,CIOPRE	PREPARE FOR CIO 
	CF	A15,NVLCHK	CHECK IF NEW VOLUME LOADED 
	ADK	A1,0 
	RB(NZ)	TEST50	NEW VOLUME LOADED : END IO 
* 
	EJECT		DRFD02
* 
* 
	LD	A4,DWTFOR,A6	FORMAT 
	LD	A1,ECBRL,A8	REQUESTED LENGTH
	RB(Z)	ER:ILE	ILLEGAL LENGTH
	LD	A2,ECBCW2,A8	START SECTOR 
	RB(N)	REQERR	ILLEGAL SECTOR NUMBER 
	CWK	A2,MS:256-13	MAX TOSS SECTOR NUMBER
	RB(NL)	REQERR	ILLEGAL SECTOR NUMBER
	ST	A1,DWTRL,A6	SAVE LENGTH 
	LDR	A3,A1
	SRL	A3,7	NUMBER OF 128 SECTORS 
	SRC	A4,2	FORMAT
	RF(N)	TRA500	FORM: (256-2D)
	IFT	TOSS+IBM=2 
	SLC	A4,1 
	RF(N)	TRA300	IBM FORMATED
	XIF
	IFT	TOSS=1 
	SLL	A2,1	START SECTOR
	XIF
	IFT	TOSS+IBM=2 
	CWK	A2,MS:128	MAX SECTOR NUMBER
	RB(NL)	REQERR	ILLEGAL SECTOR NUMBER
	RF	TRA400
TRA300	EQU	*
	XIF
	IFT	IBM=1
	SLL	A1,1 
	ADK	A3,78	SPARE TRACK SECTORS
	CWK	A2,MS:128-78	MAX IBM SECTOR NUMBER 
	RB(NL)	REQERR	ILLEGAL SECTOR NUMBER
TRA400	EQU	*
	XIF
	ADKL	A3,MS:256-MS:128	ADJUST SECTOR NUMBER 
	RF	TRA590	CHECK VALUE
* 
	EJECT		DRFD02
* 
* 
TRA500	EQU	*
	IFT	TOSS+IBM=2 
	SLC	A4,1 
	RF(N)	TRA525	IBM FORMATTED 
	XIF
	IFT	TOSS=1 
	CWK	A2,13
	RF(NL)	TRA550	NOT TRACK ZERO 
	SLL	A2,1	PHYSICAL SECTOR NUMBER
	RF	TRA600
TRA525	EQU	*
	XIF
	IFT	IBM=1
	CWK	A2,MS:256-104	MAX IBM SECTOR NUMBER
	RB(NL)	REQERR	ILLEGAL SECTOR NUMBER
	CWK	A2,26
	RF(NL)	TRA530
	SLL	A1,1 
	ADR	A3,A2	END OF BUFFER SECTOR 
	SUK	A3,26
	RF(N)	TRA600	TRACK ZERO
	ANK	A3,1	ODD OR EVEN 
	RB(NZ)	ER:ILE	ILLEGAL LENGTH 
TRA530	EQU	*
	SRL	A3,1	NUMBER OF 256 SECTORS 
	ADK	A3,104	SPARE SECTORS 
	RF	TRA590
	XIF
	IFT	TOSS=1 
TRA550	EQU	*
	ADK	A2,13
	SRL	A3,1 
	XIF
* 
	EJECT		DRFD02
* 
* 
TRA590	EQU	*
	ADR	A3,A2	LAST SECTOR NUMBER 
	CWK	A3,MS:256	MAX SECTOR NUMBER
	RB(G)	ER:ILE	INCORRECT LENGTH
TRA600	EQU	*
	ANK	A1,/FF 
	RB(NZ)	ER:ILE	ILLEGAL LENGTH 
	IFT	CPU852=0 
	DVK	26	A1,A2 PHYSICAL SECTOR NUMBER
	XIF
	IFT	CPU852=1 
	LDR	A1,A2
	LDK	A2,0 
	LDKL	A3,/D00	26 SHIFTED
DVK26A	EQU	*
	SLL	A2,1 
	SUR	A1,A3
	RF(NN)	DVK26B
	ADR	A1,A3
	RF	DVK26C
DVK26B	EQU	*
	ADK	A2,1 
DVK26C	EQU	*
	SRC	A3,1 
	CWK	A3,26
	RB(NL)	DVK26A
	XIF
	IFT	TOSS+IBM=2 
	SRC	A4,1	FORMAT
	XIF
	IFF	TOSS+IBM=2 
	ADK	A4,0 
	XIF
	RF(N)	IOR100	(256-2D)
	SLL	A2,1 
* 
	EJECT		DRFD02
* 
* 
IOR100	EQU	*
	ST	A1,DWTSEC,A6	SECTOR NUMBER ON CYLINDER
	SC	A2,DWTSEC,A6	CYLINDER NUMBER
IOR200	EQU	*
	IFT	TOSS+IBM=2 
	IFT	ASCEBC=1 
	LD	A4,DWTFOR,A6	FORMAT 
	SRC	A4,1 
	RF(NN)	IOR250	TOSS DISC
	XIF
	IFT	IBM+ASCEBC=2 
	LD	A3,DWTIOR,A6	GET IO ORDER 
	RF(NZ)	IOR220	WRITE ORDER
	CF	A5,CIOI00	PERFORM READ
	LDR	A3,A1	SAVE RETURN CODE 
	CF	A5,ASCMOV	TRANSFORM AND MOVE TO USER
	LDR	A1,A3	GET RETURN CODE
	RF(NZ)	ENDIOR	READ ERROR 
	RF	IOR230	UPDATE PARAMETERS
IOR220	EQU	*	WRITE IBM SECTOR 
	CF	A5,EBCDIC	MOVE FROM USER AND TRANSFORM
	CF	A5,CIOI00	WRITE ON DISC 
	RF(NZ)	ENDIOR	ERROR
	LC	A1,DWTOR+1,A6	GET ORDER 
	SUK	A1,/15 
	RF(NE)	IOR230	NOT READ AFTER WRITE 
	CF	A5,CIOIVF	VERIFY
	RF(NZ)	END:IO	ERROR
IOR230	EQU	*
	CF	A5,GETLEN	GET LENGTH OF IO
	CF	A5,INCSEC	INCREMENT SECTOR NUMBER 
	LDR	A2,A7	LENGTH OF IO 
	IFT	TOSS=1		=1 
	RF	IOR400		=1
	XIF
	IFF	TOSS+EBCASC=0
* 
	EJECT		DRFD02
* 
* 
IOR250	EQU	*	TOSS DISC
	LD	A3,DWTSEC,A6	START SECTOR NUMBER
	ECR	A2,A3
	ANK	A3,/FF	SECTOR NUMBER 
	NGR	A3,A3	26-A3
	ADK	A3,26
	ANK	A2,/FF	CYLINDER AND HEAD NUMBER
	RF(Z)	IOR260	1ST TRACK 
	LD	A4,DWTFOR,A6	FORMAT 
	SRC	A4,2 
	RF(NN)	IOR260	(128-1)
	SLL	A3,1	LENGTH LEFT ON TRACK
IOR260	EQU	*
	SLL	A3,6	WORD MODE 
	LD	A4,DWTRL,A6	REST OF IO
	SRL	A4,1	WORD MODE 
	CWR	A3,A4
	RF(L)	IOR275 
	LDR	A3,A4	REST OF TRACK IN ONE IO
IOR275	EQU	*
	LDKL	A4,/F000
	ANS	A4,DWTWE1,A6	RESET LENGTH IN 1ST WER 
	ORS	A3,DWTWE1,A6	LENGTH TO 1ST WER 
	CF	A5,CIO:WR	PERFORM READ/WRITE
	RF(NZ)	END:IO	READ/WRITE ERROR 
	LC	A1,DWTOR+1,A6	GET ORDER 
	SUK	A1,/15 
	RF(NE)	IOR300	NOT READ AFTER WRITE 
	CF	A5,CIO:VF	PERFORM VERIFY
	RF(NZ)	END:IO	VERIFY ERROR 
* 
	EJECT		DRFD02
* 
* 
IOR300	EQU	*
	CF	A5,INCCYL	NEXT HEAD 
	AD	A2,DWTSEC,A6	NEXT TRACK 
	ANKL	A2,/FF00	SECTOR 0 
	ST	A2,DWTSEC,A6	SECTOR ID
	LD	A2,DWTWE1,A6	GET LENGTH OF PERFORMED IO 
	SLL	A2,4 
	SRL	A2,3	CHARACTERS
IOR400	EQU	*
	XIF

	ADS	A2,ECBEL,A8	UPDATE ECBEL 
	NGR	A3,A2
	IFT	MMUPAG=1 
	LDK	A1,0 
	SRL	A2,1 
	DA	DWTBA,A6
	ANK	A1,/3
	MS	2,DWTBA,A6
	XIF
	IFT	MMUPAG=0 
	ADS	A2,DWTBA,A6
	XIF
	ADS	A3,DWTRL,A6
	RB(NZ)	IOR200	NEXT TRACK/SECTOR
	LDK	A1,0	RESET RETURN CODE 
ENDIOR	EQU	*
	RF	END:IO	REQUEST READY
* 
	EJECT		DRFD02
* 
**********
* FORMAT *
**********
* 
* 
FORMAT	EQU	*
	CF	A15,NVLCHK
	ADK	A1,0 
	RF(NZ)	END:IO	ERROR: NEW VOLUME LOADED 
	CF	A5,WRIPRE	PREPARE FOR WRITE 
	LDK	A2,36
FORM10	EQU	*
	CM	FD:BUF,A2	CLEAR BUFFER
	SUK	A2,2 
	RB(NN)	FORM10
	CF	A15,VOLCLR	CLEAR VOLUME NAME IN DWT 
	LDKL	A1,'TO' 
	LDKL	A2,'SS' 
	LDKL	A4,FD:BUF+32	TOSS INDICATION ADDRESS
	LDK	A3,IN:TOS	INDICATE TOSS DISC 
	ANS	A3,DWTFOR,A6 
	LD	A3,ECBCW1,A8	TOSS/IBM INDICATOR 
	RF(Z)	FORM40	TOSS
	CM	DWTSEC,A6	WRITE SECTOR 0
	CF	A5,CIOI00 
	LDK	A3,IN:IBM	INDICATE IBM DISC
	ORS	A3,DWTFOR,A6 
	LDKL	A1,EBC:VO	'VO'
	LDKL	A2,EBC:L1	'L1'
	LDK	A3,6	WRITE SECTOR 6
	LDKL	A4,FD:BUF	IBM INDICATION ADDRESS
FORM40	EQU	*
	STR	A1,A4	INDICATE TOSS/IBM
	ST	A2,2,A4 
	ST	A3,DWTSEC,A6
	CF	A5,CIOI00	WRITE SECTOR
* 
	EJECT		DRFD02
* 
* 
**********
* END:IO *
**********
* 
* 
* 
END:IO	EQU	*
	CF	A5,SETPAR	SET DISC DEPENDENT PARAMETERS 
	OR	A1,DWTRC,A6	GET COLLECTED RC
	CF	A15,TENDIO
T:DISP	EQU	*
	ABL	TDISP
END:30	EQU	*
	LDK	A1,1	NOT OPERABLE
	ORS	A1,DWTST,A6	RECOVERY DONE	=1 
	RB	END:IO
* 
	EJECT		DRFD02
* 
**********
* LOCKDO *
**********
* 
*   LOCK ORDER
* 
LOCKDO	EQU	*
	CF	A5,LOCK	LOCK DOOR 
	RB(NZ)	END:IO	NOT OPERABLE 
	LDK	A2,IN:LCK
	ORS	A2,DWTFOR,A6	INDICATE LOCKED 
	IFT	IBM=1
	LD	A1,DWTFOR,A6	GET FORMAT 
	ANK	A1,1 
	SRC	A1,6	INDICATE TOSS/IBM 
	XIF
	RB	END:IO
* 
	EJECT			DRFD02 
* 
**********
* LOAD   *
**********
* 
*   LOAD ORDER
* 
*   INPUT : A4 = DOUBLED INDEX + A6 
LOAD	EQU	*
	CF	A5,LOCK	LOCK DOORS
	RF(NZ)	END:UL	ERROR
	LDK	A2,IN:LCK
	ORS	A2,DWTFOR,A6	INDICATE DOOR LOCKED
	CF	A5,VO:NAM	GET VOLUME NAME 
	ANK	A1,/F
	RF(NZ)	END:UL	ERROR UNLOCK DOOR
	IFT	TOSS+IBM=2 
	LD	A2,DWTFOR,A6
	SRC	A2,1 
	RB(NN)	END:IO	TOSS DISC
	XIF
	IFT	IBM=0
	RB	END:IO
	XIF
	IFT	IBM=1
* 
	EJECT		DRFD02
* 
* 
	LD	A4,ECBCW1,A8	DATA SET NUMBER	=3 
	LDR	A3,A4	SAVE NUMBER
	SUK	A4,7 
	RF(N)	LOA:85	ILLEGAL DATA SET NUMBER 
	IFT	TOSS=1 
	SRC	A2,1 
	XIF
	IFT	TOSS=0 
	LD	A2,DWTFOR,A6	GET FORMAT 
	SRC	A2,2 
	XIF
	IFT	IBM=1
	RF(NN)	LOA:10	(128-1)
	SUK	A4,77-25 
	CWK	A3,25
	RF(NG)	LOA:10	HEAD 0 
	SUK	A3,26	DATA SET NUMBER ON TRACK 1 
	SRC	A3,1	SECTOR NUMBER IN RIGHT BYTE 
	ORKL	A3,/100	HEAD 1
LOA:10	EQU	*
	SUK	A4,25-7
	RF(P)	LOA:85	ILLEGAL DATA SET NUMBER 
	CF	A15,INXDWT
	ST	A3,DWTDSS,A4	SAVE DATA SET NUMBER 
	CF	A5,REAPDS	PREPARE READ DATA SET 
	CF	A5,CIOI00	READ
	LDR	A3,A1	GET RETURN CODE
	SRL	A3,7 
	ORR	A1,A3
	RF(NZ)	END:UL	ERROR UNLOAD 
* 
	EJECT		DRFD02
* 
* 
	LDKL	A7,FD:BUF+BOE	ADDRESS TO BOE
	LD	A4,DWTDSS,A4	GET DATA SET NUMBER
	RF(NN)	LOA:20	1ST DATA SET IN BUFFER 
	ADK	A7,/80	2ND DATA SET IN BUFFER
LOA:20	EQU	*
	CF	A5,IBMTRA	TRANSFORM TO BINARY 
	ST	A3,DWTBOE,A4	SAVE BEGINNING OF EXTENT 
	CF	A5,DECBOE	CURRENT RECORD NUMBER=BOE-1 
	ADK	A7,EOE-BOE-5	ADDRESS TO EOE
	CF	A5,IBMTRA 
	ST	A3,DWTEOE,A4	END OF EXTENT
	ADK	A7,EOD-EOE-5	ADDRESS TO EOD
	CF	A5,IBMTRA 
	ST	A3,DWTEOD,A4	END OF DATA
	LDKL	A1,RC:IBM	INDICATE IBM DISC 
	RB	END:IO	END REQUEST
LOA:85	EQU	*
	LDKL	A1,RC:REQ	REQUEST ERROR 
	RF	END:UL	UNLOAD 
* 
	XIF
	EJECT			DRFD02 
* 
**********
* UNLOAD *
**********
* 
*   UNLOAD ORDER
* 
	IFT	IBM=1
UNLOAD	EQU	*
	IFT	TOSS+IBM=2 
	LD	A1,DWTFOR,A6	GET FORMAT 
	SRC	A1,1 
	RF(NN)	UNL:50	TOSS DISC
	XIF
	IFT	IBM=1
	LD	A3,DWTEOD,A4	END OF DATA
	RF(Z)	UNL:50	NOT OPENED
	CF	A5,SECBIN	CONVERT TO BINARY 
	ST	A3,ECBCW2,A8	EOD TO ECB 
	LD	A3,DWTDSS,A4	DATA SET SECTOR ID 
	CF	A5,REAPDS	PREPARE READ DATA SET 
	CF	A5,CIOI00	READ
	RF(NZ)	END:UL	READ ERROR 
	LDKL	A1,FD:BUF+EOD	EOD ADDRESS 
	LD	A3,DWTDSS,A4	DATA SET NUMBER
	RF(NN)	UNL:20	1ST DATA SET IN SECTOR 
	ADK	A1,/80	2ND DATA SET IN SECTOR
* 
	EJECT		DRFD02
* 
* 
UNL:20	EQU	*
	LC	A7,DWTEOD,A4	END OF DATA
	LDR	A2,A7	SAVE END OF DATA 
	ANK	A2,1 
	ORK	A2,/F0	HEAD NUMBER 
	SC	A2,2,A1	HEAD NUMBER TO BUFFER 
	SRL	A7,1 
	CF	A5,BINDEC	EBCDIC CODE 
	STR	A3,A1	TRACK NUMBER TO BUFFER 
	LD	A7,DWTEOD,A4	GET SECTOR NUMBER
	ADK	A7,1	IBM SECTOR NUMBER 
	CF	A5,BINDEC	A3=SECTOR NUMBER IN EBCDIC
	SC	A3,4,A1	SECTOR NUMBER TO BUFFER 
	ECR	A3,A3
	SC	A3,3,A1 
	CF	A5,WRIPRE	PREPARE FOR WRITE 
	CF	A5,CIOI00 
	RF(NZ)	END:UL	WRITE ERROR
	CM	DWTEOD,A4	INDICATE NOT OPENED 
	XIF
END:UL	EQU	*
	ORS	A1,DWTRC,A6	SAVE RETURN CODE 
	IFT	IBM=0
UNLOAD	EQU	*
	XIF
UNL:50	EQU	*
	CF	A5,UNLOCK	UNLOCK DOORS
	RF(NZ)	ENDIO 
	LDK	A2,IN:ULC	INDICATE UNLOCKED DRIVE
	ANS	A2,DWTFOR,A6	UNLOCKED DOOR 
ENDIO	EQU	* 
	ABL	END:IO 
* 
	IFT	IBM=1
	EJECT			DRFD02 
* 
**********
* SQREAD *
**********
* 
*   SEQUENTIAL READ 
* 
SQREAD	EQU	*
	CF	A5,REAPRE	PREPARE FOR READ
	CF	A5,IBMCHK	CHECK IBM PARAMETERS
	LD	A3,DWTCRN,A4	GET CRN
	CF	A5,INCSE0	CRN+1 
	ECR	A3,A3	LEFT BYTE
	CC	A3,DWTEOD,A4	END OF DATA
	ECR	A3,A3	RIGHT BYTE 
	RF(NE)	SQR:10	LEFT BYTES NOT EQUAL 
	CC	A3,DWTEOD+1,A4	EOD
SQR:10	EQU	*
	RF(NL)	ENDEOD	ERROR : END OF DATA
	CF	A5,SECBIN	SECTOR ID IN BINARY 
	ST	A3,ECBCW2,A8	CRN TO ECB 
	IFT	ASCEBC=1 
	CF	A5,CIOI00	READ SECTOR 
	ANK	A1,1	JUST NOT OPERABLE	=4
	RB(NZ)	ENDIO	READ ERROR
	CF	A5,ASCMOV	TRANSFORM AND MOVE
	LD	A3,DWTSEC,A6	GET CRN+1
	ADK	A4,DWTCRN	CRN ADDRESS
	RF	SQW:90	END REQUEST
	XIF
	IFT	IBM=1
	IFT	ASCEBC=0 
	CF	A5,CIO:WR	READ
	ANK	A1,1	JUST NOT OPERABLE	=4
	RB(NZ)	ENDIO	ERROR 
	LD	A3,DWTSEC,A6	CURRENT RECORD NUMBER
	ADK	A4,DWTCRN	ADDRESS
	RF	SQW:90
	XIF
	IFT	IBM=1
* 
	EJECT		DRFD02
* 
* 
ENDEOD	EQU	*
	LDKL	A1,RC:EOD	END OF DATA 
	RB	ENDIO 
* 
	EJECT			DRFD02 
* 
**********
* SQWRIT *
**********
* 
*   SEQUENTIAL WRITE
* 
SQWRIT	EQU	*
	CF	A5,WRIPRE	PREPARE FOR WRITE 
	CF	A5,IBMCHK	CHECK IBM PARAMETERS
	LD	A3,DWTEOD,A4	EOD
	ECR	A3,A3	LEFT BYTE
	CC	A3,DWTEOE,A4	LEFT CHARACTERS
	ECR	A3,A3
	RF(NE)	SQW:10
	CC	A3,DWTEOE+1,A4	RIGTH CHARACTERS 
SQW:10	EQU	*
	RF(G)	ENDEOE	ERROR: END OF EXTENT
	ST	A3,DWTSEC,A6	END OF DATA
	CF	A5,SECBIN	CONVERT TO BINARY 
	ST	A3,ECBCW2,A8	EOD TO ECB 
	IFT	ASCEBC=1 
	CF	A5,EBCDIC 
	CF	A5,CIOI00	WRITE SECTOR
	RB(NZ)	ENDIO	ERROR 
	XIF
	IFT	ASCEBC=0 
	IFT	IBM=1
	CF	A5,CIO:WR	PERFORM IO
	RB(NZ)	ENDIO	ERROR 
	XIF
	IFT	IBM=1
	CF	A5,INCSEC	DWTSEC+1
	ADK	A4,DWTEOD	ADDRESS TO EOD 
* 
	EJECT		DRFD02
* 
* 
SQW:90	EQU	*
	STR	A3,A4	UPDATED POINTER
	LD	A3,ECBRL,A8	REQUESTED LENGTH
	ST	A3,ECBEL,A8	EFFECTIVE LENGTH
	RB	ENDIO 
ENDEOE	EQU	*
	LDKL	A1,RC:EOE	END OF EXTENT 
	RB	ENDIO 
* 
	EJECT			DRFD02 
* 
**********
* REWIND *
**********
* 
REWIND	EQU	*
	CF	A5,IBMCH5	CHECK IF IBM DISK 
	LD	A3,DWTBOE,A4
	ST	A3,DWTEOD,A4	EOD=BOE
	CF	A5,DECBOE	GET CRN 
	RB	ENDIO 
* 
	XIF
	EJECT			DRFD02 
* 
********************
*                  *
* RECOVERY ROUTINE *
*                  *
********************
* 
FDON	EQU	*
	CF	A15,SAVE8	SAVE A1-A8 ON STACK 
	LDKL	A6,DWFD01	DWT ADDRESS 
	LDKL	A4,/7FFE	SET UNIT BUSY AND RECOVERY ON	=1 
	ANS	A4,DWTST,A6		=1
* 
	EJECT		DRFD02
* 
* DELAY 2 SEC 
* 
	LD	A4,DWTTP,A6 
	RF(Z)	FDON10	NO TIMER SET
	LDKL	A4,-TIME
	ST*	A4,DWTTP,A6	RESTART TIMER
	RF	F:DISP
FDON10	EQU	*
	LDK	A4,DWTTP 
	ADR	A4,A6
	LDR	A1,A6	SAVE A6
	CF	A15,SETIMP
	DATA	FDON20,TIME 
* 
F:DISP	EQU	*
	ABL	T:DISP 
* 
*   TIME OUT ROUTINE
* 
FDON20	EQU	*
	LDR	A6,A1
	CM	DWTTP,A6
FDRE00	EQU	*
	LD	A5,DWTTP,A6		=5 
	RB(NZ)	F:DISP	TIMER SET	=5 
	LDKL	A5,/7FFE	SET UNIT BUSY AND RECOVERY ON	=1 
	ANS	A5,DWTST,A6		=1
	LDKL	A5,DWTSB2 
	ADR	A5,A6	GET STACK BASE 
	LDK	A3,/F8	FILE CODE 
	ST	A3,DWT:FC,A6
	LDK	A3,3	4 VOLUMES 
* 
	EJECT		DRFD01
* 
* 
*  READ VOLUME NAME 
* 
FDONLD	EQU	*
	SC	A3,DWTOR,A6	GET VOLUME NAME 
	CF	A5,LOCK	LOCK DOOR 
	RF(NZ)	FDON19	OPERABLE 
	CF	A5,GETPAR	GET DEVICE DEPENDENT PARAMETERS 
	CF	A5,VO:NAM 
	CF	A5,SETPAR	SET DEVICE DEPENDENT PARAMETERS 
	ANK	A1,/F
	RF(Z)	FDON21	NO ERROR
FDON19	EQU	*	NOT OPERABLE	=5
	LDK	A1,6	NBR OF BYTES TO CLEAR	=5
	CF	A15,VOLCLR	CLEAR VOLUME NAME
	RF	FDON24
FDON21	EQU	*
	LD	A4,DWTFOR,A6	GET FORMAT PARAMETERS
	ANK	A4,IN:LCK
	RF(NZ)	FDON25
FDON24	EQU	*
	CF	A5,UNLOCK 
FDON25	EQU	*
	LDK	A3,0 
	LC	A3,DWTOR,A6	GET INDEX FOR LAST VOL. 
	SUK	A3,1 
	RB(NN)	FDONLD	NEXT VOLUME
	EJECT			DRFD02 
* 
*   RESTART IO
* 
	IM	DWTST,A6	INDICATE RECOVERY OVER 
	LD	A8,DWTECB,A6	ECB ADDRESS
	ABL(Z)	END:IO	NO REQUEST ON
	LD	A7,DWTORD,A6	GET INDEX AND ORDER
	ST	A7,DWTOR,A6 
	CM	ECBEL,A8	RESET EFFECTIVE LENGTH 
	ANK	A7,/3F	ORDER 
	ABL	FDAD 
* 
	EJECT			DRFD02 
* 
********************* 
*                   * 
* INTERRUPT HANDLER * 
*                   * 
********************* 
* 
*   INPUT FROM CU : 
*           BIT 1 : READY INTERRUPT 
*           BIT 4 : DELETED DATA ADDRESS MARK 
*           BIT 5 : SECTOR NOT FOUND
*           BIT 6 : SEEK ERROR
*           BIT 7 : WRITE PROTECT 
*           BIT8,9: DRIVE NUMBER
*           BIT 10: RETRY 
*           BIT 11: PROGRAM ERROR 
*           BIT 12: FULL TRACK PROCESSED
*           BIT 13: DATA FAULT
*           BIT 14: THROUGHPUT ERROR
*           BIT 15: NOT OPERABLE
* 
*   OUTPUT REGISTER A1: 
*           BIT 4 : NO DATA 
*           BIT6,9: WRITE PROTECTED 
*           BIT 7 : RETRIES PERFPRMED (IN DWTRC)
*           BIT 11: FORMAT
*           BIT 13: CRC ERROR 
*           BIT 14: SEEK ERROR / THROUGHPUT ERROR 
*           BIT 15: NOT OPERABLE
* 
*           A5 = STACK POINTER
*           A6 = DWT ADDRESS
*           A8 = ECB ADDRESS
* 
	EJECT		DRFD02
* 
* 
IHFD	EQU	*
	CF	A15,SAVE8	SAVE REGISTERS ON STACK 
	SST	A1,CUADR	GET STATUS
	RF(A)	IHFD00	CORRECT CH. UNIT	=2 
	CIO	A1,0,CUADR		=2 
	SST	A1,CUADR		=2 
	RB(NA)	*-2		=2 
	LDK	A1,1	SET RETURN CODE	=2
IHFD00	EQU	*		=2
	LDR	A2,A1
	LDKL	A6,DWFD01	DWT ADDRESS 
	LD	A8,DWTECB,A6	ECB ADDRESS
	SLL	A2,1 
	RB(N)	FDRE00	READY INTERRUPT 
	ANK	A1,/17 
	SLL	A2,3	BIT4
	RF(NN)	IHFD10	NOT SET
	ORKL	A1,RC:NOD	NO DATA 
IHFD10	EQU	*
	SLC	A2,3	BIT7
	RF(NN)	IHFD20	NOT SET
	ORKL	A1,RC:WRP	WRITE PROTECTED 
IHFD20	EQU	*
	SLL	A2,3	BIT10 
	RF(NN)	IHFD30	NOT SET
	LDKL	A3,RC:RET	RETRIES PERFORMED 
	ORS	A3,DWTRC,A6	SAVE RC
IHFD30	EQU	*
* 
	EJECT		DRFD02
* 
* 
	SRL	A2,2	BIT5 , BIT6 
	ANK	A2,/6	SECTOR NOT FOUND,SEEK ERROR
	RF(Z)	IHFD50	NO SEEK ERROR 
	ORR	A1,A2
	LDK	A2,/FF	DUMMY CYLINDER NUMBER 
	ST	A2,DWTCYN,A6
IHFD50	EQU	*
	CF	A15,INXDWT
	LD	A5,DWTA5,A6	STACK POINTER 
RTN:CR	EQU	*	SET CR ACCORDING TO A1 
	ADK	A5,4	UPDATE STACK POINTER
	ADK	A1,0	SET CR
	ABR*	A5	RETURN 
* 
	EJECT			DRFD02 
* 
******************************************* 
*                                         * 
*    S U B R O U T I N E S                * 
*                                         * 
******************************************* 
* 
* 
**********
* GETPAR *
**********
* 
*   GET DEVICE DEPENDENT PARAMETERS 
* 
*   INPUT :  A6 = DWT ADDRESS 
* 
*   OUTPUT* 
*   A4 = DOUBLED INDEX + A6 
* 
GETPAR	EQU	*
	CF	A15,INXDWT
	LD	A1,DWTPAR,A4	GET DEVICE DEPENDENT PARAMETERS
	SC	A1,DWTFOR+1,A6	FORMAT PARAMETER 
	ECR	A1,A1
	SC	A1,DWTCYN+1,A6	PRESENT CYLINDER NUMBER
	RTN	A5 
* 
	EJECT		DRFD02
* 
*
**********
* SETPAR *
**********
* 
*   SET DEVICE DEPENDENT PARAMETERS 
* 
SETPAR	EQU	*
	LD	A2,DWTCYN,A6	PRESENT HEAD POSITION
	ECR	A2,A2
	LC	A2,DWTFOR+1,A6	PRESENT FORMAT PARAMETERS
	CF	A15,INXDWT
	ST	A2,DWTPAR,A4	SAVE DRIVE DEPENDENT PARAMETERS
	RTN	A5 
* 
	EJECT		DRFD02
* 
**********
* VO:NAM *
**********
* 
* 
VO:NAM	EQU	*
	LDK	A3,IN:LCK	RESET ALL BUT LOCK/UNLOCK INDICATOR
	ANS	A3,DWTFOR,A6 
	LDK	A3,0	CYLINDER 0
	CF	A5,SEEKA3	SEEK
	RF(NZ)	VOL900	RETURN 
	IFT	TOSS=1 
	LDK	A3,0	READ ORDER
	CF	A5,CIOVOL 
	RF(NZ)	VOL900	ERROR
	IFT	CPU852+IBM=2 
	LD	A2,FD:BUF+32
	CWK	A2,'TO'
	RF(NE)	VOL200	NO TOSS DISC 
	LD	A2,FD:BUF+34
	CWK	A2,'SS'
	RF(NE)	VOL200
	XIF
	IFT	TOSS+IBM=2 
	IFT	CPU852=0 
	ML	2,FD:BUF+32 
	DSK	'TO','SS'
	RF(NE)	VOL200	NO TOSS DISC 
	XIF
	IFT	TOSS=1 
VOL100	EQU	*	TOSS FORMATED
	LDKL	A2,FD:BUF	ADDRESS TO VOLUME NAME
	IFT	IBM=1
	LDK	A1,0	INDICATE TOSS 
	RF	VOL500
	XIF
	IFT	IBM=1
* 
	EJECT		DRFD02
* 
* 
VOL200	EQU	*	CHECK IF IBM DISC
	LDKL	A2,FD:BUF+40	DONT OVERLAP TOSSS LABEL 
	LDK	A3,/18	READ SECTOR 6 
	CF	A5,CIOVO1 
	RF(NZ)	VOL900	ERROR
	IFT	TOSS=1 
	LD	A2,FD:BUF+40
	CWK	A2,EBC:VO	EBCDIC FOR 'VO'
	RB(NE)	VOL100	TOSS DISC
	LD	A2,FD:BUF+42
	CWK	A2,EBC:L1	EBCDIC FOR 'L1'
	RB(NE)	VOL100	TOSS DISC
	XIF
	IFT	IBM=1
	LDKL	A2,FD:BUF+44	VOLUME NAME ADDRESS
	IFT	ASCEBC=1 
	LDR	A4,A2
	LDK	A7,10
	CF	A5,ASCII	TRANSFORM TO ASCII 
	XIF
	IFT	IBM=1
	LDK	A1,IN:IBM	INDICATE IBM DISC
* 
	XIF
	EJECT		DRFD02
* 
* 
VOL500	EQU	*
	ORS	A1,DWTFOR,A6	INDICATE TOSS/IBM 
	SRC	A1,6	RC: TOSS/IBM
	ORS	A1,DWTRC,A6
	LD	A3,DWT:FC,A6	FILE CODE AND TEST STATUS INDICATOR
	CF	A15,VOLGET	VOLUME NAME TO DWT 
	LD	A8,DWTECB,A6	ECB ADDRESS TO A8
	LDKL	A3,/4000	READ SECTOR 0 HEAD 1 
	CF	A5,CIOVOL 
	SRL	A1,3 
	ANK	A1,2	FORMAT (256-2D) OR (128-1)
	XRK	A1,2 
	ORS	A1,DWTFOR,A6	INDICATE FORMAT 
	SRC	A1,6	RC:FORMAT 
VOL900	EQU	*
	RTN	A5 
* 
	EJECT		DRFD02
* 
**********
* GETLEN *
* GETLE0 *
**********
* 
*   GET LENGTH ACCORDING TO FORMAT
* 
GETLEN	EQU	*
	LC	A7,DWTSEC,A6	SECTOR ID
	ANK	A7,/7F	CYLINDER AND HEAD NO
	RF(Z)	GETL05	TRACK 0 
GETLE0	EQU	*
	LD	A7,DWTFOR,A6	FORMAT 
	ANK	A7,2 
	RF(NZ)	GETL10	(256-2D) 
GETL05	EQU	*
	LDK	A7,1 
GETL10	EQU	*
	SLL	A7,7	*128
	RTN	A5 
* 
	IFT	IBM+MMUPAG=2 
	EJECT		DRFD02
* 
**********
* GETPAG *
**********
* 
*   GET PAGE ID 
* 
GETPAG	EQU	*
	ML	2,DWTBA,A6	BUFFER ADDRESS 
	RB(Z)	RTN:CR	SET CR
	DLA	4	GET PAGE 
	SRC	A1,6 
	ST	A1,DWTPAG,A6
	ADKL	A1,/400	NEXT PAGE 
	ST	A1,DWTPAG+2,A6
	SRL	A2,3	LOGICAL ADDRESS 
	RB	RTN:CR
* 
	XIF
	IFT	IBM+ASCEBC=2 
	EJECT		DRFD02
* 
**********
* ASCII  *
**********
* 
*   TRANSFORM EBCDIC TO ASCII CODE
* 
*   INPUT :  A4 =BUFFER ADDRESS 
*            A7 =LENGTH 
* 
*   OUTPUT:  A1,A4,A7 CHANGED 
* 
ASCII	EQU	* 
	ENB
	ADR	A4,A7
ASC:10	EQU	*
	SUK	A4,1 
	LCR	A1,A4	EBCDIC CHARACTER 
	ANK	A1,/FF 
	LC	A1,TASCII,A1	TRANSFORM TO ASCII 
	SCR	A1,A4	PUT ASCII CHAR. IN OUTPUT BUFFER 
	SUK	A7,1 
	RB(P)	ASC:10 
	INH
	RTN	A5 
* 
	EJECT			DRFD02 
* 
**********
* ASCMOV *
**********
* 
*  FUNCTION:   TRANSFORMS A STRING FROM EBCDIC TO 
*             ASCII CODE AND MOVES IT FROM FD:BUF TO USER BUFFER
*             INPUT STRING ADDRESS IS BUF 
*   OUTPUT:   A1,A2, CHANGED
*               A4 = INDEXED DWT ADDRESS
*             A7  CHANGED 
* 
ASCMOV	EQU	*
	CF	A5,GETLEN 
	IFT	MMUPAG=0 
	LD	A4,DWTBA,A6	BUFFER ADDRESS
	CF	A5,ASCII
	XIF
	IFT	IBM+ASCEBC=2 
	IFT	MMUPAG=1 
	LDKL	A4,FD:BUF	DRIVER BUFFER ADDRESS 
	ENB
	CF	A5,ASCII
	CF	A5,GETLEN 
	CF	A5,GETPAG	GET PAGE IDENTITY 
	TS	-30,A15	SAVE RUNNING TASK'S MMU 
	TL	DWTPAG,A6	LOAD MMUTABLE 
	LDR	A1,A4	DRIVER BUFFER ADDRESS
	MVSU	A7	MOVE SECTOR TO USER BUFFER 
	TL	-30,A15	RESTORE MMU TABLE FROM STACK
	XIF
	IFT	IBM+ASCEBC=2 
	LDK	A1,0	RESET RC
	RF	IBMT60
* 
	EJECT			DRFD02 
* 
**********
* EBCDIC *
**********
* 
*  FUNCTION:  EBCDIC TRANSFORMES A STRING FROM ASCII TO 
*             EBCDIC CODE 
*             OUTPUT STRING IS PUT IN DRIVER BUFFER 
* 
*  OUTPUT:    A1  CHANGED 
*	     A4 = BUFFER ADDRESS
*             A7  CHANGED 
EBCDIC	EQU	*
	IFT	IBM+MMUPAG=2 
	IFT	ASCEBC=1 
	LDKL	A4,FD:BUF	BUFFER ADDRESS
	CF	A5,GETLEN 
	CF	A5,GETPAG 
	RF(Z)	EBC:05	SYSTEM AREA 
	LDR	A1,A2	LOGICAL ADDRESS SOURCE 
	TS	-30,A15	SAVE RUNNING TASK'S MMU 
	TL	DWTPAG,A6	LOAD MMU TABLE
	LDR	A2,A4	DESTINATION ADDRESS
	MVUS	A7	MOVE SECTOR TO DRIVER BUFFER 
	TL	-30,A15	RESTORE MMU TABLE FROM STACK
	RF	EBC:07
EBC:05	EQU	*
	LDR	A4,A2	BUFFER ADDRESS 
	SLL	A4,1 
EBC:07	EQU	*
* 
	EJECT		DRFD02
* 
* 
	XIF
	IFT	ASCEBC+IBM=2 
	ENB
	IFT	MMUPAG=0 
	IFT	IBM+ASCEBC=2 
	LD	A4,DWTBA,A6	BUFFER ADDRESS
	XIF
	IFT	IBM+ASCEBC=2 
	CF	A5,GETLEN 
	ADR	A4,A7
EBC:10	EQU	*
	SUK	A4,1 
	LCR	A1,A4	GET ASCII CHAR.
	ANK	A1,/FF 
	LC	A1,TEBCDIC,A1 
	SC	A1,FD:BUF-1,A7
	SUK	A7,1 
	RB(P)	EBC:10 
	INH		INHIBIT INTERRUPTS
	RTN	A5 
	XIF
	IFT	IBM=1
* 
	EJECT			DRFD02 
* 
**********
* BINDEC *
**********
* 
*  FUNCTION:  BINDEC TRANSFORMS A BINARY NUMBER TO TWO
*             EBCDIC-CODED DIGITS (DECIMAL) 
* 
*  INPUT:  A7  BINARY NUMBER
* 
*  OUTPUT: A3  EBCDIC CODED DECIMAL DIGITS
*          A7  CHANGED
* 
BINDEC	EQU	*
	LDKL	A3,/EFF0	EBCDIC CHARACTERS
	ANK	A7,/7F 
BIN:10	EQU	*
	ADKL	A3,/100	ADD 10 IN EBCDIC
	SUK	A7,10
	RB(NN)	BIN:10
	ADK	A7,10	NUMBER 0-9 
	ORR	A3,A7
	RTN A5 
* 
	EJECT		DRFD02
* 
**********
* IBMTRA *
**********
* 
*   TRANSFORM SECTOR IDENTIFIER FROM EBCDIC CODE
*   TO BINARY CODE
* 
*   FORMAT : TTHSS (EBCDIC CODE)
*            TT=TRACK,H=HEAD,SS=SECTOR
* 
*   INPUT  :  A7 = ADDRESS TO TTHSS 
* 
*   OUTPUT :  A3 = TTH IN LEFT BYTE AND SS IN RIGHT BYTE
*             A7 = ADDRESS TO TTHSS + 5 
*              = A6+DOUBLE INDEX
* 
IBMTRA	EQU	*
	CF	A5,EBCBI2	TRANSFER EBCDIC - BIN 
	LDR	A3,A1	SAVE TRACK NUMBER
	SLL	A3,1	IN POSITION 
	LDK	A4,1	TRANSFER HEAD NUMBER
	CF	A5,EBCBIN	EBCDIC-BINARY 
	ORR	A3,A1	HEAD NUMBER IN POSITION
	LD	A2,DWTFOR,A6	GET FORMAT 
	SRC	A2,2 
	RF(NN)	IBMT05	(128-1)
	SUK	A1,1	HEAD NUMBER 
IBMT05	EQU	*
	SUK	A1,1 
	RF(NN)	IBMT70	HEAD NUMBER TOO HIGH 
	CF	A5,EBCBI2	EBCDIC-BINARY 
	ECR	A3,A3	TRACK AND HEAD NO TO LEFT BYTE 
	SUK	A1,1	PHYSICAL SECTOR NUMBER
	ORR	A3,A1	SECTOR NUMBER TO RIGHT BYTE
* 
	EJECT		DRFD02
* 
* 
	ECR	A4,A3
	ANK	A4,/FF	CYL NO AND HEAD NO
	SUK	A4,1 
	RF(NP)	IBMT70	TRACK 0: ERROR 
	LD	A2,DWTFOR,A6	GET FORMAT 
	SRC	A2,2 
	RF(NN)	IBMT10	(128-1)
	SUK	A4,2	DECREMENT TRACK NO
IBMT10	EQU	*
	CWK	A4,FD:BUF+EOD+5
	RF(E)	IBMT15	EOD 
	CWK	A4,FD:BUF+EOD+/45
	RF(NE)	IBMT20	BOE OR EOE 
IBMT15	EQU	*
	SUK	A4,147	2*74-1
	RF(G)	IBMT70	INCORRECT TRACK NUMBER
	RF(L)	IBMT40	TRACK OK RETURN 
	SUK	A1,0	CHECK SECTOR NUMBER IF LAST TRACK 
	RF	IBMT50
IBMT20	EQU	*	EOD
	ADK	A2,0	FORMAT
	RF(NN)	IBMT30	(128-1)
	SUK	A4,1 
IBMT30	EQU	*
	SUK	A4,145	2*73-1
	RF(P)	IBMT70	INCORRECT TRACK,HEAD
IBMT40	EQU	*
	SUK	A1,25	 
IBMT50	EQU	*	CHECK SECTOR NUMBER
	RF(G)	IBMT70	INCORRECT SECTOR NUMBER 
IBMT60	EQU	*
	CF	A15,INXDWT
	RTN	A5 
* 
	EJECT		DRFD02
* 
* 
IBMT70	EQU	*	ERROR
	LDK	A1,RC:IDS	RC: ERROR
	ABL	END:UL 
* 
	EJECT		DRFD02
* 
* 
**********
* SECBIN *
**********
* 
*   CONVERT SECTOR IDENTIFIER TO BINARY CODE
* 
* 
SECBIN	EQU	*
	LDR	A1,A3
	LD	A2,DWTFOR,A6	FORMAT 
	ANK	A2,/2
	RF(NZ)	SECB05	(256-2D) 
	SRL	A3,1 
SECB05	EQU	*
	SRL	A3,8	TRACK AND HEAD
	LDR	A2,A3
	SLL	A3,5	*32 
	SLL	A2,2	*4
	SUR	A3,A2	*28
	SRL	A2,1	*2
	SUR	A3,A2	*26
	ANK	A1,/FF 
	ADR	A3,A1	LOGICAL SECTOR NUMBER
	RTN	A5 
* 
	EJECT			DRFD01 
* 
**********
* EBCBIN *
**********
* 
*   EBCBIN TRANSFORM EBCDIC CODED DIGITS TO 
*             BINARY. RANGE OF EBCDIC CODE /F0 - /F9 IS CHECKED 
*     INPUT:  A4  ADDRESS TO FIRST DIGIT
*              A7 = NUMBER OF DIGITS
*   OUTPUT: A1  BINARY
*           A4 = A4 + A7
*   WORKING REG:  A2,A7 
* 
EBCBI2	EQU	*
	LDK	A4,2	TWO DIGITS
EBCBIN	EQU	*
	LDK	A1,0 
DEC:10	LCR	A2,A7	DIGIT
	ANK	A2,/FF 
	SUK	A2,/F0 
	RB(N)	IBMT70 
	SUK	A2,9 
	RB(P)	IBMT70	NOT DIGIT 
	ADK	A2,9 
	ADK	A7,1	ADDRESS TO NEXT DIGIT 
	SUK	A4,1 
	RF(Z)	DEC:30 
DEC:20	SUK	A2,1 
	RB(N)	DEC:10	NEXT DIGIT
	ADK	A1,/A	MULTIPLY BY 10 
	RB	DEC:20
DEC:30	ADR	A1,A2
	RTN	A5 
* 
	EJECT		DRFD02
* 
* 
**********
* IBMCHK *
* IBMCH5 *
**********
* 
*   IBM CHECK OF PARAMETERS 
* 
*   INPUT  :  A4=INDEXED DWT ADDRESS
*   OUTPUT :  A4 UNCHANGED
* 
IBMCHK	EQU	*
	LD	A1,DWTFOR,A6	GET FORMAT 
	LD	A2,ECBRL,A8	REQUESTED LENGTH
	SRC	A1,2 
	RF(NN)	IBMC10	(128-1)
	SUK	A2,128 
IBMC10	EQU	*
	SUK	A2,128 
	ABL(NZ)	ER:ILE	ILLEGAL LENGTH
IBMCH5	EQU	*
	LD	A2,DWTEOD,A4	END OF DATA
	RF(Z)	REQERO	NOT OPENED DATA SET 
	IFT	ASCEBC=0 
	CF	A5,GETLE0	GET LENGTH
	SRL	A7,1 
	ORS	A7,DWTWE1,A6 
	XIF
	IFT	IBM=1
	CF	A15,NVLCHK
	ADK	A1,0 
	ABL(NZ)	END:IO	NEW VOLUME LOADED 
	IFT	TOSS=1 
	LD	A2,DWTFOR,A6	GET FORMAT 
	SRC	A2,1 
	RB(N)	IBMT60	IBM DISC
	XIF
	IFT	TOSS=0 
	RB	IBMT60
	XIF
	IFT	IBM=1
REQERO	EQU	*	REQUEST ERROR
	ABL	DISIOE 
* 
	EJECT		DRFD02
* 
**********
* INCSEC *
**********
* 
*   INCREMENT SECTOR IDENTIFIER 
* 
*   OUTPUT:  A3 = SECTOR ID 
* 
INCSEC	EQU	*
	LD	A3,DWTSEC,A6	SECTOR ID
INCSE0	EQU	*
	ADK	A3,1 
	CCK	A3,/1A00	SECTOR 26 
	RF(L)	INCS10	SAME TRACK
	CF	A5,INCCYL	NEXT TRACK
	ADR	A3,A2
	SUK	A3,26	SECTOR 0 
INCS10	EQU	*
	ST	A3,DWTSEC,A6	INCREMENTED SECTOR ID
	RTN	A5 
* 
	EJECT		DRFD02
* 
**********
* DECBOE *
**********
* 
*   CRN = A3-1
* 
DECBOE	EQU	*
	CCK	A3,0 
	RF(NZ)	DECS10
	CF	A5,INCCYL	NEXT TRACK
	SUR	A3,A2
	ORK	A3,26
DECS10	EQU	*
	SUK	A3,1 
	ST	A3,DWTCRN,A4	CURRENT RECORD NUMBER
	RTN	A5 
* 
	XIF
	EJECT		DRFD02
* 
* 
**********
* INCCYL *
**********
* 
*   NEXT TRACK OF SECTOR ID 
* 
* 
INCCYL	EQU	*
	LD	A2,DWTFOR,A6
	C1R	A2,A2
	ANK	A2,2	(128-1)/(256-2D) INDICATOR
	ADK	A2,2	NEXT TRACK
	SLL	A2,7	IN POSITION 
	RTN	A5 
* 
	EJECT		DRFD02
* 
**********
* REAPRE *
* WRIPRB *
* WRIPRE *
* CIOPRE *
**********
* 
*   PREPARE FOR CIO START 
* 
	IFT	IBM=1
REAPDS	EQU	*
	ANKL	3,/7FFF 
	ST	A3,DWTSEC,A6	SECTOR IDENTIFIER
	XIF
REAPRB	EQU	*
	IFT	MMUPAG=0 
	LDKL	A1,FD:BUF	BUFFER ADDRESS
	ST	A1,DWTBA,A6	BUFFER ADDRESS SAVE AREA
	XIF
* 
REAPRE	EQU	*	READ 
	LDKL	A1,IN:WE1-/80	1ST WER 
	LDK	A3,0	CIO REGISTER
	RF	CIOPRE
* 
WRIPRE	EQU	*	WRITE
	LDKL	A1,IN:WE1+/4000-/80 
	LDK	A3,1 
* 
CIOPRE	EQU	*	GENERAL
	ST	A1,DWTWE1,A6
	ST	A3,DWTIOR,A6
	RTN	A5 
* 
	EJECT		DRFD02
* 
* 
**********
* LOCK   *
* UNLOCK *
* SEEK   *
* CIO:WR *
* CIO:VF *
**********
* 
* 
* 
LOCK	EQU	*
	LDKL	A3,/0400
	RF	CIO:00
UNLOCK	EQU	*
	LDKL	A3,/0C00
	RF	CIO:00
SEEK	EQU	*
	LD	A3,DWTSEC,A6	GET CYLINDER NUMBER
	SRL	A3,9 
	CW	A3,DWTCYN,A6	PRESENT CYLINDER NUMBER
	RF(E)	CIORTN	RETURN WITHOUT SEEK 
SEEKA3	EQU	*
	ST	A3,DWTCYN,A6
	SLL	A3,2	IN POSITION 
	ORK	A3,3	ORDER CODE
	RF	CIO:00
* 
	EJECT		DRFD02
* 
* 
CIOIVF	EQU	*
	LDKL	A3,/400	VERIFY
	RF	CIOI03
CIOI00	EQU	*	IBM IO ROUTINE 
	CF	A5,SEEK 
	ANK	A1,/F
	RF(NZ)	CIOERR	SEEK ERROR 
	LDK	A3,0	WRITE/READ
CIOI03	EQU	*
	CF	A5,GETLEN	GET LENGTH
	LDR	A1,A7
	SRL	A1,1 
	OR	A1,DWTWE1,A6	1ST WER
	LDKL	A2,FD:BUF	BUFFER
	OR	A3,DWTIOR,A6
	IFT	MMUPAG=0 
	RF(NZ)	CIOWE2	WRITE ORDER
	LD	A2,DWTBA,A6	BUFFER ADDRESS
	XIF
	RF	CIOWE2
* 
CIOVOL	EQU	*
	LDKL	A2,FD:BUF 
CIOVO1	EQU	*
	LDKL	A1,/8020
	RF	PERCIO
* 
	IFF	TOSS+EBCASC=0
	EJECT		DRFD02
* 
* 
CIO:VF	EQU	*
	LDKL	A3,/400	VERIFY
	RF	CIOWER
CIO:WR	EQU	*
	CF	A5,SEEK 
	ANK	A1,/F
	RF(NZ)	CIOERR	SEEK ERROR 
	LDK	A3,0	READ/WRITE
CIOWER	EQU	*
	IFT	MMUPAG=0 
	LD	A1,DWTWE1,A6
	LD	A2,DWTBA,A6	2ND WER 
	OR	A3,DWTIOR,A6	IO REGISTER
	XIF
	IFF	TOSS+EBCASC=0
	IFT	MMUPAG=1 
	ML	2,DWTBA,A6	GET 18 BIT BUFFER ADDRESS
	SRC	A1,4 
	OR	A1,DWTWE1,A6	1ST WER
	SLL	A2,1	2ND WER 
	OR	A3,DWTIOR,A6	IO REGISTER
	XIF
CIOWE2	EQU	*
	LD	A4,DWTSEC,A6	SECTOR NUMBER
	ANK	A4,/FF 
	SLL	A4,2	IN POSITION 
	ORR	A3,A4	IN ORDER WORD
	LC	A4,DWTSEC,A6	TRACK NUMBER 
	ANK	A4,1	HEAD NUMBER 
	SRC	A4,2	IN POSITION 
	ORR	A3,A4	IN ORDER WORD
* 
	EJECT		DRFD02
* 
* 
PERCIO	EQU	*
	WER	A1,MUXADR
	WER	A2,MUXADR+1
CIO:00	EQU	*
	LD	A2,PFPOST 
	RF(NZ)	CIO:AB	POWER FAILURE POST PROCESSING ON 
	CF	A15,INXDWT
	EX	DWTCIO,A4	EXECUTE CIO 
	LDK	A1,RC:NOP
	ABL(3)	END:30	CU ADDRESS UNKNOWN 
CIO:AB	EQU	*
	ST	A5,DWTA5,A6	SAVE STACK POINTER
	ABL	T:DISP	DISPATCH
CIORTN	EQU	*
	LDK	A1,0	RESET RC
CIOERR	EQU	*
	RTN	A5 
* 
	EJECT		DRFD02
* 
* 
**********
* FD:BUF *
**********
* 
*   FLEXIBLE DISK BUFFER
* 
FD:BUF	EQU	*
	RES	64 
	IFT	IBM=1
	RES	64 
	XIF
* 
	EJECT			DRFD02 
* 
********************* 
*                   * 
* DEVICE WORK TABLE * 
*                   * 
********************* 
* 
DWFD01	EQU	*
	DATA	0 
	DATA	/8000	DWT STATUS
	DATA	0	ECB ADDRESS 
	DATA	0	ORDER 
	DATA	FDADR	ACTIVATION ADDRESS
	DATA	0	TTAB-ADDRESS
	DATA	0	WAIT/ACTIVATE INDICATOR 
	DATA	0	TERMINAL QUEUE
* 
	IFT	MMUPAG=1 
	DATA	0	SAVE AREA USER ECB ADDRESS
	DATA	DEVECB	MMU ECB ADDRESS
	XIF
* 
DWTA5	EQU	*-DWFD01
	DATA	0 
DWTRC	EQU	*-DWFD01	RETURN CODE SAVE AREA
	DATA	0 
	DATA	0 
	DATA	0 
	DATA	0,0,0,0	STACK (3 LEVELS)
	DATA	0	ORDER SAVE AREA 
* 
	EJECT			DRFD02 
* 
* 
	DATA	/8000	NVL INDICATOR 0 
	DATA	/8000	NVL INDICATOR 1 
	DATA	/8000	NVL INDICATOR 2 
	DATA	/8000	NVL INDICATOR 3 
DWTVO0	EQU	*-DWFD01	VOLUME NAME NO 0
	DATA	/FFFF,/FFFF,/FFFF 
DWTVO1	EQU	*-DWFD01	VOLUME NAME NO 1
	DATA	/FFFF,/FFFF,/FFFF 
DWTVO2	EQU	*-DWFD01	VOLUME NAME NO 2
	DATA	/FFFF,/FFFF,/FFFF 
DWTVO3	EQU	*-DWFD01	VOLUME NAME NO 3
	DATA	/FFFF,/FFFF,/FFFF 
DWTTP	EQU	*-DWFD01	TIMER POINTER
	DATA	0 
DWTCIO	EQU	*-DWFD01	CIO START 
	CIO	A3,1,CUADR	UNIT 0
	CIO	A3,1,CUADR+/10	UNIT 1
	CIO	A3,1,CUADR+/20	UNIT 2
	CIO	A3,1,CUADR+/30	UNIT 3
* 
	EJECT			DRFD02 
* 
* 
	IFT	IBM=1
DWTBOE	EQU	*-DWFD01	BEGINNING OF EXTENT 
	DATA	0,0,0,0 
DWTEOD	EQU	*-DWFD01	END OF DATA 
	DATA	0,0,0,0 
DWTEOE	EQU	*-DWFD01	END OF EXTENT 
	DATA	0,0,0,0 
DWTCRN	EQU	*-DWFD01	CURRENT RECORD NO 
	DATA	0,0,0,0 
DWTDSS	EQU	*-DWFD01	DATA SET LABEL SECTOR 
	DATA	0,0,0,0 
* 
	IFT	IBM+MMUPAG=2 
DWTPAG	EQU	*-DWFD01	PAGE ADDRESS TO USER BUFFER 
	DATA	0,0 
	XIF
	EJECT			DRFD02 
* 
* 
DWT:FC	EQU	*-DWFD01	FILE CODE 
	DATA	/F8 
DWTPAR	EQU	*-DWFD01	DEVICE DEPENDENT PARAMETERS 
	DATA	/FF00,/FF00,/FF00,/FF00	HEAD POS,LOCK/UNLOCK,2D/1S,TOSS/IBM 
DWTFOR	EQU	*-DWFD01	PRESENT FORMAT PARAMETER
	DATA	0 
DWTCYN	EQU	*-DWFD01	PRESENT CYLINDER NUMBER 
	DATA	/FFFF 
DWTSEC	EQU	*-DWFD01	SECTOR NUMBER ON CYLINDER 
	DATA	0 
DWTWE1	EQU	*-DWFD01	1ST WER REGISTER
	DATA	0 
DWTRL	EQU	*-DWFD01	LENGTH OF IO 
	DATA	0 
DWTBA	EQU	*-DWFD01	BUFFER ADDRESS 
	IFT	MMUPAG=1 
	DATA	0,0 
	XIF
	IFT	MMUPAG=0 
	DATA	0 
	XIF
DWTIOR	EQU	*-DWFD01	CIO REGISTER
	DATA	0 
* 
	IFT	MMUPAG=1 
DEVECB	EQU	*
	DATA	0,0,0,0,0,0,0 
	XIF
* 
* 
* 
	END

Full view