              :        DFLT    1

              :START   EQU     6800
              :RAM     EQU     7000

              :TTD     EQU     3 40mS Track-TracK De!ay
              :DUAL    EQU     1  work drive
              :RETRYC  EQU     3 no of retries
              :FD1771  EQU     0C 1771 port
              :FDCMD   EQU     FD1771 command/stat us
              :FDTRK   EQU     FD1771+1 track register
              :FDSEC   EQU     FD1771+2 sector register
              :FDDAT   EQU     FD1771+3 data register
              :FDINT   EQU     10 Control port

              :BUSY    EQU     1 Status bits
              :CRC     EQU     8 Cyclic redundancy check
              :LSD     EQU     4 Lost data
              :RNF     EQU     10 Record not found
              :HDENG   EQU     20  Head engaged
              :WPRT    EQU     40 Write protect
              :NREADY  EQU     80 Drive not ready

              :VERS    EQU     45 ???

              :*	ERROR	CODES

              :*	R	Read error
              :*	U	Write error
              :*	F	Full disc
              :*	S	Seek error
              :*	N	Not ready
              :*	P	Protected disc
              :*	0	Open error
              :*	D	Device does not exist
              :*	H	Hex error

              :* MicroDOS		PAGE 2
              :        ORG     START
6800  1F683D  :        BCTA,UN DOS         	Normal entry point
6803  6893    :        ACON    ENTER

6805  6A16    :        ACON    OPNR Open seq file for read
6807  6B16    :        ACON    GETCH Get next char,
6809  68BA    :        ACON    CHAIN Chain to a file
680B  6A41    :        ACON    OPNW Open for writing
680D  6AD9    :        ACON    PUTCH Put next char
680F  6BA3    :        ACON    CLSR Close read stream
6811  6B2B    :        ACON    CLSW Put char; close file
6813  6D6B    :        ACON    FIND Find file
6815  6D82    :        ACON    FNEXT Find next file this spec
6817  6EBF    :        ACON    IO General 1/0 routine
6819  6CDB    :        ACON    DRIVE Select drive RO
681B  6E45    :        ACON    ITEM Move buf ptr to next item
681D  6E0F    :        ACON    DOUT Print R2,R3 as decimal
681F  6E70    :        ACON    LINE Accept a line of chcrs
6821  6EB9    :        ACON    CRLF Put ON 0A on any Stream
6823  6C66    :        ACON    STDR Start of dir read
6825  6C72    :        ACON    RDS1 Read sec at Tx R2, Sc R3
6827  6DF7    :        ACON    PNAM Print file name just found
6829  6C8E    :        ACON    RDSC Read a sector
682B  6C0B    :        ACON    WRSC Write a sector
682D  6F0D    :        ACON    HXOUT Hexout (BOUT from RK
682F  6F26    :        ACON    GNMB Get NuMBer to XGOT0
6831  6EDE    :        ACON    PRID Print ID message,
6833  6F7A    :        ACON    DVRS DOS version
6835  68E4    :        ACON    NFD Not found routine
6837  6BA8    :        ACON    DELENT Delete entry
6839  692A    :        ACON    ASGN Assign dev to a stream
683B  6C79    :        ACON    RDNXSC Read next sector

              :* Directory structure

              :*	2	link to next sector

              :* Identity block ( first sector only :)

              :*	2	start of freeiist (track,sector)
              :*	2	end of freelist (track,sector)
              :*	2	length of freeliSt (sectors)
              :*	1	no of tracks on disc
              :*	1	no of sectors per track
              :*	3	disk identity
              :*	3	format date (DD/MM/YY)

              :*	Directory entry - repeated 10 times Per sector

              :*	10	file name (0 padding)
              :*	3	extension (0 padding)
              :*	2	start of file (track, sector)
              :*	2	end of file (track, sector)
              :*	2	length of file (sectors)
              :*	I	file type
              :*	1	spare
              :*	3	write date (DD/MM/YY)
              :* MicroDOS		PAGE 3
              :* Cold entry point - initialises RAM

683D  04D0    :DOS     LODI,R0 0D0         	Force interrupt
683F  D40C    :        WRTE,R0 FD1771      	Clear scratch RAM
6841  20      :        EORZ,R0
6842  07E6    :        LODI,R3 CLEAR-RAM   	Force drive 1
6844  CF5000  :        STRA,R0 RAM,R3-     	Restore on drive 1
6847  5B7B    :        BRNR,R3 $-3
6849  D410    :        WRTE,R0 FDINT
684B  040B    :        LODI,R0 8+TTD
684D  D40C    :        WRTE,R0 FD1771

684F  3B1D    :        BSTR,UN VDU0        	Setup VDU stream 0
6851  0700    :        LODI,R3 STR-STR
6853  3F6EE2  :        BSTA,UN PRCR        	"DOS"

6856  3B21    :        BSTR,UN SBFP        	Setup Buf ptrs

6858  0702    :        LODI,R3 2
685A  0F4FD0  :DR      LODA,R0 STRTUP,R3-  	Point to coldstart file
685D  CF7070  :        STRA,R0 BUFF,R3
6860  5B78    :        BRNR,R3 DR

6862  0510    :        LODI,R1 10          	Keyboard stream
6864  3F6D6B  :        BSTA,UN FIND        	Coldstart file
6867  1A20    :        BCTR,N  ENTERK      	not found
6869  3F6A16  :        BSTA,UN OPNR
686C  1B25    :        BCTR,UN ENTER       	Execute startup

              :* Initialise VDU stream 0
686E  0707    :VDU0    LODI,R3 7
6870  0F4F8E  :VB      LODA,R0 VDUB,R3-    	Setup VDU stream 0
6873  CF7000  :        STRA,R0 IDNT,R3
6876  5B78    :        BRNR,R3 VB
6878  17      :        RETC,UN

              :* Initialize stream buffer pointers
6879  0471    :SBFP    LODI,R0 <RAM+100
687B  0700    :        LODI,R3 0
687D  CF700F  :SBF     STRA,R0 HBUF,R3     	Setup Buf Ptrs
6880  8401    :        ADDI,R0 1
6882  8710    :        ADDI,R3 10
6884  E760    :        COMI,R3 60
6886  9875    :        BCFR,EQ SBF
6888  17      :        RETC,UN

6889  0707    :ENTERK  LODI,R3 7
688B  0F4F95  :KB      LODA,R0 KBDB,R3-    	Setup KBD stream 10
688E  CF7010  :        STRA,R0 IDNT+10,R3
6891  5B78    :        BRNR,R3 KB
              :* MicroDOS		PAGE 4
              :* Normal	entry point

6893  0402    :ENTER   LODI,R0 LCOM
6895  93      :        LPSL                	Set LCOM,
6896  3B61    :        BSTR,UN SBFP
6898  0710    :        LODI,R3 PMT-STR
689A  3F6EE2  :        BSTA,UN PRCR        	Prompt
689D  CC10E5  :        STRA,R0 ERRH        	Error handling flag
68A0  3F6E70  :        BSTA,UN LINE        	Get command line
68A3  0C1072  :        LODA,R0 BUF         	First char
68A6  E430    :        COMI,R0 A'0'
68A8  1A69    :        BCTR,LT ENTER       	<0, ignore line
68AA  E439    :        COMI,R0 A'9'        	Numeric?
68AC  BD6F26  :        BSFA,GT GNMB        	Yes, Set address,
68AF  9805    :        BCFR,EQ FCMD        	No valid; look for command file
68B1  3FF0DD  :        BSTA,UN *XGOTO      	branch to it
68B4  1B5D    :        BCTR,UN ENTER       	loop for subroutines

68B6  3B02    :FCMD    BSTR,UN CHAIN       	Into CHAIN, to execute it
68B8  1B59    :        BCTR,UN ENTER       	loop for subroutines
              :* MicroDOS		PAGE 05
              :* Find file, load & execute it
              :* Note uses stream 20; Uses 4 subr levels

68BA  0520    :CHAIN   LODI,R1 20          	Use str 20 to search dir
68BC  0C10D7  :        LODA,R0 SYSD        	Try SYS ory first
68BF  3F699B  :FCMD1   BSTA,UN ASDRV       	assign drive, name

68C2  0703    :        LODI,R3 3           	Force .CMD
68C4  0F4FDE  :CCMD2   LODA,R0 CMDS,R3-
68C7  CF706D  :        STRA,R0 EXTN,R3     	to extension
68CA  5B78    :        BRNR,R3 CCMD2
68CC  3F6D7A  :        BSTA,UN FIND1       	find file in NAME
68CF  191B    :        BCTR,P  CHAINI      	Into CHAIN, to execute it

68D1  0D700E  :        LODA,R0 DBPT,R1
68D4  1908    :        BCTR,P  NFD0        	explicit drive
68D6  0C10D8  :        LODA,R0 WRKD        	default- test work
68D9  ED7006  :        COMA,R0 DRV,R1      	Work drv = current drv?
68DC  9861    :        BCFR,EQ FCMD1       	No, try it

68DE  0C10E5  :NFD0    LODA,R0 ERRH        	test error flag
68E1  1E6A1F  :        BCTA,N  NFDERR      	return to caller
68E4  0719    :NFD     LODI,R3 NOTF-STR    	"File not found"
68E6  3F6EE2  :        BSTA,UN PRCR
68E9  1F6889  :        BCTA,UN ENTERK

              :* Execute entry from command module
68EC  3F6C6C  :CHAINI  BSTA,UN FIRST       	Get first blk
68EF  20      :        EORZ,R0
68F0  CC10CF  :        STRA,R0 ADR+1

68F3  3F6B16  :CHAINL  BSTA,UN GETCH       	hi address
68F6  CC10CE  :        STRA,R0 ADR
68F9  3F6B16  :        BSTA,UN GETCH       	lo address
68FC  C3      :        STRZ,R3
68FD  3F6B16  :        BSTA,UN GETCH       	Block length
6900  C2      :        STRZ,R2
6901  1824    :        BCTR,Z  CXIT
6903  0D1025  :        LODA,R1 PBPT+20     	Use resisters for speed

6906  D907    :MOVE    BIRR,R1 MOV
6908  0520    :        LODI,R1 20
690A  3F6C79  :        BSTA,UN RDNXSC      	get next sector
690D  0502    :        LODI,R1 2           	Skip links only
690F  0DF0DB  :MOV     LODA,R0 *TMP,R1     	Move from buffer
6912  CFF0CE  :        STRA,R0 *ADR,R3
6915  DB07    :        BIRR,R3 IADR
6917  20      :        EORZ,R0
6918  8C30CD  :        ADDA,R0 ADR-1,R0+   	Inc RAM ptr
691B  CC10CE  :        STRA,R0 ADR
691E  FA66    :IADR    BDRR,R2 MOVE        	Repeat [blk len] times

6920  CD1025  :        STRA,R1 PBPT+20     	Save for GETCHs
6923  0520    :        LODI,R1 20          	Start new block
6925  1B4C    :        BCTR,UN CHAINL

6927  9FF0CE  :CXIT    BXA     *ADR,R3     	Yes, autostart
              :* MicroDOS 		PAGE 06
              :* Assign filespec (e.g. LPT: or n:NAME.EXT) to a stream
              :* Spec at *BUFF; stream # in R1
              :* Only R1 saved; 2 subr levels
              :* Clear stream buffer; set IDNT, DRV, DBPT, (CODE non-disc)

692A  20      :ASGN    EORZ,R0
692B  CD2FFF  :AS0     STRA,R0 IDNT-1,R1+
692E  F50F    :        TMI,R1  0F
6930  9879    :        BCFR,EO AS0
6932  4570    :        ANDI,R1 70
6934  0703    :        LODI,R3 3
6936  0FF070  :        LODA,R0 *BUFF,R3    	Check for dev
6939  E43A    :        COMI,R0 A':'
693B  9C698C  :        BCFA,EQ AS1         	No

              :* Parse device pointer
693E  0704    :        LODI,R3 4
6940  0603    :        LODI,R2 3
6942  8503    :        ADDI,R1 3
6944  0ED070  :DPRL    LODA,R0 *BUFF,R2-   	Copy device name
6947  CD5000  :        STRA,R0 IDNT,R1-    	to IDeNT of stream
694A  5A78    :        BRNR,R2 DPRL
694C  0603    :        LODI,R2 3
694E  0ED070  :AS4     LODA,R0 *BUFF,R2-
6951  EE6FDB  :        COMA,R0 DSKD,R2     	Was it DSK: ?
6954  9805    :        BCFR,EQ COD         	No, look it up
6956  5A76    :        BRNR,R2 AS4
6958  1F69B0  :        BCTA,UN AS3         	As before

695B  0600    :COD     LODI,R2 0           	R2 steps thru device table
695D  07FF    :COD2    LODI,R3 -1          	R3 " " dev name
695F  0E6F81  :CODL    LODA,R0 DEVS,R2     	Lookup table
6962  1A11    :        BCTR,N  ERRD        	End of table if neg
6964  EFB070  :        COMA,R0 *BUFF,R3+
6967  9806    :        BCFR,EQ NEQ         	Not =, try next dev
6969  F601    :        TMI,R2  1
696B  180D    :        BCTR,EQ CODI        	Done if 2 chars match
696D  DA70    :        BIRR,R2 CODL
696F  8604    :NEQ     ADDI,R2 4
6971  467C    :        ANDI,R2 7C          	Put to 4byte bdry
6973  1B68    :        BCTR,UN COD2

6975  0455    :ERRD    LODI,R0 A'U'        	U error - Unknown device
6977  1F6DC0  :        BCTA,UN ERRM

697A  0E2F81  :CODI    LODA,R0 DEVS,R2+    	Get srvce routine addr
697D  CD7003  :        STRA,R0 CODE,R1     	Store in stream info
6980  0E2F81  :        LODA,R0 DEVS,R2+
6983  CD7004  :        STRA,R0 CODE+1,R1
6986  04FF    :        LODI,R0 -1
6988  CD7006  :        STRA,R0 DRV,R1      	Flag as non disk
698B  17      :        RETC,UN             	Flag as non disk

698C  06FF    :AS1     LODI,R2 -1
698E  0E2FDB  :AS2     LODA,R0 DSKD,R2+    	No! default to DSK:
6991  CD2FFF  :        STRA,R0 IDNT-1,R1+
6994  FB78    :        BDRR,R3 AS2
6996  4570    :        ANDI,R1 70          	Restore R1
              :* MicroDOS	PAGE 07
6998  0C10D8  :        LODA,R0 WRKD        	Default use work drive
              :* Assign drive R0 or explicitly specified drive
699B  07FF    :ASDRV   LODI,R3 -1
699D  CD7006  :        STRA,R0 DRV,R1      	set default drive
69A0  0C9070  :        LODA,R0 *BUFF
69A3  A431    :        SUBI,R0 A'1'        	test drive no
69A5  1A09    :        BCTR,N  AS3         	No
69A7  E403    :        COMI,R0 3
69A9  1905    :        BCTR,GT AS3         	No
69AB  0701    :        LODI,R3 1           	skip digit,dot
69AD  CD7006  :        STRA,R0 DRV,R1
69B0  03      :AS3     LODZ,R3
69B1  CD700E  :        STRA,R0 DBPT,R1     	pointer to file spec.

              :* Parse name into buffer
69B4  070D    :ASNAME  LODI,R3 0D
69B6  20      :TTT     EORZ,R0
69B7  CF5063  :        STRA,R0 NAME,R3-    	clear name scratch
69BA  5B7A    :        BRNR,R3 TTT
69BC  0D700E  :        LODA,R0 DBPT,R1
69BF  C3      :        STRZ,R3             	R3 steps thru name at *BUFF
              :* Subr to parse filespec
69C0  06FF    :PSN     LODI,R2 -1
69C2  3B3D    :PSN1    BSTR,UN GETSEP      	get next char of spec
69C4  182F    :        BCTR,EQ PSED        	Default extn
69C6  E42E    :        COMI,R0 A'.'        	End of name?
69C8  1818    :        BCTR,EQ PSE         	Parse extension
69CA  E609    :        COMI,R2 9
69CC  1874    :        BCTR,EQ PSN1        	already got 10
69CE  E42A    :        COMI,R0 A'*'
69D0  1805    :        BCTR,EQ PSN2
69D2  CE3063  :        STRA,R0 NAME,R2+    	store char in name buffer
69D5  1B6B    :        BCTR,UN PSN1
69D7  043F    :PSN2    LODI,R0 A'?'        	Replace * by ?
69D9  CE3063  :PSN3    STRA,R0 NAME,R2+    	store char in name buffer
69DC  E609    :        COMI,R2 9
69DE  9879    :        BCFR,EQ PSN3
69E0  1B60    :        BCTR,UN PSN1

69E2  06FF    :PSE     LODI,R2 -1
69E4  3B1B    :PSE1    BSTR,UN GETSEP      	set next char of spec
69E6  1818    :        BCTR,EQ PSEND       	seperator found
69E8  E602    :        COMI,R2 2
69EA  1814    :        BCTR,EQ PSEND       	already sot
69EC  E42A    :        COMI,R0 A'*'
69EE  1807    :        BCTR,EQ PSE2
69F0  CE306D  :        STRA,R0 EXTN,R2+    	store char in extension buffer
69F3  1B6F    :        BCTR,UN PSE1
              :* Default extension
69F5  06FF    :PSED    LODI,R2 -1
69F7  043F    :PSE2    LODI,R0 A'?'        	Replace * by ?
69F9  CE306D  :PSE3    STRA,R0 EXTN,R2+    	store char in extension buffer
69FC  E602    :        COMI,R2 2
69FE  9879    :        BCFR,EQ PSE3
6A00  17      :PSEND   RETC,UN
              :* Get char ; test if seperator
6A01  0FB070  :GETSEP  LODA,R0 *BUFF,R3+
6A04  E461    :        COMI,R0 A'a'
              :* MicroDOS	PAGE 08
6A06  1A02    :        BCTR,LT $+4         	Conv to upper case
6A08  445F    :        ANDI,R0 5F
6A0A  E40D    :        COMI,R0 CR
6A0C  14      :        RETC,EQ
6A0D  E42C    :        COMI,R0 A','
6A0F  14      :        RETC,EQ
6A10  E43D    :        COMI,R0 A'='
6A12  14      :        RETC,EQ
6A13  E420    :        COMI,R0 SPAC
6A15  17      :        RETC,UN
              :* MicroDOS	PAGE 09
              :* Open a file for read
              :* Name is at *BUFF; use stream in R1
              :* Saves RI-R3 subr levels

6A16  3F6D6B  :OPNR    BSTA,UN FIND        	Look it up
6A19  1911    :        BCTR,P  S1          	found
6A1B  181C    :        BCTR,Z  RT          	Return if non-disk
6A1D  D81A    :        BIRR,R0 RT          	error return
6A1F  044E    :NFDERR  LODI,R0 A'N'        	N error - File does Not exist
6A21  3B16    :        BSTR,UN RT          	restore resisters
6A23  1F6DC0  :        BCTA,UN ERRM

              :*Open after successful FIND
6A26  CE10D2  :OPNRF   STRA,R2 SR2         	Save R2,R3
6A29  CF10D3  :        STRA,R3 SR3

6A2C  046B    :S1      LODI,R0 <GETCH
6A2E  CD7003  :        STRA,R0 CODE,R1     	Srvce, rtne is GETCH
6A31  0416    :        LODI,R0 >GETCH
6A33  CD7004  :        STRA,R0 CODE+1,R1

6A36  3F6C6C  :        BSTA,UN FIRST       	Get first sector to buffer

6A39  0E10D2  :RT      LODA,R2 SR2         	Restore regs:
6A3C  0F10D3  :        LODA,R3 SR3
6A3F  60      :        IORZ,R0             	set CC
6A40  17      :        RETC,UN

              :* Open a file for write
              :* Can't open more than 1 file for write
              :* Name at *BUFF; str # in R1
              :* Saves R1-R3; 4 subr levels

6A41  3F6D6B  :OPNW    BSTA,UN FIND        	Check if already exists
6A44  1906    :        BCTR,P  OPREM       	exists
6A46  E4FF    :        COMI,R0 -1
6A48  1809    :        BCTR,EQ OP1         	doesn' t exist
6A4A  1B6D    :        BCTR,UN RT          	non-disk or error

              :* File already exists - remove
6A4C  0704    :OPREM   LODI,R3 4           	remove flag
6A4E  3F6BAA  :        BSTA,UN REMENT
6A51  1A66    :        BCTR,N  RT

6A53  046A    :OP1     LODI,R0 <PUTCH      	Service routine iS PUTCH
6A55  CD7003  :        STRA,R0 CODE,R1
6A58  04D9    :        LODI,R0 >PUTCH
6A5A  CD7004  :        STRA,R0 CODE+1,R1
6A5D  3F6C66  :        BSTA,UN STDR        	St of d i r
6A60  1A25    :        BCTR,N  WRT2        	disc error
6A62  0702    :        LODI,R3 2
6A64  0FF0DB  :        LODA,R0 *TMP,R3     	freeIist - track
6A67  CC10CE  :        STRA,R0 ADR         	Save start of freeIist
6A6A  9A06    :        BCFR,N  OP2         	valid track
6A6C  DC6C62  :        BIRA,R0 WPE         	unclosed write on disc
6A6F  1F6D0A  :        BCTA,UN FERR        	disc full

              :* MicroDOS	PAGE 10
6A72  6480    :OP2     IORI,R0 80          	flag write
6A74  CFF0DB  :        STRA,R0 *TMP,R3
6A77  0FB0DB  :        LODA,R0 *TMP,R3+    	freelist - sector
6A7A  CC10CF  :        STRA,R0 ADR+1
6A7D  3F6C0B  :        BSTA,UN WRSC        	Rewrite identity block
6A80  1A05    :        BCTR,N  WRT2        	disc error

              :*Search for free directory entry
6A82  07F8    :        LODI,R3 10-18       	"Zeroth" entry
6A84  3F6D52  :OP3     BSTA,UN DIRF        	Move forward 1 dir entry
6A87  1E6ACC  :WRT2    BCTA,N  WRT1        	disc error
6A8A  0FF0DB  :        LODA,R0 *TMP,R3
6A8D  1975    :        BCTR,P  OP3

              :*Construct new directory entry in DENT
6A8F  20      :        EORZ,R0
6A90  0618    :        LODI,R2 18
6A92  CE50B6  :ZDEN    STRA,R0 DENT,R2-
6A95  5A7B    :        BRNR,R2 ZDEN

6A97  060D    :        LODI,R2 0D
6A99  0E5063  :TFNAM   LODA,R0 NAME,R2-
6A9C  CE70B6  :        STRA,R0 DENT,R2     	Put in name and ext
6A9F  5A78    :        BRNR,R2 TFNAM

6AA1  0702    :        LODI,R3 2
6AA3  0F50CE  :OP5     LODA,R0 ADR,R3-     	Transfer start of file
6AA6  CF70C3  :        STRA,R0 DENT+0D,R3
6AA9  5B78    :        BRNR,R3 OP5
6AAB  0C10FC  :        LODA,R0 DATV        	Date valid?
6AAE  D80A    :        BIRR,R0 NDAT        	No
6AB0  0703    :        LODI,R3 3
6AB2  0F50FD  :WDAT    LODA,R0 DATE,R3-    	Transfer date
6AB5  CF70CB  :        STRA,R0 DENT+15,R3
6AB8  5B78    :        BRNR,R3 WDAT

              :* Transfer DENT to directory buffer
6ABA  0618    :NDAT    LODI,R2 18
6ABC  0D700A  :        LODA,R0 DBYT,R1
6ABF  82      :        ADDZ,R2
6AC0  C3      :        STRZ,R3
6AC1  0E50B6  :WDIR    LODA,R0 DENT,R2-
6AC4  CFD0DB  :        STRA,R0 *TMP,R3-
6AC7  5A78    :        BRNR,R2 WDIR

6AC9  3F6C0B  :        BSTA,UN WRSC        	Move buffer to floppy
6ACC  1A08    :WRT1    BCTR,N  WRT         	disc error
6ACE  0401    :        LODI,R0 1
6AD0  CD700C  :        STRA,R0 LLEN,R1     	Length=l
6AD3  3F6C6C  :        BSTA,UN FIRST       	Read first sector
6AD6  1F6A39  :WRT     BCTA,UN RT          	Restore R2113, return
              :* MicroDOS	PAGE 11
              :* Put one byte to a file opened for write
              :* Byte is in R0: R1 has str #
              :* Saves R0-R3; 3 subr levels if disk

6AD9  CF10D3  :PUTCH   STRA,R3 SR3         	Save R3
6ADC  CC10D2  :        STRA,R0 SR0         	Save R0
6ADF  0D7005  :        LODA,R0 PBPT,R1     	Get buf ptr
6AE2  D81A    :        BIRR,R0 PEND
6AE4  0D700C  :        LODA,R0 LLEN,R1     	Increment length
6AE7  D809    :        BIRR,R0 PUT0
6AE9  0D700B  :        LODA,R0 HLEN,R1
6AEC  8401    :        ADDI,R0 1
6AEE  CD700B  :        STRA,R0 HLEN,R1
6AF1  20      :        EORZ,R0
6AF2  CD700C  :PUT0    STRA,R0 LLEN,R1
6AF5  3F6C0B  :        BSTA,UN WRSC        	Write current buffer
6AF8  3C6C79  :        BSTA,EQ RDNXSC      	Read next to, set Iinks
6AFB  16      :        RETC,N              	Read next to, set Iinks
6AFC  0402    :        LODI,R0 2
6AFE  CD7005  :PEND    STRA,R0 PBPT,R1
6B01  C3      :        STRZ,R3
6B02  3B0B    :        BSTR,UN STMP
6B04  0C10D2  :        LODA,R0 SR0         	Get char
6B07  CFF0DB  :        STRA,R0 *TMP,R3     	Store it
6B0A  0F10D3  :        LODA,R3 SR3
6B0D  E0      :        COMZ,R0             	CC =
6B0E  17      :        RETC,UN

6B0F  0D700F  :STMP    LODA,R0 HBUF,R1     	Get approp bUF ptr
6B12  CC10DB  :        STRA,R0 TMP         	Save
6B15  17      :        RETC,UN

              :* Get one bYte from file opened for read or write
              :* Returns byte in R0; Strm # must be in R1
              :* Saves RI-R3; 3 subr levels if disk

6B16  3B77    :GETCH   BSTR,UN STMP        	Setup tyuff ptr
6B18  0D7005  :        LODA,R0 PBPT,R1     	Prog Buf PTr
6B1B  D806    :        BIRR,R0 HERE
6B1D  3F6C79  :        BSTA,UN RDNXSC      	Get next sector
6B20  16      :        RETC,N              	Get next sector
6B21  0402    :        LODI,R0 2           	Skip links
6B23  CD7005  :HERE    STRA,R0 PBPT,R1
6B26  0CF0DB  :        LODA,R0 *TMP,R0     	Get char
6B29  E0      :        COMZ,R0             	Get char
6B2A  17      :        RETC,UN
              :* MicroDOS	PAGE 12
              :* Close a file that was opened for write
              :* Only R1 saved; 3 subr levels if disk

6B2B  0D700B  :CLSW    LODA,R0 HLEN,R1     	length written
6B2E  6D700C  :        IORA,R0 LLEN,R1
6B31  1C6BA3  :        BCTA,Z  CLSR        	File not t open for r write
6B34  3B59    :        BSTR,UN STMP        	Setup buff ptr

6B36  8502    :        ADDI,R1 2
6B38  0602    :        LODI,R2 2
6B3A  0D5007  :CLS1    LODA,R0 TRK,R1-
6B3D  CE50CE  :        STRA,R0 DENP,R2-    	Trk,sec of last block
6B40  0EF0DB  :        LODA,R0 *TMP,R2
6B43  CE70D0  :        STRA,R0 DENP+2,R2   	Trk,sec of following block
6B46  5A72    :        BRNR,R2 CLS1

6B48  04FF    :        LODI,R0 -1
6B4A  CC90DB  :        STRA,R0 *TMP        	Put end of file to last sector
6B4D  3F6C0B  :        BSTA,UN WRSC        	Write last block
6B50  16      :        RETC,N              	Write last block
6B51  0D7006  :        LODA,R0 DRV,R1
6B54  1E6BA3  :        BCTA,N  CLSR        	Exit if nondisk

              :* Update disc identity block
6B57  3F6C66  :        BSTA,UN STDR
6B5A  16      :        RETC,N              	disc error
6B5B  0704    :        LODI,R3 4
6B5D  0608    :        LODI,R2 8
6B5F  8502    :        ADDI,R1 2
6B61  7709    :        PPSL    WC+CAR
6B63  0F50CE  :CLS2    LODA,R0 DENP,R3-    	TrK, sec of following
6B66  CFF0DB  :        STRA,R0 *TMP,R3     	Update start of freelist
6B69  0ED0DB  :        LODA,R0 *TMP,R2-    	Old length
6B6C  AD500B  :        SUBA,R0 HLEN,R1-    	length written,
6B6F  CEF0DB  :        STRA,R0 *TMP,R2     	new length
6B72  F501    :        TMI,R1  1
6B74  186D    :        BCTR,EQ CLS2
6B76  7508    :        CPSL    WC
6B78  3F6C0B  :        BSTA,UN WRSC        	Put to disk
6B7B  16      :        RETC,N              	Put to disk

              :* Update directory entry
6B7C  0D7009  :        LODA,R0 DSEC,R1     	directory sector
6B7F  3F6C86  :        BSTA,UN SSEC        	Get incomplete file dir
6B82  16      :        RETC,N              	Get incomplete file dir
6B83  0D700A  :        LODA,R0 DBYT,R1     	directory byte
6B86  8414    :        ADDI,R0 0A+3+7      	Skip name, ext, start
6B88  C3      :        STRZ,R3
6B89  0603    :        LODI,R2 3
6B8B  8503    :        ADDI,R1 3
6B8D  0D500B  :CLS3    LODA,R0 HLEN,R1-    	Move length, type
6B90  CFD0DB  :        STRA,R0 *TMP,R3-
6B93  FA78    :        BDRR,R2 CLS3
6B95  0602    :        LODI,R2 2
6B97  0E50CE  :CLS4    LODA,R0 DENP,R2-    	Move last trk,sec.
6B9A  CFD0DB  :        STRA,R0 *TMP,R3-
6B9D  5A78    :        BRNR,R2 CLS4
6B9F  3F6C0B  :        BSTA,UN WRSC        	Write completed dir
              :* MicroDOS	PAGE 13
6BA2  16      :        RETC,N              	Write completed dir

              :* Close file opened for read

6BA3  20      :CLSR    EORZ,R0
6BA4  CD7000  :        STRA,R0 IDNT,R1     	Close stream
6BA7  17      :        RETC,UN

              :* Delete directory entry just found
              :* Only R1 saved; 3 subr levels
              :* CAUTION - doesn't check for open file yet!!

6BA8  0706    :DELENT  LODI,R3 6           	delete flag
6BAA  0D700A  :REMENT  LODA,R0 DBYT,R1     	Directory byte
6BAD  C2      :        STRZ,R2
6BAE  20      :        EORZ,R0
6BAF  CEF0DB  :        STRA,R0 *TMP,R2     	zero first char of name
6BB2  3F6C0B  :        BSTA,UN WRSC        	rewrite directory sector
6BB5  16      :        RETC,N              	rewrite directory sector
6BB6  3F6C66  :        BSTA,UN STDR        	Get identity block
6BB9  16      :        RETC,N              	Get identity block

6BBA  0606    :        LODI,R2 6
6BBC  0EF0DB  :        LODA,R0 *TMP,R2
6BBF  6EB0DB  :        IORA,R0 *TMP,R2+    	Test 0 length
6BC2  9804    :        BCFR,Z  LEN0
              :* Freelist length 0; file becomes freelist
6BC4  0706    :        LODI,R3 6
6BC6  3B30    :        BSTR,UN SWAP        	Interchange end
6BC8  3B2E    :LEN0    BSTR,UN SWAP        	Interchange start or end

              :* Add length of deleted file to freelist length
6BCA  0608    :        LODI,R2 8
6BCC  0ED0DB  :ADL     LODA,R0 *TMP,R2-    	freelist length
6BCF  8E70C1  :        ADDA,R0 DENT+0B,R2  	file length
6BD2  CEF0DB  :        STRA,R0 *TMP,R2
6BD5  7708    :        PPSL    WC
6BD7  F601    :        TMI,R2  1
6BD9  1871    :        BCTR,EQ ADL
6BDB  7508    :        CPSL    WC
6BDD  3B2C    :        BSTR,UN WRSC        	rewrite identity block
6BDF  16      :        RETC,N              	rewrite identity block

              :* Relink end sector to start sector
6BE0  0E10C5  :        LODA,R2 DENT+0A+05
6BE3  0F10C6  :        LODA,R3 DENT+0A+06
6BE6  3F6C72  :        BSTA,UN RDS1        	Get end sector
6BE9  16      :        RETC,N              	Get end sector
6BEA  0702    :        LODI,R3 2
6BEC  0F50C3  :RLNK    LODA,R0 DENT+0A+03,R3-	Start (link)
6BEF  CFF0DB  :        STRA,R0 *TMP,R3
6BF2  5B78    :        BRNR,R3 RLNK
6BF4  9A15    :        BCFR,N  WRSC        	rewrite last sector
6BF6  E0      :        COMZ,R0
6BF7  17      :        RETC,UN
              :* MicroDOS	PAGE 14
              :* Swap start or end sectors in freelist and DENT
6BF8  0FD0DB  :SWAP    LODA,R0 *TMP,R3-
6BFB  C2      :        STRZ,R2
6BFC  0F70C1  :        LODA,R0 DENT+0B,R3
6BFF  CFF0DB  :        STRA,R0 *TMP,R3
6C02  02      :        LODZ,R2
6C03  CF70C1  :        STRA,R0 DENT+0B,R3
6C06  F701    :        TMI,R3  1
6C08  186E    :        BCTR,EQ SWAP
6C0A  17      :        RETC,UN
              :* MicroDOS	PAGE 15
              :* Write a sector from buffer to disk
              :* Saves R1-R3; 2 subr levels if disk, or M+1 subr levels
              :* if non-disk.

6C0B  3F6CCD  :WRSC    BSTA,UN INIT
6C0E  1E6EFC  :        BCTA,N  WRND        	Non disk

6C11  3F6CF6  :        BSTA,UN SK
6C14  1A37    :        BCTR,N  WRTN        	disc error
6C16  0603    :        LODI,R2 RETRYC
6C18  CE10D4  :NWPA    STRA,R2 RTYCNT
6C1B  04AC    :        LODI,R0 0AC         	- Write sector command
6C1D  D40C    :        WRTE,R0 FDCMD
6C1F  5410    :        REDE,R0 FDINT
6C21  9A7C    :        BCFR,N  $-2         	wait for DRQ or INTERUPT
6C23  540C    :        REDE,R0 FDCMD
6C25  F440    :        TMI,R0  WPRT        	Check wrt Prot bit
6C27  1839    :        BCTR,EQ WPE
6C29  4498    :        ANDI,R0 NREADY+RNF+CRC
6C2B  9823    :        BCFR,Z  WERR        	write error
6C2D  0FF0DB  :L5      LODA,R0 *TMP,R3     	Get from buffer
6C30  5610    :        REDE,R2 FDINT
6C32  9A7C    :        BCFR,N  $-2         	wait for DRQ
6C34  D40F    :        WRTE,R0 FDDAT       	Into data reg
6C36  DB75    :        BIRR,R3 L5
6C38  540C    :WWAIT   REDE,R0 FDCMD
6C3A  F401    :        TMI,R0  BUSY
6C3C  987A    :        BCFR,EQ WWAIT
6C3E  4414    :        ANDI,R0 RNF+LSD
6C40  980E    :        BCFR,Z  WERR        	write error
              :* Check CRC of sector just written
6C42  048C    :        LODI,R0 8C          	Read sector command
6C44  D40C    :        WRTE,R0 FDCMD
6C46  3F6CC1  :        BSTA,UN WBSDD       	Wait for 1771 to interrupt out
6C49  4418    :        ANDI,R0 CRC+RNF
6C4B  9803    :        BCFR,Z  WERR        	write error
6C4D  7510    :WRTN    CPSL    RS
6C4F  17      :        RETC,UN

6C50  F410    :WERR    TMI,R0  RNF         	Record not found?
6C52  3C6D30  :        BSTA,EQ RESEEK
6C55  1A76    :        BCTR,N  WRTN        	disc error
6C57  0E10D4  :        LODA,R2 RTYCNT
6C5A  FE6C18  :        BDRA,R2 NWPA        	try again
6C5D  0657    :        LODI,R2 A'W'        	Write error
6C5F  1F6DBC  :WRR     BCTA,UN ERR

6C62  0650    :WPE     LODI,R2 A'P'        	Write protected
6C64  1B79    :        BCTR,UN WRR
              :* MicroDOS	PAGE 16
              :* Move to start of directory
              :* Saves R1-R3; 2 subr levels
6C66  20      :STDR    EORZ,R0
6C67  CD7007  :        STRA,R0 TRK,R1      	Track 0
6C6A  D81A    :        BIRR,R0 SSEC        	sector 1

              :* Get first sector of found  file to buffer
6C6C  0E10C3  :FIRST   LODA,R2 DENT+0D     	Start track
6C6F  0F10C4  :        LODA,R3 DENT+0D+1   	St sec

              :* Move to Track R2, Sector R3
6C72  02      :RDS1    LODZ,R2
6C73  CD7007  :        STRA,R0 TRK,R1
6C76  03      :        LODZ,R3
6C77  1B0D    :        BCTR,UN SSEC        	Get this sector

              :* Read next sector
              :* Saves R1-R3; 2 subr levels
6C79  3F6B0F  :RDNXSC  BSTA,UN STMP        	Setup buff ptr
6C7C  0C90DB  :        LODA,R0 *TMP        	Trk,Sec of next block
6C7F  CD7007  :        STRA,R0 TRK,R1
6C82  20      :        EORZ,R0
6C83  0CB0DB  :        LODA,R0 *TMP,R0+
6C86  CD7008  :SSEC    STRA,R0 SEC,R1

6C89  0401    :        LODI,R0 1
6C8B  CD7005  :        STRA,R0 PBPT,R1     	Skip links

              :* Read one e sector from disk to buffer
              :* Saves R1-R3; 2 subr levels if disk, or M+1 subr
              :* levels if non-disk, where M is levels of service rtne

6C8E  3F6CCD  :RDSC    BSTA,UN INIT
6C91  1E6EEE  :        BCTA,N  RDND        	If non dsk
6C94  3F6CF6  :        BSTA,UN SK          	Seek correct track
6C97  1A25    :        BCTR,N  RRTN        	disk error
6C99  0603    :        LODI,R2 RETRYC
6C9B  048C    :RDL     LODI,R0 8C          	Read sector command
6C9D  D40C    :        WRTE,R0 FDCMD
6C9F  5410    :L4      REDE,R0 FDINT       	DRQ?
6CA1  9A7C    :        BCFR,N  L4
6CA3  540F    :        REDE,R0 FDDAT       	Move from data reg
6CA5  CFF0DB  :        STRA,R0 *TMP,R3     	into approp buffer
6CA8  DB75    :        BIRR,R3 L4
6CAA  3B1A    :        BSTR,UN WBSY
6CAC  441C    :        ANDI,R0 RNF+CRC+LSD
6CAE  180E    :        BCTR,Z  RRTN
6CB0  F410    :        TMI,R0  RNF         	Record not found?
6CB2  3C6D30  :        BSTA,EQ RESEEK
6CB5  1A07    :        BCTR,N  RRTN        	disc error
6CB7  FA62    :        BDRR,R2 RDL         	Retry
6CB9  0652    :        LODI,R2 A'R'
6CBB  1F6DBC  :        BCTA,UN ERR         	Read error

6CBE  7510    :RRTN    CPSL    RS
6CC0  17      :        RETC,UN
              :* MicroDOS		PAGE 17
6CC1  08FE    :WBSDD   LODR,R0 *$          	Super delay entry
6CC3  C0      :        NOP                 	Super delay entry
6CC4  1B05    :        BCTR,UN WBSD

              :* Wait for drive not

6CC6  540C    :WBSY    REDE,R0 FDCMD
6CC8  F401    :        TMI,R0  BUSY
6CCA  16      :        RETC,NE
6CCB  1B79    :WBSD    BCTR,UN WBSY        	Delay entry

6CCD  01      :INIT    LODZ,R1
6CCE  7710    :        PPSL    RS
6CD0  C1      :        STRZ,R1             	Save stream index
6CD1  0D700F  :        LODA,R0 HBUF,R1
6CD4  CC10DB  :        STRA,R0 TMP
6CD7  0D7006  :        LODA,R0 DRV,R1
6CDA  16      :        RETC,N

              :* Select drive given in R0 on str R1
              :* Saves R1; 1 subr level

6CDB  0F10D5  :DRIVE   LODA,R3 CDRV        	Current drive
6CDE  D410    :        WRTE,R0 FDINT       	Select side, drive
6CE0  4403    :        ANDI,R0 3           	Isolate drive
6CE2  CD7006  :        STRA,R0 DRV,R1
6CE5  CC10D5  :        STRA,R0 CDRV        	Save drive
6CE8  E3      :        COMZ,R3             	Save drive
6CE9  14      :        RETC,EQ             	Save drive
6CEA  C2      :        STRZ,R2
6CEB  540D    :        REDE,R0 FDTRK       	Current track
6CED  CF70B2  :        STRA,R0 TRK1,R3     	Save it
6CF0  0E70B2  :        LODA,R0 TRK1,R2
6CF3  D40D    :        WRTE,R0 FDTRK       	tO FD1771
6CF5  17      :        RETC,UN
              :* MicroDOS		PAGE 18
              :* Seek to requested track
6CF6  0714    :SK      LODI,R3 D'20'
6CF8  540C    :        REDE,R0 FDCMD
6CFA  4420    :        ANDI,R0 HDENG
6CFC  1807    :        BCTR,Z  SKHLD       	head not loaded
6CFE  540D    :        REDE,R0 FDTRK
6D00  ED7007  :        COMA,R0 TRK,R1      	Already on read trek?
6D03  1813    :        BCTR,EQ SRDY        	Yes, no seek
6D05  0D7007  :SKHLD   LODA,R0 TRK,R1
6D08  9A04    :        BCFR,N  SKOK
6D0A  0646    :FERR    LODI,R2 A'F'        	F error- disk
6D0C  1B18    :        BCTR,UN CERR        	or dir full
6D0E  D40F    :SKOK    WRTE,R0 FDDAT       	Track
6D10  041B    :        LODI,R0 18+TTD      	Seek with HLD
6D12  D40C    :        WRTE,R0 FDCMD
6D14  5410    :W1      REDE,R0 FDINT
6D16  9A7C    :        BCFR,N  W1
              :*Wait for drive ready
              :*Loop for 100 mSec
6D18  0655    :SRDY    LODI,R2 D'85'
              :*Inner loop 1mSec
6D1A  540C    :SRDY1   REDE,R0 FDCMD       	wait for drive ready
6D1C  9A0A    :        BCFR,N  SKD
6D1E  F87E    :        BDRR,R0 $
6D20  FA78    :        BDRR,R2 SRDY1
6D22  FB61    :        BDRR,R3 SKHLD       	seek to Keep head loaded
              :*Drive not ready after 2 Sec
6D24  0644    :        LODI,R2 A'D'        	Drive Not ready error
6D26  1B27    :CERR    BCTR,UN IERR

6D28  0D7008  :SKD     LODA,R0 SEC,R1
6D2B  D40E    :        WRTE,R0 FDSEC       	Write sector reg
6D2D  0700    :        LODI,R3 0
6D2F  17      :        RETC,UN

6D30  0703    :RESEEK  LODI,R3 RETRYC
6D32  040B    :        LODI,R0 08+TTD
6D34  D40C    :        WRTE,R0 FDCMD       	restore
6D36  5410    :W2      REDE,R0 FDINT
6D38  9A7C    :        BCFR,N  W2
6D3A  0D7007  :        LODA,R0 TRK,R1
6D3D  D40F    :        WRTE,R0 FDDAT       	Track
6D3F  041F    :        LODI,R0 1C+TTD      	Seek with HLD and Ver
6D41  D40C    :        WRTE,R0 FDCMD
6D43  5410    :W3      REDE,R0 FDINT
6D45  9A7C    :        BCFR,N  W3
6D47  540C    :        REDE,R0 FDCMD
6D49  F410    :        TMI,R0  RNF         	Seek error?
6D4B  985B    :        BCFR,EQ SKD
6D4D  0653    :        LODI,R2 A'S'        	Seek error - can't find track
6D4F  1F6DBC  :IERR    BCTA,UN ERR
              :* MicroDOS		PAGE 19
6D52  8718    :DIRF    ADDI,R3 18          	Advance 1 dir entry
6D54  0D7008  :        LODA,R0 SEC,R1      	directory sector
6D57  5B09    :        BRNR,R3 DIR2
6D59  8401    :        ADDI,R0 1           	next directory sector
6D5B  0710    :        LODI,R3 10          	All start at byte 10
6D5D  3B03    :        BSTR,UN DIR2        	Save directory location
6D5F  1F6C79  :        BCTA,UN RDNXSC      	Load next sector of dir

6D62  CD7009  :DIR2    STRA,R0 DSEC,R1     	Save directory sector
6D65  03      :        LODZ,R3
6D66  CD700A  :        STRA,R0 DBYT,R1     	Start of directory entry
6D69  E0      :        COMZ,R0             	Start of directory entry
6D6A  17      :        RETC,UN

              :* Find first file satisfying a spec at *BUFF
              :* Only R1 preserved; 3 subr levels
              :* Returns R0 := 0 non-disc; -1 not found; 1 found

6D6B  CE10D2  :FIND    STRA,R2 SR2         	Save R2,R3
6D6E  CF10D3  :        STRA,R3 SR3
6D71  3F692A  :        BSTA,UN ASGN        	set name from *BUFF to NAME
6D74  0D7006  :        LODA,R0 DRV,R1
6D77  A4FF    :        SUBI,R0 -1          	if not disk,
6D79  14      :        RETC,Z              	if not disk,
6D7A  3F6C66  :FIND1   BSTA,UN STDR
6D7D  16      :        RETC,N              	disc error
6D7E  07F8    :        LODI,R3 10-18
6D80  1B0E    :        BCTR,UN GDEN:

              :* Find next file satisfying a wildcard spec
              :* Only R1 Preserved; 3 subr levels
              :* Returns R0 := -1 non-disc or not found; 1 found

6D82  0D7006  :FNEXT   LODA,R0 DRV,R1      	Not found if
6D85  16      :        RETC,N              	Not found if
6D86  3F6B0F  :        BSTA,UN STMP        	Setup TMP
6D89  3F69B4  :        BSTA,UN ASNAME      	set name from *BUFF to NAME

6D8C  0D700A  :FNX     LODA,R0 DBYT,R1     	last directory byte
6D8F  C3      :        STRZ,R3

              :* Get next non-deleted directory entry
6D90  3F6D52  :GDEN    BSTA,UN DIRF        	Skip whole entry if null
6D93  16      :        RETC,N              	Skip whole entry if null
6D94  0FF0DB  :        LODA,R0 *TMP,R3     	Look at 1st char of name
6D97  16      :        RETC,N              	Look at 1st char of name
6D98  1876    :        BCTR,Z  GDEN        	deleted entry
              :* Copy directory entry to DENT
6D9A  06FF    :        LODI,R2 -1
6D9C  A701    :        SUBI,R3 1
6D9E  0FB0DB  :GDL     LODA,R0 *TMP,R3+    	COPY from buffer
6DA1  CE30B6  :        STRA,R0 DENT,R2+    	to DENT
6DA4  E617    :        COMI,R2 18-1
6DA6  9876    :        BCFR,EQ GDL
              :* Compare with NAME
6DA8  060D    :        LODI,R2 0D
6DAA  0E5063  :COMPAR  LODA,R0 NAME,R2-
              :* MicroDOS		PAGE 20
6DAD  E43F    :        COMI,R0 A'?'
6DAF  1806    :        BCTR,EQ MATCH
6DB1  EE70B6  :        COMA,R0 DENT,R2
6DB4  9C6D8C  :        BCFA,E8 FNX         	no match
6DB7  5A71    :MATCH   BRNR,R2 COMPAR
6DB9  0401    :        LODI,R0 1           	Flag as found
6DBB  17      :        RETC,UN
              :* MicroDOS		PAGE 21
              :* Error handling routine
6DBC  CC10E4  :ERR     STRA,R0 ERR17       	1771 Status
6DBF  02      :        LODZ,R2
6DC0  CC10E0  :ERRM    STRA,R0 ERRTYP
6DC3  7518    :        CPSL    RS+WC
6DC5  CD10E1  :        STRA,R1 ERRSTR      	Error stream
6DC8  0D7006  :        LODA,R0 DRV,R1      	Save drive #
6DCB  CC10DF  :        STRA,R0 ERRDR
6DCE  0D7007  :        LODA,R0 TRK,R1      	Save track
6DD1  CC10E2  :        STRA,R0 ERRTRK
6DD4  0D7008  :        LODA,R0 SEC,R1      	Save sector
6DD7  CC10E3  :        STRA,R0 ERRSEC
6DDA  0C10E5  :        LODA,R0 ERRH
6DDD  4480    :        ANDI,R0 80          	force 80 error code
6DDF  16      :        RETC,N              	force 80 error code
6DE0  5903    :        BRNR,R1 ERRP        	Error not on stream 0
6DE2  3F686E  :        BSTA,UN VDU0        	Setup VDU stream 0
6DE5  040B    :ERRP    LODI,R0 8+TTD       	Restore
6DE7  D40C    :        WRTE,R0 FD1771
6DE9  072B    :        LODI,R3 ERRMSG-STR
6DEB  3F6EE2  :        BSTA,UN PRCR
6DEE  0C10E0  :        LODA,R0 ERRTYP
6DF1  3F6EBF  :        BSTA,UN IO
6DF4  1F6889  :        BCTA,UN ENTERK      	to command level

              :* Print filename from DENT (Directory ENTry)
              :* Use str in R1 (can write to disk, etc)
              :* Saves R1,R2; M+1 subr levels

6DF7  07FF    :PNAM    LODI,R3 -1
6DF9  0F30B6  :PNAM2   LODA,R0 DENT,R3+
6DFC  1803    :        BCTR,Z  CPN
6DFE  3F6EBF  :        BSTA,UN IO
6E01  E709    :CPN     COMI,R3 0A-1
6E03  9805    :        BCFR,EQ $+7
6E05  042E    :        LODI,R0 A'.'
6E07  3F6EBF  :        BSTA,UN IO
6E0A  E70C    :        COMI,R3 0D-1
6E0C  986B    :        BCFR,EQ PNAM2
6E0E  17      :        RETC,UN
              :* MicroDOS		PAGE 22
              :* Print R2R3 as decimal to stream R1
              :* R2R3 NOT preserved; M+2 subr levels
6E0F  CD10D3  :DOUT    STRA,R1 SAVE        	Save stream no.
6E12  0500    :        LODI,R1 0           	Hundreds
6E14  770B    :        PPSL    WC+CAR+LCOM
6E16  02      :LP1     LODZ,R2
6E17  9804    :        BCFR,Z  D1
6E19  E764    :        COMI,R3 D'100'
6E1B  1A06    :        BCTR,LT P1
6E1D  A764    :D1      SUBI,R3 D'100'      	Subt dec 100
6E1F  A600    :        SUBI,R2 0
6E21  D973    :        BIRR,R1 LP1
6E23  7508    :P1      CPSL    WC
6E25  01      :        LODZ,R1
6E26  C2      :        STRZ,R2             	Save hundreds
6E27  7810    :        BSNR,R0 PRDG        	Print digit unless zero
6E29  0500    :        LODI,R1 0
6E2B  E70A    :LP2     COMI,R3 D'10'
6E2D  1A04    :        BCTR,LT P2
6E2F  A70A    :        SUBI,R3 D'10'
6E31  D978    :        BIRR,R1 LP2
6E33  01      :P2      LODZ,R1
6E34  5A0B    :        BRNR,R2 FORC        	If hunds, force tens
6E36  7801    :        BSNR,R0 PRDG        	Print tens
6E38  03      :UNS     LODZ,R3             	Print tens
6E39  8430    :PRDG    ADDI,R0 A'0'        	Print digit
6E3B  0D10D3  :        LODA,R1 SAVE
6E3E  1F6EBF  :        BCTA,UN IO

6E41  3B76    :FORC    BSTR,UN PRDG
6E43  1B73    :        BCTR,UN UNS

              :* Locate next item in buffer
              :* Saves R1,R2; single subr level
              :* IF leading "=" point to next non-sep char
              :* ELSE skip till sep char
              :* IF trailing "=" point to "=" ELSE skip trailing seps
              :* IF CR - no item cc :- EQ
6E45  07FF    :ITEM    LODI,R3 -1
6E47  0FB070  :ITEML   LODA,R0 *BUFF,R3+
6E4A  E42C    :        COMI,R0 A','
6E4C  180F    :        BCTR,EQ SEPS
6E4E  E43D    :        COMI,R0 A'='
6E50  9804    :        BCFR,EQ NTEQ
6E52  5B10    :        BRNR,R3 IGO         	ABC=
6E54  1B07    :        BCTR,UN SEPS        	=ABC
6E56  E420    :NTEQ    COMI,R0 SPAC
6E58  196D    :        BCTR,GT ITEML       	Skip anything significant
6E5A  E40D    :IT2     COMI,R0 CR
6E5C  14      :        RETC,EQ             	CC = EQ => no item found
6E5D  0FB070  :SEPS    LODA,R0 *BUFF,R3+
6E60  E420    :        COMI,R0 SPAC
6E62  9976    :        BCFR,GT IT2         	Skip trailing seps
6E64  8F1071  :IGO     ADDA,R3 BUFF+1      	Update BUFF
6E67  CF1071  :        STRA,R3 BUFF+1
6E6A  17      :        RETC,UN             	Ignore carry
              :* MicroDOS		PAGE 23:
              :* Accept line of Chars, put to BUF
              :* Handles various control chars
              :* Converts to upper case in buffer
              :* No regs saved! 2+M subr levels, where
              :* M is levels of COUT (normally M=3)
6E6B  0713    :PRT     LODI,R3 CTU-STR
6E6D  3F6EE4  :        BSTA,UN PRNT        	" ^U", CR, LF

6E70  0701    :LINE    LODI,R3 1
6E72  0470    :        LODI,R0 <BUF        	Point to normal
6E74  CC1070  :        STRA,R0 BUFF        	line buffer
6E77  0472    :        LODI,R0 >BUF
6E79  CC1071  :        STRA,R0 BUFF+1
6E7C  0510    :LLOP    LODI,R1 10
6E7E  3F6EBF  :        BSTA,UN IO          	Input from strm 10
6E81  E401    :        COMI,R0 01          	Cntrl A ?
6E83  1C0022  :        BCTA,EQ 22
6E86  E403    :        COMI,R0 03          	Cntrl C / ETX?
6E88  1C6889  :        BCTA,EQ ENTERK
6E8B  E412    :        COMI,R0 12          	Cntrl R ?
6E8D  1828    :        BCTR,EQ CRLF0
6E8F  E415    :        COMI,R0 15          	Cntrl U ?
6E91  1858    :        BCTR,EQ PRT
6E93  E47F    :        COMI,R0 7F          	DELETE ?
6E95  1804    :        BCTR,EQ N7
6E97  E408    :        COMI,R0 BS          	BS ?
6E99  9808    :        BCFR,EQ N8
6E9B  A701    :N7      SUBI,R3 1           	backspace
6E9D  1851    :        BCTR,Z  LINE
6E9F  0408    :        LODI,R0 BS
6EA1  1B0B    :B0B     BCTR,UN N9
6EA3  E40D    :N8      COMI,R0 CR
6EA5  180D    :        BCTR,EQ LEND        	Exit on CR
6EA7  E73F    :        COMI,R3 3F          	full ?
6EA9  1851    :        BCTR,EQ LLOP        	Ignore on buffer full
6EAB  CF3070  :        STRA,R0 BUF-2,R3+
6EAE  0500    :N9      LODI,R1 0
6EB0  3B0D    :        BSTR,UN IO
6EB2  1B48    :        BCTR,UN LLOP

6EB4  CF3070  :LEND    STRA,R0 BUF-2,R3+   	Store CR in buffer

6EB7  0500    :CRLF0   LODI,R1 0           	Put CRLF on stream 0

              :* Put CR,LF on stream R1

6EB9  040D    :CRLF    LODI,R0 CR
6EBB  3B02    :        BSTR,UN IO
6EBD  040A    :        LODI,R0 LF
              :* MicroDOS		PAGE 24
              :* Do one byte of 1/0 on stream R1
              :* Saves R1-R3; same subr levels as service routine
6EBF  CC10D2  :IO      STRA,R0 SR0
6EC2  0D7000  :        LODA,R0 IDNT,R1
6EC5  9805    :        BCFR,Z  IOPN
6EC7  044F    :        LODI,R0 A'O'
6EC9  1F6DC0  :        BCTA,UN ERRM        	Stream not open
6ECC  0D7003  :IOPN    LODA,R0 CODE,R1
6ECF  CC10CE  :        STRA,R0 ADR
6ED2  0D7004  :        LODA,R0 CODE+1,R1
6ED5  CC10CF  :        STRA,R0 ADR+1
6ED8  0C10D2  :        LODA,R0 SR0
6EDB  1FF0CE  :        BCTA,UN *ADR        	Execute

6EDE  0702    :PRID    LODI,R3 IDM-STR
6EE0  1B02    :        BCTR,UN PRNT

6EE2  3B53    :PRCR    BSTR,UN CRLF0
6EE4  0500    :PRNT    LODI,R1 0           	Print string on stream 0
6EE6  0F2F9B  :PRNT2   LODA,R0 STR-1,R3+
6EE9  14      :        RETC,Z
6EEA  3B53    :        BSTR,UN IO
6EEC  1B78    :        BCTR,UN PRNT2

              :* Read non-disk device
6EEE  0702    :RDND    LODI,R3 2
6EF0  7510    :RDNDL   CPSL    RS
6EF2  3F6EBF  :        BSTA,UN IO          	Must Preserve R3
6EF5  7710    :        PPSL    RS
6EF7  DB77    :        BIRR,R3 RDNDL
6EF9  7510    :        CPSL    RS
6EFB  17      :        RETC,UN

              :* Write buffer to non-disk dev
6EFC  0702    :WRND    LODI,R3 2
6EFE  0FF0DB  :WRNDL   LODA,R0 *TMP,R3
6F01  7510    :        CPSL    RS
6F03  3F6EBF  :        BSTA,UN IO
6F06  7710    :        PPSL    RS
6F08  DB74    :        BIRR,R3 WRNDL
6F0A  7510    :        CPSL    RS
6F0C  17      :        RETC,UN

              :* Print R0 as hex on str R1
              :* Equiv Mon BOUT
              :* Saves R1-R3; M+1 subr levels
6F0D  CC10D3  :HXOUT   STRA,R0 SAVE
6F10  50      :        RRR,R0
6F11  50      :        RRR,R0
6F12  50      :        RRR,R0
6F13  50      :        RRR,R0
6F14  3B03    :        BSTR,UN HOUT
6F16  0C10D3  :        LODA,R0 SAVE
              :* MicroDOS		PAGE 25
6F19  440F    :HOUT    ANDI,R0 0F
6F1B  8430    :        ADDI,R0 A'0'
6F1D  E439    :        COMI,R0 A'9'
6F1F  9902    :        BCFR,GT $+4
6F21  8407    :        ADDI,R0 7           	If A-F, add 7
6F23  1F6EBF  :        BCTA,UN IO
              :* MicroDOS		PAGE 26
              :* Get number from buffer to XGOTO
              :* Equiv Mon GNUM
              :* Saves R1-R3; 2 subr levels
              :* CC - EQ if valid HEX number
6F26  771A    :GNMB    PPSL    LCOM+RS+WC
6F28  20      :        EORZ,R0
6F29  C1      :        STRZ,R1
6F2A  C2      :        STRZ,R2
6F2B  07FF    :        LODI,R3 -1
6F2D  CC10D2  :LNUM    STRA,R0 SR0
6F30  3F6A01  :        BSTA,UN GETSEP      	set char from buffer
6F33  1827    :        BCTR,EQ DNUM        	Seperator
6F35  7701    :        PPSL    CAR
6F37  A430    :        SUBI,R0 A'0'        	Leaves carry on
6F39  1A1E    :        BCTR,N  HERR        	Invalid delimiter
6F3B  E409    :        COMI,R0 9
6F3D  990A    :        BCFR,GT GNOK        	0-9 is OK
6F3F  A407    :        SUBI,R0 7
6F41  E40A    :        COMI,R0 0A          	Else should be A
6F43  1A14    :        BCTR,LT HERR
6F45  E40F    :        COMI,R0 0F          	to F
6F47  1910    :        BCTR,GT HERR
6F49  D2      :GNOK    RRL,R2              	Shift R1R2 left 4 bits
6F4A  D1      :        RRL,R1
6F4B  D2      :        RRL,R2
6F4C  D1      :        RRL,R1
6F4D  D2      :        RRL,R2
6F4E  D1      :        RRL,R1
6F4F  D2      :        RRL,R2
6F50  D1      :        RRL,R1
6F51  46F0    :        ANDI,R2 0F0
6F53  62      :        IORZ,R2             	Include new digit
6F54  C2      :        STRZ,R2
6F55  0401    :        LODI,R0 1
6F57  1B54    :        BCTR,UN LNUM        	Set Byte flag and loop for next

6F59  751A    :HERR    CPSL    RS+WC+LCOM
6F5B  17      :        RETC,UN

6F5C  E40D    :DNUM    COMI,R0 CR
6F5E  1805    :        BCTR,EQ OUTX        	end of buffer
6F60  0C10D2  :        LODA,R0 SR0         	Found No Yet?
6F63  1848    :        BCTR,Z  LNUM        	Ignore leading spaces
6F65  7508    :OUTX    CPSL    WC
6F67  3F6E64  :        BSTA,UN IGO         	Update BUFF
6F6A  CD10DD  :        STRA,R1 XGOTO
6F6D  CE10DE  :        STRA,R2 XGOTO+1
6F70  01      :        LODZ,R1             	Return high order in R0
6F71  75D0    :        CPSL    RS+H'C0'
6F73  17      :        RETC,UN
              :* MicroDOS		PAGE 27
6F74  E404    :VDU     COMI,R0 4           	Simple VDU dev handler
6F76  16      :        RETC,LT
6F77  1F02B4  :        BCTA,UN COUT

              :* Return version number; CC = P
6F7A  5803    :DVRS    BRNR,R0 DVRS1
6F7C  0445    :        LODI,R0 VERS
6F7E  17      :        RETC,UN
6F7F  E0      :DVRS1   COMZ,R0
6F80  17      :        RETC,UN

              :* Device table
6F81  5644    :DEVS    DATA    A'VD' VdU
6F83  6F74    :        ACON    VDU
6F85  4B42    :        DATA    A'KB' Keyboard
6F87  0286    :        ACON    KBD
6F89  4C50    :        DATA    A'LP' Printer (LPT:)
6F8B  70F0    :        ACON    POUT
6F8D  FF      :        DATA    0FF

6F8E  564455  :VDUB    DATA    A'VDU'
6F91  6F74    :        ACON    VDU
6F93  00FF    :        DATA    0,0FF
6F95  4B4244  :KBDB    DATA    A'KBD'
6F98  0286    :        ACON    KBD
6F9A  00FF    :        DATA    0,0FF

6F9C  0909    :STR     DATA    9,9
6F9E  4D6963726F444F532076342E3500:IDM     DATA    A'MicroDOS v4.5',0
6FAC  3A3A00  :PMT     DATA    A'::',0
6FAF  205E550D0A00:CTU     DATA    A' ^U',CR,LF,0
6FB5  46696C65206E6F7420666F756E642E2E2E00:NOTF    DATA    A'File not found...',0
6FC7  4572726F72202D2000:ERRMSG  DATA    A'Error - ',0
6FD0  6FD2    :STRTUP  ACON    KOLD
6FD2  313A53542E5359530D:KOLD    DATA    A'1:ST.SYS',CR

6FDB  44534B  :DSKD    DATA    A'DSK'
6FDE  434D44  :CMDS    DATA    A'CMD'

              :CR      EQU     0D
              :LF      EQU     0A
              :BS      EQU     08
              :SPAC    EQU     20

              :COUT    EQU     02B4 Monitor
              :KBD     EQU     0286
              :* MicroDOS			PAGE 28
              :        ORG     RAM
7000          :IDNT    RES     3 Stream identity, 3 chars
7003          :CODE    RES     2 Addr of service routine
7005          :PBPT    RES     1 Program Buffer PoinTer
7006          :DRV     RES     1 Bit 1,0=drv #; bit 2=side
7007          :TRK     RES     1 Track #
7008          :SEC     RES     1 Sector #
7009          :DSEC    RES     1 Directory sector
700A          :DBYT    RES     1 Dir byte
700B          :HLEN    RES     1 Lensth (for
700C          :LLEN    RES     1 writes)
700D          :FTYP    RES     1 File type (0=ordinary)
700E          :DBPT    RES     1 Device Buffer Pointer
700F          :HBUF    RES     1 High byte of buffer addr

              :        ORG     RAM+60

7060          :        RES     3
7063          :NAME    RES     0A
706D          :EXTN    RES     3

7070          :BUFF    RES     2 Line buffer pointer
7072          :BUF     RES     40 Normal line buffer
70B2          :TRK1    RES     4 Track info for dual drive
70B6          :DENT    RES     18 Directory ENTry copy
70CE          :DENP    RES     4 Scratch
              :ADR     EQU     DENP
70D2          :SR2     RES     1
70D3          :SR3     RES     1
              :SR0     EQU     SR2
              :SAVE    EQU     SR3
70D4          :RTYCNT  RES     1 retry count
70D5          :CDRV    RES     1 Current drive
70D6          :        RES     1
70D7          :SYSD    RES     1 Sys drive
70D8          :WRKD    RES     1 Work dry
70D9          :        RES     2
70DB          :TMP     RES     2 Disk buffer pointer
70DD          :XGOTO   RES     2 Res of GNUM
70DF          :ERRDR   RES     1 Error drive
70E0          :ERRTYP  RES     1 Error type
70E1          :ERRSTR  RES     1 Error stream
70E2          :ERRTRK  RES     1 Error track
70E3          :ERRSEC  RES     1 Error sector
70E4          :ERR17   RES     1 1771 error status
70E5          :ERRH    RES     1 Error handling flag

              :CLEAR   EQU     $
              :        ORG     RAM+0F0
70F0          :POUT    RES     3 Printer COUT
70F3          :PINIT   RES     3 Printer Initialise
70F6          :PTERM   RES     3 Printer Terminate
70F9          :TSTBRK  RES     3 Test for break

70FC          :DATV    RES     1 Date valid flag
70FD          :DATE    RES     3 DD,MM,YY in BCD
