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

⟦b5b52ad0a⟧ 

    Length: 49312 (0xc0a0)
    Notes: pts_type(SC)
    Names: »DRFD01.SC«

Derivation

└─⟦9af60a727⟧ Bits:30009707 Philips computer tape "M_173"
    └─⟦this⟧ »M:173/DRFD01.SC« 
    └─⟦this⟧ »M:173/DRFD01.SC«

PTS(SC)

	IDENT DRFD01 	REL 9.2 79-12-05  870105040920 

			=2,TIMING PROBLEMS IN INT. HANDLER 
			REL 9.2 79-11-16 
			=1,CHANGED INTERRUPT HANDLER 
			REL 9.1 79-05-23 
* 
**********************************************
* 
*  PHILIPS TERMINAL SYSTEM PTS
* 
*  DRFD01 = DRIVER FOR FLEXIBLE DISK
* 
* 
* 
* 
* 
* 
********************************************* 
*  THIS DISK DRIVER HANDLES UP TO FOUR DAISY
*  CHAINED FLEXIBLE DISK DRIVES PTS 6879, 
*  CONNECTED TO CPU VIA CHANNEL UNIT CHFD ON
*  MULTIPLEX OR PROGRAMMED CHANNEL
* 
	EJECT			DRFD01 
* 
*  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 
*  /1A   SEARCH KEY 
*  /21	OPEN 
*  /22	CLOSE
*  /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			DRFD01 
* 
*********** 
*         * 
* ENTRIES * 
*         * 
*********** 
* 
	ENTRY 	FDADR	ACTIVATION ADDRESS
	ENTRY	IHFD	INTERRUPT HANDLER 
	ENTRY	FDON	RECOVERY ROUTINE
	ENTRY	DWFD01	DWT-ADDRESS 
	EJECT			DRFD01 
* 
************* 
*           * 
* EXTERNALS * 
*           * 
************* 
* 
	EXTRN	TDISP	DISPATCHER 
	EXTRN	TENDIO	ENDIO 
	EXTRN	DISIOE	REQUEST ERROR 
	EXTRN	DWTST	STATUS 
	EXTRN	DWTECB	ECB ADDRESS 
	EXTRN	DWTOR	DWT INDEX AND ORDER
	EXTRN	DWTA2	SAVE AREA A2 
	EXTRN	DWTA5	SAVE AREA A5 
	EXTRN	DWTSB2	STACK BASE 2 IN DWT 
	EXTRN	SCTPLD	PROGRAM LOADING DEVICE
	EXTRN	SAVE8	SAVE A1-A8 ON A15 STACK
	EXTRN	SETIMP	TIMER 
	EXTRN	INTSAV	INTERRUPT SAVE AREA 
	EXTRN	INIFLG	INITIALIZATION FLAG 
	EXTRN	TASCII	EBCDIC TO ASCII TAB 
	EXTRN	TEBCDIC	ASCII TO EBCDIC TAB
	EXTRN	SPDLCI	OPEN/CLOSE STATUS FOR FD DRIVE
	EXTRN	ECBBA	ECB BUFFER ADDRESS 
	EXTRN	ECBRL	ECB REQUESTED LENGTH 
	EXTRN	ECBEL	ECB EFFECTIVE LENGTH 
	EXTRN	ECBRC	ECB RETURN CODE
	EXTRN	ECBCW	ECB CONTROL WORD 
	EJECT			DRFD01 
* 
************************
*                      *
* CONDITIONAL ASSEMBLY *
*                      *
************************
* 
* MULTIPLEX CHANNEL INSTEAD OF PROGRAMMED 
* CHANNEL BY SETTING X:A = 0
* 
X:A	EQU	1 
CHAN	EQU	1
* 
*	A PROGRAM VERSION INCLUDING TOSS DISC FORMAT
*	IS OBTAINED BY SETTING TOSS EQU 1.
* 
X:B	EQU	0 
TOSS	EQU	1
* 
*	A PROGRAM VERSION INCLUDING IBM DISC FORMAT 
*	IS OBTAINED BY SETTING IBM EQU 1. 
* 
X:C	EQU	0 
IBM	EQU	1 
* 
*	A PROGRAM VERSION USING TOSS MMU PAGING 
*	IS OBTAINED BY SETTING MMUPAG EQU 1.
* 
MMUPAG	EQU	1
* 
* 
*	A PROGRAM VERSION USING THE EXTENDED INSTRUCTION
*	SET IS OBTAINED BY SETTING CPU852 EQU 0.
* 
CPU852	EQU	0
* 
	EJECT			DRFD01 
* 
* 
*	A PROGRAM VERSION USING TOSS DISC PAGING
*	IS OBTAINED BY SETTING DSKPAG EQU 1.
* 
DSKPAG	EQU	1
* 
* 
*	A PROGRAM VERSION INCLUDING TOSS SWAPPABLE WORK 
*	BLOCKS IS OBTAINED BY SETTING SWPBLK EQU 1. 
* 
SWPBLK	EQU	0
* 
* 
*    ORDERS /21 OPEN AND /22 CLOSE WHICH CONTROLS THE POWER 
*    TO THE DISK DRIVE UNIT CAN BE INCLUDED BY SETTING OPCLOS =1
* 
X:D	EQU	0 
OPCLOS	EQU	0
* 
	EJECT			DRFD01 
* 
* 
*   MMU BUFFER SIZE 
* 
* 
X:E	EQU	256		 
DVBLEN	EQU	256		
* 
* 
*   MMU DEVICE INDEX
* 
* 
	IFT	CHAN=1 
DEVIND	EQU	2
	XIF
* 
	IFT	CHAN=0 
DEVIND	EQU	4-IBM-IBM
	XIF
* 
	EJECT			DRFD01 
* 
************* 
*           * 
* CONSTANTS * 
*           * 
************* 
* 
CUADR	EQU	09	CONTROL UNIT ADDRESS 
MUXADR	EQU	CUADR+CUADR	MUX-ADDRESS
SOPDA	EQU	/2E	S.O.P. DEVICE ADDRESS 
STALEN	EQU	512	MAX STANDARD SEC. LEN. 
TOSLEN	EQU	410	MAX TOSS SEC. LENGTH 
IBMLEN	EQU	128	IBM SEC. LENGTH
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
OPENTI	EQU	10	DELAY AT OPEN ORDERS
* 
********************
*                  *
* DWT-DISPLACEMENTS*
*                  *
********************
* 
DWTDRD	EQU	/10	START OF DRIVER DEFINED PART 
* 
	IFT	MMUPAG=0 
START	EQU	DWTDRD
	XIF
* 
	IFT	MMUPAG=1 
START	EQU	DWTDRD+4
	XIF
* 
DWTA3	EQU	START+/04 
* 
	EJECT			DRFD01 
* 
**********
*        *
* TABLES *
*        *
**********
* 
	IFT	DEVIND=2 
	DATA	DVBLEN+DVBLEN	MMU BUFFER SIZE 
	XIF
* 
	IFT	DEVIND=4 
	DATA	0	INDICATE NO MMU BUFFER
	XIF
* 
	DATA	DEVIND	DEVICE INDEX 
FDADR	DATA	FDAD	ACTIVATION ADDRESS
	DATA	0	ABORT ROUTINE ADDRESS 
* 
	EJECT			DRFD01 
* 
**************
*            *
* ACTIVATION *
*            *
**************
* 
FDAD	EQU	*	ACTIVATION ENTRY 
* 
	IFT	OPCLOS=1 
*    CHECK IF OPEN OR CLOSE ORDER 
* 
	LDR	A1,A7	ORDER
	SUK	A1,/21 
	RF(Z)	OPEN	OPEN
	SUK	A1,1 
	RF(Z)	CLOSE	CLOSE
* 
	EJECT
	XIF
* 
	LDK	A3,0 
	LC	A3,DWTOR,A6	INDEX 
	LDR	A2,A3	SAVE FOR FDIX
* 
*  PUT DRIVE NO IN CIO-INSTRUCTION
* 
	CF	A5,SETCIO	A3,A4 AFFECTED
	CM	DWTRCW,A6	SAVE RETURN CODE WORD 
* 
*  CHECK IF LOCKED
* 
	LD	A1,DWTLC,A6	 LOCK INDICATOR 
	CF	A5,FDIX	GET BIT MASK IN A3
	ST	A3,DWTA3,A6	SAVE DRIVE INDEX MASK 
	ANR	A1,A3
	RF(NZ)	FD:ORD	LOCKED 
	LDR	A1,A7
	SUK	A1,/26 
	ABL(Z)	LOAD	LOCK ORDER 
	SUK	A1,/11 
	ABL(Z)	LOAD	LOAD ORDER 
	LDKL	A1,/8001	RETURN CODE
	ABL	END:IO	ENDIO 
* 
	EJECT
* 
*   ORDER?
* 
FD:ORD	EQU	*
	IFT	CHAN+TOSS=2
	IFT	MMUPAG=1 
	IFF	DSKPAG+SWPBLK=0
	LD	A2,ECBBA,A8	GET BUFFER ADDRESS
	LDR*	A1,A8	GET FIRST WORD OF ECB 
	ANKL	A1,/3000	GET BITS 16-17 IN BUFFER ADDRESS 
	RF(NZ)	FD:000	BUFFER NOT IN SYSTEM AREA? 
	LDR	A3,A2
	RF(NN)	FD:005
	ADKL	A3,TOSLEN	CHECK IF 64K LIMIT WILL BE PASSED 
	RF(N)	FD:005	NO? 
* 
FD:000	EQU	*
	ST	A2,DWT:BF,A6	SAVE IT
	LDR	A3,A2
	ANKL	A2,/F000
	SRL	A2,2 
	SLL	A1,2 
	ORR	A1,A2
	ANKL	A3,/FFF 
	ST	A1,DWT:PA,A6	6 BIT PHYSICAL BUFFER ADDRESS
	ADKL	A1,/400	CREATE ONE MORE MMU ENTRY 
	ST	A1,DWT:PA+2,A6
	LDR	A1,A3
	ORK	A1,1	INDICATE ADDRESS NOT ZERO 
	LDKL	A2,FD:BUF	GET DWT BUFFER ADDRESS
	ST	A2,ECBBA,A8	SET NEW BUFFER ADDRESS IN ECB 
* 
FD:005	ST	A1,DWT:LA,A6	16 BIT LOGICAL BUFFER ADDRESS
* 
	EJECT			DRFD01 
	XIF
* 
	LDR	A1,A7
	ABL(Z)	FD:070	TEST STATUS
	SUK	A1,1 
	RF(Z)	FD:040	PHYSICAL READ 
	SUK	A1,4 
	RF(Z)	FD:010	BASIC WRITE 
	SUK	A1,12
	RF(Z)	FD:040	PHYSICAL READ 
	SUK	A1,4 
	RF(Z)	FD:028	PHYSICAL WRITE
	SUK	A1,15
	RF(Z)	FD:030	WRITE DELETED DATA
	SUK	A1,/14 
	ABL(Z)	UNLOAD	UNLOAD ORDER 
	IFT	IBM=1
	ADK	A1,/36 
	ABL(Z)	SQREAD	SEQUENTIAL READ
	SUK	A1,4 
	ABL(Z)	SQWRIT	SEQUENTIAL WRITE 
	SUK	A1,/2B 
	ABL(Z)	REWIND	REWIND 
	XIF
	IFT	TOSS+IBM=0 
	IFT	MMUPAG=0 
	ADK	A1,30
	RF(Z)	FD:050	SEARCH KEY
	XIF

FD:DIS	EQU	*
	ABL	DISIOE	REQUEST ERROR 
* 
	IFT	OPCLOS=1 
	EJECT
* 
********
*      *
* OPEN *
*      *
********
* 
*    OPEN IS PERFORMED BY WRITING A ZERO TO BIT 
*    ZERO OF THE SOP LIGHTS EXTERNAL REGISTER.
* 
OPEN	EQU	*
	LDKL	A1,/7FFF	MASK FOR BIT 0 
	ANS	A1,SPDLCI	CLEAR OPEN/CLOSE BIT 
	LD	A1,SPDLCI	SOP LIGHTS AND OPEN/CLOSE DATA
	OTR	A1,0,SOPDA	OPEN FD DRIVE 
* 
*    WAIT FOR DRIVE TO BECOME OPERABLE
	LDK	A4,DWTTP2	TIMER POINTER OFFSET 
	ADR	A4,A6	A4:=TIMER POINTER ADDRESS
	LDR	A1,A6	SAVE DWT-ADDR
	CF	A15,SETIMP	WAIT 
	DATA	OPENRE,OPENTI	START ADDR, WAIT TIME 
	ABL	TDISP	EXIT 
* 
OPENRE	EQU	*
*    TIME HAS EXPIRED 
	LDR	A6,A1	GET DWT-ADDR 
	CM	DWTTP2,A6	INDICATE NO TIMER RUNNING 
	RF	OCLEXI	COMMON OPEN/CLOSE EXIT 
* 
	EJECT
* 
********* 
*       * 
* CLOSE * 
*       * 
********* 
* 
*    CLOSE IS PERFORMED BY WRITING A ONE TO BIT 
*    ZERO OF THE SOP LIGHTS EXTERNAL REGISTER 
* 
CLOSE	EQU	* 
	LDKL	A1,/8000	MASK FOR BIT 0 
	ORS	A1,SPDLCI	SET OPEN/CLOSE BIT 
	LD	A1,SPDLCI	SOP LIGHTS AND OPEN/CLOSE DATA
	OTR	A1,0,SOPDA	CLOSE FD DRIVE
* 
OCLEXI	EQU	*
*    COMMON EXIT FOR OPEN/CLOSE 
	LDK	A1,0	RETURN CODE 
	RF	FD:090	ENDIO
* 
	XIF
* 
	EJECT			DRFD01 
* 
*************** 
*             * 
* BASIC WRITE * 
*             * 
*************** 
* 
FD:010	CF	A5,BIO
	ORK	A2,1 
FD:015	EQU	*
	IFT	TOSS+IBM=2 
	LD	A1,DWTLAB,A6
	AN	A1,DWTA3,A6 
	RF(Z)	FD:018	NOT IBM 
	XIF
	IFT	IBM=1
	LDR	A7,A3	NO OF CHAR. TO BE TRANSFORMED
	CF	A5,EBCDIC 
FD:018	EQU	*
	XIF
* 
	IFT	CHAN+TOSS=2
	IFT	MMUPAG+SWPBLK=2
	LD	A1,DWT:LA,A6	GET FLAG/LOGICAL BUFFER ADDRESS
	RF(Z)	FD:019	BUFFER IN SYSTEM AREA?
	LD	A7,ECBRL,A8	GET REQUESTED LENGTH
	LDR	A8,A2	SAVE A2
	LDR	A2,A4	GET DWT BUFFER ADDRESS 
	TS	-30,A15	SAVE RUNNING TASK MMU 
	TL	DWT:PA,A6	LOAD PSEUDO MMU TABLE 
	MVUS	A7	MOVE BUFFER FROM USER TO SYSTEM AREA 
	TL	-30,A15	RESTORE MMU FROM STACK
	LDR	A2,A8	RESTORE A2 
* 
	EJECT			DRFD01 
* 
* 
FD:019	EQU	*
	XIF
* 
	CF	A5,FD:WRITE	PERFORME WRITE
* 
	IFT	CHAN+TOSS=2
	IFT	MMUPAG+SWPBLK=2
	LD	A1,DWT:LA,A6	GET BUFFER FLAG
	RF(Z)	FD:025	BUFFER WAS IN SYSTEM AREA?
	LD	A1,DWT:BF,A6	GET SAVED BUFFER ADDRESS 
	ST	A1,ECBBA,A8	RESTORE IT IN ECB 
* 
FD:025	EQU	*
	XIF
* 
	RF	FD:048	GOTO FD:RC 
* 
******************
*                *
* PHYSICAL WRITE *
*                *
******************
* 
FD:028	CF	A5,BIO
	ORK	A2,5	INSERT BIO BITS 13-15 
	RB	FD:015
	EJECT			DRFD01 
* 
**********************
*                    *
* WRITE DELETED DATA *
*                    *
**********************
* 
FD:030	CF	A5,BIO
	ORK	A2,6 
	RB	FD:015
* 
***************** 
*               * 
* PHYSICAL READ * 
*               * 
***************** 
* 
FD:040	CF	A5,BIO:RE 
	IFT	TOSS+IBM=2 
	LD	A1,DWTLAB,A6
	AN	A1,DWTA3,A6 
	RF(Z)	FD:042	TOSS DISC 
	XIF
	IFT	IBM=1
	LDKL	A4,BUF
FD:042	EQU	*
	XIF
FD:045	CF	A5,FD:REA	PERFORM READ
* 
	EJECT			DRFD01 
* 
* 
	IFT	CHAN+TOSS=2
	IFT	MMUPAG=1 
	IFF	DSKPAG+SWPBLK=0
	LD	A2,DWT:LA,A6	GET FLAG/LOGICAL BUFFER ADDRESS
	RF(Z)	FD:046	BUFFER IN SYSTEM AREA?
	LD	A7,ECBRL,A8	GET REQUESTED LENGTH
	LDKL	A1,FD:BUF	GET DWT BUFFER ADDRESS
	TS	-30,A15	SAVE RUNNING TASK MMU 
	TL	DWT:PA,A6	LOAD PSEUDO MMU TABLE 
	MVSU	A7	MOVE BUFFER FROM SYSTEM TO USER AREA 
	TL	-30,A15	RESTORE MMU FROM STACK
	LD	A2,DWT:BF,A6	GET SAVED BUFFER ADDRESS 
	ST	A2,ECBBA,A8	RESTORE IT IN ECB 
	RF	FD:048
* 
FD:046	EQU	*
	XIF
* 
	IFT	TOSS+IBM=2 
	LD	A1,DWTLAB,A6
	AN	A1,DWTA3,A6 
	RF(Z)	FD:047	NOT IBM 
	XIF
	IFT	IBM=1
	LD	A7,ECBRL,A8	REQ LEN 
	LD	A4,ECBBA,A8	ASCII OUTPUT ADDRESS
	CF	A5,ASCII
FD:047	EQU	*
	XIF
FD:048	EQU	*
	ABL	FD:RC
* 
	EJECT			DRFD01 
* 
	IFT	TOSS+IBM=0 
	IFT	MMUPAG=0 
* 
**************
*            *
* SEARCH KEY *
*            *
**************
* 
FD:050	EQU	*
	LD	A4,10,A8	KEY AREA ADDRESS 
	LDR*	A2,A4	KEY AREA LENGTH 
	LDR	A1,A2
	ABL(NP)	END:10	ILLEGAL LENGTH
	SUK	A1,128 
	ABL(P)	END:10	ILLEGAL LENGTH 
	LDR	A3,A2
* 
*   IF ODD CHANGE TO EVEN NO OF BYTES 
* 
	ADK	A3,1 
	SRL	A3,1 
	SLL	A3,1 
* 
	SLL	A2,3 
	ORK	A2,7	BIO 
	ADK	A3,4 
	ADK	A4,2	KEY ADDRESS 
	CF	A5,FD:WRI	SEARCH KEY
	LDR	A3,A3	RETURN CODE
	RB(NZ)	FD:048
* 
	EJECT			DRFD01 
* 
*  READ RECORD WITH KEY COMMAND 
* 
FD:060	EQU	*
	LDK	A2,4	BIO 
	LD	A3,4,A8	REQUESTED LENGTH
	CWK	A3,130 
	ABL(NE)	END:10	ILLEGAL LENGTH
	LD	A4,2,A8	BUFFER ADDRESS
	RB	FD:045
	XIF
* 
	EJECT			DRFD01 
* 
*************** 
*             * 
* TEST STATUS * 
*             * 
*************** 
* 
FD:070	EQU	*
	LDKL	A2,/FFF9	BIO DUMMY
	CF	A5,FD:WRI 
	LDR	A1,A3
	ANK	A1,1 
	RF(NZ)	FD:090	DISC NOT OPERABEL? 
	ANKL	A3,/200	WRITE PROTECTED?
	ORS	A3,DWTRCW,A6 
	IFF	TOSS+IBM=0 
	RF	LOA:05	READ VOLUME NAME 
* 
FD:075	EQU	*
	XIF
	LD	A1,DWTRCW,A6	GET RETURN CODE
FD:090	ABL	END:IO 
* 
	EJECT			DRFD01 
* 
********
*      *
* LOAD *
*      *
********
* 
LOAD	EQU	*
	LDK	A2,/14	LOCK
	CF	A5,FD:REA 
	ANK	A3,1 
	ABL(NZ)	FD:RC	NOT OPERABEL 
LOA:05	EQU	*
	IFT	TOSS+IBM=2 
* 
*  CHECK IF TOSS/IBM LABEL
* 
	LDK	A2,0	BIO 
	LDKL	A4,BUF
	LDK	A3,38	NO OF BYTES
	CF	A5,FD:REA 
	CF	A5,LD:RC
	ADK	A4,34
	LDR*	A2,A4 
	CWK	A2,'TO'
	RF(NE)	LOA:10	IBM LABEL PREASSUMED 
	ADK	A4,2 
	LDR*	A2,A4 
	CWK	A2,'SS'
	RF(NE)	LOA:10	IBM LABEL
	XIF
* 
	EJECT			DRFD01 
* 
* 
	IFT	TOSS=1 
* 
*  READ VOLUME NAME 
* 
	LDK	A3,8	LENGTH
	LDK	A2,0	BIO 
	C1	A1,DWTA3,A6	1 COMP. DRIVE BIT MASK
	ANS	A1,DWTLAB,A6	INDICATE TOSS LABEL 
	RF	LOA:15
	XIF
	IFT	IBM=1
LOA:10	LDK	A3,10	LENGTH 
	LDK	A2,/30	BIO 
	LD	A1,DWTA3,A6	DRIVE NO BIT MASK 
	ORS	A1,DWTLAB,A6	INDICATE IBM DISC 
	LDK	A1,/20	RETURN CODE BIT 10
	ORS	A1,DWTRCW,A6 
	XIF
	IFF	TOSS+IBM=0 
LOA:15	EQU	*
	LDKL	A4,BUF	BUFFER ADDRESS 
	CF	A5,FD:REA 
	CF	A5,LD:RC
	LDK	A1,2 
	XIF
	IFT	IBM=1
	LD	A7,DWTRCW,A6
	ANK	A7,/20	CHECK TYPE OF LABEL 
	RF(Z)	LOA:30	TOSS LABEL
	LDK	A7,10	NO OF CHAR.
	CF	A5,ASCII
	LDK	A1,4 
LOA:30	EQU	*
	XIF
* 
	EJECT			DRFD01 
* 
* 
	IFF	TOSS+IBM=0 
* 
*  GET DWT VOL NAME ADDRESS 
* 
	CF	A5,VOLADR	ADDRESS TO A2 
* 
*  STORE NAME IN DWT
* 
	LDK	A3,3 
LOA:40	LD	A4,BUF,A1 
	STR	A4,A2
	SUK	A3,1 
	RF(Z)	LOA:50 
	ADK	A1,2 
	ADK	A2,2 
	RB	LOA:40
LOA:50	EQU	*
	LC	A2,DWTOR+1,A6	GET ORDER 
	ANK	A2,/FF 
	RB(Z)	FD:075	JUMP IF TEST STATUS 
	XIF
	IFT	IBM=1
* 
* DATA SET OPENING WANTED?
* 
	ANK	A1,/2	A1:  TOSS=6, IBM=8 
	RF(NZ)	LOA:70	TOSS LABEL 
	LC	A1,DWTOR+1,A6	ORDER 
	CCK	A1,/2600 
	RF(E)	LOA:70	LOCK ORDER
* 
*  READ DATA SET LABEL
* 
	LD	A2,ECBCW,A8	SECTOR NO 
	SUK	A2,7 
	ABL(N)	FD:DIS	REQUEST ERROR
	SUK	A2,18
	ABL(P)	FD:DIS	REQUEST ERROR
	ADK	A2,25
	SLL	A2,3	BIO 
	LDK	A3,80	LENGTH 
	LDKL	A4,BUF
	CF	A5,FD:REA 
	LDR	A1,A3	RETURN CODE
	SLL	A1,4	CHECK NO DATA BIT 
	RF(NN)	LOA:60	NOT NO DATA
	ORKL	A3,/2000	INDICATE ILLEGAL DATA SET LABEL
LOA:60	EQU	*
	CF	A5,LD:RC
	ENB
	LD	A3,ECBCW,A8	DATA SET LABEL SECTOR 
	LDK	A1,DWTDSS
	CF	A5,STDWT	SAVE IN DWT
	ADK	A4,BOE	BOE ADDRESS 
	CF	A5,LOGSEC	TRANSFORM TO LOGICAL SECTOR 
	LDK	A1,DWTBOE
	CF	A5,STDWT	STORE BOE NO IN DWT
	SUK	A3,1	CRN 
	LDK	A1,DWTCRN
	CF	A5,STDWT
	ADK	A4,EOE-BOE	EOE ADDRESS 
	CF	A5,LOGSEC 
	LDK	A1,DWTEOE
	CF	A5,STDWT	STORE EOE NO IN DWT
	ADK	A4,EOD-EOE	EOD ADDRESS 
	CF	A5,LOGSEC 
	CF	A5,SETINH	INHIBIT 
	LDK	A1,DWTEOD
	CF	A5,STDWT	STORE EOD NO IN DWT
* 
LOA:70	EQU	*
	XIF
	LD	A2,DWTA3,A6 
	ORS	A2,DWTLC,A6	INDICATE LOCK
LOA:75	LD	A3,DWTRCW,A6	RETURN CODE
LOA:80	ABL	FD:RC
* 
	EJECT			DRFD01 
* 
* 
	IFF	TOSS+IBM=0 
* 
*  ERROR , UNLOCK 
* 
LOA:90	EQU	*
	LDR	A5,A6
	ADKL	A5,DWTSB2	STACK BASE
	LDK	A2,/C	UNLOCK 
	CF	A5,FD:REA 
	RB	LOA:75
* 
*---------------------------------------------------- 
*   LD:RC  SUBROUTINE 
* 
LD:RC	ORS	A3,DWTRCW,A6
	ANKL	A3,/2007	FATAL ERROR
	RB(NZ)	LOA:90
	LDKL	A4,BUF	DRIVER BUFFER ADDRESS
	RTN	A5 
	XIF
	EJECT			DRFD01 
* 
**********
*        *
* UNLOAD *
*        *
**********
* 
UNLOAD	EQU	*
	IFT	IBM=1
* 
*    DATA SET OPEN? 
* 
	CF	A5,DSOPCH	A1,AFFECTED 
	LDR	A7,A7	EOD
	RF(Z)	UNL:70	NOT OPEN
	ST	A7,10,A8	STORE EOD-NO IN CONTROL WORD OF ECB
* 
*  READ DATA SET LABEL TO DRIVER BUFFER 
* 
	CF	A5,DSLIO	PREPARE FOR I/O
	CF	A5,FD:REA	READ DATA SET LABEL 
	CF	A5,UNL:RC	RETURN CODE CHECK 
	ENB
**
*------------------------------ 
*  TRANSFORM RETURN CODE TO IBM SECTOR NO (EBCDIC-CODED)
* 
	CF	A5,DSOPCH	EOD-NO TO A7
* 
*  DIVIDE EOD BY 26 
* 
	LDK	A1,0 
UNL:10	SUK	A7,26
	RF(N)	UNL:20 
	ADK	A1,1 
	RB	UNL:10
UNL:20	ADK	A7,27
* 
*   A1 = BINARY TRACK NO
*   A7 = SECTOR NO WITHIN TRACK (0-25)
* 
	CF	A5,BINDEC	TRANSFORM SEC.NO TO A3
	LDKL	A4,BUF+EOD+4	ADDRESS TO POS 79
	SCR	A3,A4
	SUK	A4,1 
	SRL	A3,8	LEFT BYTE 
	SCR	A3,A4	STORE IN BUFFER
	LDR	A7,A1	TRACK
	CF	A5,BINDEC	DEC EBCDIC-CODED IN A3
	SUK	A4,3 
	STR	A3,A4	TRACK INTO BUF 
	CF	A5,SETINH	INHIBIT 
* 
*  WRITE DATA SET LABEL 
* 
	CF	A5,DSLIO	PREPARE FOR I/O
	ORK	A2,5	PHYSICAL WRITE
	CF	A5,FD:WRITE	WRITE DATA SET LEBEL
	CF	A5,UNL:RC	CHECK RETURN CODE 
	CF	A5,DSOPCH 
	CMR	A2	INDICATE NOT OPEN 
* 
*    UNLOCK 
* 
	XIF
UNL:70	EQU	*
	LDK	A2,/C	UNLOCK 
	CF	A5,FD:REA 
	ORS	A3,DWTRCW,A6 
	ANK	A3,1 
	RF(NZ)	UNL:80	NOT OPERABLE,STILL LOCKED
	LD	A2,DWTA3,A6	INDEX MASK
	XRS	A2,DWTLC,A6	INDICATE UNLOCK IN DWT 
UNL:80	EQU	*
	RB	LOA:75	END:IO 
	IFF	TOSS+IBM=0 
* 
*   UNLOAD RETURN CODE CHECK
* 
UNL:RC	ORS	A3,DWTRCW,A6 
	ANK	A3,/7	FATAL ERROR? 
	RB(NZ)	UNL:80	ENDIO
	RTN	A5 
	XIF
	IFT	IBM=1
	EJECT			DRFD01 
* 
******************* 
* SEQUENTIAL READ * 
******************* 
* 
SQREAD	EQU	*
	CF	A5,DSOPCH	GET EOD AND EOD ADDRESS 
	LDR	A7,A7	EOD
SQR:05	ABL(Z)	DISIOE	NOT OPEN 
	ADK	A2,DWTCRN-DWTEOD	A2 = ADDRESS TO CRN 
	LDR*	A3,A2	CRN 
	ADK	A3,1	CRN+1 
	ST	A3,ECBCW,A8	STORE CRN+1 IN ECB
	CWR	A3,A7
	RF(NL)	SQR:10	END OF DATA
	CF	A5,BIO:RE 
	LDKL	A4,BUF	BUFFER ADDRESS 
	CF	A5,FD:REA	READ SECTOR POINTED AT BY CRN+1 
	LD	A4,ECBBA,A8	USER BUFFER ADDRESS 
	LD	A7,ECBRL,A8	REQUESTED LENGTH
	CF	A5,ASCII	TRANSFORM TO ASCII 
	LDK	A1,DWTCRN
	CF	A5,DSPAD
	RF	SQW:10	UPDATE CRN 
* 
*    END OF DATA
* 
SQR:10	LDKL	A1,/1000	RETURN CODE
	RF	END:IO
	EJECT			DRFD01 
* 
******************* 
* SEQUENTIAL WRITE *
******************* 
* 
SQWRIT	EQU	*
	CF	A5,DSOPCH	GET EOD 
	ADK	A7,0	EOD-NO (SET CR) 
	RB(Z)	SQR:05	NOT OPEN
* 
*   CHECK IF END OF EXTENT
* 
	LDK	A1,DWTEOE
	CF	A5,DSPAD	EOE-NO ADDRESS TO A2 
	ST	A7,ECBCW,A8	STORE EOD IN ECB C. W.
	CWR*	A7,A2 
	RF(G)	SQW:20	YES,EOE 
	CF	A5,BIO
	LDK	A7,128 
	CF	A5,EBCDIC	TRANSFORM AND MOVE TO BUF 
	ORK	A2,5	PHYS. WRITE 
	CF	A5,FD:WRI 
	CF	A5,DSOPCH 
SQW:10	LDR	A1,A3	RETURN CODE
	ANK	A1,/1
	RF(NZ)	SQW:15	NOT OPERABLE 
	IMR	A2	EOD=EOD+1 OR CRN=CRN+1 IN DWT 
SQW:15	RF	FD:RC 
* 
* 
*  END OF EXTENT
SQW:20	LDKL	A1,/400	RETURN CODE 
	RF	END:IO
	EJECT			DRFD01 
* 
**********
* REWIND *
**********
* 
REWIND	EQU	*
	CF	A5,DSOPCH 
	ADK	A7,0	EOD (SET CR)
	RB(Z)	SQR:05	DATA SET NOT OPEN 
	LDR	A3,A2	SAVE EOD ADDRESS 
	LDK	A1,DWTBOE
	CF	A5,DSPAD
	LDR*	A4,A2	BOE 
	STR	A4,A3	EOD = BOE
	LDK	A1,DWTCRN
	CF	A5,DSPAD
	SUK	A4,1	BOE - 1 
	STR	A4,A2	CRN = BOE -1 
	LDK	A1,0	RETURN CODE 
	RF	END:IO
	XIF
	EJECT			DRFD01 
* 
***************** 
*               * 
* PERFORM ORDER * 
*               * 
***************** 
* 
* 
*  INPUT:  A2  BIO CONTENTS 
*          A3  NO OF BYTES TO BE TRANSFERED 
*          A4  BUFFER ADDRESS 
* 
FD:WRI	EQU	*
	IFT	CHAN=0 
	LDKL	A1,/C000	WORDS,WRITE
	XIF
	IFT	CHAN=1 
	CM	DWTRW,A6	INDICATOR TO WRITE MODE
	XIF
	RF	FD:800
* 
FD:REA	EQU	*
	IFT	CHAN=1 
	LDK	A1,1 
	ST	A1,DWTRW,A6	READ MODE 
	XIF
	IFT	CHAN=0 
	LDKL	A1,/8000	WORDS  READ
	XIF
FD:800	EQU	*
	IFT	CHAN=0 
	SRL	A3,1	FROM BYTES TO WORDS 
* 
	IFT	MMUPAG=1 
	ORR*	A1,A8	GET FIRST WORD OF ECB 
	ANKL	A1,/F000	KEEP FOUR LEFTMOST BITS
	XIF
* 
	IFT	CHAN=0 
	ORR	A3,A1
WER1	WER	A3,MUXADR	FIRST WER
WER2	WER	A4,MUXADR+1	SECOND WER 
	XIF
	IFT	CHAN=1 
* 
	EJECT			DRFD01 
* 
*  PUT BUFFER START AND END ADDRESS IN DWT
* 
	ST	A4,DWTUB,A6 
	ADR	A3,A4
	ST	A3,DWTUBE,A6	END ADDRESS+2
	XIF
FD:820	EQU	*
	ST	A5,DWTA5,A6	SAVE STACK POINTER
FD:CIO	CIO	A2,1,CUADR	CIO-START 
	RF(3)	FD:840	DEVICE ADDRESS UNKNOWN
	RF	T:DISP
FD:840	LDK	A1,1	NOT OPERABLE
	RF	END:IO
	EJECT			DRFD01 
* 
************************************* 
*                                   * 
*  FD:RC - STORE EFF LEN, END:IO     *
*                                   * 
************************************* 
* 
*  INPUT:  A3  RETURN CODE
* 
FD:RC	EQU	* 
	LDR	A1,A3
* 
*  PUT EFFECTIVE LENGTH IN ECB
* 
	LD	A2,ECBRL,A8	REQ LENGTH
	ST	A2,ECBEL,A8	EFF LENGTH
	EJECT			DRFD01 
* 
**********
*        *
* END:IO *
*        *
**********
* 
END:IO	EQU	*
	CF	A15,TENDIO
T:DISP	ABL	TDISP
* 
* 
*  ENTRY FROM RECOVERY ROUTINE
* 
END:05	EQU	*
* 
*  ILLEGAL LENGTH 
* 
END:10	LDK	A1,8	RETURN CODE 
	RB	END:IO
	EJECT			DRFD01 
* 
********************
*                  *
* RECOVERY ROUTINE *
*                  *
********************
* 
FDON	EQU	*
	IFT	CPU852=1 
	CF	A15,SAVE8	SAVE A1-A8 ON STACK 
	XIF
* 
	IFT	CPU852=0 
	MSR	8,A15	SAVE A1-A8 ON STACK
	XIF
* 
	LDKL	A6,DWFD01	DWT ADDRESS 
* 
FDON05	EQU	*
	IM	DWTA2,A6	SET FDON FLAG
	LDKL	A5,DWTSB2 
	ADR	A5,A6	GET STACK BASE 
* 
	IFF	DSKPAG+SWPBLK=0
	LD	A2,INIFLG	CHECK INITIALIZATION FLAG 
	RF(Z)	FDON07	POWER UP? 
	LD	A2,SCTPLD	GET FILE CODE OF PROGRAM LOADING DEVICE 
	SUK	A2,/F8 
	RF(N)	FDON07	NOT FLEXIBLE DISC?
	LDR	A3,A2
	CF	A5,SETCIO	DRIVE NR IN CIO INSTRUCTION 
	CF	A5,FDIX	GET DRIVE BIT INDICATOR 
	ORS	A3,DWTLC,A6	INDICATE DRIVE LOCKED
* 
	EJECT			DRFD01 
* 
* 
	C1R	A3,A3
	ANS	A3,DWTLAB,A6	INDICATE TOSS LABEL 
* 
*	READ VOLUME NAME (A2 = 0 FROM FDIX) 
* 
	LDK	A3,8 
	LDKL	A4,BUF
	CF	A5,FD:REA 
	LD	A3,SCTPLD 
	CF	A5,VOLA05	GET VOLUME NAME ADDRESS IN DWT
	LDK	A1,2 
	LDK	A3,3 
* 
*	MOVE VOLUME NAME TO DWT 
* 
FDON06	LD	A4,BUF,A1 
	STR	A4,A2
	ADK	A1,2 
	ADK	A2,2 
	SUK	A3,1 
	RB(P)	FDON06 
* 
FDON07	EQU	*
	XIF
* 
	EJECT			DRFD01 
* 
*  SAVE DWTST TO DWTST2 IF NOT ALREADY DONE.
*    DWTST IS SET BUSY
* 
	LD	A2,DWTST2,A6
	CWK	A2,-1
	RF(NE)	FDON08	ALREADY SAVED
	LD	A2,DWTST,A6 
	ST	A2,DWTST2,A6
FDON08	CM	DWTST,A6	SET BUSY 
* 
	IFT	OPCLOS=1 
* 
	EJECT
* 
*    TERMINATE WAIT REQUEST FOR OPEN ORDER IF RUNNING 
	LD	A4,DWTTP2,A6	TIMER POINTER
	RF(Z)	FDON09	NOT RUNNING 
	CMR	A4	STOP TIMER
	CM	DWTTP2,A6	INDICATE NO TIMER 
FDON09	EQU	*
* 
*    OPEN FD TO MAKE FOLLOWING LOCK ORDER POSSIBLE
	LDKL	A4,SPDLCI	OPEN/CLOSE STATUS WORD ADDRESS
* 
	LDKL	A2,/8000	OPEN/CLOSE BIT MASK
	ANR*	A2,A4	A2:=OPEN/CLOSE FLAG 
	ORS	A2,DWTOCF,A6	SAVE
	XRRS	A2,A4	SET STATUS WORD TO OPEN 
* 
	LDR*	A2,A4 
	OTR	A2,0,SOPDA	SET DRIVE TO OPEN 
* 
	XIF
* 
	EJECT
* 
* DELAY 2 SEC 
* 
	LD	A4,DWTTP,A6 
	RF(Z)	FDON10	NO TIMER SET
	LDKL	A4,-TIME
	ST*	A4,DWTTP,A6	RESTART TIMER
	RB	T:DISP
FDON10	LDK	A4,DWTTP 
	ADR	A4,A6
	LDR	A1,A6	SAVE A6
	CF	A15,SETIMP
	DATA	FDON20,TIME 
	RB	T:DISP
* 
*   TIME OUT ROUTINE
* 
FDON20	LDR	A6,A1
	CM	DWTTP,A6
	LDKL	A5,DWTSB2 
	ADR	A5,A6	STACK BASE 
* 
*  LOCK DOORS 
* 
	LDK	A2,1 
FDON25	EQU	*
	LD	A1,DWTLC,A6	LOCK INDICATOR
	ANR	A1,A2
	RF(Z)	FDON30	NOT LOCKED
	ST	A2,DWTA3,A6	SAVE
* 
	EJECT
* 
*  PUT DRIVE NO IN CIO INSTR
* 
	SRN	A2,A3	DRIVE NO IN A3 
	CF	A5,SETCIO	PUT DRVE NO IN CIO-INSTR
	LDK	A2,/14	LOCK
	CF	A5,FD:REA 
	LD	A2,DWTA3,A6	DRIVE IND.
	ANK	A3,1 
	RF(Z)	FDON30	OK
	XRS	A2,DWTLC,A6	INDICATE UNLOCK
FDON30	EQU	*
	SLL	A2,1 
	CWK	A2,/0010 
	RB(NE)	FDON25
* 
	IFT	OPCLOS=1 
* 
*    RESTORE OPEN/CLOSE STATUS TO SAME VALUE AS BEFORE POWER OFF
	LD	A2,DWTOCF,A6	OPEN/CLOSE FLAG
	ORS	A2,SPDLCI	TO STATUS WORD 
	CM	DWTOCF,A6	CLEAR FLAG
* 
	LD	A2,SPDLCI	OPEN/CLOSE STATUS 
	OTR	A2,0,SOPDA	CLOSE DRIVE IF IT WAS CLOSED
*			BEFORE THE POWER OFF
	XIF
* 
	EJECT
* 
*  ANY REQUEST? 
* 
*  RESTORE STATUS SAVED IN DWST2 TO DWTST.
*   SET DWTST2 TO -1
	LD	A2,DWTST2,A6	SAVED STATUS 
	ST	A2,DWTST,A6	PUT IN CUURENT STATUS 
	LDKL	A2,-1 
	ST	A2,DWTST2,A6	INDICATE NOT SAVED 
	CM	DWTA2,A6	RESET FDON FLAG
FDON60	EQU	*
	LD	A2,DWTST,A6 
	ABL(N)	END:05	NO REQUEST, RETURN VIA TENDIO
* 
*  RETRY REQUEST
* 
	IM	DWTRTY,A6	INDICATE RETRY
	LD	A7,DWTOR,A6 
	ANK	A7,/3F	ORDER 
	LD	A8,DWTECB,A6	ECB ADDRESS
	ABL	FDAD	REACTIVATE
	EJECT			DRFD01 
* 
********************* 
*                   * 
* INTERRUPT HANDLER * 
*                   * 
********************* 
* 
IHFD	EQU	*
	ST	P,INTSAV	SAVE LAST INTERRUPT
********************	=1 START 
	IFT	CPU852=1 
	CF	A15,SAVE8	SAVE REGISTERS ON STACK 
	XIF
* 
	IFT	CPU852=0 
	MSR	8,A15	SAVE A1-A8 ON STACK
	XIF
* 
	LDKL	A6,DWFD01	DWT ADDRESS 
	IFT	CHAN=1 
	ENB
	LD	A1,DWTUB,A6	GET BUFFER POINTER
	LD	A2,DWTUBE,A6	END OF BUFFER
	SUR	A2,A1	LENGTH 
IH005	EQU	* 
	SST	A3,CUADR	GET STATUS
	RF(A)	IH:000	READY INTERRUPT 
	LD	A3,DWTRW,A6	READ/WRITE INDICATOR
	RF(NZ)	IH050	READ
* 
	EJECT		DRFD01
* 
* 
IH010	EQU	* 
	LCR	A3,A1	ONE BYTE FROM BUFFER 
	ECR	A3,A3	LEFT POSITION
	LC	A3,1,A1	RIGHT BYTE FROM BUFFER
	OTR	A3,0,CUADR	WRITE 
	RB(NA)	IH005 
	ADK	A1,2	UPDATE BUFFER POINTER 
	SUK	A2,2 
	RB(P)	IH010
	CIO	A2,0,CUADR	CIO HALT
	ABL	TDISP	GOTO DISPATCHER
* 
IH050	EQU	* 
	INR	A3,0,CUADR	READ
	RB(NA)	IH005 
	SC	A3,1,A1	RIGHT BYTE TO BUFFER
	ECR	A3,A3
	SCR	A3,A1	LEFT BYTE TO BUFFER
	ADK	A1,2	UPDATE BUFFER POINTER 
	SUK	A2,2 
	RB(P)	IH050
	CIO	A2,0,CUADR	CIO HALT
	SST	A3,CUADR	STATUS	=2 
	RB(NA)	*-2		=2 
IH:000	EQU	*		=1
	XIF
* 
	EJECT		DRFD01
* 
* 
********************	=1 END 
	IFT	CHAN=0		=2 
	SST	A3,CUADR	STATUS
	XIF			=2 
	LDKL	A6,DWFD01	DWT ADDRESS 
	LD	A8,DWTECB,A6	ECB ADDRESS
	LD	A5,DWTA5,A6	STACK POINTER 
	SLL	A3,1 
	RF(N)	FDRE	READY INTERRUPT 
	SRL	A3,1 
	LD	A2,DWTRTY,A6	RETRY? 
	RF(Z)	IH:10	NO 
	CM	DWTRTY,A6	RESET RETRY FLAG
	LDR	A1,A3
	ANKL	A1,/0405
	RF(Z)	IH:10	RETURN CODE OK 
	LDK	A1,/4
	ORR	A3,A1	CRC ERROR
IH:10	EQU	* 
* 
	EJECT		DRFD01
* 
* TRANSFORM RETURN CODE, CU - ECB 
* 
	ANKL	A3,/FF37
	RF(Z)	IH:80
	LDR	A1,A3
	ANKL	A3,/0A05	UNCHANGED BITS 
	LDR	A4,A1
	ANKL	A4,/0400	BIT 5
	SLC	A4,7	TO BIT 14 
	ORR	A3,A4
	IFT	TOSS+IBM=0 
	LDR	A4,A1
	ANKL	A4,/2000	BIT 2
	SLL	A4,1	TO BIT 1
	ORR	A3,A4
	XIF
	LDR	A4,A1
	ANK	A4,/20	BIT 10
	SLL	A4,3	TO BIT 7
	ORR	A3,A4
	ANK	A1,/10	BIT 11
	SRC	A1,5	TO BIT 0
	ORR	A3,A1
IH:80	EQU	* 
	IFT	CHAN=1	=1
	INH		=1
	XIF		=1
	RTN	A5 
	EJECT			DRFD01 
* 
********************
*                  *
*  READY INTERRUPT *
*                  *
********************
* 
FDRE	EQU	*
	LD	A2,DWTA2,A6 
	ABL(NZ)	T:DISP	POWER ON ROUTINE ACTIVE 
	LDKL	A5,DWTSB2 
	ADR	A5,A6	STACK BASE 
	RB	FDON60
	EJECT			DRFD01 
* 
******************************************* 
*                                         * 
*    S U B R O U T I N E S                * 
*                                         * 
******************************************* 
* 
******* 
*     * 
* BIO * 
*     * 
******* 
* 
* 
*  INPUT:  A8  ECB ADDRESS
* 
*  OUTPUT: A2  BITS 0-12 OF CONTROL WORD USED BY CIO START
*          A3  NO OF BYTES TO BE TRANSFERED 
*          A4  BUFFER ADDRESS 
* 
BIO	EQU	* 
	LDK	A4,0	FLAG
	RF	BIO010
BIO:RE	LDK	A4,1 
BIO010	EQU	*
	LD	A3,ECBRL,A8	REQ LEN 
	RF(N)	BIOERR	ILLEGAL LENGTH
	IFT	TOSS+IBM=2 
	LD	A2,DWTLAB,A6
	AN	A2,DWTA3,A6 
	RF(Z)	BIO020	TOSS DISC 
	XIF
	IFT	IBM=1
	LDK	A7,IBMLEN
	LDK	A2,0 
	XIF
	IFT	TOSS+IBM=2 
	RF	BIO030
	XIF
	IFT	TOSS=1 
BIO020	LDKL	A7,TOSLEN 
	LDK	A2,3 
BIO030	EQU	*
	XIF
	IFF	TOSS+IBM=0 
	ADK	A4,0	SET CR
	RF(Z)	BIO060	WRITE 
	LDK	A2,0 
	LDR	A1,A3	REQ LEN
	CWR	A3,A7	REQ LENGTH WITHIN RANGE
	RF(G)	BIOERR	NO
BIO040	SUK	A1,128 
	RF(NP)	BIO100
	ADK	A2,1	INCREMENT NO OF SECTORS 
	RB	BIO040
* 
*  WRITE, CHECK REQ LENGTH
* 
BIO060	CWR	A3,A7
	RF(NE)	BIOERR	ILLEGAL REQ LEN
	XIF
	IFT	TOSS+IBM=0 
* 
*  FIND NO OF SECTORS TO BE READ/WRITTEN, CHECK REQ LENGTH
* 
	LDR	A1,A3	REQ LENGTH 
	LDK	A2,0	NO OF SECTORS-1 
BIO015	LDR	A4,A4	READ OR WRITE? 
	RF(NZ)	BIO035	READ!
	SUK	A1,128 
	RF(Z)	BIO100	REQ LEN ACCEPTED
	RF	BIO045
* 
BIO035	SUK	A1,128 
	RF(NP)	BIO100	REQ LENGTH ACCEPTED
BIO045	ADK	A2,1 
	CWK	A2,3 
	RB(NG)	BIO015
	RF	BIOERR	REQ LEN OUTSIDE RANGE
	XIF
* 
BIO100	SRC	A2,2	SHIFT NO OF SECTORS-1 INTO POS 0-1
* 
*  CHECK SECTOR NO FROM CONTROL WORD OF ECB IS
*  WITHIN RANGE, PUT IT IN POS 2-12 
* 
	LD	A1,ECBCW,A8	SECTOR NO 
	RF(N)	BIOER2	OUTSIDE RANGE 
	IFT	TOSS+IBM=2 
	ANK	A7,/A
	RF(Z)	BIO110	IBM DISC
	XIF
	IFT	TOSS=1 
	CWK	A1,499 
	RF(G)	BIOER2	OUT OF RANGE
	SLL	A1,2	MULTIPLY BY 4TO GET DM SECTOR 
	XIF
	IFT	TOSS+IBM=2 
	RF	BIO120
	XIF
	IFT	IBM=1
BIO110	CWK	A1,1923
	RF(P)	BIOER2	OUT OF RANGE
	XIF
	IFT	TOSS+IBM=0 
	CWK	A1,2001	SECTOR NO OUT OF RANGE 
	RF(G)	BIOER2	YES!
	XIF
BIO120	EQU	*
	SLL	A1,3 
	ORR	A2,A1
	LD	A4,ECBBA,A8	BUFFER ADDRESS
	LDR	A1,A3	REQ LENGTH 
	ANK	A1,1 
	RF(NZ)	BIOERR	REQ LEN. NOT EVEN
	RTN	A5 
* 
* 
*  ILLEGAL REQUESTED LENGTH, RETURN VIA TENDIO
* 
BIOERR	ABL	END:10 
*   ILLEGAL SECTOR NO 
BIOER2	ABL	FD:DIS 
* 
	EJECT			DRFD01 
* 
********* 
*       * 
* FDIX  * 
*       * 
********* 
* 
*  INPUT:  A2   X 
* 
*  OUTPUT: A3   2 POWER(X)
* 
FDIX	LDK	A3,1 
	ADK	A2,0	SET CR
FDIX10	EQU	*
	RF(Z)	FDIX20 
	SLL	A3,1 
	SUK	A2,1 
	RB	FDIX10
FDIX20	RTN	A5 
	EJECT			DRFD01 
	IFF	TOSS+IBM=0 
******************
*                *
*  VOLADR        *
*                *
******************
* 
*  INPUT:  A6  DWT ADDRESS
* 
*  OUTPUT: A2  VOLUME NAME ADDRESS
*          A3  ZERO 
* 
VOLADR	EQU	*
	LC	A3,DWTOR,A6	DRIVE NO
VOLA05	EQU	*
	LDK	A2,DWTVO0
	ADR	A2,A6
	ANK	A3,/3
VOLA10	EQU	*
	RF(Z)	VOLA20 
	ADK	A2,6	UPDATE ADDRESS
	SUK	A3,1 
	RB	VOLA10
VOLA20	RTN	A5 
	XIF

	IFT	IBM=1
	EJECT			DRFD01 
* 
********* 
* ASCII * 
********* 
* 
*  FUNCTION:  ASCII TRANSFORMS A STRING FROM EBCDIC TO
*             ASCII CODE
*             INPUT STRING ADDRESS IS BUF 
*  INPUT:     A7  NO OF CHARACTERS
*             A4  OUTPUT  STRING ADDRESS
*  OUTPUT:    A1  CHANGED 
*             A4 CHANGED
*             A7  CHANGED 
* 
ASCII	EQU	* 
	ENB
	LDK	A1,0 
	ADR	A4,A7
ASC:10	SUK	A7,1 
	RF(N)	ASC:20 
	SUK	A4,1 
	LC	A1,BUF,A7	GET EBCDIC CHAR 
	LC	A1,TASCII,A1	TRANSFORM TO ASCII 
	SCR	A1,A4	PUT ASCII CHAR. IN OUTPUT BUFFER 
	RB	ASC:10
ASC:20	EQU	*
	RF	EBC:90	SET INH AND RETURN 
	EJECT			DRFD01 
* 
**********
* EBCDIC *
**********
* 
*  FUNCTION:  EBCDIC TRANSFORMES A STRING FROM ASCII TO 
*             EBCDIC CODE 
*             OUTPUT STRING IS PUT IN DRIVER BUFFER 
* 
*  INPUT:     A7 NO OF CHARACTERS 
*             A4  INPUT STRING ADDRESS
* 
*  OUTPUT:    A1  CHANGED 
*              A4  DRIVER BUFFER ADDRESS
*             A7  CHANGED 
EBCDIC	EQU	*
	ENB
	ADR	A4,A7
	LDK	A1,0 
EBC:10	SUK	A7,1 
	RF(N)	EBC:80 
	SUK	A4,1 
	LCR	A1,A4	GET ASCII CHAR.
	LC	A1,TEBCDIC,A1 
	SC	A1,BUF,A7 
	RB	EBC:10
EBC:80	EQU	*
	LDKL	A4,BUF
EBC:90	EQU	*
	CF	A5,SETINH 
	RTN	A5 
	EJECT			DRFD01 
* 
**********
* LOGSEC *
********* 
* 
*  FUNCTION:  LOGSEC TRANSFORMS PHYSICAL SECTOR TO STANDARD 
*              LOGICAL SECTOR (BINARY). 
*             FORMAT OF PHYS. SEC.  TT0SS  (EBCDIC CODE)
*              TT = TRACK,  SS=SECTOR 
* 
*  INPUT:    A4  ADDRESS TO PHYS. SECTOR
* 
*  OUTPUT:   A3  BINARY SECTOR NO 
*            A4  ADDRESS TO PHYS. SEC. + 4
* 
LOGSEC	EQU	*
	CF	A5,DECBIN 
	LDR	A3,A1	SAVE 
	ADK	A4,2 
* 
*  MULTIPLY BY 26 
* 
	SLL	A3,5	*32 
	LDR	A2,A1
	SLL	A2,2 
	SUR	A3,A2	*28
	SLL	A1,1 
	SUR	A3,A1	*26
	CF	A5,DECBIN 
	SUK	A1,1 
	ADR	A3,A1
* 
*  CHECK SECTOR NO
* 
	LDR	A1,A3
	SUK	A1,25
	RF(NP)	LOG:10
	CWK	A4,BUF+EOD+4	EOD?
	RF(E)	LOG:02	YES!
	SUKL	A1,1898 
	RF	LOG:04
* 
*  CHECK EOD LESS/EQUAL 74001 
* 
LOG:02	SUKL	A1,1899 
LOG:04	EQU	*
	RF(P)	LOG:10	NOT ACC SEC. NO 
	SUK	A4,4	RESET BUFFER POINTER
	RTN	A5 
* 
*  FATAL ERROR
* 
LOG:05	ADK	A5,4	ADJUST STACK POINTER
LOG:10	LDKL	A1,/2000	RETURN CODE
	ORS	A1,DWTRCW,A6 
	CF	A5,SETINH 
	ABL	LOA:90	ERROR ROUTINE 
* 
	EJECT			DRFD01 
* 
**********
* DECBIN* 
**********
* 
*  FUNCTION:  DECBIN TRANSFORMS TWO EBCDIC CODED DIGITS TO
*             BINARY. RANGE OF EBCDIC CODE /F0 - /F9 IS CHECKED 
*     INPUT:  A4  ADDRESS TO FIRST DIGIT
*   OUTPUT: A1  BINARY
*   WORKING REG:  A2,A7 
* 
DECBIN	LDK	A1,0 
	LDK	A7,2 
DEC:10	LCR	A2,A4	DIGIT
	ANK	A2,/FF 
	SUK	A2,/F0 
	RB(N)	LOG:05 
	SUK	A2,9 
	RB(P)	LOG:05	NOT DIGIT 
	ADK	A2,9 
	SUK	A7,1 
	RF(Z)	DEC:30 
	ADK	A4,1	ADDRESS TO SECOND DIGIT 
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 
	XIF
	EJECT			DRFD01 
* 
**********
* SETCIO *
**********
* 
*  FUNCTION:  PUT DRIVE NO IN CIO INSTRUCTION 
* 
*  INPUT:  A3  DRIVE NO , (BITS 0-13 MUST BE ZEROES 
* 
*  OUTPUT: A3  CHANGED
*          A4  CHANGED
* 
SETCIO	LDKL	A4,/FFCF
	ANS	A4,FD:CIO
	SLL	A3,4 
	ORS	A3,FD:CIO
	RTN 	A5
	IFT	IBM=1
	EJECT			DRFD01 
* 
**********
* 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	LDK	A3,0 
BIN:10	SUK	A7,10
	RF(N)	BIN:20 
	ADK	A3,1 
	RB	BIN:10
BIN:20	ADK	A7,10
	SLL	A3,8 
	ORR	A3,A7	DECIMAL CONVERTED NO IN A3 
	ORKL	A3,/F0F0	EBCDIC CODED 
	RTN A5 
	EJECT			DRFD01 
********* 
* DSLIO * 
********* 
* 
*  FUNCTION:  PREPARE FOR READING DATA SET LABEL
* 
*  INPUT:  A6  DWT ADDRESS
* 
*  OUTPUT: A2  BITS 0-12 SECTOR NO, BITS 13-15 ZEROES 
*          A3   128 
*          A4  DRIVER BUFFER ADDRESS
*          A6  DWT ADDRESS
*           A1 IS CHANGED 
* 
DSLIO	LDK	A1,DWTDSS 
	CF	A5,DSPAD
	LDR*	A2,A2 
	SLL	A2,3 
	LDK	A3,128 
	LDKL	A4,BUF
	RTN	A5 
	EJECT			DRFD01 
* 
**********
* DSOPCH *
**********
* 
*  FUNCTION:  GET EOD-NO AND EOD-NO ADDRESS IN DWT
* 
*  INPUT:  A6  DWT ADDRESS
* 
*  OUTPUT: A2  EOD ADDRESS
*          A7  EOD-NO      (0=NOT OPEN) 
*          A1  CHANGED
DSOPCH	LDK	A1,DWTEOD
	CF	A5,DSPAD
	LDR*	A7,A2	EOD-NO
	RTN	A5 
	EJECT			DRFD01 
* 
********* 
* DSPAD * 
********* 
* 
*  FUNCTION: GET ABSOLUTE ADDRESS OF SPECIFIED
*            TYPE OF DATA FOR COORESSPONDING DRIVE
* 
*  INPUT:  A1  DWT OFFSET 
*          A6  DWT ADDRESS
* 
*  OUTPUT: A2  ADDRESS TO DATA
*          A6  DWT ADDRESS
* 
DSPAD	LC	A2,DWTOR,A6	DRIVE NO 
	ANK	A2,/3
	ADR	A2,A2
	ADR	A2,A6
	ADR	A2,A1
	RTN	A5 
	EJECT			DRFD01 
* 
********* 
* STDWT * 
********* 
* 
*  FUNCTION: STORE INPUT WORD IN DWT-AREA DEPENDING OF
*            DRIVE NO 
* 
*  INPUT:    A1  OFFSET TO DWT AREA 
*            A3  WORD TO BE STORED IN DWT 
*            A6  DWT ADDRESS
* 
*  OUTPUT:   A1  UNCHANGED
*            A2  ADDRESS TO WORD IN DWT AREA
*            A3  UNCHANGED
*            A6  UNCHANGED
* 
STDWT	EQU	* 
	CF	A5,DSPAD
	STR	A3,A2
	RTN	A5 
	EJECT			DRFD01 
* 
**********
* SETINH *
**********
* 
*  FUNCTION:  INHIBIT INTERRUPTS, IF FDON ROUTINE IS ACTIVE 
*             ESCAPE VIA DISPATCHER ELSE RESET DWTENB AND 
*             RETURN
* 
*  INPUT:     A6  DWT ADDRESS 
* 
SETINH	INH
	LD	A1,DWTA2,A6	FDON
	RF(Z)	SET:10	NOT ACTIVE
	ABL	T:DISP	ESCAPE
SET:10	RTN	A5 
	XIF
* 
*    D R I V E R   B U F F E R
BUF	DATA	0,0,0,0
* 
	IFT	IBM=1
	RES	60 
	XIF
* 
	EJECT			DRFD01 
* 
********************* 
*                   * 
* 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
* 
	DATA	0 
	DATA	0	SAVE AREA 
	DATA	0 
	DATA	0 
	DATA	0,0,0,0	STACK 
DWTST2	EQU	*-DWFD01	SAVE STATUS WORD
	DATA	-1
DWTRTY	EQU	*-DWFD01	RETRY REQUEST FLAG
	DATA	0 
DWTTP	EQU	*-DWFD01	TIMER POINTER
	DATA	0 
DWTRCW	EQU	*-DWFD01	TEMP RETURN CODE
	DATA	0 
DWTLAB	EQU	*-DWFD01	DISC LABEL INDICATOR
	DATA	0 
DWTLC	EQU	*-DWFD01	DRIVE LOCK INDICATOR 
	DATA	0 
DWTVO0	EQU	*-DWFD01	VOLUME NAME NO 0
	DATA	0,0,0 
DWTVO1	EQU	*-DWFD01	VOLUME NAME NO 1
	DATA	0,0,0 
DWTVO2	EQU	*-DWFD01	VOLUME NAME NO 2
	DATA	0,0,0 
DWTVO3	EQU	*-DWFD01	VOLUME NAME NO 3
	DATA	0,0,0 
	IFT	OPCLOS=1 
DWTTP2	EQU	*-DWFD01	TIMER POINTER FOR OPEN
	DATA	0 
DWTOCF	EQU	*-DWFD01	OPEN/CLOSE FLAG AT POWER ON 
	DATA	0 
	XIF
* 
	IFT	CHAN=1 
DWTUB	EQU	*-DWFD01	POINTER AT NEXT WORD IN BUFFER 
	DATA	0 
DWTUBE	EQU	*-DWFD01	BUFFER END ADDRESS+2
	DATA	0 
DWTRW	EQU	*-DWFD01	READ/WRITE INDICATOR 
	DATA	0 
	XIF
* 
	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 
	XIF
* 
	IFT	CHAN+TOSS=2
	IFT	MMUPAG=1 
	IFF	DSKPAG+SWPBLK=0
DWT:PA	EQU	*-DWFD01 
	DATA	0	6 BIT PHYSICAL BUFFER ADDRESS 
	DATA	0	SECOND MMU ENTRY
* 
DWT:LA	EQU	*-DWFD01 
	DATA	0	16 BIT LOGICAL BUFFER ADDRESS 
* 
DWT:BF	EQU	*-DWFD01 
	DATA	0	SAVE AREA BUFFER ADDRESS
	XIF
* 
	IFT	MMUPAG=1 
DEVECB	EQU	*
	DATA	0 
	DATA	FD:BUF
	DATA	0,0,0,0 
* 
	IFT	DEVIND=2 
FD:BUF	RES	DVBLEN+1 
	XIF
* 
	IFT	MMUPAG=1 
	IFT	DEVIND=4 
FD:BUF	EQU	0
	XIF
* 
* 
* 
	END

Full view