;Disassembly of Acorn DFS 2.24 ;Greg Cook, 12 May 2023 ;Source: http://wouter.bbcmicro.net/bbc/bestanden/roms-2009.01.28.zip ;Path: roms/kopie_van_disk/Acorn/DFS__2.24 ;Code length: &38D7 ;Acorn CRC: &E3E0 ;PKZIP CRC: &5E5D82CA ;XFER CRC: &00B813AB ;Cksum: 3911480006 ;This is a BeebAsm assembly source file. ; ; https://github.com/stardot/beebasm ; ;Most symbols copied from matching code in Acorn DNFS 3.00, ;as landmarks. ; ; https://github.com/stardot/AcornDNFSv300/ ; ;Comments by Greg Cook and occasionally the Acornsoft team. ;Comments beginning with capital letters are entry points. ;Questions with double marks are open queries regarding the code. ;Questions with single marks are flowchart nodes. ;[D] marks differences from DNFS 3.00. Work in progress - commentary ;is being adapted from the disassembly of Opus DDOS 3.46. ;Potential space savings can be found near comments containing ;"redundant", "unused", "can save", "unreachable code". ;Usability options _BUGFIX =? 0 ;Handle the sector size code correctly in ;OSWORD $7F command $63, Format track ;(other fixes to follow) CPU 1 dftbid = $01 ;Tube claimant ID for Disc Filing System srtbid = $08 ;Tube claimant ID for SRAM prenmi = $00A0 ;previous owner of NMI area L00A1 = $00A1 L00A2 = $00A2 L00A3 = $00A3 L00A4 = $00A4 L00A5 = $00A5 L00A6 = $00A6 L00A7 = $00A7 linno = $00A8 ;[D]now one byte L00A9 = $00A9 ;high byte of linno used separately utemp = $00AA ltemp = $00AB ptemp = $00AE L00AE = $00AE temp = $00B0 L00B0 = $00B0 L00B0a = $00B0 L00B1 = $00B1 xtemp = $00B2 ;2 bytes itemp = $00B3 ;overlaps xtemp L00B3 = $00B3 atemp = $00B4 ;2 bytes ytemp = $00B5 ;overlaps atemp L00B5 = $00B5 vtemp = $00B6 ;4 bytes L00B7 = $00B7 ztemp = $00B8 ;2 bytes, overlaps vtemp L00B8 = $00B8 etemp = $00B9 ;overlaps ztemp work = $00BA L00BA = $00BA lodcat = work +$0000 ;temp cat offset in OSFILE $FF baselo = work +$0001 ;LSB base LBA in *FREE / *MAP intwa = work +$0001 ;integer working area in LA960 wrkcat = work +$0002 ;load/exec/length/start sector in catalogue format lodlo = work +$0002 ;LSB load address in OSFILE basehi = work +$0002 ;MSB base LBA in *FREE / *MAP L00BC = $00BC lodhi = work +$0003 ;3MSB load address in OSFILE frecat = work +$0003 ;temp cat offset in *FREE / *MAP L00BD = $00BD exelo = work +$0004 ;LSB exec address in OSFILE L00BE = $00BE exehi = work +$0005 ;3MSB exec address in OSFILE comtxt = work +$0005 ;offset of command table entry [D] was work+$02 freelo = work +$0005 ;LSB free space in *FREE / *MAP L00BF = $00BF strtlo = work +$0006 ;LSB start address in OSFILE 0 lenlo = work +$0006 ;LSB file length in OSFILE freehi = work +$0006 ;MSB free space in *FREE / *MAP strthi = work +$0007 ;3MSB start address in OSFILE 0 lenhi = work +$0007 ;2MSB file length in OSFILE headlo = work +$0007 ;LSB headroom in *FREE / *MAP bitcnt = work +$0007 ;bit counter in LA960 endlo = work +$0008 ;LSB end address in OSFILE 0 lbahi = work +$0008 ;MSB LBA in OSFILE headhi = work +$0008 ;MSB headroom in *FREE / *MAP endhi = work +$0009 ;3MSB end address in OSFILE 0 lbalo = work +$0009 ;LSB LBA in OSFILE lenhl = work +$000A ;MSB file length in OSFILE L00C4 = work +$000A ;temp cat offset in *RENAME todolo = work +$000A ;LSB no. sectors remaining to be copied todohi = work +$000B ;MSB no. sectors remaining to be copied wrknam = work +$000B ;current filename srclo = work +$000C ;LSB LBA of next sector to copy from source L00C6 = work +$000C ;microcode in *FREE / *MAP srchi = work +$000D ;MSB LBA of next sector to copy from source userpt = work +$000D ;pointer to user's OSWORD control block dstlo = work +$000E ;LSB LBA of next sector to copy to destination dsthi = work +$000F ;MSB LBA of next sector to copy to destination L00C9 = work +$000F ;microcode in *FORM / *VERIFY cpycat = work +$0010 ;catalogue pointer in *COPY L00CA = work +$0010 ;command line offset in *FORM / *VERIFY qualif = $00CC ;current directory fdrive = $00CD ;current drive track = $00CE ;current track pos. of current drive in OSWORD $7F sector = $00CF ;current sector no. on current drive in OSWORD $7F worda = $00EF ;reason code in A on entry to OSWORD wordx = $00F0 ;LSB control block address in X on entry to OSWORD wordy = $00F1 ;MSB control block address in Y on entry to OSWORD linptr = $00F2 ;2 bytes; pointer to character array in GSINIT/Svc $25 romid = $00F4 ;slot number of ROM currently paged in romptr = $00F6 ;2 bytes; pointer to next byte of RFS stream L00F6 = $00F6 ;romptr+$00 when used as a temp L00F7 = $00F7 ;romptr+$01 when used as a temp escflg = $00FF ;$00 = normal, $FF = ESCAPE pressed stack = $0100 ;hardwired 6502 stack page errbuf = $0100 ;error trampoline so a language ROM can print the message bytev = $020A ;BYTEV vector, redirected by SRAM filev = $0212 ;FILEV, first FS vector claimed by DFS fscv = $021E ;FSCV vector to shut down prev/control current FS tubadr = $0406 ;set up address for tube intnmi = $0D00 ;NMI service routine ecowsp = $0D60 ;Econet reserved area; end of NMI service routine priptr = $0DF0 ;table of private pages to each ROM base = $C000 ;start of HAZEL extended memory dirlow = base +$0000 ;first sector of volume catalogue catlow = dirlow+$0008 ;first catalogue entry; filename catdun = catlow+$0000 ;b7=catalogue entry listed modify = catlow+$0007 ;directory letter; b7=file locked dirhig = dirlow+$0100 ;second sector of catalogue cycno = dirhig+$0004 ;BCD cycle number, incremented when updating catalogue dirlen = dirhig+$0005 ;number of files in catalogue * 8; pointer to last entry option = dirhig+$0006 ;when accessing option bits cathig = dirhig+$0008 ;first catalogue entry; attributes mainws = dirhig+$0100 ;when saved/restored in bulk buffer = mainws+$0000 ;64 bytes; file spec passed to command tmpcin = mainws+$0045 ;18 bytes; saved arg ptr, cat attributes and filename tmpcat = tmpcin+$0002 ;load/exec/length/start sector of file being copied namtra = tmpcin+$000B ;filename and directory of file being copied tmpnam = mainws+$0058 ;filename and directory portion of file spec to *COPY dosram = mainws+$0060 ;copy of OSGBPB/OSFILE ctrl block; temp filename in *CAT ldlow = mainws+$0072 ;4 bytes; load address passed to OSFILE; Tube tx addr hiwork = ldlow +$0002 ;8 bytes; high words of load/exec/start/end to OSFILE exlow = hiwork+$0000 ;overlaps ldlow; exec address passed to OSFILE strthl = hiwork+$0004 ;2MSB start addres in OSFILE 0 strthh = hiwork+$0005 ;MSB start address in OSFILE 0 endhl = hiwork+$0006 ;MSB file length in OSFILE btemp = mainws+$007D ;2 bytes; pointer to user's OSGBPB control block ctemp = mainws+$007F ;transfer direction 0=writing from mem 1=reading to mem tumflg = mainws+$0081 ;$00=transferring to/from host $FF=txing to/from Tube catdrv = mainws+$0082 ;drive no. of catalogue in dirlow/hi; $FF=cat invalid olddrv = mainws+$0083 ;set during init1, otherwise unused dufflg = mainws+$0086 ;$20=update EXT if changed $00=ensure buffers only LC287 = mainws+$0087 ;b7=drive 0, b6=drive 1 uncalibrated LC288 = mainws+$0088 ;track no. under heads on drive 0/2, 1/3 LC28A = mainws+$008A ;disc operation modifier... LC28B = mainws+$008B ;bad tracks 1,2 on drive 0/1, 2/3 LC290 = mainws+$0090 ;high OSWORD $7F control block LC29D = mainws+$009D ;retry counter in *FORM / *VERIFY LC29E = mainws+$009E ;retry counter in OSWORD $7F LC29F = mainws+$009F ;number of tracks to *FORMAT / *VERIFY prsist = mainws+$00C0 ;start of persistent workspace saved to private page dcbmap = mainws+$00C0 ;channel open flags dcbbit = mainws+$00C1 ;channel open bit mask for current open file dcby = mainws+$00C2 ;channel workspace pointer for current open file seqwb = mainws+$00C3 ;Offset of catalogue entry of current open file seqwc = mainws+$00C4 ;counter for copying catalogue entry while opening file LC2C4 = mainws+$00C4 ;LSB offset of current buffer from start of file in OSARGS 1,Y seqwx = mainws+$00C5 ;temporary copy of X register during sequential file ops monflg = mainws+$00C6 ;*OPT 1 monitor $00=verbose $FF=quiet enaflg = mainws+$00C7 ;*ENABLE counter $01=*ENABLE just called $00=current cmd ;enabled $FF=current command not enabled defqua = mainws+$00C9 ;default (CSD) directory character defdsk = mainws+$00CA ;default (CSD) drive libqua = mainws+$00CB ;library directory character libdsk = mainws+$00CC ;library drive wildch = mainws+$00CD ;$23=wildchard chars allowed in filespec $FF=not allowed dashop = mainws+$00CE ;$2A=asterisks allowed in filespec $FF=not allowed frpage = mainws+$00CF ;MSB of OSHWM; first free page of user memory frsize = mainws+$00D0 ;number of pages of user memory fdriv = mainws+$00D1 ;source drive in *BACKUP, *COPY tdriv = mainws+$00D2 ;destination drive in *BACKUP, *COPY colds = mainws+$00D3 ;$FF=allow warm start $00=force cold start memflg = $00D4 ;$FF=we have shared workspace $00=don't have workspace notube = mainws+$00D6 ;$00=Tube coprocessor present $FF=Tube absent (inverted MOS flag) qtemp = mainws+$00D7 ;2 bytes; action address in OSGBPB linadr = mainws+$00D9 ;2 bytes; offsets to cmd line start/start or pointer to tail fcbadr = mainws+$00DB ;pointer to user's OSFILE control block seqsem = mainws+$00DD ;$FF=*SPOOl/*EXEC critical, close files on error LC2DE = mainws+$00DE ;[0] flags; [0..3] b7=40 track drv LC2E2 = mainws+$00E2 ;trampoline to previous OSBYTE handler sramws = $00EE ;rest of private page used by SRAM seqmap = mainws+$0100 ;workspaces for channels $11..$15 seqcat = seqmap+$0000 ;when accessing the catalogue entry seqll = seqcat+$0009 ;LSB of file length in catalogue entry seqlm = seqcat+$000B ;2MSB of file length in catalogue entry seqrdo = seqcat+$000C ;seventh character of filename; b7=channel read-only seqlh = seqcat+$000D ;top bits exec/length/load/LBA in catalogue entry seqlok = seqcat+$000E ;directory character of filename; b7=file locked seqloc = seqcat+$000F ;LSB of starting LBA in catalogue entry seqpl = seqmap+$0010 ;LSB of sequential pointer (PTR) seqpm = seqmap+$0011 ;2MSB of sequential pointer seqph = seqmap+$0012 ;MSB of sequential pointer seqbuf = seqmap+$0013 ;page of memory containing open file's sector buffer seqlla = seqmap+$0014 ;LSB of open file's extent (EXT) seqlma = seqmap+$0015 ;2MSB of open file's extent seqlha = seqmap+$0016 ;MSB of open file's extent seqflg = seqmap+$0017 ;channel flags b7=buffer contains PTR b6=buffer changed ;b5=EXT changed b4=EOF warning given b1..b0=drive number seqem = seqmap+$0019 ;LSB of number of sectors allocated to file seqeh = seqmap+$001A ;MSB of number of sectors allocated to file seqbit = seqmap+$001B ;channel open bit mask corresponding to open file seqdal = seqmap+$001C ;LSB of starting LBA seqdah = seqmap+$001D ;MSB of starting LBA slots = seqmap+$0100 ;channel sector buffers latch = $FE24 ;floppy drive interface control latch fdc = $FE28 ;base of floppy drive controller registers fdccmd = fdc +$0000 ;WD 1770 command register (write only) fdcsta = fdc +$0000 ;WD 1770 status register (read only) fdctrk = fdc +$0001 ;WD 1770 track register fdcsec = fdc +$0002 ;WD 1770 sector register fdcdat = fdc +$0003 ;WD 1770 data register romsw = $FE30 ;ROMSEL paged ROM selection latch reg3 = $FEE5 ;Tube FIFO 3 gsinit = $FFC2 ;Initialise read gsread = $FFC5 ;Read char osrdsc = $FFB9 ;Read screen or paged ROM osfind = $FFCE ;Open file osgbpb = $FFD1 ;Get/put bytes to file osbput = $FFD4 ;Put bytes to file osbget = $FFD7 ;Get bytes from file osargs = $FFDA ;Read/write file arguments osfile = $FFDD ;Read/write whole file osrdch = $FFE0 ;Read char from kbd osasci = $FFE3 ;OSWRCH + CR]CRLF oswrch = $FFEE ;Write char to screen osbyte = $FFF4 ;Misc OS calls oscli = $FFF7 ;Execute command line ORG $8000 .lang ;Language entry BRK EQUW $0000 ;Service entry JMP LAB9F EQUB $82 ;rom type: service only EQUB copyr-lang ;copyright offset pointer EQUB $79 ;version No. EQUS "DFS",$00 ;title and terminator byte EQUS "2.24" ;version string .copyr EQUB $00 ;terminator byte EQUS "(C)1985 Acorn",$00 ;copyright string and terminator byte .osfscm ;Issue Filing System Call JMP (fscv) .dskmsg ;Raise "Disk " error JSR estrng EQUB $00 EQUS "Disc " BCC gstrng .illmsg ;Raise "Bad " error JSR estrng EQUB $00 EQUS "Bad " BCC gstrng .estrng ;Check critical flag and prefix error message LDA seqsem ;if flag clear (i.e. if *SPOOL/*EXEC critical) BNE estrn1 JSR hmtspe ;then close *SPOOL/*EXEC files. .estrn1 LDA #$FF STA catdrv ;no catalogue in pages $0E..F STA seqsem ;set *SPOOL/*EXEC non-critical flag: .fstrng ;Prefix error message immediate LDX #$02 ;error message being built from offset 2 LDA #$00 STA errbuf+$00 ;instruction at $0100 = BRK: .gstrng ;Append error message immediate STA itemp ;save A on entry PLA ;pop caller's address into pointer STA ptemp+$00 PLA STA ptemp+$01 LDA itemp ;restore A on entry LDY #$00 ;set Y=0 for indirect indexed load: JSR tmpinc ;increment ptemp LDA (ptemp),Y ;get character from after JSR STA errbuf+$01 ;$0101 = error number DEX ;decrement error message offset or POS: .estrn0 JSR tmpinc ;increment ptemp INX ;increment error message offset or POS LDA (ptemp),Y ;get character from after JSR STA errbuf,X ;store character at end of error message BMI vstrnr ;if b7=1 then opcode terminator, execute it BNE estrn0 ;else if not NUL then copy more characters JSR reltub ;else raise error. ensure Tube is released JMP errbuf ;jump to BRK to raise error .vstrng STA itemp ;save A on entry PLA ;pop caller's address into pointer STA ptemp+$00 PLA STA ptemp+$01 LDA itemp ;restore A on entry and save on stack PHA TYA ;save Y PHA LDY #$00 ;set Y=0 for indirect indexed load .vstrlp JSR tmpinc ;increment ptemp LDA (ptemp),Y ;get character from after JSR BMI vstrnx ;if b7=1 then opcode terminator, execute it JSR pchr ;else print character JMP vstrlp ;and loop .vstrnx PLA ;restore AY TAY PLA .vstrnr CLC ;jump to address of end of string with C=0 JMP (ptemp) .dpdot ;Print digit and dot JSR digout .pdot ;Print a dot LDA #$2E .pchr ;Print character in A (OSASCI) JSR savita ;save AXY PHA ;else save character LDA #$EC ;call OSBYTE $EC = read/write char dest status JSR readby TXA ;save current output stream setting PHA ORA #$10 ;b4=1 disable *SPOOL output JSR wriwde ;call OSBYTE $03 = specify output stream in A PLA ;restore previous output stream setting TAX PLA ;restore character JSR osasci ;call OSASCI JMP wriwdx ;call OSBYTE $03 = specify output stream ;unreachable code JSR L8426 ;[D] .bytout ;Print hex byte PHA ;save A JSR sfour ;shift A right 4 places JSR digout ;print top nibble of byte PLA ;restore bottom nibble: .digout ;Print hex nibble JSR digut1 ;[D]convert hex nibble to ASCII BNE pchr ;print character (always) .digut1 ;Convert hex nibble to ASCII AND #$0F ;extract b3..0 CMP #$0A ;if in range 10..15 BCC digot0 ADC #$06 ;then C=1; add 7 to put in range 17..22 .digot0 ADC #$30 ;c=0; add 48, result 48..57, 65..70 RTS ;return ASCII "0".."9" or "A".."F" .shftbo ;Copy address to (work,hiwork)+X JSR shfttw ;copy low word to zero page DEX ;backtrack destination offset DEX JSR shftt0 ;copy high word to workspace: .shftt0 ;copy byte of high word to workspace LDA (temp),Y STA hiwork-$02,X INX ;increment source and destination offsets INY RTS .shfttw ;copy low word to zero page: JSR shfton .shfton ;copy byte of low word to zero page LDA (temp),Y STA work,X INX ;increment source and destination offsets INY RTS .getnam ;Set current file from file spec JSR setdef ;set current drive and directory = default JMP getnm0 ;parse file spec .frmnam ;Set current file from argument pointer JSR setdef ;set current drive and directory = default: .frmnm1 ;Parse file spec from argument pointer LDA work+$00 ;copy argument pointer to GSINIT pointer STA linptr+$00 LDA work+$01 STA linptr+$01 LDY #$00 ;set Y = 0 offset for GSINIT JSR setupr ;call GSINIT with C=0: .getnm0 ;Parse file spec LDX #$20 ;directory defaults to " " JSR rdchr ;call GSREAD BCS namerr ;if argument empty then "Bad filename" STA buffer+$00 ;else save first character of filename CMP #$2E ;if not "." then skip to dir/filename BNE getnm1 ;else empty dir spec, set directory = " ": .getnm2 STX qualif ;set as current directory BEQ getnm0 ;loop to parse file spec (always) .getnm1 CMP #$3A ;else is first character ":"? BNE getnm3 ;if not then skip to dir/filename JSR getdrv ;[D]else a drive is specified, get drive spec JSR rdchr ;a pathname must follow, so call GSREAD BCS namerr ;if only a drive spec then "Bad filename" CMP #$2E ;else next character must be "." BEQ getnm0 ;if so then parse pathname, else: .namerr ;Raise "Bad filename" error. JSR illmsg EQUB $CC EQUS "name" EQUB $00 .getnm3 TAX ;save first char in case it's a directory JSR rdchr ;call GSREAD, get second filename character BCS getnm4 ;if absent then process one-character name CMP #$2E ;else is the second character "."? BEQ getnm2 ;if so then set current directory from X LDX #$01 ;else offset = 1, second character of buffer: .getnm5 STA buffer,X ;store character of filename INX ;point X to next character of current filename JSR rdchr ;call GSREAD, get next character of leaf name BCS getnm6 ;if no more then filename complete, return CPX #$07 ;else have seven characters been read already? BNE getnm5 ;if not then loop BEQ namerr ;else raise "Bad filename" error. .rdchr ;Call GSREAD and validate filename character JSR gsread ;call GSREAD PHP ;save result AND #$7F ;clear bit 7 CMP #$0D ;if result = $0D BEQ rdchok ;then accept "|M" and "|!|M" as an embedded CR CMP #$20 ;else if ASCII value less than " " BCC namerr ;then raise "Bad filename" error CMP #$7F ;else if ASCII value = DEL or higher BEQ namerr ;then raise "Bad filename" error .rdchok PLP ;else restore GSREAD result RTS ;and return character in A, new offset in Y .getnm4 ;Process one-character filename LDX #$01 ;offset = 1, second character of buffer: .getnm6 ;Clear rest of filename buffer LDA #$20 ;put " " in A .getnm7 STA buffer,X ;fill rest of buffer with spaces INX ;increment buffer offset CPX #$40 ;have we reached end of buffer? BNE getnm7 ;if not then loop LDX #$06 ;else offset = 6: .clrnm0 LDA buffer,X ;copy filename in buffer STA wrknam,X ;to current filename DEX ;loop until 7 characters copied BPL clrnm0 RTS .prtnam ;Print filename from catalogue JSR savita ;save AXY LDA modify,Y ;get directory character PHP ;save N = lock attribute AND #$7F ;extract ASCII character BNE ptnam2 ;if NUL then file is in CSD JSR pdspc ;so print two spaces BEQ ptnam3 ;branch (always) .ptnam2 JSR pchr ;else print directory character JSR pdot ;print a dot .ptnam3 LDX #$06 ;repeat 7 times: .ptnam0 LDA catlow,Y ;get character of leaf name AND #$7F ;mask bit 7 JSR pchr ;print character INY DEX BPL ptnam0 ;and loop JSR pdspc ;print two spaces LDA #$20 ;a = space PLP ;restore lock attribute in N BPL ptnam1 ;if lock bit set LDA #$4C ;then A = capital L .ptnam1 JSR pchr ;print attribute character LDY #$01 ;print a space and exit .yspace JSR pspace ;Print number of spaces in Y DEY ;print a space BNE yspace ;loop until Y = 0 RTS .isoexe ;Extract b7,b6 of A LSR A LSR A .isolen ;Extract b5,b4 of A LSR A LSR A LSR A LSR A AND #$03 RTS .isolod ;Extract bit 3 to bits 1 and 0 AND #$08 ;[D]new BEQ L81BD ;if bit 3 clear then return 0 LDA #$03 ;else return 3: b1=1,b0=1 .L81BD RTS .sfive ;Shift A right 5 places LSR A .sfour ;Shift A right 4 places LSR A .sthree ;Shift A right 3 places LSR A ;[D]new entry point LSR A LSR A RTS .lfive ;Shift A left 5 places ASL A .lfour ;Shift A left 4 places ASL A ASL A ASL A ASL A RTS .atot ;Prepare ordinary file transfer LDA #$05 ;[D]new STA LC290+$05 LDA fdrive STA LC290+$00 LDA #$0A ;[D]set 10 sectors per track STA temp LDA wrkcat+$00 ;copy user data address to NMI area STA LC290+$01 LDA wrkcat+$01 STA LC290+$02 LDA ldlow+$02 STA LC290+$03 LDA ldlow+$03 STA LC290+$04 LDA #$FF ;set track number for transfer STA LC290+$07 ;decrement, to increment at start of loop LDA wrkcat+$06 ;get top bits exec/length/load/start sector JSR isolen ;extract b5,b4 of A STA LC290+$0A ;?$A5 = b17..16 (MSB) of length LDA wrkcat+$04 ;copy 2MSB length STA LC290+$0B LDA wrkcat+$05 ;copy LSB length STA LC290+$09 LDA wrkcat+$06 AND #$03 ;x = b9..8 (MSB) of relative LBA TAX LDA wrkcat+$07 ;get LSB of relative LBA: .trsca SEC ;set C=1 to subtract without borrow: .trscb INC LC290+$07 ;increment track number SBC temp ;subtract sectors-per-track from LBA BCS trscb ;loop until LSB borrows in DEX ;then decrement MSB of relative LBA BPL trsca ;loop until MSB borrows in/underflows ADC temp ;add sectors per track to negative remainder STA LC290+$08 ;set sector number. .loksuc RTS .getlok ;Ensure file matching spec in catalogue JSR getnam ;set current file from file spec BMI errlok ;ensure matching file in catalogue .frmlok ;Ensure file matching argument in catalogue JSR frmnam ;set current file from argument pointer: .errlok ;Ensure matching file in catalogue JSR lookup ;search for file in catalogue BCS loksuc ;if found then return, else: .nofil ;Raise "Not found" error JSR fstrng EQUB $D6 EQUS "Not found" EQUB $00 .ex ;FSC 9 = *EX JSR stxylp ;set GSINIT pointer to XY, set Y=0 [D]new JSR setdef ;set current drive and directory = default JSR setupr ;call GSINIT with C=0 BEQ L8246 ;if no argument then list default directory JSR readd0 ;else parse directory spec .L8246 LDA #$2A ;set filename="*" STA buffer+$00 JSR getnm4 ;process one-character filename JSR setwld ;allow wildcard characters in filename JSR errlok ;ensure matching file in catalogue JMP L8265 ;print *INFO lines for all matching files ;can save 1 byte (BCS/BRA L8265) .info ;FSC 10 = *INFO JSR stxylp ;allow wildcard characters in filename JSR setwld JSR setupr ;call GSINIT with C=0 BEQ L826E ;if no argument then raise "Bad name" error JSR getlok ;else ensure file matching spec in catalogue .L8265 JSR prtinf ;print *INFO line JSR next ;find next matching file BCS L8265 ;loop until no more files match. RTS .L826E JMP namerr ;raise "Bad name" error .L8271 ;Search for file with execute privilege JSR L93AD ;ensure catalogue loaded with execute privilege LDA #buffer-buffer ;compare with name in buffer BEQ L8296 .lookw ;Search for wrknam in catalogue LDX #$06 ;7 characters to copy: .lookw0 LDA wrknam,X ;copy current leafname to workspace STA tmpnam,X DEX ;loop until 7 characters copied BPL lookw0 LDA #$20 ;set eighth character to space STA tmpnam+$07 ;to serve as filename terminator LDA #tmpnam-buffer ;compare with name in tmpnam BNE lookux .next ;Find next matching file LDX #buffer-buffer ;compare with name in buffer BEQ next0 .lookup ;Search for file in catalogue LDA #buffer-buffer ;compare with name in buffer: .lookux PHA JSR L93B1 ;ensure current volume catalogue loaded PLA .L8296 TAX ;set X = offset of comparand LDA #(catlow ;[D]set MSB of pointer to first catalogue page STA vtemp+$01 LDA vtemp+$00 ;set A = catalogue pointer CMP dirlen ;have we reached the end of the catalogue? BCS matchf ;if so return C=0 file not found ADC #$08 ;else add 8 to A STA vtemp+$00 ;store new catalogue pointer JSR matchs ;compare leafname with one in catalogue BCC next0 ;if unequal then loop until file found or not LDA qualif ;else set A = current directory LDY #$07 ;y=7 point to directory character: JSR cpchar ;compare with character in catalogue BNE next0 ;if unequal then loop until file found or not LDY vtemp+$00 ;y=absolute offset of found file in workspace SEC ;return C=1 file found: .unstep ;Subtract 8 from Y DEY ;returns offset from start of catalogue DEY DEY DEY DEY DEY DEY DEY RTS .matchs ;Compare leafname with one in catalogue JSR savita ;save AXY .match1 LDA buffer,X ;get character of pattern CMP dashop ;if not "*" or wildcards are barred BNE match4 ;then compare literals INX ;else advance X past the * .match6 JSR matchs ;if rest of pattern matches rest of filename BCS matchr ;then return C=1 file found INY ;else skip one char of filename, adding it to wc CPY #$07 ;if not at end of filename BCC match6 ;then loop to see if pattern matches here .mathmt LDA buffer,X ;else globbed to end of filename CMP #$20 ;if pattern does not also end here BNE matchf ;then return C=0 no match RTS ;else return C=1 file found .match4 CPY #$07 ;comparing literals; if end of filename reached BCS mathmt ;then check pattern ends here also JSR cpchar ;else compare characters BNE matchf ;if unequal return C=0 no match INX ;else consume pattern character INY ;consume filename character BNE match1 ;loop to compare rest of pattern (always) .matchf ;match failed CLC ;return C=0 file not found .matchr ;match succeeded (C=1) RTS ;return C=1 file found .cpchar ;Compare characters CMP dashop ;if equal to "*" and wildcards are allowed BEQ cpret ;then return Z=1 characters match CMP wildch ;else if equal to "#" and wildcards allowed BEQ cpret ;then return Z=1 characters match JSR caps ;else test is character in A is a letter EOR (vtemp),Y ;compare pattern character with filename BCS cpchr0 ;if pattern character is a letter AND #$5F ;then ignore case differences .cpchr0 AND #$7F ;ignore bit 7, return Z=characters equal .cpret RTS .setcap ;Uppercase letter in A PHP ;preserve flags JSR caps ;is character in A a letter? BCS scap0 ;if not then just clear bit 7 AND #$5F ;else clear bits 5 and 7, convert to capitals .scap0 AND #$7F ;clear bit 7 PLP ;restore flags RTS ;and exit .delfil ;Delete catalogue entry JSR chkopl ;ensure file not locked or open (mutex) .dellop LDA catlow+$08,Y ;copy next file's entry over previous entry STA catlow,Y ;shifting entries up one place LDA cathig+$08,Y ;(copies title/boot/size if catalogue full) STA cathig,Y INY ;loop until current file count reached CPY dirlen ;have we reached the end of the catalogue? BCC dellop TYA ;copy Y to A = pointer to last file; C=1 SBC #$08 ;subtract 8, catalogue contains one file less STA dirlen ;store new file count CLC .infrts RTS .caps ;Set C=0 iff character in A is a letter PHA ;preserve character AND #$5F ;clear bits 5 and 7, convert lowercase to upper CMP #$41 ;is character less than capital A? BCC caps0 ;if so then return C=1 CMP #$5B ;else is it more than capital Z? BCC caps1 ;if not then return C=0 .caps0 SEC ;else return C=1, character is a letter .caps1 PLA RTS .inform ;Print *INFO line if verbose BIT monflg ;test *OPT 1 setting BMI infrts ;if b7=1 then *OPT 1,0 do not print, else: .prtinf ;Print *INFO line JSR savita ;save AXY JSR prtnam ;print filename from catalogue TYA ;save catalogue pointer PHA LDA #dosram STA temp+$01 JSR chukbk ;return catalogue information to OSFILE block LDY #$02 ;y = $02 offset of load address in block JSR pspace ;print a space JSR prtin0 ;print load address JSR prtin0 ;print execution address JSR prtin0 ;print file length PLA ;restore catalogue pointer TAY LDA cathig+$06,Y ;get top bits exec/length/load/start sector AND #$03 ;extract MSB start sector JSR digout ;print hex nibble LDA cathig+$07,Y ;get LSB start sector JSR bytout ;print hex byte JMP pcrlf ;print newline .prtin0 ;Print 24-bit field at dosram+Y LDX #$03 ;3 bytes to print (1 to skip on exit): .prtin1 LDA dosram+$02,Y ;y points to LSB, get MSB JSR bytout ;print hex byte DEY ;decrement offset DEX ;decrement counter BNE prtin1 ;loop until 3 bytes printed JSR step7 ;add 7 to Y to point to LSB of next field JMP pspace ;print a space and exit ;can save 3 bytes (join) .getdir JSR savita ;save AXY JMP L93C0 ;load volume catalogue .chukbk ;Return catalogue information to OSFILE block JSR savita ;save AXY TYA ;save catalogue pointer on stack PHA TAX ;and copy to X LDY #$12 ;clear bytes at offsets 2..17 LDA #$00 .chukb7 DEY ;[D]opto STA (temp),Y CPY #$02 BNE chukb7 ;offset 2 = LSB load address .chukb5 JSR chukb4 ;copy two bytes from catalogue to OSFILE block INY ;skip high bytes of OSFILE field INY CPY #$0E ;loop until 3 fields half-filled: BNE chukb5 ;load address, execution address, file length PLA ;restore catalogue pointer TAX LDA modify,X ;get directory character BPL chukb3 ;if b7=1 then file is locked LDA #$08 ;so set attributes to LRW/RW (old style) STA (temp),Y ;no delete, owner read/write, public read/write .chukb3 LDA cathig+$06,X ;get top bits exec/length/load/start sector LDY #$04 ;offset 4 = 2MSB load address JSR chukb1 ;expand bits 3,2 to top 16 bits of field LDY #$0C ;offset 12 = 2MSB file length LSR A ;chukb1 returned A = ..eelldd LSR A ;shift A right twice to make A = ....eell PHA ;save exec address AND #$03 ;extract bits 1,0 for length (don't expand) STA (temp),Y ;store in OSFILE block PLA ;restore exec address in bits 3,2 LDY #$08 ;offset 8 = 2MSB execution address: .chukb1 LSR A ;shift A right 2 places LSR A PHA ;save shifted value for return AND #$03 ;extract bits 3,2 of A on entry CMP #$03 ;if either one is clear [D]opto BNE L83D8 ;then save both as b1,0 of 2MSB LDA #$FF ;else set MSB and 2MSB = $FF. STA (temp),Y INY .L83D8 STA (temp),Y PLA ;discard byte on stack RTS .chukb4 ;Copy two bytes from catalogue to OSFILE block JSR chukb6 .chukb6 LDA cathig,X STA (temp),Y INX INY RTS .tmpinc ;Increment ptemp INC ptemp+$00 BNE tmpin0 INC ptemp+$01 .tmpin0 RTS .savita ;Save AXY PHA ;stack = $22,$A3,y,x,a,cl,ch,sl,sh TXA ;cl,ch=caller return address PHA ;sl,sh=superroutine return address TYA PHA LDA #>(savrta-$01) PHA LDA #<(savrta-$01) PHA .savit0 LDY #$05 ;duplicate y,x,a,cl,ch .savit1 TSX LDA stack+$07,X PHA DEY BNE savit1 LDY #$0A ;copy top 10 bytes down 2 places: .savit2 LDA stack+$09,X ;overwrite bottom copy of cl,ch STA stack+$0B,X DEX DEY ;stack now contains: BNE savit2 ;y,x,y,x,a,cl,ch,$22,$A3,y,x,a,sl,sh PLA ;discard y,x: PLA .savrta ;Restore AXY and return to superroutine PLA TAY PLA TAX PLA RTS .savit ;Save XY PHA ;push y,x,a TXA PHA TYA PHA JSR savit0 ;restack then "call" rest of caller's routine! TSX ;get stack pointer STA stack+$03,X ;store A on exit from caller in stack: JMP savrta ;restore y,x on entry, a on exit. .L8426 ;Convert binary value in A to BCD JSR savit ;save XY TAY ;if A=0 BEQ L8436 ;then nothing to do, return A=0 CLC ;else clear carry for add SED ;set BCD mode LDA #$00 ;start with A=0: .L8430 ADC #$01 ;add 1 in BCD mode (C=0) DEY ;loop until conversion complete BNE L8430 CLD ;then clear BCD mode and exit .L8436 RTS ;unreachable code ;was *DUMP character filtering AND #$7F CMP #$7F BEQ L8441 CMP #$20 BCS L8443 .L8441 LDA #$2E .L8443 RTS .L8444 ;Convert ASCII digit to binary and validate SEC ;C=1 iff invalid SBC #$30 BCC L845F ;(redundant) CMP #$0A RTS ;unreachable code ;Convert ASCII hex digit to binary and validate JSR setcap ;uppercase letter in A JSR L8444 ;convert ASCII digit to binary and validate BCC L845E ;if in range 0..9 then return C=0 SBC #$07 ;else subtract 7; now C=1, A >= 3 BCC L845F ;(redundant) CMP #$0A ;if A < 10 then invalid digit BCC L845F ;so return C=1 CMP #$10 ;else C=0 if 10 <= A < 16, otherwise return C=1 .L845E RTS .L845F SEC RTS .L8461 ;Input number up to 3 digits JSR setupr ;call GSINIT with C=0 SEC BEQ L848D ;if no argument then exit Z=1, C=1 PHP LDA #$00 ;else set total = 0 STA etemp BEQ L8482 ;and branch into loop (always) .L846E JSR L8444 ;convert ASCII digit to binary and validate BCS L848C ;if digit invalid return Z=0, C=1 STA ztemp ;else store new unit LDA etemp ;double total ASL A ;(Can save 1 byte: ASL etemp) STA etemp ASL A ;multiply by four: A = 8 * total ASL A ADC etemp ;add 2 * total ADC ztemp ;add unit: A = 10 * total + unit STA etemp ;store new total: .L8482 JSR gsread ;call GSREAD, get next character BCC L846E ;if character present then convert it LDA etemp ;else put total in A PLP ;restore flags from GSINIT: Z=0 CLC ;return Z=0, C=0, number valid RTS .L848C PLP .L848D RTS .wdcat ;FSC 5 = *CAT JSR stxylp ;set GSINIT pointer to XY, set Y=0 JSR readrv ;[D]select specified or default drive JSR L93C0 ;load catalogue LDY #$FF STY linno ;print a newline before first entry INY STY utemp ;CSD printed first, directory char = NUL .cat8 LDA dirlow,Y ;y=0; if Y=0..7 get char from sector 0 CPY #$08 ;if Y=8..11 BCC cat9 LDA dirhig-$08,Y ;then get character of title from sector 1 .cat9 JSR pchr ;print character in A (OSASCI) INY ;loop until 12 characters of title printed CPY #$0C BNE cat8 JSR vstrng ;print " (" EQUS " (" LDA cycno ;get BCD catalogue cycle number JSR bytout ;print hex byte JSR vstrng ;print ") FM" +newline +"Drive " EQUS ") FM" EQUB $0D EQUS "Drive " LDA fdrive JSR digout LDY #$0D JSR yspace ;print number of spaces in Y JSR vstrng ;print "Option " EQUS "Option " LDA option ;get boot option/top bits volume size JSR sfour ;shift A right 4 places PHA ;a=0..3; save for printing descriptor JSR digout ;print hex nibble JSR vstrng ;print " (" EQUS " (" LDY #$03 ;4 characters to print PLA ASL A ;multiply boot option by 4 ASL A TAX ;transfer to X for use as offset .cat5 LDA opttab,X ;get character of boot option descriptor JSR pchr ;print character in A (OSASCI) INX ;increment offset DEY ;decrement count BPL cat5 ;loop until 4 characters printed JSR vstrng ;print ")" + newline + "Dir. :" EQUS ")" EQUB $0D EQUS "Dir. :" LDA defdsk ;get default drive JSR dpdot ;print digit and dot LDA defqua ;get default directory JSR pchr ;print character in A (OSASCI) LDY #$0B JSR yspace ;print number of spaces in Y JSR vstrng ;print "Lib. :" EQUS "Lib. :" LDA libdsk ;get library drive JSR dpdot ;print digit and dot LDA libqua ;get library directory JSR pchr ;print character in A (OSASCI) JSR pcrlf ;print newline LDY #$00 .cat0 CPY dirlen ;have we reached the end of the catalogue? BCS catscn ;if so then start sorting entries LDA modify,Y ;else get directory character of cat entry EOR defqua ;compare with default (CSD) directory AND #$5F ;mask off lock bit, make caseless BNE cat1 ;if directories differ skip to next entry LDA modify,Y ;else set directory character to NUL AND #$80 ;and preserve lock bit STA modify,Y .cat1 JSR step ;add 8 to Y BCC cat0 ;and loop (always) .catscn LDY #$00 ;y=$00, start at first file entry JSR findir ;find unlisted catalogue entry BCC newbst ;if entries remaining then print them LDA #$FF ;else finish catalogue STA catdrv ;forget catalogue in workspace JMP pcrlf ;print newline .nxtcat ;Find next unlisted catalogue entry JSR step ;add 8 to Y .findir ;Find unlisted catalogue entry CPY dirlen ;if catalogue pointer beyond last file BCS findx ;then return C=1 LDA catdun,Y ;else test first character of leaf name BMI nxtcat ;if b7=1 then already listed, skip .findx RTS ;else return C=0, catalogue pointer in Y .newbst STY ltemp ;save catalogue pointer LDX #$00 ;set filename offset = 0 .catlop LDA catlow,Y ;copy name and directory of first entry JSR setcap ;with b7 clear and capitalised STA dosram,X ;to workspace INY INX CPX #$08 ;loop until 8 characters copied BNE catlop .cattry JSR findir ;find unlisted catalogue entry BCS scand ;if none remaining then print lowest entry SEC ;else set C=1 for subtraction LDX #$06 ;start at 6th character (LSB) of leaf name: .catsbc LDA catlow+$06,Y ;get character of entry JSR setcap ;clear bit 7, make uppercase SBC dosram,X ;subtract character of workspace DEY ;loop until 7 characters compared DEX BPL catsbc JSR step7 ;add 7 to Y LDA modify,Y ;get directory character (MSB) of entry JSR setcap ;mask off lock bit, make uppercase SBC dosram+$07 ;subtract directory character in workspace BCC newbst ;if entry < wksp then copy entry to wksp JSR step ;else add 8 to Y BCS cattry ;and loop (always) .scand LDY ltemp ;get catalogue pointer LDA catdun,Y ;set b7 in first character of leaf name ORA #$80 ;marking entry as listed STA catdun,Y LDA dosram+$07 ;get directory character from workspace CMP utemp ;compare with last one printed BEQ sameq ;if same then add entry to group LDX utemp ;else test previous directory STA utemp ;set previous directory = current directory BNE sameq ;if prev=NUL we go from CSD to other dirs JSR pcrlf ;so print double newline: .cat3 JSR pcrlf ;print newline LDY #$FF ;set Y = $FF going to 0, start of line BNE firstc ;branch (always) .sameq LDY linno ;have we printed two entries on this line? BNE cat3 ;if so then print newline and reset counter LDY #$05 ;else tab to next field. Y = 5 spaces JSR yspace ;print number of spaces in Y, set index = 1: .firstc INY STY linno ;y = index of next entry on this line LDY ltemp ;get catalogue pointer JSR pdspc ;print two spaces JSR prtnam ;print filename from catalogue JMP catscn ;loop until all files listed .opttab ;Table of boot option descriptors 0..3 EQUS "off",$00 EQUS "LOAD" EQUS "RUN",$00 EQUS "EXEC" .dskadr ;Test if new file will fit after current file LDA cathig+$06,Y ;get top bits exec/length/load/start sector JSR isolen ;extract b5,b4 of A = MSB length STA lbahi ;save length in zero page (big-endian) CLC ;can save 1 byte (CMP #$01) LDA #$FF ;subtract 1 from LSB length ADC cathig+$04,Y ;setting C=1 if file includes partial sector LDA cathig+$07,Y ;add LSB start LBA + 2MSB length + C ADC cathig+$05,Y ;=LSB LBA after last sector of file STA lbalo ;save LBA in zero page (big-endian) LDA cathig+$06,Y ;get top bits exec/length/load/start sector AND #$03 ;extract MSB start LBA ADC lbahi ;add MSB start LBA + MSB length + C STA lbahi ;=MSB LBA after last sector of file: .dskspc ;Test if new file will fit at current LBA SEC LDA cathig-$01,Y ;subtract LSBs LBA of file - current LBA SBC lbalo PHA ;=LSB no. free sectors after file LDA cathig-$02,Y ;get top bits exec/length/load/start sector AND #$03 ;extract MSB start LBA SBC lbahi ;subtract MSB current LBA TAX ;=MSB no. free sectors after file LDA #$00 ;compare no. free sectors - file size in sectors CMP lenlo ;c=0 iff file includes a partial sector PLA ;compare 2MSBs SBC lenhi TXA ;compare MSBs SBC lenhl ;return C=1 file will fit, C=0 file won't fit. .return RTS .comtab ;DFS command table EQUS "ACCESS" ;*ACCESS $89AC EQUB >(access-$01),<(access-$01) EQUB $32 ;syntax $2,$3: (L) EQUS "BACKUP" ;*BACKUP $A436 EQUB >(cpydsk-$01),<(cpydsk-$01) EQUB $04 ;syntax $4: EQUS "COMPACT" ;*COMPACT $A263 EQUB >(compct-$01),<(compct-$01) EQUB $07 ;syntax $7: () EQUS "COPY" ;*COPY $A482 EQUB >(cpyfil-$01),<(cpyfil-$01) EQUB $24 ;syntax $4,$2: EQUS "DESTROY" ;*DESTROY $8756 EQUB >(destry-$01),<(destry-$01) EQUB $02 ;syntax $2: EQUS "DIR" ;*DIR $8905 EQUB >(set -$01),<(set -$01) EQUB $06 ;syntax $6: () EQUS "DRIVE" ;*DRIVE $87B0 EQUB >(drive -$01),<(drive -$01) EQUB $09 ;syntax $9: () (40)(80) EQUS "ENABLE" ;*ENABLE $8B0D EQUB >(enable-$01),<(enable-$01) EQUB $00 ;syntax $0: no arguments EQUS "FORM" ;*FORM $A5DE EQUB >(form -$01),<(form -$01) EQUB $BA ;syntax $A,$B: 40/80 ()... EQUS "FREE" ;*FREE $A812 EQUB >(free -$01),<(free -$01) EQUB $07 ;syntax $7: () EQUS "LIB" ;*LIB $8909 EQUB >(slib -$01),<(slib -$01) EQUB $06 ;syntax $6: () EQUS "MAP" ;*MAP $A815 EQUB >(map -$01),<(map -$01) EQUB $07 ;syntax $7: () EQUS "RENAME" ;*RENAME $8B72 EQUB >(rename-$01),<(rename-$01) EQUB $05 ;syntax $5: EQUS "TITLE" ;*TITLE $897D EQUB >(title -$01),<(title -$01) EQUB $08 ;syntax $8: EQUS "VERIFY" ;*VERIFY $A5DA EQUB >(verify-$01),<(verify-$01) EQUB $0B ;syntax $B: (<drive>)... EQUS "WIPE" ;*WIPE $8712 EQUB >(wipe -$01),<(wipe -$01) EQUB $02 ;syntax $2: <afsp> ;unrecognised command, *RUN it $8835 EQUB >(defcom-$01),<(defcom-$01) .initbl ;Utility command table EQUS "DISC" ;*DISC $9B6B EQUB >(init -$01),<(init -$01) EQUB $00 ;syntax $0: no arguments EQUS "DISK" ;*DISK $9B6B EQUB >(init -$01),<(init -$01) EQUB $00 ;syntax $0: no arguments ;unrecognised utility, return $8626 EQUB >(return-$01),<(return-$01) .hlptab ;*HELP keyword table EQUS "DFS" ;*HELP DFS $A125 EQUB >(help -$01),<(help -$01) EQUB $00 ;syntax $0: no arguments ;unrecognised keyword, skip $A15D EQUB >(nohelp-$01),<(nohelp-$01) .wname ;FSC 3 = unrecognised *command JSR stxylp ;set GSINIT pointer to XY, set Y=0 LDX #<(comtab-comtab-$03) ;command table offset = $FD going to 0: .wname0 TYA ;save string offset PHA .thunk INX ;skip action address, 2 bytes INX PLA ;restore offset of start of command line PHA TAY JSR setupr ;call GSINIT with C=0 INX ;skip syntax byte LDA comtab,X ;fetch first byte BMI finish ;if terminator,empty keyword matches anything DEX ;else decrement X and Y to stay in place: DEY STX comtxt .firch INX ;advance command line and table offsets INY LDA comtab,X ;get byte from table BMI chklst ;if terminator, check command also terminates EOR (linptr),Y ;else compare with character of command AND #$5F ;make comparison case-insensitive BEQ firch ;if equal then compare next characters DEX .minus INX ;scan keyword in table LDA comtab,X BPL minus ;loop until terminator reached LDA (linptr),Y ;get mismatching character of command CMP #$2E ;is it a dot? abbreviation if so, else mismatch BNE thunk ;if mismatch then skip syntax, scan next kywd INY ;else advance command line offset past the dot: BCS finish ;accept abbreviated command (always) .chklst LDA (linptr),Y ;get character of command JSR caps ;set C=0 iff character in A is a letter BCC thunk ;if so then command longer than keyword, no match .finish ;Accept command PLA ;discard offset to start of command LDA comtab,X ;get action address high byte PHA ;store high byte of vector LDA comtab+$01,X ;get action address low byte PHA ;store low byte of vector RTS ;execute command. .stxylp ;Set GSINIT pointer to XY, set Y=0 STX linptr+$00 STY linptr+$01 LDY #$00 RTS .setupr ;Call GSINIT with C=0 CLC ;c=0 space or CR terminates unquoted strings JMP gsinit ;jump to GSINIT .wipe ;*WIPE JSR setwld ;allow wildcard characters in filename JSR chksyn ;call GSINIT with C=0 and require argument JSR getlok ;ensure file matching spec in catalogue .qdel0 LDA modify,Y ;test lock bit BMI qdel4 ;if b7=1 then deletion not allowed, skip JSR prtnam ;else print filename from catalogue JSR LA403 ;print " : " and ask user yes or no BNE qdel2 ;if user replies no then find next match LDX vtemp ;[D] hold catalogue pointer; what clobbers?? JSR chksam ;else ensure disc not changed STX vtemp ;[D] restore catalogue pointer to zero page JSR deldec ;delete catalogue entry STY ltemp ;[D] stash updated catalogue pointer elsewhere JSR dirout ;write volume catalogue; does it wipe pointer?? LDA ltemp ;[D] put catalogue pointer back in workspace STA vtemp .qdel2 JSR pcrlf ;print newline .qdel4 JSR next ;find next matching file BCS qdel0 ;if found then wipe the file RTS ;else exit ;unreachable code ;was *DELETE JSR clrwld ;disallow wildcard characters in filename JSR chksyn ;call GSINIT with C=0 and require argument JSR getlok ;ensure file matching spec in catalogue JSR inform ;print *INFO line if verbose JSR delfil ;delete catalogue entry JMP dirout ;write volume catalogue .destry ;*DESTROY JSR chkena ;ensure *ENABLE active JSR setwld ;allow wildcard characters in filename JSR chksyn ;call GSINIT with C=0 and require argument JSR getlok ;ensure file matching spec in catalogue .destr1 LDA modify,Y ;test lock bit BMI destr5 ;if b7=1 then deletion not allowed, skip JSR prtnam ;else print filename from catalogue JSR pcrlf ;print newline .destr5 JSR next ;find next matching file BCS destr1 ;loop until all unlocked files listed JSR sure ;print "Go?" and ask user yes or no BEQ destr2 ;if user replies yes then destroy files JMP pcrlf ;else print newline and exit .destr2 JSR chksam ;ensure disc not changed JSR lookup ;search for file in catalogue .destr3 LDA modify,Y ;test lock bit BMI destr4 ;if b7=1 then deletion not allowed, skip JSR deldec ;else delete file and decrement catalogue pointer .destr4 JSR next ;find next matching file BCS destr3 ;loop until all unlocked files deleted JSR dirout ;write volume catalogue JSR vstrng ;print "Deleted" and exit EQUB $0D EQUS "Deleted" EQUB $0D .step ;Add 8 to Y INY .step7 ;Add 7 to Y INY INY INY INY INY INY INY RTS .deldec ;Delete file and decrement catalogue pointer JSR delfil ;delete file LDY vtemp ;put catalogue pointer in Y JSR unstep ;subtract 8 from Y STY vtemp ;save new catalogue pointer RTS .drive ;*DRIVE JSR chksyn ;call GSINIT with C=0 and require argument JSR getdrv ;select specified drive STA defdsk ;set default drive = current drive JSR L8461 ;input number up to 3 digits BEQ L87D7 ;if no number given then preserve 40/80 setting CMP #$28 ;else does number = 40? BEQ L87CA ;if so then C=1, set drive to 40 tracks CMP #$50 ;else does number = 80? CLC BEQ L87CA ;if so then C=0, set drive to 80 tracks JMP synerr ;else raise "Syntax: " error. .L87CA ;Set default drive to 40/80 tracks PHP ;save C=1 40 track drive, C=0 80tracks [D]new LDX defdsk ;get default drive LDA LC2DE,X ;get flags for default drive ROL A ;shift bit 7 into carry flag PLP ;restore state of carry flag on entry ROR A ;move carry flag into b7, preserve b6..0 STA LC2DE,X ;save updated drive flags .L87D7 RTS .dodriv ;Select drive in A AND #$03 ;[D]no disc operation STA fdrive ;mask drive number 0..3, set current drive RTS .loader ;OSFILE $FF = load file JSR frmlok ;ensure file matching argument in catalogue JSR tryfl0 ;set up pointer to user's OSFILE block JSR chukbk ;return catalogue information to OSFILE block LDA #$80 .loadt ;Load file into memory STA LC290+$06 ;[D] store command in high OSWORD $7F control block STY lodcat ;save catalogue offset of found file LDX #$00 LDA exelo ;test offset 6, LSB exec from OSFILE block BNE reloc ;if non-zero, use load address in catalogue INY ;else skip first two bytes of catalogue entry INY LDX #$02 ;skip over user-supplied load address in zp BNE loadt0 ;branch (always) .reloc LDA cathig+$06,Y ;get top bits exec/length/load/start sector STA lbahi JSR decodl ;expand 18-bit load address to 32-bit .loadt0 LDA cathig,Y ;copy load/exec/length/start from catalogue STA wrkcat,X ;into low words of OSFILE block INY ;(our copy, gave user theirs at loader+$06) INX CPX #$08 ;loop until 8 or 6 bytes copied, 0..7/2..7 BNE loadt0 JSR decode ;expand 18-bit exec address to 32-bit LDY lodcat ;restore catalogue offset of found file JSR inform ;print *INFO line if verbose JMP blkxx ;read ordinary file L5 and exit ;can save 1 byte: fall through, L8826 does BNE/BRA .blkrd ;Read ordinary file L5 LDA #$80 BNE L8826 .saver ;OSFILE 0 = save file JSR dirdo ;create file from OSFILE block JSR tryfl0 ;set up pointer to user's OSFILE block JSR chukbk ;return catalogue information to OSFILE block .blkwr ;Write ordinary file L5 LDA #$A0 .L8826 STA LC290+$06 ;store command in high OSWORD $7F control block: .blkxx ;Transfer ordinary file L5 JSR atot ;prepare ordinary file transfer JSR L93F9 ;transfer data and report errors L4 LDA #$01 ;return A=1, file found ;(appears in A on exit from OSFILE 0/$FF ;but these calls define no return value) RTS .wnota ;FSC 2/4/11 = */, *RUN, *RUN from library JSR stxylp ;set GSINIT pointer to XY, set Y=0 .defcom ;FSC 3 with *command not in table JSR supld ;copy argument ptr and load to cat address STY linadr+$01 ;store offset of start of command line JSR frmnam ;set current file from argument pointer STY linadr+$00 ;store offset of command line tail JSR L8271 ;search for file in catalogue BCS defsuc ;if found then execute command binary LDY linadr+$01 ;else restore offset of start of command line LDA libqua ;get library directory STA qualif ;set as current directory LDA libdsk ;get library drive JSR dodriv ;select drive in A JSR frmnm1 ;parse file spec from argument pointer JSR L8271 ;search for file in catalogue BCS defsuc ;if found then execute it LDA linptr+$00 ;[D]else get LSB of GSINIT pointer ADC linadr+$01 ;add offset of start of command line TAX ;hold in X LDY linptr+$01 ;put MSB of GSINIT pointer in Y BCC L8867 ;carry out to MSB INY .L8867 LDA #$0B ;[D]pass to library FS JMP osfscm ;[BUG]no infinite loop check like ADFS .defsuc ;Execute command binary LDA cathig+$06,Y ;[D]test exec address JSR isoexe CMP #$03 ;if b17 or b16 clear BNE L88BA ;then run as executable LDA cathig+$02,Y ;else both set. AND low bytes of exec address AND cathig+$03,Y CMP #$FF ;if exec address <> $FFFFFFFF BNE L88BA ;then run as executable LDX #$06 ;else 7 characters to move: .L8882 LDA buffer,X ;shift filename down 7 characters STA buffer+$07,X DEX BPL L8882 LDA #$0D ;add CR command line terminator STA buffer+$0E LDA #$45 ;prepend "E.:<drv>.<dir>." STA buffer+$00 LDA #$2E STA buffer+$01 LDA #$3A STA buffer+$02 LDA fdrive ORA #$30 STA buffer+$03 LDA #$2E ;can save 2 bytes here STA buffer+$04 STA buffer+$06 LDA qualif STA buffer+$05 LDX #<buffer ;*EXEC the file. LDY #>buffer JMP oscli .L88BA LDA #$81 ;$81 = read sector + execute privilege JSR loadt ;load file into memory CLC LDA linadr+$00 ;get offset of command line tail TAY ;and pass to command in Y (if on host) ADC linptr+$00 ;add it to GSINIT pointer in $F2,3 STA linadr+$00 ;giving command line tail pointer LDA linptr+$01 ;save it in linptr for OSARGS 1 (redundant) ADC #$00 STA linadr+$01 LDA exlow+$02 ;and high bytes of address AND exlow+$03 ;a=$FF if address is in the host ORA notube ;a=$FF if Tube absent (inverted MOS flag) CMP #$FF ;if host address or Tube absent BEQ runho ;then jump indirect LDA exelo ;else copy low word of exec address STA exlow+$00 ;over high word of load addr in OSFILE block LDA exehi STA exlow+$01 JSR clatub ;claim Tube LDX #<exlow ;point XY to 32-bit execution address LDY #>exlow LDA #$04 ;tube service call $04 = *Go JMP tubadr ;jump into Tube service .runho ;Execute command on host LDA #$01 ;enter with A=$01, entering executable?? JMP (exelo) ;jump to execution address .supld ;Copy argument ptr and load to cat address LDA #$FF ;lsb exec address in our OSFILE block = $FF: STA exelo ;load executable to load address in catalogue LDA linptr+$00 ;copy GSINIT string pointer to zero page STA work+$00 ;= command line pointer LDA linptr+$01 STA work+$01 RTS .set ;*DIR LDX #defqua-defqua ;point X to default directory/drive BEQ slib1 ;branch (always) .slib ;*LIB LDX #libqua-defqua ;point X to library directory/drive .slib1 JSR readdf ;set current directory STA defdsk,X ;set as default/library drive LDA qualif ;get current directory STA defqua,X ;set as default/library directory RTS .savmem ;Copy shared workspace to private page JSR savita LDA temp+$00 ;save current contents of page pointer PHA LDA temp+$01 PHA JSR suspri ;set up pointer to private page LDY #$00 ;[D]opto .relme1 CPY #$C0 ;store persistent main and channel workspace BCC relme2 ;(wrapped around so that private page LDA mainws,Y ;contains: $00..$BF=seqmap, $C0..$ED=mainws) BCS relme3 .relme2 LDA seqmap,Y .relme3 STA (temp),Y INY CPY #sramws ;[D]stop at SRAM workspace BNE relme1 PLA ;restore old contents of page pointer STA temp+$01 PLA STA temp+$00 RTS .readdf ;Set current directory LDA defqua ;get default directory STA qualif ;set as current directory JSR setupr ;call GSINIT with C=0 BNE readd0 ;if argument present then parse it LDA #$00 ;else default to drive 0 JSR dodriv ;select drive in A BEQ set3 ;and exit (always) .readd0 ;Parse directory spec LDA defdsk ;get default drive JSR dodriv ;select drive in A .set4 JSR rdchr ;call GSREAD and validate filename character BCS illdir ;if invalid then raise "Bad dir" error CMP #$3A ;else is character a colon? BNE set0 ;if not then accept directory character JSR getdrv ;else JSR rdchr ;else call GSREAD BCS set3 ;if ":" by itself then "Bad drive" error CMP #$2E ;else is character a full stop? BEQ set4 ;if so then expect a directory character, else: .illdir ;Raise "Bad dir" error JSR illmsg EQUB $CE EQUS "dir" EQUB $00 .set0 STA qualif ;set directory from ASCII character JSR rdchr ;if not at end of argument BCC illdir ;then raise "Bad dir" error .set3 LDA fdrive ;else return drive number. RTS .title ;*TITLE JSR chksyn ;call GSINIT with C=0 and require argument JSR setdef ;set current drive and dir = default JSR getdir ;load volume catalogue L4 LDX #$0B ;first offset to store = 11 LDA #$00 ;set title to 12 NULs: .clrti0 JSR titwit ;store character of title DEX ;loop until 12 characters stored BPL clrti0 .titset INX ;x=$FF, set X=0 offset of first character JSR rdchr ;call GSREAD BCS titend ;if end of argument write catalogue JSR titwit ;else store character of title CPX #$0B ;is this the twelfth character written? BCC titset ;if not then loop to write more, else: .titend JMP dirout ;write volume catalogue and exit ;can save 3 bytes (join; acces1 BCC booto) .titwit ;Store character of title CPX #$08 ;if offset is 8 or more BCC titllw STA dirhig-$08,X ;then store second sector, X=8..11 RTS .titllw STA dirlow,X ;else store in first sector, X=0..7 RTS .access ;*ACCESS JSR setwld ;allow wildcard characters in filename JSR chksyn ;call GSINIT with C=0 and require argument JSR getnam ;set current file from argument LDX #$00 ;preset X=$00 file unlocked JSR setupr ;call GSINIT with C=0 BNE acces5 ;if argument is empty .acces0 STX utemp ;then attribute mask = $00, file unlocked JSR lookup ;search for file in catalogue BCS acces1 ;if not found JMP nofil ;then raise "Not found" error ;can save 5 bytes (JSR errlok) .acces1 JSR chkopn ;ensure file not open (mutex) LDA modify,Y ;get directory character from catalogue AND #$7F ;mask off old attribute ORA utemp ;apply new attribute STA modify,Y ;put back in catalogue JSR inform ;print *INFO line if verbose JSR next ;find next matching file BCS acces1 ;if found then set its attribute BCC titend ;else write volume catalogue and exit .acces6 LDX #$80 ;found L, set bit 7 to indicate file locked: .acces5 JSR rdchr ;call GSREAD, get character of attribute BCS acces0 ;if end of string then set attribute AND #$5F ;else clear bit 7, make uppercase CMP #$4C ;is character "L" or "l"? BEQ acces6 ;if so then set bit 7 JSR illmsg ;else raise "Bad attribute" error. EQUB $CF EQUS "attribute" EQUB $00 .wfopt ;FSC 0 = *OPT JSR savita ;save AXY TXA CMP #$04 ;is it *OPT 4? BEQ booto ;if so go and set boot option CMP #$02 ;else is it *OPT 0 or *OPT 1? BCC setmon ;if so go and set monitoring option JSR illmsg ;else raise "Bad option" error. EQUB $CB EQUS "option" EQUB $00 .setmon ;*OPT 0 / *OPT 1 monitor LDX #$FF TYA ;is verbosity level =0? BEQ stmon0 ;if so then set flag = $FF LDX #$00 ;else level >0, set flag = 0. .stmon0 STX monflg RTS .booto ;*OPT 4 set boot option TYA ;save requested option PHA JSR setdef ;set current drive and dir = default JSR L93C0 ;load volume catalogue PLA ;restore option JSR lfour ;shift A left 4 places EOR option ;xor new option with old AND #$30 ;clear all but option bits 5,4 EOR option ;b5,4 contain new option, others preserved STA option ;store new option in catalogue JMP dirout ;write volume catalogue and exit. .noroom ;Raise "Disk full" error. JSR dskmsg EQUB $C6 EQUS "full" EQUB $00 .dirdo ;OSFILE 7 = create file JSR frmnam ;set current file from argument pointer JSR lookup ;search for file in catalogue BCC filels ;if found JSR delfil ;then delete catalogue entry .filels LDA strtlo ;save start address low word PHA LDA strthi PHA SEC ;subtract end address - start address LDA endlo ;(24 bits) yielding file length SBC strtlo STA lenlo LDA endhi SBC strthi STA lenhi LDA endhl SBC strthl STA lenhl JSR genfil ;create catalogue entry LDA strthh ;copy start address high word to data pointer STA ldlow+$03 LDA strthl STA ldlow+$02 PLA ;restore low word to data pointer STA lodhi PLA STA lodlo RTS .genfil ;Create catalogue entry LDA #$00 ;start of data area = LBA $0002 STA lbahi ;set MSB of LBA = 0 LDA #$02 ;a=no. reserved sectors in data area STA lbalo ;set as LSB of LBA LDY dirlen ;get number of files in catalogue * 8 CPY #$F8 ;if there are already 31 files BCS dirful ;then raise "Cat full" error, else: JSR dskspc ;test if new file will fit at current LBA JMP spachk ;jump into loop .spalop BEQ noroom ;if cat ptr = 0 then raise "Disk full" error JSR unstep ;else subtract 8 from Y JSR dskadr ;test if new file will fit after current file .spachk TYA ;test if catalogue pointer > 0 BCC spalop ;if file won't fit then test prev cat entry STY temp ;else insert new catalogue entry here LDY dirlen ;point Y to last valid catalogue entry: .moveup CPY temp ;compare pointer with insertion point BEQ insnam ;stop copying if insertion point reached LDA catlow-$01,Y ;else copy current catalogue entry STA catlow+$07,Y ;to next slot LDA cathig-$01,Y ;leaving one slot open STA cathig+$07,Y ;for new catalogue entry DEY ;decrease pointer to work back from end BCS moveup ;and loop (always) .insnam ;Write entry into catalogue at Y=0..$F0 LDX #$00 ;offset into current filename = 0 JSR encode .namin LDA wrknam,X ;get character of current filename+dir STA catlow,Y ;store in catalogue INY ;increment both offsets INX CPX #$08 ;loop until 8 bytes copied: BNE namin .varin ;Write load/exec/length/start into catalogue LDA wrkcat-$01,X ;x=8..1 copy from wrkcat DEY ;y=catalogue pointer + 7..0 STA cathig,Y ;copy to catalogue address fields DEX ;loop until 8 bytes copied BNE varin JSR inform ;print *INFO line if verbose TYA ;save catalogue pointer PHA LDY dirlen ;get number of files in catalogue * 8 JSR step ;add 8 to Y STY dirlen ;store new file count JSR dirout ;write volume catalogue PLA ;restore catalogue pointer TAY RTS .dirful ;Raise "Cat full" error. JSR estrng EQUB $BE EQUS "Cat full" EQUB $00 .encode ;Compose top bits exec/length/load/start LDA exlow+$02 ;get b17,b16 exec address AND #$03 ;place in b1,b0 of A, clear b7..b2 ASL A ;shift A left 2 places ASL A ;a = ....ee.. EOR lenhl ;place b17,b16 of length in b1,b0 AND #$FC ;keep b7..b2 of A EOR lenhl ;a = ....eell ASL A ;shift A left 2 places ASL A ;a = ..eell.. EOR ldlow+$02 ;place b17,b16 of load address in b1,b0 AND #$FC ;keep b7..b2 of A EOR ldlow+$02 ;a = ..eelldd ASL A ;shift A left 2 places ASL A ;a = eelldd.. EOR lbahi ;place b10,b9 of start LBA in b1,b0 AND #$FC ;keep b7..b2 of A EOR wrkcat+$06 ;a = eellddss STA wrkcat+$06 ;set top bits exec/length/load/start sector RTS .enable ;*ENABLE LDA #$01 ;set *ENABLE flag = 1; will be nonnegative STA enaflg ;(after FSC 8) for next *command only. RTS .decodl ;Expand 18-bit load address to 32-bit LDA #$00 STA ldlow+$03 ;set MSB of address = $00 LDA wrkcat+$06 ;get top bits exec/length/load/start sector JSR isolod ;extract bit 3 to bits 1 and 0 CMP #$03 ;redundant (BEQ decdl0) BNE decdl0 ;if clear then set high word = $0000 LDA #$FF ;else set high word of OSFILE load address = $FFFF STA ldlow+$03 .decdl0 STA ldlow+$02 RTS .decode ;Expand 18-bit exec address to 32-bit LDA #$00 STA exlow+$03 ;set MSB of address = $00 LDA wrkcat+$06 ;get top bits exec/length/load/start sector JSR isoexe ;extract b7,b6 of A CMP #$03 ;if b7,b6 both set BNE decde0 LDA #$FF ;then a host address, set high word = $FFFF STA exlow+$03 .decde0 STA exlow+$02 ;else set 2MSB parasite address $0..2FFFF RTS .setdef ;Set current drive and directory = default LDA defqua ;get default directory STA qualif ;set as current directory: .setddr ;Select default drive LDA defdsk ;get default drive JMP dodriv ;select drive in A .readrv ;Select specified or default drive JSR setupr ;call GSINIT with C=0 BEQ setddr ;if argument empty select default drive, else: .getdrv ;Set current drive from argument JSR rdchr ;call GSREAD and validate filename character BCS drverr ;if invalid then raise "Bad drive" error CMP #$3A ;else is character a colon? BEQ getdrv ;if so then skip it and loop SEC SBC #$30 ;else convert ASCII digit to binary BCC drverr ;redundant CMP #$04 ;ensure drive number in range 0..3 BCS drverr ;if not then raise "Bad drive" error JSR dodriv ;else select drive in A CLC ;return C=0, drive spec valid RTS .drverr ;Raise "Bad drive" error JSR illmsg EQUB $CD EQUS "drive" EQUB $00 .rename ;*RENAME JSR clrwld ;disallow wildcard characters in filename JSR chksyn ;call GSINIT with C=0 and require argument JSR getnam ;set current file from file spec TYA ;save command line offset PHA JSR errlok ;ensure matching file in catalogue JSR chkopl ;ensure file not locked or open (mutex) STY L00C4 ;save catalogue offset [D] was to itemp, $B3 PLA ;restore command line offset TAY JSR chksyn ;call GSINIT with C=0 and require argument LDA fdrive ;save current drive PHA JSR getnam ;set current file from file spec PLA ;restore current drive CMP fdrive ;compare with destination drive BNE drverr ;if rename across drives then "Bad command" JSR lookup ;else search for file in catalogue BCC ren4 ;if not found then update filename+dir CPY L00C4 ;else compare catalogue offsets BEQ ren4 ;if file specs match then allow case change JSR estrng ;else raise "Exists" error. EQUB $C4 EQUS "Exists" EQUB $00 .ren4 LDY L00C4 ;get catalogue offset of file JSR step ;add 8 to Y LDX #$07 ;8 characters to replace: .ren5 LDA wrknam,X ;get character of current filename+dir STA catlow-$01,Y ;store in catalogue DEY ;decrement both offsets DEX BPL ren5 ;loop until 8 bytes copied JMP dirout ;write volume catalogue and exit .L8BBC ;Internal OSWORD $7F handler CLC ;c=0 interrupts not enabled BCC L8BC1 ;branch into routine (always) .L8BBF ;Internal OSWORD $7F handler w/interrupts CLI ;enable IRQ handling SEC ;set carry flag to indicate this .L8BC1 ROR xtemp ;save interrupt flag state in xtemp STX temp+$00 ;set up pointer to caller's control block STY temp+$01 CLD ;clear decimal mode JSR L8C1C ;prepare for OSWORD $7F operation LDA L00A2 ;test result code BNE L8BD8 ;if recalibration failed then skip LDY #$05 ;else get number of OSWORD $7F parameters LDA (temp),Y BEQ L8BD8 ;if zero then skip JSR L8CD1 .L8BD8 LDY #$05 ;get number of OSWORD $7F parameters LDA (temp),Y CLC ;add 7 = offset of OSWORD $7F result ADC #$07 TAY ;set new offset LDA L00A2 ;get final controller status JSR L8C0D ;convert WD 1770 status to i8271 result STA (temp),Y ;store in caller's control block PHA ;save status for return CMP #$18 ;$18 = sector not found BNE L8BF1 ;if status matches LDA #$FF ;then mark both drives uncalibrated STA LC287 .L8BF1 LDA fdrive ;get drive number AND #$01 ;mask unit number TAY ;in Y as offset LDA track ;get track number of disc operation STA LC288,Y ;get track number of current unit JSR L8EDF ;write track register BIT L00A1 ;test Tube flag BPL L8C05 ;if Tube in use JSR L8F2F ;then release Tube .L8C05 JSR L8F13 ;release NMI LDA fdcdat ;read and discard FDC data register PLA ;restore result code for return RTS .L8C0D ;Convert WD 1770 status to i8271 result LDX #L90F3-L90ED-$01 ;start at end of table .L8C0F CMP L90ED,X ;scan table for known WD 1770 results BEQ L8C18 ;if match found then convert DEX ;else step to start of table BPL L8C0F ;loop until before first entry (X=$FF) RTS ;if not found return WD 1770 status. .L8C18 LDA L90F3,X ;return equivalent Intel 8271 result code RTS .L8C1C ;Prepare for OSWORD $7F operation JSR L8F04 ;claim NMI JSR L8F37 ;set track stepping speed from CMOS RAM LDA #$00 STA L00A1 ;clear read/write flag LDY #$09 ;copy bytes 9..11 of control block to zp .L8C28 LDA (temp),Y STA itemp-$09,Y ;sets itemp, atemp, ytemp from parms 3..5 INY CPY #$0C ;do not copy offset 12 BNE L8C28 LDY #$06 ;offset of command LDA (temp),Y ;get command byte AND #$F0 ;mask off flag bits (except m, multiple) CMP #$A0 ;is command $A0, write sector? BEQ L8C3E ;if so then C=1, set write flag CMP #$F0 ;else set C=1 if $F0, write track else C=0 .L8C3E ROR L00A1 ;b7=1 writing to disc, b7=0 reading from disc LDY #$03 ;offset of 2MSB data address LDA (temp),Y ;get 2MSB data address INY ;y=$04 AND (temp),Y ;and with MSB data address CMP #$FF ;if both = $FF then it's a host address CLC BEQ L8C69 ;so skip Tube setup with C=0, host transfer JSR L8EF4 ;else set Tube presence flag CLC BMI L8C69 ;if Tube absent then skip setup with C=0 JSR clatub ;else claim Tube LDA L00A1 ;flag=$80 write, $00 read ROL A ;convert to $01=bytes to disc, $00=bytes from disc ROL A AND #$01 ;redundant EOR #$01 ;flip b0: $00=bytes to host, $01=bytes from host LDX temp+$00 ;point XY to caller's control block LDY temp+$01 INX ;increment low byte of pointer BNE L8C65 ;carry out to high byte INY ;to point to data address in control block .L8C65 JSR tubadr ;call Tube service to set up data transfer SEC ;set C=1, transferring to Tube: .L8C69 ROR L00A1 ;set b7=Tube flag, b6=write flag JSR L8F48 ;install NMI service routine LDY #$00 ;$00 = offset of drive parameter LDA (temp),Y ;get drive number to operate on BMI L8C78 ;if b7=1 reuse current drive then skip AND #$0F ;else mask drive number and option bits STA fdrive ;set current drive .L8C78 LDA fdrive ;get current drive AND #$03 ;mask drive number 0..3 TAX ;transfer to X for use as index LDA LC2DE,X ;get flags for current drive STA LC28A ;set current drive flags LDA fdrive ;get current drive again LDY #$0A ;preset 10 sectors per track AND #$08 ;mask b3, force double density BEQ L8C8D ;if set LDY #$10 ;then set 16 sectors per track .L8C8D STY L00A3 ;set sectors per track EOR L90D1,X ;apply flags for drive 0..3 in X STA latch ;store in control latch [BUG] wrong DD bit LSR A ;c=0 drive 1/3; c=1 drive 0/2 LDX LC288+$00 ;get head position of chosen drive BCS L8C9E ;drive 0/2 LDX LC288+$01 ;or drive 1/3 .L8C9E LDY #$00 STY L00A2 ;clear result code/NMI busy flag LDA LC287 ;test b7=d0, b6=d1 uncal flags BIT LC287 BCC L8CB3 ;if drive 0 selected BPL L8CC4 ;and drive 0 uncal flag is set STY LC288+$00 ;then zero head position AND #$7F ;and clear uncal flag BPL L8CBA .L8CB3 BVC L8CC4 ;likewise for drive 1 STY LC288+$01 AND #$BF .L8CBA STA LC287 ;update uncal flags LDA #$00 ;$00 = restore JSR L8DC9 ;execute WD 1770 command in A LDX #$00 ;head now at track 0: .L8CC4 TXA ;store current track STA track JSR L8EDF ;write track register. .L8CCA RTS .L8CCB JMP L8E64 ;$C0 read address .L8CCE JMP L8DC9 ;execute WD 1770 command in A .L8CD1 JSR L8EB4 ;seek track BNE L8CCA ;if command failed then exit silently LDY #$06 ;get command byte LDA (temp),Y CMP #$10 ;if $10 seek BEQ L8CCA ;then we just did it, so exit CMP #$C0 ;if $C0 read address BEQ L8CCB ;then handle separately CMP #$E0 ;if $E0 read track/$F0 write track BCS L8CCE ;then execute WD 1770 command in A LDY #$08 ;2nd parm, starting sector LDA (temp),Y BIT xtemp ;if called from OSWORD $7F BMI L8D49 ;then use the i8271 emulator LDX ytemp ;else get ytemp set from XY+9 BEQ L8CF8 ;if transferring a partial sector INC itemp ;then round up LSB number of sectors BNE L8CF8 ;carry out to MSB INC atemp .L8CF8 JSR L90AF ;write sector register STA sector ;store current sector SBC L00A3 ;c=1; subtract number of sectors per track EOR #$FF ;take two's complement CLC ;can save 3 bytes (EOR #$FF:ADC L00A3) ADC #$01 ;=number of sectors to end of track STA L00A5 ;store sector count LDA atemp ;if more than 255 sectors to transfer BNE L8D2B ;then transfer rest of track LDA itemp ;else get LSB number of sectors BEQ L8D48 ;if zero then nothing to do, so exit CMP L00A5 ;else compare with span to end of track BEQ L8D14 ;if equal then transfer correct no. bytes BCS L8D2B ;if more then transfer rest of track .L8D14 STA L00A5 ;else set sector count LDX ytemp ;get number of bytes to transfer BEQ L8D2B ;if >0, i.e. partial sector STX L00A6 ;then set byte count ROR L00A1 ;set b0 of flag SEC ROL L00A1 CMP #$01 ;if doing no whole sectors, only partial BNE L8D2B ;then no sector advance occurs LDA L8FA7-L8F86+intnmi+$01 ;so emulate L8FA7: ?$0D4C=?$0D22 STA L8FD1-L8F86+intnmi+$01 ;discard/write zeroes at end of count .L8D2B LDA itemp ;get LSB number of sectors to transfer SEC ;subtract number of sectors in this operation SBC L00A5 ;store updated count of sectors remaining STA itemp LDA atemp ;borrow in from MSB SBC #$00 STA atemp JSR L8DC5 ;execute WD 1770 command BNE L8D48 ;if failed then exit silently LDA itemp ;else test number of sectors remaining ORA atemp BEQ L8D48 ;if none remaining then exit Z=1 JSR L8E81 ;else advance track and skip bad tracks BEQ L8CF8 ;if successful then loop to do next track .L8D48 RTS ;else exit .L8D49 JSR L90AF ;write sector register STA sector ;store current sector LDY #$09 ;3rd parm, sector size+count LDA (temp),Y AND #$1F ;mask off sector size code BEQ L8D48 ;if no sectors to transfer then exit Z=1 STA L00A5 ;else store sector count BIT L00A1 ;test write flag in b6 BVS L8DC5 ;if writing then execute WD 1770 command BIT LC28A ;else test disc op modifier (from C2DE,X) BVC L8DC5 ;if drive 0 and Z-BREAK in effect LDX #(L90AF-L901B+intnmi-ecowsp-$01) ;then X=size of overhang - $01: .L8D63 LDA ecowsp,X ;copy Econet reserved area STA buffer,X ;to buffer DEX BPL L8D63 JSR L8D7D ;emulate Intel 8271 disc operation LDX #(L90AF-L901B+intnmi-ecowsp-$01) ;x=size of saved Econet area .L8D71 LDA buffer,X ;restore Econet reserved workspace STA ecowsp,X ;from buffer DEX BPL L8D71 LDA L00A2 ;return final result code RTS .L8D7D ;Emulate Intel 8271 disc operation IF _BUGFIX LDA (temp),Y ;3rd parm, sector size+count STA atemp ;store in temp shift register AND #$80 ;extract b7 of byte = b2 of code BMI emudon ;%111 = 128 * 128 bytes/sec LDA #$08 ;%011 = 8 * 128 bytes/sec .emudon ASL atemp ;test b6 of byte, b1 of code BMI emudo1 ;if b6=0, %x0x LSR A ;then divide sector size by 4 LSR A .emudo1 ASL atemp ;test b5 of byte, b0 of code BMI emudo2 ;if b5=0, %xx0 LSR A ;then halve sector size .emudo2 LSR A ;halve again to get no. pages STA atemp ;store MSB sector size LDA #$00 ;clear LSB sector size ROR A ;shift carry into b7 STA itemp ;store LSB = 0 or 128 bytes ELSE LDA #$00 STA atemp ;clear MSB sector size LDA (temp),Y ;3rd parm, sector size+count AND #$E0 ;extract sector size code BNE L8D89 ;if %000, 128-byte sectors LDA #$10 ;then sector size = 128 bytes .L8D89 ASL A ;[BUG] not decoded! ROL atemp ;shift sector size code ASL A ;into MSB sector size b2..b0 ROL atemp ASL A ROL atemp STA itemp ;store LSB = 0 or 128 bytes TAX ;test LSB ENDIF BEQ L8D99 ;if sector size = 128 bytes INC atemp ;then treat as one (short) page .L8D99 JSR L8FF2 ;install i8271 emulator ISR LDA #$14 ;20 attempts STA vtemp+$01 .L8DA0 LDA #$E0 ;command = $E0 read track STA L00A2 ;set b7=1 ISR busy flag STA fdccmd ;store command register .L8DA7 LDA L00A2 ;test ISR busy flag BMI L8DA7 ;loop until ISR finished BNE L8DC4 ;if error occurred then exit LDA L00A5 ;else test no. sectors remaining BEQ L8DBA ;if no more then set result code DEC vtemp+$01 ;else decrement attempt counter BNE L8DA0 ;if attempts remaining then try again LDA #$10 ;else WD 1770 S4 = record not found STA L00A2 ;can save 1 byte: BNE L8DC4-$02 RTS .L8DBA LDA vtemp+$00 ;test found data address mark EOR #$FB ;if equal to $FB, normal DAM BEQ L8DC4 ;then return $00, good completion LDA #$20 ;else WD 1770 S5 = deleted data mark STA L00A2 .L8DC4 RTS .L8DC5 ;Execute WD 1770 command LDY #$06 LDA (temp),Y .L8DC9 ;Execute WD 1770 command in A LDY #$FF .L8DCB INY CMP L90D5,Y BNE L8DCB ;only recognised commands used, always terminates PHA ;save command LDA L90E1,Y ;get status code mask corresponding to command STA L8F8A-L8F86+intnmi+$01 ;set AND operand in NMI handler ROR L00A2 ;c=1; set b7 of flag PLA ;restore command BPL L8E29 ;if a Type I command then branch BIT L00A1 ;else test write flag BVC L8DE9 ;if writing to disc LDY track CPY #$14 ;and if track number >= 20 BCC L8DE9 ORA #$02 ;then enable write precompensation .L8DE9 STA L00A7 ;store command byte LDY #$01 ;if command = $C0, read address CMP #$C0 ;then Y=1 read one address BEQ L8E0A ;and no settling delay ORA #$04 ;else enable head settling delay BCS L8E0A ;if $F0 then write one track LDY L00A5 ;else $80/$A0 read/write Y sectors CMP #$85 ;if original command was $81 BEQ L8E04 ;(read w/privilege) then command=$80 CMP #$87 ;else if $83 (=$5E/$5F verify data) BNE L8E0A LDA #L8FD8-L8F8E-$02 ;then discard all data read during NMI STA L8F8E-L8F86+intnmi+$01 .L8E04 LDA #$80 ;set repeat command =$80 read sector STA L00A7 LDA #$84 ;actual first command =$84 read/settling .L8E0A STY L00A5 ;set count of items STA fdccmd ;send command to FDC CMP #$F0 ;if it is $F0, write track BCC L8E1B JSR L8E54 ;then wait until controller idle AND #$5C ;mask {WrProt NotFound CRCError LostData} STA L00A2 ;store command result RTS .L8E1B LDA L00A2 ;else wait until ISR finished BMI L8E1B CMP #$20 ;if deleted data was read?? BNE L8E26 JSR L8E5A ;then wait until controller idle .L8E26 LDA L00A2 ;return masked controller status RTS .L8E29 ;type I command LDY #$01 ;execute it once STY L00A5 ORA L00A4 ;apply stepping speed bits in b1,b0 STA fdccmd ;send command to FDC BIT xtemp ;if called from OSWORD $7F BMI L8E1B ;then wait for ISR and return status CMP #$20 ;else if $20 step/$40 step in/$60 step out BCS L8E1B ;then wait for ISR and return status .L8E3A LDA L00A2 ;else seek/restore. wait until ISR finished BPL L8E53 ;if so then exit LDA escflg ;else test escape flag BPL L8E3A ;if Escape not pressed then keep waiting LDA #$40 ;else $0D00 = RTI STA intnmi+$00 LDA #$00 ;b2=0 put FDC in reset STA latch LDA escflg ;reload escape flag = $FF [BUG] STA catdrv ;forget catalogue in workspace STA L00A2 ;set bogus controller status = $FF, escape .L8E53 RTS .L8E54 ;Wait for controller to complete operation LDA fdcsta ;get status from FDC ROR A ;test WD1770 S0 = busy BCC L8E54 ;if not busy then wait for operation to start .L8E5A ;Wait for controller to become idle LDA fdcsta ;get status from FDC ROR A ;test WD1770 S0 = busy BCS L8E5A ;if busy then wait for operation to finish LDA fdcsta ;then get final status from FDC RTS .L8E64 ;$C0 Read address LDA #L8FD8-L8F8E-$02 ;?$0D4C=$48 STA L8FD1-L8F86+intnmi+$01 ;set ISR to discard data after count read LDX L8F8E-L8F86+intnmi+$01 ;hold DRQ dispatch branch operand .L8E6C SBC #$01 ;wait 180 microseconds BNE L8E6C STX L8F8E-L8F86+intnmi+$01 ;restore branch operand (=$2F?? store bytes read) LDA #$04 ;4 bytes to read STA L00A6 ;set count of bytes to transfer JSR L8DC5 ;execute WD 1770 command BNE L8E80 ;if command failed exit Z=0 DEC itemp ;else decrement count of sector IDs to read BNE L8E6C ;loop until all IDs read .L8E80 RTS .L8E81 ;Advance track and skip bad tracks JSR L8EA1 ;advance track BNE L8EA0 ;if failed then exit LDA fdrive ;else get drive number AND #$01 ;mask unit number ASL A ;double it TAY ;to Y as bad track table offset LDA track ;get current track BIT LC28A ;test 40-track flag BPL L8E94 ;if set LSR A ;then halve track number .L8E94 CMP LC28B,Y ;compare with first bad track BEQ L8E81 ;if equal then advance track CMP LC28B+$01,Y ;else compare with second bad track BEQ L8E81 ;if equal then advance track LDA #$00 ;else return Z=1, succeeded .L8EA0 RTS .L8EA1 ;Advance track BIT LC28A ;test 40-track flag BPL L8EAD ;if clear then step in once LDA #$40 ;else $40 = step in JSR L8EAF ;increment track and step drive BNE L8EA0 ;if step failed then exit .L8EAD LDA #$50 ;$50 = step in, update track reg. .L8EAF INC track ;increment current track JMP L8DC9 ;execute WD 1770 command in A .L8EB4 ;Seek track LDA fdrive ;get current drive AND #$01 ;extract unit number 0=0/2 1=1/3 ASL A ;double it TAX ;to X as bad track register offset LDY #$07 LDA (temp),Y ;1st parm, track number JSR L8EE8 ;skip bad tracks on unit X/2 BIT LC28A ;test current disc operation flags BPL L8EC7 ;if 40-track flag set ASL A ;then double track number .L8EC7 STA track ;store current track number TAY ;if zero BEQ L8ED6 ;then command=$00 restore .L8ECC STA fdcdat ;else store track no. in data register CMP fdcdat ;loop until FDC takes it BNE L8ECC LDA #$10 ;command=$10 seek .L8ED6 JSR L8DC9 ;execute WD 1770 command in A BNE L8EF3 ;if command failed then exit silently LDY #$07 ;else get back 1st parm, track number LDA (temp),Y ;set FDC track register to logical track number: .L8EDF ;Write track register STA fdctrk CMP fdctrk BNE L8EDF RTS .L8EE8 ;Skip bad tracks on unit X/2 JSR L8EEC ;skip first bad track INX ;point X to second bad track register: .L8EEC CMP LC28B,X ;if A equals or exceeds bad track no. then add 1 BCC L8EF3 ;redundant, can save 2 bytes ADC #$00 ;or 1 byte by unrolling (-INX) .L8EF3 RTS .L8EF4 ;Set Tube presence flag LDA #$EA LDX #$00 ;$00 = don't alter variable LDY #$FF ;$FF = don't update variable JSR osbyte ;call OSBYTE $EA = read Tube presence flag TXA EOR #$FF ;invert; 0=tube present $FF=Tube absent STA notube ;save Tube presence flag RTS .L8F04 ;Claim NMI LDA #$8F ;OSBYTE $8F = issue service call LDX #$0C ;service call $0C = claim NMI LDY #$FF ;call OSBYTE with Y=$FF JSR osbyte STY prenmi ;save ID of previous NMI owner INC colds ;$00 = force cold start RTS .L8F13 ;Release NMI LDY prenmi ;Y = ID of previous NMI owner LDA #$8F LDX #$0B ;service call $0B = NMI release JSR osbyte ;call OSBYTE $8F = issue service call DEC colds ;$FF = allow warm start RTS .clatub ;Claim Tube PHA .clatb0 LDA #$C0+dftbid ;tube service call = $C0 + ID for DFS (1) JSR tubadr ;call Tube service BCC clatb0 ;loop until C=1, indicating claim granted PLA RTS .reltub ;Release Tube JSR L8EF4 ;set Tube presence flag [D]opto BMI L8F36 ;if Tube not present then exit, else: .L8F2F PHA LDA #$80+dftbid ;tube service call = $80 + ID for DFS (1) JSR tubadr ;call Tube service PLA .L8F36 RTS .L8F37 ;Set track stepping speed from CMOS RAM LDA #$A1 ;OSBYTE $A1 = read CMOS RAM LDX #$0B ;$0B = ADFS start-up options, keyboard settings and floppy drive parameters JSR osbyte TYA AND #$02 ;if bit 1 set BEQ L8F45 LDA #$03 ;then set $03 = slowest stepping (30 ms) .L8F45 STA L00A4 ;else set $00 = fastest stepping (6 ms) RTS .L8F48 ;Install NMI service routine LDX #L8FE4-L8F86-$01 ;set X=offset of last byte of routine .L8F4A LDA L8F86,X ;copy routine to NMI service area at $0D00 STA intnmi,X DEX BPL L8F4A LDX #L8FC2-L8FBF ;if reading, X=3 BIT L00A1 ;to paste address into STA instruction BVC L8F69 LDA #L8FDD-L8F8E-$02 ;else set NMISR to write zeroes at end of transfer STA L8FA7-L8F86+intnmi+$01 LDX #L8FF2-L8FE4 ;point X to last byte of write overlay .L8F60 LDA L8FE4-$01,X ;replace part of NMI service routine with write overlay STA L8FBF-L8F86+intnmi-$01,X DEX BNE L8F60 ;finish with X=0 .L8F69 BIT L00A1 ;test Tube flag BMI L8F7B ;if transferring to host LDY #$01 ;then get LSB of data address from control block LDA (temp),Y STA L8FBF-L8F86+intnmi+$01,X ;paste LSB LDA operand (X=0) or STA (X=3) INY ;y=$02 LDA (temp),Y ;get 3MSB data address STA L8FBF-L8F86+intnmi+$02,X ;paste MSB LDA operand (X=0) or STA (X=3) RTS .L8F7B ;transferring to Tube. LDA #$B0 ;0D3F=BCS L8FCD STA L8FC5-L8F86+intnmi+$00 LDA #L8FCD-L8FC5-$02 ;always branch; do not increment R3DATA address STA L8FC5-L8F86+intnmi+$01 RTS ;NMI routine copied to $0D00 .L8F86 PHA ;save A from main thread LDA fdcsta ;read status register .L8F8A AND #$18 ;apply mask matching command (pasted here) CMP #$03 ;if {DRQ Busy} then data request .L8F8E BEQ L8FBF ;so handle DRQ (default: read to Tube) AND #$FC ;else mask off {DRQ Busy}; b7 already clear BNE L8F98 ;if S6..S2 set then return result code DEC L00A5 ;else command complete; decrement sector count BNE L8F9C ;if more sectors then advance to next sector .L8F98 STA L00A2 ;clear NMI busy flag, b6..2=status PLA ;restore A from main thread RTI ;return from interrupt .L8F9C ;advance sector LDA L00A5 ;test no. sectors remaining CMP #$01 ;if next sector is the last BNE L8FAC LDA L00A1 ;then test b0=partial sector flag ROR A BCC L8FAC ;if set .L8FA7 LDA #L8FD8-L8F8E-$02 ;then discard data/write zeroes at end of byte count STA L8FD1-L8F86+intnmi+$01 .L8FAC INC sector ;increment current sector LDA sector ;get new current sector .L8FB0 STA fdcsec ;write sector register CMP fdcsec ;loop until FDC takes it BNE L8FB0 LDA L00A7 ;get repeat command STA fdccmd ;write to command register PLA ;restore A from main thread RTI ;return from interrupt .L8FBF ;data request handler LDA fdcdat ;read data register .L8FC2 STA reg3 ;if reading to host, address pasted here .L8FC5 INC L8FC2-L8F86+intnmi+$01 ;increment low byte of host address BNE L8FCD ;(branched-over if transferring to/from Tube) INC L8FC2-L8F86+intnmi+$02 ;carry out to high byte .L8FCD DEC L00A6 ;decrement byte count BNE L8FD6 ;exit ISR if bytes remaining .L8FD1 LDA #L8FBF-L8F8E-$02 ;0D4B set dispatch branch offset for next DRQs STA L8F8E-L8F86+intnmi+$01 ;default: continue reading to memory .L8FD6 PLA ;restore A from main thread RTI ;return from interrupt .L8FD8 LDA fdcdat ;read and discard data register PLA ;restore A from main thread RTI ;return from interrupt .L8FDD LDA #$00 ;write zero to data register STA fdcdat PLA ;restore A from main thread RTI ;return from interrupt .L8FE4 ;Write overlay pasted to $0D39 LDA reg3 ;if writing to host, address pasted here / L8FBF .L8FE7 STA fdcdat ;write data register INC L8FBF-L8F86+intnmi+$01 ;increment low byte of host address BNE L8FF2 ;actually goes to L8FCD INC L8FBF-L8F86+intnmi+$02 ;carry out to high byte .L8FF2 ;Install i8271 emulator ISR LDX L8FC2-L8F86+intnmi+$01 ;extract I/O write address LDA L8FC2-L8F86+intnmi+$02 ;from basic ISR, X=LSB A=MSB PHA ;save MSB LDY #L90AF-L901B ;y=offset of last byte of ISR .L8FFB LDA L901B-$01,Y ;copy ISR from ROM STA intnmi-$01,Y ;to NMI area at $0D00 DEY BNE L8FFB PLA ;restore MSB write address BIT L00A1 ;if reading to Tube BPL L9014 LDA #$B0 ;then $0D18 = BCS $0D20 STA L9033-L901B+intnmi+$00 LDA #L903B-L9033-$02 ;always branch; do not increment R3DATA address STA L9033-L901B+intnmi+$01 RTS .L9014 STX L9030-L901B+intnmi+$01 ;else reading to I/O memory STA L9030-L901B+intnmi+$02 ;paste write address into new ISR. RTS ;NMI routine copied to $0D00 .L901B PHA ;save A from main thread LDA fdcsta ;read status register AND #$1B ;apply mask matching command (pasted here) CMP #$03 ;if idle or no DRQ BNE L902A ;then finish ISR LDA fdcdat ;else DRQ, read data register .L9028 BCS L9050 ;state 0: wait for IAM .L902A AND #$FC ;mask off S1 DRQ/S0 busy STA L00A2 ;clear NMI busy flag, b6..2=status PLA RTI .L9030 ;state 8 STA reg3 ;store data in I/O or Tube memory .L9033 INC L9030-L901B+intnmi+$01 ;increment LSB I/O address BNE L903B ;carry out to MSB INC L9030-L901B+intnmi+$02 ;fall through: .L903B ;state 9 DEC L00A6 ;decrement LSB bytes remaining this sector BNE L904E ;borrow in from MSB DEC L00A7 BNE L904E ;if count underflows LDA #L90A1-L9028-$02 ;then go to state 10 if more sectors DEC L00A5 ;decrement sector count BNE L904B ;if no more sectors LDA #L904E-L9028-$02 ;then go to state 13 .L904B STA L9028-L901B+intnmi+$01 ;set dispatch branch offset, fall through: .L904E ;state 13 PLA ;discard all further data from FDC RTI .L9050 ;state 0 CMP #$FE ;if Index Address Mark reached BEQ L9058 CMP #$CE ;or variant due to sync error BNE L904E .L9058 LDA #L905C-L9028-$02 ;then go to state 1 BNE L904B .L905C ;state 1 SBC fdcdat ;c=1, subtract data reg.; =0 if stable STA ytemp ;this is the C parameter; save result LDA #L9065-L9028-$02 ;go to state 2 BNE L904B .L9065 ;state 2 LDA #L9069-L9028-$02 ;discard H parameter BNE L904B ;go to state 3 .L9069 ;state 3 SBC sector ;compare R with current sector ORA ytemp ;or difference with C result STA ytemp ;ytemp=0 if sector numbers match LDA #L9073-L9028-$02 ;go to state 4 BNE L904B .L9073 ;state 4 LDA #L9077-L9028-$02 ;discard N parameter BNE L904B ;go to state 5 .L9077 ;state 5 LDA itemp ;discard MSB ID CRC character STA L00A6 ;reset LSB number of bytes to read LDA #L907F-L9028-$02 ;go to state 6 BNE L904B .L907F ;state 6 LDA atemp ;discard LSB ID CRC character STA L00A7 ;reset number of (short) pages to read LDA #L9087-L9028-$02 ;go to state 7 BNE L904B .L9087 ;state 7 CMP #$FB ;if normal Data Address Mark reached BEQ L908F CMP #$F8 ;or Deleted Data Address Mark reached BNE L904E ;then proceed else exit ISR .L908F STA vtemp+$00 ;store Data Address Mark found LDA ytemp ;if sector ID is incorrect BNE L909B ;then discard sector contents INC sector ;else increment sector no. to match next LDA #L9030-L9028-$02 ;and go to state 8 BNE L904B .L909B ;discard sector contents INC L00A5 ;inc. sector count to include this interloper LDA #L903B-L9028-$02 ;and go to state 9 BNE L904B .L90A1 ;state 10 LDA #L90A5-L9028-$02 ;discard MSB data CRC character BNE L904B ;go to state 11 .L90A5 ;state 11 LDA #L90A9-L9028-$02 ;discard LSB data CRC character BNE L904B ;go to state 12 .L90A9 ;state 12 BNE L904E ;discard data until $00 found LDA #L9050-L9028-$02 ;then go to state 0 BNE L904B .L90AF ;Write sector register STA fdcsec CMP fdcsec ;loop until FDC acknowledges new value BNE L90AF RTS ;unreachable code LDX #$00 LDA #$5A ;set track reg. out of range .L90BC STA fdctrk CMP fdctrk BEQ L90C9 DEX BNE L90BC .L90C7 CLC RTS .L90C9 LDA latch AND #$03 BEQ L90C7 RTS ;Table of drive control latch values for drives 0..3 .L90D1 EQUB $25,$26,$35,$36 ;Table of WD 1770 commands .L90D5 EQUB $00,$10,$40,$50 EQUB $80,$81,$83,$A0 EQUB $A1,$C0,$E0,$F0 ;Table of WD 1770 status code mask values .L90E1 EQUB $18,$18,$18,$18 EQUB $3F,$1F,$1F,$5F EQUB $5F,$17,$1B,$5F ;Table of WD 1770 status codes .L90ED EQUB $08,$10,$18,$20 EQUB $40,$00 ;Table of equivalent Intel 8271 result codes .L90F3 EQUB $0E,$18,$0C,$20 EQUB $12,$00 ;Addresses of format RLE tables .L90F9 EQUW L9121 .L90FB EQUW L90FD .L90FD ;Double density format RLE table EQUB $3C .L90FE ;lead-in to sector ID EQUB $0C,$03,$01 EQUB $01,$01,$01,$01 EQUB $01,$16,$0C,$03 EQUB $01 .L910A ;sector data area (bytes) EQUB $FF .L910B ;sector data area (pages) EQUB $01,$01 .L910D ;gap3 EQUB $18 .L910E ;gap4 EQUB $04 .L910F EQUB $4E,$00,$F5,$FE .L9113 ;CHRN values in sector header EQUB $00,$00,$00,$00 EQUB $F7,$4E,$00,$F5 EQUB $FB,$5A,$5A,$F7 EQUB $4E,$4E .L9121 ;Single density format RLE table EQUB $10,$06,$00,$01 EQUB $01,$01,$01,$01 EQUB $01,$0B,$06,$00 EQUB $01,$FF,$01,$01 EQUB $13,$03 EQUB $FF,$00,$00,$FE EQUB $00,$00,$00,$00 EQUB $F7,$FF,$00,$00 EQUB $FB,$E5,$E5,$F7 EQUB $FF,$FF .L9145 ;Table of Intel 8271 commands EQUB $0A,$0B,$0E,$0F ;first four are write commands .L9149 EQUB $12,$13,$16,$17 EQUB $1B,$1E,$1F,$23 EQUB $29 .L9152 ;Table of extension commands EQUB $20,$30 .L9154 ;Table of equivalent WD 1770 commands EQUB $A0,$A0,$A1,$A1 EQUB $80,$80,$81,$81 EQUB $C0,$83,$83,$F0 EQUB $10,$E0,$F0 .L9163 ;OSWORD $7F = general read/write function (DFS) LDA #$FF STA catdrv ;forget catalogue in workspace STX userpt+$00 ;set up pointer to user's control block STY userpt+$01 LDY #$0C ;13 bytes to copy incl. space for format result .L916E LDA (userpt),Y ;copy bytes of user's control block STA work,Y ;to workspace DEY ;loop until 13 bytes copied BPL L916E LDX #L9152-L9145-$01 ;end of official command table LDA work+$05 ;get number of parameters CMP #$0A ;if equal to ten BNE L9180 LDX #L9154-L9145-$01 ;then search extension commands .L9180 LDA work+$06 ;get command byte AND #$3F ;mask off drive select bits CMP #$3A ;if =$3A write special registers BEQ L91D3 ;then branch CMP #$3D ;if =$3D read special registers BEQ L91F3 ;then branch CMP #$35 ;if =$35 initialise BNE L9193 JMP L920E ;then jump to handler .L9193 CMP L9145,X ;compare user's command with table entry BEQ L919F ;if match found then proceed with disc op DEX ;else loop until whole table scanned BPL L9193 .L919B ;command not found LDA #$FE ;return status $FE BMI L91C8 ;branch (always) .L919F CMP #$23 ;if A=$0A,$0B,$0E,$0F or $23 BEQ L91A7 ;(all write commands) CPX #L9149-L9145 ;then reject if 40-track flag set BCS L91B5 .L91A7 LDA work+$00 ;get drive number from control block BPL L91AD ;if b7=1, reusing previous drive LDA fdrive ;then get current drive number .L91AD AND #$03 ;mask drive number in bits 1,0 TAY ;transfer to y for use as index LDA LC2DE,Y ;b7=40-track flag set on drive Y BMI L919B ;if set then exit with status $FE .L91B5 LDY L9154,X ;else fetch equivalent WD 1770 command STY work+$06 ;replace original in workspace CPY #$F0 ;if =$F0 write track BNE L91C1 JSR L9251 ;then convert CHRN table to track buffer .L91C1 LDX #<work ;point XY to modified control block LDY #>work JSR L8BBF ;call internal OSWORD $7F handler .L91C8 PHA ;save result of disc operation LDA work+$05 ;get number of parameters to command CLC ADC #$07 ;add 7 = offset of result byte TAY ;move to Y to use as index PLA ;restore result STA (userpt),Y ;store in caller's control block RTS .L91D3 ;$3A Write special registers JSR L923E ;validate bad track register address BCS L91DF ;if not a bad track reg. then skip LDA work+$08 ;2nd parm, register value STA LC28B,X ;store in bad track array at X BCC L91EF ;return result $00 (always) .L91DF JSR L922D ;validate current track register address BCC L920B ;if invalid then return result $FE LDA work+$08 ;else 2nd parm, register value LDY LC2DE,X ;test 40-track flag for UNIT X BPL L91EC ;if set ASL A ;then double track number .L91EC STA LC288,X ;store position of unit 0/1 .L91EF LDA #$00 ;return result $00 BEQ L920B .L91F3 ;$3D Read special registers JSR L923E ;validate bad track register address BCS L91FD ;if not a bad track reg. then skip LDA LC28B,X ;else read from bad track array at X BCC L920B ;return track number as result (always) .L91FD JSR L922D ;validate current track register address BCC L920B ;if invalid then return result $FE LDA LC288,X ;else get position of unit 0/1 LDY LC2DE,X ;test 40-track flag for UNIT X BPL L920B ;if set LSR A ;then halve track number .L920B JMP L91C8 ;can save 1 byte (BPL/BRA) .L920E ;$35 Initialise LDA #$FF ;preset result $FF (not $FE!) LDX #$00 ;preset offset 0 for unit 0 LDY work+$07 ;1st parm, subcommand / parameter 0 CPY #$10 ;$10 = load surface 0 bad tracks BEQ L921E ;if match then set up unit 0 CPY #$18 ;$18 = load surface 1 bad tracks BNE L922A ;if mismatch then return result $FF INX ;else point to unit 1 bad track array INX ;(can save time: LDX #$02) .L921E LDA work+$08 ;2nd parm, bad track 1 STA LC28B,X LDA work+$09 ;3rd parm, bad track 2 STA LC28B+$01,X ;[BUG] current track not initialised LDA #$00 ;return result $00 .L922A JMP L91C8 .L922D ;Validate current track register address LDX #$00 ;preset offset to 0 LDA work+$07 ;1st parm, register address CMP #$12 ;if =$12, unit 0 current track BEQ L923D ;then accept with C=1, offset=0 INX ;else offset=1 CMP #$1A ;if =$1A, unit 1 current track BEQ L923D ;then accept with C=1, offset=1 LDA #$FE ;else result=$FE, unrecognised command CLC ;return C=0, invalid address .L923D RTS .L923E ;Validate bad track register address LDA work+$07 ;1st parm, register address AND #$F6 ;accept n,n+1,n+8,n+9 CMP #$10 ;if not $10,$11,$18,$19 SEC ;then exit C=1 invalid address BNE L9250 LDA work+$07 ;get back address LSR A ;move b3, unit select LSR A ;to b1 (b0=0 from previous test) ORA work+$07 ;put bad track slot no. in b0 AND #$03 ;mask b1=unit, b0=bad track slot no. TAX ;to X as bad track array offset .L9250 RTS .L9251 ;Convert CHRN table to track buffer JSR getlsz ;get start and size of user memory LDA work+$01 ;get LSB of caller's data address (CHRN table) STA temp+$00 ;set up LSB of data pointer STA atemp+$00 ;and LSB of track buffer pointer CLC ADC #$80 ;add 128 to it STA xtemp+$00 ;set up LSB of RLE table pointer LDA work+$02 ;get MSB of caller's data address STA temp+$01 ;set up MSB of data pointer PHP ;save carry flag from ADC JSR L8EF4 ;set Tube presence flag BMI L9271 ;if Tube absent LDA work+$03 ;or high bytes = $FF ORA work+$04 ;of source address CMP #$FF BNE L9278 .L9271 LDA temp+$01 ;then atemp[1]=max(OSHWM,work[2]) CMP frpage BCS L927B .L9278 LDA frpage ;else source on Tube; atemp[1]=OSHWM .L927B PLP STA atemp+$01 ;but now xtemp[]=atemp[]+$0080 ADC #$00 ;and atemp[]=atemp[]+$0100 STA xtemp+$01 ;i.e. 128/256 bytes above CHRN table INC atemp+$01 ;[BUG]clobbers user memory! LDA work+$00 ;if b7=1, reusing previous drive BPL L928A LDA #$00 ;then format drive 0, SD! (C=0) .L928A ROL A ;shift bit 5 of drive parameter into carry ROL A ROL A STA LC28A ;save b4..2 (and drive) as disc op modifier LDX #L90FB-L90F9 ;point to SD table address ROL A ;if b3, force DD, was set BMI L9297 LDX #L90F9-L90F9 ;then point to DD table address .L9297 LDA L90F9+$00,X ;set up pointer to RLE table in ROM STA vtemp+$00 LDA L90F9+$01,X STA vtemp+$01 LDY #L9121-L90FD-$01 ;40 bytes to copy: .L92A3 LDA (vtemp),Y ;copy RLE table from ROM STA (xtemp),Y ;to user memory DEY ;loop until 40 bytes copied BPL L92A3 IF _BUGFIX LDY #$01 ;size code %000 = 1 * 128 bytes LDA work+$09 BPL code1 LDY #$08 ;size code %100 = 16 * 128 bytes = 2K .code1 STY vtemp+$00 ;store starter sector size in workspace ASL A ;put b6 of parameter = b1 of code in N BPL code0 ;if set ASL vtemp+$00 ;then multiply sector size by 4 ASL vtemp+$00 .code0 ASL A ;put b5 of parameter = b0 of code in N BPL coded ;if set ASL vtemp+$00 ;then multiply sector size by 2 .coded LSR A ;restore sector count to bits 5..0 LSR A AND #$1F ;mask sector count STA etemp ;save as counter LDA vtemp+$00 ;get number of 128-byte units per sector LSR A ;halve it; 128-byte remainder in C LDY #L910A-L90FD ;point to data area (pages) count STA (xtemp),Y ;store in RLE table INY ;point to data area (bytes) count LDA #$00 ;set A=$00 no bytes ROR A ;or $80 if data area is 128 bytes STA (xtemp),Y ;store in RLE table ELSE INY ;y=$00 STY vtemp+$00 ;zero size code receiver LDA work+$09 ;3rd parm, sector size+count PHA ;save sector count AND #$E0 ;mask size code in b7..b5 BNE L92B6 ;all codes >0 indicate a whole no. of pages LDA #$10 ;code 0 indicates 128-byte sectors: .L92B6 ASL A ;shift the three size code bits ROL vtemp+$00 ;into the size code receiver ASL A ROL vtemp+$00 ASL A ;now A=$00 or A=$80 ROL vtemp+$00 LDY #L910A-L90FD ;point to data area (bytes) count STA (xtemp),Y ;store A in RLE table LDA vtemp+$00 ;get size code in b2..b0 INY ;point to data area (pages) count STA (xtemp),Y ;set as count of pages ;[BUG] not decoded! code %011 writes 768 bytes PLA AND #$1F ;extract b5..b0 STA etemp ;store number of sectors on track ENDIF LDA work+$08 ;2nd parm, gap3 LDY #L910D-L90FD ;point to gap3 count STA (xtemp),Y ;store in RLE table LDA work+$0B ;5th parm, gap1 LDY #$00 ;point to gap1 count STA (xtemp),Y ;store in RLE table TYA STA ztemp ;redundant JSR L9387 ;append run from table to track buffer JSR L8EF4 ;test Tube presence BMI L931B ;if Tube absent then skip LDA work+$03 ;if high bytes are $FF AND work+$04 ;i.e. address is not a Tube address CMP #$FF BEQ L931B ;then skip LDA #$FF ;else set high bytes to $FF STA work+$03 ;[BUG] WHAT?? STA work+$04 ;Tube transfer starts from $FFFFxxxx JSR clatub LDX #<(work+$01) LDY #>(work+$01) TYA ;a=0, bytes to host JSR tubadr ;must delay 24 us from return to first LDr LDX atemp+$01 ;set temp[1]=host src addr or OSHWM DEX STX temp+$01 LDA etemp ;get number of sectors on track ASL A ASL A ;* 4 = number of CHRN bytes; C=0 TAX ;put in X as counter LDY #$00 ;start at beginning of local table (9.5 us): .L9309 LDA #$07 ;wait 15.5 us (C=0)/18.0 us (C=1) .L930B SBC #$01 BNE L930B ;c=1 at end of loop LDA reg3 ;get CHRN byte from Tube FIFO 3 STA (temp),Y ;store in local table INY ;increment offset DEX ;decrement counter BPL L9309 ;loop until CHRN acquired (26.5 us/byte) JSR L8F2F ;release Tube .L931B LDA atemp+$01 STA work+$02 ;work[2] = atemp[1] w/o increments .L931F LDY #L9113-L90FD ;point to sector ID in RLE table (C byte) LDX #$00 ;zero offset for indexed indirect load: .L9323 LDA (temp,X) ;get byte of CHRN table STA (xtemp),Y ;overwrite CHRN fields in RLE table INC temp ;increment LSB of CHRN table pointer BNE L932D ;carry out to MSB INC temp+$01 .L932D INY ;increment offset into RLE table CPY #L9113-L90FD+$04 ;have we reached the CRC insertion code? BNE L9323 ;if not then update the rest of CHRN LDA #L90FE-L90FD ;else start at ID lead-in sequence STA vtemp+$00 ;and add 13 entries including data area (bytes): .L9336 LDA vtemp+$00 ;get current offset into RLE table CMP #L910B-L90FD ;have we reached the data area (pages)? BNE L9341 ;if not then append rest of preamble JSR L9368 ;else append required number of pages of data BEQ L9344 ;and skip next instruction (always) .L9341 JSR L9387 ;append run from table to track buffer .L9344 INC vtemp+$00 ;increment RLE table offset LDA vtemp+$00 ;get its current value CMP #L910E-L90FD ;are we now at the last entry (gap4)? BNE L9336 ;if not then loop INC ztemp ;redundant DEC etemp ;else decrement number of sectors remaining BNE L931F ;loop until all sectors added TAY ;transfer RLE table offset to Y LDA #$0E ;3584 bytes = SD track length 3125 + 459 BIT LC28A ;if formatting double density BVC L935C LDA #$1A ;then 6656 bytes = DD track length 6250 + 406 .L935C CLC ADC work+$02 ;add MSB start of track buffer = generous end point SBC atemp+$01 ;subtract end of last sector BCS L9365 ;if track short then pad with gap4 [BUG] may be 0! LDA #$01 ;else $01 = write 256 bytes: .L9365 ;Append byte from table x (A*256) to track buffer STA (xtemp),Y ;store run length in RLE table TYA ;copy offset to A: .L9368 ;Append run x 256 from table to track buffer JSR L9379 ;get run from RLE table BEQ L9378 ;if run length = $00 then exit, else: STX vtemp+$01 ;store run length in counter LDX #$00 ;$00 = repeat 256 times .L9371 JSR L938C ;append A x X to track buffer DEC vtemp+$01 ;decrement counter BNE L9371 ;loop until 256*X bytes appended .L9378 RTS ;returns Z=1 .L9379 ;Get run from RLE table TAY ;offset in A, transfer to Y LDA (xtemp),Y ;get run length into X TAX TYA ;put offset back in A CLC ;add run table length to point to values ADC #L910F-L90FD TAY ;put new offset in Y LDA (xtemp),Y ;get value in A CPX #$00 ;test run length; Z=1 if zero RTS .L9387 ;Append run from table to track buffer JSR L9379 ;get run from RLE table BEQ L9399 ;if run length = $00 then exit, else: .L938C ;Append A x X to track buffer LDY #$00 ;clear offset, start at (atemp) .L938E STA (atemp),Y ;write value in A to track buffer INC atemp+$00 ;increment low byte of address BNE L9396 ;carry out to high byte INC atemp+$01 .L9396 DEX ;decrement repeat count BNE L938E ;loop until X copies appended .L9399 RTS .dirout ;Write volume catalogue L4 LDA cycno ;add 1 to BCD catalogue cycle number CLC ;[D]reordered SED ADC #$01 STA cycno CLD .L93A5 ;Write volume catalogue as-is LDY #$A0 ;command = $A0, write sector BNE L93C2 ;branch (always) .L93A9 ;Load catalogue with execute privilege LDY #$81 ;command = $80, read sector, b0 repurposed BNE L93C2 ;branch (always) .L93AD ;Ensure catalogue loaded with execute privilege LDY #$81 ;command = $80, read sector, b0 repurposed BNE L93B3 ;branch (always) .L93B1 ;Ensure current volume catalogue loaded LDY #$80 ;command = $80, read sector .L93B3 BIT fdcsta ;test FDC status register BPL L93C2 ;if motor is off then load catalogue LDA catdrv ;else get drive number of loaded catalogue CMP fdrive ;compare with current drive BNE L93C2 ;if unequal then load volume catalogue RTS ;else exit .L93C0 ;Load catalogue LDY #$80 .L93C2 ;Transfer catalogue JSR L94EA ;clear high OSWORD $7F control block STY LC290+$06 ;store WD 1770 command at offset 6 LDA fdrive ;get current drive STA LC290+$00 ;store at offset 0 LDA #$02 ;512 bytes to transfer STA LC290+$09 LDA #>dirlow ;set data address = $FFFFC000 STA LC290+$02 DEC LC290+$03 ;set address high bytes = $FF DEC LC290+$04 JSR L93F9 ;transfer data and report errors L4 LDA fdrive ;get current drive STA catdrv ;set drive number of loaded catalogue RTS .L93E6 ;Check for escape condition BIT escflg ;test escape flag BPL L93F8 ;if ESCAPE not pressed then return .escape JSR ackesc ;else acknowledge escape condition JSR fstrng ;and raise "Escape" error. EQUB $11 EQUS "Escape" EQUB $00 .L93F8 RTS .L93F9 ;Transfer data and report errors L4 JSR L94CA ;ensure not writing to 40-track mode drive LDA #$06 ;5 attempts STA LC29E JSR L93E6 ;check for escape condition .L9404 LDA LC290+$07 ;1st parm, track number LDX LC290+$00 ;get drive number to transfer to LDY LC2DE,X ;test 40-track flag for said drive BPL L9410 ;if set ASL A ;then double track number .L9410 LDY #$18 ;preset result $18 = Sector not found CMP #$50 ;if track no. >80 then return this BCS L9475 LDX #<LC290 ;else point XY to high OSWORD $7F control block LDY #>LC290 JSR L8BBC ;call internal OSWORD $7F handler TAY ;test result code BEQ L93F8 ;if no errors then return BMI escape ;if escape key pressed then raise Escape error CMP #$12 ;else if result = $12, write protect BEQ L947A ;then raise "Disc read only" error CMP #$20 ;else if result = $20, Deleted data found BNE L9441 LDA LC290+$06 ;then test bit 0 of WD 1770 command ROR A ;in read sector commands, b0 unused and repurposed BCS L93F8 ;as execute privilege bit. If not set when needed JSR fstrng ;then raise "Execute only" error. EQUB $BC EQUS "Execute only" EQUB $00 .L9441 CMP #$18 ;$18 = sector not found BNE L9470 ;if another error then retry operation LDA LC28A ;else test disc operation modifier CMP #$04 ;if loading catalogue during boot sequence BNE L945D LDX LC290+$06 ;and command = $81 read sector with exec privilege CPX #$81 BNE L945D LDA #$FF ;then invert first bad track register of unit 0 EOR LC28B+$00 ;putting it out of range STA LC28B+$00 ;but preserving its value BCS L9470 ;branch (always) .L945D LDX track ;otherwise if current track > 0 BEQ L9470 ROL A ;then move BIT 6 of disc op modifier AND #$80 ;to bit 7, and mask it LDX LC290+$00 ;get drive number of OSWORD $7F operation EOR LC2DE,X ;toggle 40-track flag for drive if b6 was set STA LC2DE,X ;update 40-track flag for drive JSR L94CA ;ensure not writing to 40-track mode drive .L9470 DEC LC29E ;decrement retry counter BNE L9404 ;loop until counter reaches zero .L9475 TYA ;y=result code. move to A: .dknern ;Translate result code to error CMP #$12 ;if result = $12, write protect, then: BNE dkerr0 .L947A ;Raise "Disc read only" error JSR dskmsg EQUB $C9 EQUS "read only" EQUB $00 .dkerr0 ;Raise "Disc fault ..." error PHA ;save result code in A JSR dskmsg ;start "Disc ..." error EQUB $00 ;error number $00, empty string NOP ;not $00 = return, don't BRK JSR gstrng ;append "fault " to error message EQUB $C7 ;replace error number with $C7 EQUS "fault " NOP ;not $00 = return, don't BRK PLA ;restore result code JSR L94DA ;append hex byte to error message JSR gstrng ;append " at :" to error message EQUB $00 ;replace error number with $00 EQUS " at :" LDA fdrive ;get current drive JSR L94E2 ;append hex byte to error message JSR gstrng ;append space to error message EQUB $00 EQUS " " LDA track ;get track number of OSWORD $7F command BIT LC28A ;test 40-track flag of current drive BPL L94B8 ;if set LSR A ;then double track number .L94B8 JSR L94DA ;append hex byte to error message JSR gstrng ;append "/" to error message EQUB $00 EQUS "/" LDA sector ;get sector number of OSWORD $7F command JSR L94DA ;append hex byte to error message JSR gstrng ;append empty string to error message EQUB $C7 ;error number $C7 EQUB $00 ;jump to BRK to raise error .L94CA ;Ensure not writing to 40-track mode drive LDA LC290+$06 ;get command from high OSWORD $7F control block CMP #$A0 ;if $A0 write sector, $F0 write track BCC L94E9 ;OR $C0 read address LDX LC290+$00 ;then get drive number of OSWORD $7F operation LDA LC2DE,X ;test 40-track flag for drive BMI L947A ;if set then raise "Disc read only" error RTS ;else exit .L94DA ;Append hex byte to error message PHA JSR sfour ;shift A right 4 places JSR L94E2 ;print top nibble of byte PLA ;restore bottom nibble: .L94E2 JSR digut1 ;convert hex nibble to ASCII STA errbuf,X ;append character to error message INX ;and increment offset .L94E9 RTS .L94EA ;Clear high OSWORD $7F control block LDX #$0D LDA #$00 .L94EE STA LC290-$01,X DEX BNE L94EE LDA #$05 STA LC290+$05 RTS .whlim ;FSC 7 = range of valid file handles LDX #$11 LDY #$15 .shtal1 RTS .wfdie ;FSC 6 = new filing system starting up JSR savita ;save AXY LDA #$77 ;call OSBYTE $77 = close *SPOOL/*EXEC files JSR osbyte JMP relmem ;[D]vacate absolute workspace ;unreachable code LDA #$20 STA dufflg .close2 ;Close all files JSR wfdie ;close *SPOOL/*EXEC files and vacate workspace .shtall LDA #$00 ;set channel workspace pointer = $00: .shtal0 CLC ;add $20 to point to next channel ADC #$20 BEQ shtal1 ;if =0 then exit (close 5 files $A0..20). TAY JSR vshut BNE shtal0 .wshut ;Close a file/all files LDA #$20 ;$20 = write EXT to catalogue if updated STA dufflg TYA ;if handle = 0 BEQ close2 ;then close all files JSR dcrych ;else convert to pointer, if valid ($11..17) .vshut PHA JSR cheeky ;validate workspace offset BCS vshutq ;if channel invalid or closed then exit LDA seqbit,Y ;else get bit mask corresponding to channel EOR #$FF ;invert it, bit corresponding to channel =0 AND dcbmap ;clear bit of channel open flag byte STA dcbmap ;update flag byte LDA seqflg,Y ;get channel flags AND #$60 ;if either buffer or EXT changed BEQ vshutq JSR vlook ;then ensure open file still in drive LDA seqflg,Y ;if EXT changed AND dufflg ;and this is a close operation BEQ vshdd LDX seqwb ;then set X = catalogue pointer LDA seqlla,Y ;copy low word of EXT to length in catalogue STA cathig+$04,X LDA seqlma,Y STA cathig+$05,X LDA seqlha,Y ;get high byte of EXT JSR lfour ;shift A left 4 places EOR cathig+$06,X ;replace b5,b4 of top bits with b5,b4 from A AND #$30 EOR cathig+$06,X STA cathig+$06,X ;store top bits back in catalogue JSR dirout ;write volume catalogue LDY dcby ;put channel workspace pointer in Y .vshdd JSR bflush ;ensure buffer up-to-date on disc L6 .vshutq LDX seqwx ;restore X on entry PLA ;restore A on entry RTS .vlook ;Ensure open file still in drive JSR setq ;set current vol/dir from open filename: .vlook3 ;Ensure open file still on current drive LDX #$06 ;start at seventh character of leaf name: .vshutl LDA seqcat+$0C,Y ;copy leaf name of file to current leaf name STA wrknam,X DEY ;skip odd bytes containing length and addrs DEY ;select previous character of leaf name (Y>0) DEX ;decrement offset in current leaf name BPL vshutl ;loop until 7 characters copied (X=7..1) JSR lookw ;search for wrknam in catalogue BCC dskchn ;if file not found then raise "Disk changed" STY seqwb ;else save offset in catalogue LDY dcby ;put channel workspace pointer in Y .cksam0 RTS .setq ;Set current drive/dir from open filename LDA seqlok,Y ;get directory character of open file AND #$7F ;mask off b7 =channel file locked bit STA qualif ;set as current directory LDA seqflg,Y ;get drive containing open file JMP dodriv ;select drive in A and exit .chksam ;Ensure disc not changed JSR savita ;save AXY LDA cycno ;get cycle number of last catalogue read JSR getdir ;load volume catalogue L4 CMP cycno ;compare with freshly loaded cycle number BEQ cksam0 ;return if equal, else: .dskchn ;Raise "Disk changed" error. JSR dskmsg EQUB $C8 EQUS "changed" EQUB $00 .wfind ;OSFIND AND #$C0 BNE wfind0 ;if A>=$40 then open a file JSR savita ;else save AXY JMP wshut ;and close a file/all files. .wfind0 ;Open a file JSR savit ;save XY STX work+$00 STY work+$01 STA atemp ;store file open mode in temporary var. BIT atemp ;set N and V from temporary variable PHP JSR frmnam ;set current file from argument pointer JSR clrwld ;disallow wildcard characters in filename JSR lookup ;search for file in catalogue BCS newdcb ;if found then set up channel PLP ;else if opening for read or update BVC vnewo ;(i.e. OSFIND call no. b6=1) LDA #$00 ;then existing file was expected, return A=0 RTS .vnewo PHP ;else opening new file for output. LDA #$00 ;can save 2 bytes (swap BVC/LDA) LDX #$07 .vnewl STA wrkcat,X ;clear load, exec, start and length = 0 STA hiwork,X DEX BPL vnewl DEC exelo ;set exec address = $FFFFFFFF DEC exehi DEC exlow+$02 DEC exlow+$03 LDA #$40 ;initial length = $4000 = 16 KiB STA endhi JSR dirdo ;create file from OSFILE block ;[BUG]even if no channels available: .newdcb ;enter with Y=catalogue offset of open file PLP ;restore flags containing channel open mode PHP BVS find3 ;if opening for output (OSFIND b6=0) JSR chklok ;then ensure file not locked .find3 JSR cmpfil ;find free channel and check for clashes BCC find1 ;if file not open then continue .find2 LDA seqrdo,Y ;else test if the channel is open read-write BPL filopn ;if so, reopening is a conflict; raise error PLP ;else if reopening a r-o channel read-write PHP ;(i.e. channel b7=1, OSFIND call no. b7=1) BMI filopn ;then this also conflicts; raise error JSR nxtfil ;else find any other channels open on this file BCS find2 ;if another channel found then loop .find1 LDY dcby ;else get free channel workspace offset from cmpfil BNE seqnul ;if valid then set up channel JSR estrng ;else raise "Too many open" error. EQUB $C0 EQUS "Too many open" EQUB $00 .filopn ;Raise "Open" error. JSR estrng EQUB $C2 EQUS "Open" EQUB $00 .seqnul LDA #$08 ;set counter = 8 STA seqwc .fillda LDA catlow,X ;copy name and attributes of file STA seqcat,Y ;to bottom half of channel workspace INY LDA cathig,X STA seqcat,Y INY INX DEC seqwc ;loop until 8 byte pairs copied BNE fillda LDX #$10 ;16 bytes to clear LDA #$00 .filldb STA seqmap,Y ;clear top half of channel workspace INY DEX BNE filldb ;loop until 16 bytes cleared LDA dcby ;put channel workspace pointer in A TAY JSR sfive ;shift A right 5 places, A=1..5, C=0 ADC #(>slots)-$01 ;add 17; A=$12..16 STA seqbuf,Y ;store page number of channel buffer LDA dcbbit ;get bit mask corresponding to channel STA seqbit,Y ;store in channel workspace ORA dcbmap ;set that bit in channel open flags byte STA dcbmap ;marking this channel open LDA seqll,Y ;test LSB of file length ADC #$FF ;c=0 from last ADC; c=1 if partial sector LDA seqlm,Y ;copy 2MSB length to allocation ADC #$00 ;rounding up to whole sector STA seqem,Y LDA seqlh,Y ;get top bits exec/length/load/start sector ORA #$0F ;mask off load/start sector ADC #$00 ;carry out to length in bits 5 and 4 JSR isolen ;extract b5,b4 of A STA seqeh,Y ;store MSB allocation PLP ;restore OSFIND call number to N and V BVC vfindo ;if opening for output then branch BMI vfind1 ;if opening for update then branch LDA #$80 ;else opening for input. ORA seqrdo,Y ;set b7=1 of seventh char of leaf name STA seqrdo,Y ;marking channel read-only. .vfind1 LDA seqll,Y ;input or update; set EXT = length of file STA seqlla,Y LDA seqlm,Y STA seqlma,Y LDA seqlh,Y JSR isolen ;extract b5,b4 of A STA seqlha,Y .vfinxx LDA fdrive ;get current drive ORA seqflg,Y ;OR with channel flags in high nibble STA seqflg,Y ;set drive of open file in low nibble TYA ;set A=workspace pointer JSR sfive ;shift A right 5 places ORA #$10 ;return A=file handle $11..15. RTS .vfindo ;opening for output LDA #$20 ;set channel flag b5=1, "EXT changed" STA seqflg,Y ;to truncate file's initial allocation BNE vfinxx ;branch to return file handle (always) .nxtfil ;Find any other channels open on this file TXA ;x=catalogue offset of open file, save PHA JMP cmpfl1 ;jump to decrement workspace offset and loop .cmpfil ;Find free channel and check for clashes LDA #$00 ;preset workspace pointer = $00 STA dcby ;to return if all channels in use / none free LDA #$08 ;start at $08, open flag mask for channel $15 STA ytemp ;save as shift register TYA ;y=catalogue offset of open file, move to X TAX LDY #$A0 ;start at channel workspace offset $A0: .cmpfl4 STY itemp ;save workspace offset TXA ;save catalogue offset PHA LDA #$08 ;set counter = 8 STA xtemp LDA ytemp ;get open flag mask for current channel BIT dcbmap ;test channel open flag BEQ cmpfl5 ;if Z=1 channel closed then skip channel LDA seqflg,Y ;else get drive of open file EOR fdrive ;compare with current drive AND #$03 ;mask off channel flags, compare drives only BNE cmpfl1 ;if unequal then no match .cmpfl0 LDA catlow,X ;get character of filename to compare EOR seqcat,Y ;compare with char of open filename AND #$7F ;ignore bit 7 BNE cmpfl1 ;if unequal then no match INX ;skip to next character of comparand INY ;skip even addresses cont'g file attributes INY ;skip to next character of open filename DEC xtemp ;decrement counter BNE cmpfl0 ;loop until 7 leaf name chars + dir tested SEC ;return C=1 matching filename found. BCS cmpfl2 ;branch to finish (always) .cmpfl5 ;channel closed STY dcby ;set offset of lowest free channel STA dcbbit ;set open mask bit of lowest free channel: .cmpfl1 ;no match SEC ;subtract $20 from channel workspace pointer LDA itemp SBC #$20 STA itemp ASL ytemp ;shift channel open bit mask to next channel down CLC ;return C=0 no match: .cmpfl2 PLA ;restore catalogue offset TAX LDY itemp ;return Y=free channel offset or Y=0 none free LDA ytemp ;test channel open bit mask BCS cmpfl3 ;if matching filename found return C=1 BNE cmpfl4 ;else if more channels to compare then loop .cmpfl3 RTS ;else return C=0 no channels match open file. .ensur ;OSARGS A=$FF ensure file/all files JSR wopa ;have A=0 returned on exit .nsrnow ;Ensure file/all files up-to-date on disc (flush) LDA dcbmap ;save channel open flags PHA LDA #$00 ;$00=this is an ensure operation STA dufflg ;do not update EXT in catalogue TYA ;if Y>0 BNE ensur1 ;then close file to ensure contents JSR shtall ;else close all files to ensure contents BEQ ensur0 ;and restore channel open flags (always) .ensur1 ;OSARGS A=$FF, Y>0 ensure file up-to-date JSR wshut ;close a file/all files [BUG] sets dufflg again .ensur0 PLA ;restore channel open flags. STA dcbmap RTS .wopa ;Have A=0 returned on exit PHA ;caller called Save AXY, A was at $0105,S TXA ;save caller's AX PHA ;these two bytes plus return address make 4 LDA #$00 ;superroutine's A is thus 5+4 = 9 bytes down TSX STA stack+$09,X PLA ;restore caller's AX TAX PLA RTS .wargs ;OSARGS JSR savita ;save AXY CMP #$FF ;if A=$FF BEQ ensur ;then ensure file up-to-date on disc CPY #$00 ;else if Y = 0 BEQ wargs1 ;then perform Y = 0 functions CMP #$04 ;else file handle in Y. if A>=4 BCS wargsr ;then return JSR wopa ;else have A=0 returned on exit CMP #$03 ;if A=3 BEQ L97A9 ;then set EXT CMP #$01 ;else compare A - 1 BNE vradr ;if A=0 or A=2 then return PTR or EXT JMP vstar ;else A=1 set PTR .wargs1 ;OSARGS Y=0 CMP #$02 ;if A>=2 BCS wargsr ;then return JSR wopa ;else have A=0 returned on exit BEQ rdfsno ;if A=0 then return FS number, else: ;unreachable code ;as FileSwitch intercepts OSARGS 1,0 LDA #$FF ;OSARGS A=1, Y=0 read command line tail STA $02,X ;command line is always in I/O processor STA $03,X ;so return a host address, $FFFFxxxx LDA linadr+$00 ;copy address of command line arguments STA $00,X ;from workspace where stored by OSFSC 2..4 LDA linadr+$01 ;to user's OSARGS block STA $01,X ;return A=0 .wargsr RTS .rdfsno ;OSARGS A=0, Y=0 return filing system number LDA #$04 ;a=4 for Disc Filing System TSX STA stack+$05,X ;save in stack to return via Restore AXY RTS .vradr ;OSARGS A=0/2, Y>0 return PTR/EXT JSR dcrych ;ensure file handle valid and open STY dcby ;save channel workspace pointer ASL A ;A=0 or 2, multiply by 2 ADC dcby ;A=0 offset of PTR, A=4 offset of EXT TAY ;add offset to channel workspace pointer LDA seqpl,Y ;copy PTR or EXT STA $00,X ;to 3 LSBs of user's OSARGS block LDA seqpm,Y STA $01,X LDA seqph,Y STA $02,X LDA #$00 ;clear MSB of user's OSARGS block STA $03,X ;PTR <= EXT < 16 MiB RTS .L97A9 ;OSARGS A=3, Y>0 set EXT JSR dcrych ;ensure file handle valid and open LDA $00,X ;copy 3 LSBS of user's OSARGS block STA seqlla,Y ;to EXT LDA $01,X ;[BUG] no range checking STA seqlma,Y ;[BUG] extended part of file not zeroed LDA $02,X STA seqlha,Y RTS .cheeky ;Validate workspace offset PHA ;save A STX seqwx ;save X in workspace TYA ;transfer workspace offset to A AND #$E0 ;mask bits 7..5, offset = 0..7 * $20 STA dcby ;save channel workspace offset BEQ chekyz ;if offset = 0 (i.e. channel $10) return C=1 JSR sfive ;else shift right five times, divide by 32 TAY ;transfer to Y for use as counter LDA #$00 ;clear channel open bit mask SEC ;set C=1 so first mask will be $80 for ch.$11: .chekya ROR A ;shift channel open bit mask to next channel up DEY ;decrement counter BNE chekya ;loop 1..5 times for channel $11..15 LDY dcby ;put channel workspace pointer in Y BIT dcbmap ;if channel's open bit in flag byte = 1 BNE chekyb ;then return C=0 .chekyz PLA ;else return C=1 SEC RTS .chekyb ;can save 3 bytes (.chekyz:SEC:.chekyb:PLA:RTS) PLA CLC ;redundant (C=0 on entry) RTS ;unreachable code PHA TXA JMP dcryp2 .dcrypt ;Convert file handle to channel pointer PHA ;save A TYA .dcryp2 CMP #$10 ;if Y outside range $10..17 BCC dcryp0 CMP #$18 BCC dcryp1 .dcryp0 LDA #$08 ;then return Y=0, C=1 .dcryp1 JSR lfive ;else multiply Y by 32 TAY ;yielding $00..E0 PLA ;transfer to Y as index RTS ;restore A on entry .hmtspe ;Close *SPOOL/*EXEC file on error LDA #$C6 ;OSBYTE $C6 = read/write *EXEC file handle JSR readby ;call OSBYTE with X=0, Y=$FF TXA ;test *EXEC file handle in X BEQ hmtsp1 ;if no *EXEC file open then test *SPOOL handle JSR hmtcmp ;else compare *EXEC handle with error handle BNE hmtsp1 ;if unequal then test *SPOOL handle LDA #$C6 ;else OSBYTE $C6 = read/write *EXEC file handle BNE hmtbyt ;set *EXEC file handle = 0 .hmtsp1 LDA #$C7 ;OSBYTE $C7 = read/write *SPOOL file handle JSR readby ;call OSBYTE with X=0, Y=$FF JSR hmtcmp ;compare *SPOOL handle with error handle BNE hmtsp2 ;if unequal then exit LDA #$C7 ;else OSBYTE $C7 = read/write *SPOOL file handle: .hmtbyt ;Set *SPOOL/*EXEC file handle = 0 LDX #$00 LDY #$00 JMP osbyte .hmtcmp ;Compare file handle with channel workspace offset TXA ;on entry X=file handle, move to Y TAY JSR dcrypt ;convert file handle to channel pointer CPY dcby ;compare with offset in use when error occurred .hmtsp2 RTS ;return Z=result .wfeof ;OSFSC 1 = read EOF state PHA ;save AY TYA PHA TXA ;transfer file handle to Y TAY JSR dcrych ;ensure file handle valid and open TYA ;a=y = channel workspace pointer JSR pcmp ;compare PTR - EXT BNE wfeof0 ;if PTR <> EXT (blech!) then return 0 LDX #$FF ;else return $FF, we are at end of file BNE wfeof2 .wfeof0 LDX #$00 .wfeof2 PLA ;restore AY and exit TAY PLA .dcryc0 RTS .dcrych ;Ensure file handle valid and open JSR dcrypt ;convert file handle to channel pointer JSR cheeky ;validate workspace offset BCC dcryc0 ;if channel open then return C=0 JSR hmtspe ;else close *SPOOL/*EXEC file on error JSR estrng ;and raise "Channel" error. EQUB $DE EQUS "Channel" EQUB $00 .illeof ;Raise "EOF" error JSR estrng EQUB $DF EQUS "EOF" EQUB $00 .wbget ;OSBGET JSR savit ;save XY JSR dcrych ;ensure file handle valid and open TYA ;a=y = channel workspace pointer JSR pcmp ;compare PTR - EXT BNE noteof ;if at EOF LDA seqflg,Y ;then test EOF warning flag b4 AND #$10 BNE illeof ;if set then raise "EOF" error LDA #$10 ;else set EOF warning flag b4=1 JSR setbit ;set channel flag bits (A = OR mask) LDX seqwx ;redundant LDA #$FE ;return A=$FE, error code for EOF SEC ;return C=1 indicating end-of-file RTS ;restore XY and exit .noteof LDA seqflg,Y ;not at EOF. get channel flags BMI vbgetb ;if PTR not within current buffer JSR setq ;then set current vol/dir from open filename JSR bflush ;ensure buffer up-to-date on disc L6 SEC ;c=1 read buffer from disc JSR xblock ;read/write sector buffer L6 .vbgetb LDA seqpl,Y ;get LSB of PTR STA work+$00 ;set LSB of buffer pointer LDA seqbuf,Y ;get MSB buffer pointer from channel workspace STA work+$01 ;set MSB of buffer pointer LDY #$00 ;set Y=0 for indirect indexed load LDA (work),Y ;get byte from channel buffer at old PTR PHA LDY dcby LDX work+$00 ;can save 2 bytes (LDX seqpl,Y) INX ;increment PTR TXA STA seqpl,Y BNE vbgetx ;if LSB rolls over CLC ;then carry out to 2MSB LDA seqpm,Y ADC #$01 STA seqpm,Y LDA seqph,Y ;and MSB ADC #$00 STA seqph,Y JSR clrcbf ;clear buffer-contains-PTR channel flag .vbgetx CLC ;c=0, not at EOF: PLA ;return byte in A, set N and Z to match RTS .setda ;Set buffer sector address from PTR CLC LDA seqloc,Y ;get LSB start sector of open file ADC seqpm,Y ;add 2MSB of PTR STA lbalo ;store LSB sector address STA seqdal,Y ;store LSB sector address of buffer LDA seqlh,Y ;get top bits exec/length/load/start sector AND #$03 ;extract MSB start sector ADC seqph,Y ;add MSB of PTR STA lbahi ;store MSB sector address STA seqdah,Y ;store MSB sector address of buffer: .setcbf ;Set buffer-contains-PTR channel flag LDA #$80 ;b7=1 buffer contains byte at PTR: .setbit ;Set channel flag bits (A = OR mask) ORA seqflg,Y BNE clrbt3 ;store if >0 else fall through harmlessly: .clrcbf ;Clear buffer-contains-PTR channel flag: LDA #$7F .clrbit ;Clear channel flag bits (A = AND mask) AND seqflg,Y .clrbt3 STA seqflg,Y CLC RTS .bflush ;Ensure buffer up-to-date on disc L6 LDA seqflg,Y ;test b6 of channel flag AND #$40 BEQ bflx ;if buffer not changed then return CLC ;c=0 write buffer to disc: .xblock ;Read/write sector buffer L6 PHP ;redundant INC seqsem ;set *SPOOL/*EXEC critical flag (now $00) LDY dcby ;put channel workspace pointer in Y LDA seqbuf,Y ;get MSB address of buffer in shared wksp STA lodhi LDA #$FF ;set high word of buffer address = $FFFF STA ldlow+$02 STA ldlow+$03 LDA #$00 STA lodlo ;clear LSB buffer address STA lenlo LDA #$01 ;256 bytes to transfer STA lenhi PLP ;redundant BCS xblrd ;if C was 1 on entry then read buffer LDA seqdal,Y ;else copy channel's sector buffer address STA lbalo ;to OSFILE control block (big-endian) LDA seqdah,Y STA lbahi JSR blkwr ;write ordinary file L5 LDY dcby ;put channel workspace pointer in Y LDA #$BF ;b6=0 buffer not changed JSR clrbit ;clear channel flag bits BCC xblfin ;clear critical flag and exit .xblrd ;Read channel buffer from disc L6 JSR setda ;set buffer sector address from PTR JSR blkrd ;read ordinary file L5 .xblfin DEC seqsem ;clear *SPOOL/*EXEC critical flag (now $FF) LDY dcby ;put channel workspace pointer in Y .bflx RTS .vbput1 JMP delprt ;raise "Locked" error. .vbput2 ;Raise "Read only" error. JSR estrng EQUB $C1 EQUS "Read only" EQUB $00 .vbput ;Write byte JSR savita ;save AXY JMP wbput1 .wbput ;OSBPUT JSR savita ;save AXY JSR dcrych ;ensure file handle valid and open .wbput1 PHA ;save byte to write LDA seqrdo,Y ;test channel read-only bit BMI vbput2 ;if b7=1 then raise "File read only" error LDA seqlok,Y ;else test file locked bit BMI vbput1 ;if b7=1 then raise "File locked" error JSR setq ;else set current vol/dir from open filename TYA ;a=y = channel workspace pointer CLC ;add 4 to point A to allocated length not EXT ADC #$04 JSR pcmp ;compare PTR - allocated length BNE notful ;if within allocation then write JSR vlook3 ;else ensure open file still on current drive LDX seqwb ;get offset of file in catalogue SEC LDA cathig-$01,X ;get LSB start LBA of previous file in cat SBC cathig+$07,X ;subtract LSB start LBA of open file PHA ;save LSB maximum available allocation LDA cathig-$02,X ;get MSB start LBA of previous file in cat SBC cathig+$06,X ;subtract MSB start LBA of open file AND #$03 ;extract b1,b0 CMP seqeh,Y ;compare MSB length of file per workspace BNE vok ;if not equal then extend file PLA ;else restore LSB maximum available allocation CMP seqem,Y ;compare 2MSB length of file per workspace BNE vokspl ;if not equal then extend file STY atemp ;redundant (vestigial in DFS 1.20) STY dcby ;else save workspace pointer JSR hmtspe ;close *SPOOL/*EXEC file on error JSR estrng ;and raise "Can't extend" error. EQUB $BF EQUS "Can't extend" EQUB $00 .vok ;extend file LDA seqeh,Y ;get MSB length of file per workspace CLC ;round up length to next 64 KiB ADC #$01 STA seqeh,Y ;store MSB file length in workspace ASL A ;shift A left 4 places ASL A ;can save 1 byte (JSR lfour) ASL A ASL A EOR cathig+$06,X ;XOR with existing top bits AND #$30 ;mask b5,b4; A=..XX.... EOR cathig+$06,X ;XOR old top bits with A; 6 bits old, 2 new STA cathig+$06,X ;set top bits exec/length/load/start sector PLA ;discard LSB maximum available allocation LDA #$00 ;clear 2MSB file length: multiple of 64 KiB .vokspl STA cathig+$05,X ;store 2MSB file length in catalogue STA seqem,Y ;store 2MSB file length in workspace LDA #$00 ;clear LSB file length in catalogue STA cathig+$04,X JSR dirout ;write volume catalogue LDY dcby ;put channel workspace pointer in Y .notful ;write byte to file LDA seqflg,Y ;test channel flags BMI vbputb ;if b7=1 buffer-contains-PTR then write byte JSR bflush ;else ensure buffer up-to-date on disc L6 LDA seqlla,Y ;does EXT equal a whole number of sectors? BNE notend ;if not then read buffer from disc TYA ;else a=y = channel workspace pointer JSR pcmp ;compare PTR - EXT BNE notend ;if not at EOF then read buffer from disc JSR setda ;else set buffer sector address from PTR BNE vbputb ;branch (always) .notend SEC ;c=1 read buffer from disc JSR xblock ;read/write sector buffer L6 .vbputb LDA seqpl,Y ;get LSB of PTR STA work+$00 ;set LSB of buffer pointer LDA seqbuf,Y ;get MSB buffer pointer from channel workspace STA work+$01 ;set MSB of buffer pointer PLA ;restore byte to write LDY #$00 ;set Y=0 for indirect indexed store STA (work),Y ;put byte in channel buffer at old PTR LDY dcby ;put channel workspace pointer in Y LDA #$40 ;b6=1, buffer has changed JSR setbit ;set channel flag bits (A = OR mask) INC work+$00 ;increment PTR LDA work+$00 STA seqpl,Y BNE ncarry ;if LSB rolls over JSR clrcbf ;then clear buffer-contains-PTR channel flag LDA seqpm,Y ;carry out to 2MSB ADC #$01 ;c=0 from clrcbf STA seqpm,Y LDA seqph,Y ;and MSB ADC #$00 STA seqph,Y .ncarry TYA ;a=y = channel workspace pointer JSR pcmp ;compare PTR - EXT BCC vbputx ;if at EOF (i.e. pointer >= EXT) LDA #$20 ;then b5=1, EXT has changed JSR setbit ;set channel flag bits (A = OR mask) LDX #$02 ;3 bytes to copy: .vbput3 LDA seqpl,Y ;copy EXT = PTR STA seqlla,Y INY DEX BPL vbput3 .vbputx RTS .vstar ;OSARGS A=1, Y>0 set PTR JSR savita ;save AXY ;can save time by entering here from OSARGS JSR dcrych ;ensure file handle valid and open LDY dcby ;redundant .vstara JSR scmp ;compare EXT - requested PTR BCS vstarb ;if EXT >= request then just set PTR LDA seqlla,Y ;else set PTR = EXT STA seqpl,Y LDA seqlma,Y STA seqpm,Y LDA seqlha,Y STA seqph,Y JSR vstarc ;update buffer-contains-PTR channel flag LDA vtemp+$00 PHA LDA vtemp+$01 PHA LDA ztemp+$00 ;[D]new save but what clobbers it?? PHA LDA #$00 ;a = $00 filler byte JSR vbput ;write byte to end of file PLA STA ztemp+$00 PLA STA vtemp+$01 PLA STA vtemp+$00 JMP vstara ;loop until last byte is just before new PTR .vstarb LDA $00,X ;copy requested PTR in user's OSARGS block STA seqpl,Y ;to channel pointer: LDA $01,X STA seqpm,Y LDA $02,X STA seqph,Y .vstarc ;Update buffer-contains-PTR channel flag LDA #$6F ;b7=0 PTR not in buffer, b4=0 EOF warning clr JSR clrbit ;clear channel flag bits LDA seqloc,Y ;get LSB start sector of file ADC seqpm,Y ;add 2MSB PTR STA LC2C4 ;store LSB target sector LDA seqlh,Y ;get MSB start sector of file AND #$03 ;extract b1,b0 ADC seqph,Y ;add MSB PTR CMP seqdah,Y ;compare with MSB sector address of buffer BNE vbputx ;if equal LDA LC2C4 ;then compare LSB buffer offset with request CMP seqdal,Y BNE vbputx ;if requested PTR within current buffer JMP setcbf ;then set buffer-contains-PTR channel flag. .pcmp ;Compare PTR - EXT (A=Y), - allocation (A=Y+4) TAX ;return C=1 iff at/past EOF or allocation LDA seqph,Y ;return Z=1 iff at EOF or equal to allocation CMP seqlha,X BNE pcmpx LDA seqpm,Y CMP seqlma,X BNE pcmpx LDA seqpl,Y CMP seqlla,X .pcmpx RTS .scmp ;Compare EXT - OSARGS parameter LDA seqlla,Y ;return C=1 iff EXT >= parameter CMP $00,X LDA seqlma,Y SBC $01,X LDA seqlha,Y SBC $02,X RTS ;Table of boot commands .load EQUS "L.!BOOT",$0D .exec EQUS "E." .run EQUS "!BOOT",$0D .L9ADE ;DFS service call handler BIT priptr,X ;65C02 instruction BPL L9AE6 ;if private page address >=$8000 BVS L9AE8 ;and <$C000 RTS ;then exit .L9AE6 BVS L9B0E ;else if >=$4000 and <$8000 then exit .L9AE8 CMP #$12 ;else test service call number in A BEQ inifsy ;if =$12 then initialise FS in Y CMP #$0B ;else if in range $00..$0A BCC L9AFA ;then call handler from jump table CMP #$26 ;else if >=$26 BCS L9B0E ;then exit CMP #$21 ;else if <$21 BCC L9B0E ;then exit SBC #$16 ;else C=1; handle calls $21..$25 from entries $0B..$10 .L9AFA ASL A ;double word offset to byte offset TAX ;transfer to X for use as index LDA L9B0F+$01,X ;get high byte of action address - 1 PHA ;push on stack LDA L9B0F+$00,X ;get low byte of action address - 1 PHA ;push on stack TXA ;transfer jump table offset to A LDX romid ;put our ROM slot number in A for return LSR A ;halve offset CMP #$0B ;if more than 10 BCC L9B0E ADC #$15 ;then C=1; add 22, restore call number .L9B0E RTS ;jump to action address and execute call handler ;Table of action addresses for paged ROM service calls $00..$0A, $21..$25 .L9B0F EQUW return-$01 ;Svc $00 = no operation $8626 EQUW return-$01 ;Svc $01 = reserve abs wkspace $8626 EQUW savpri-$01 ;Svc $02 = reserve private wksp $9C5B EQUW pmsg -$01 ;Svc $03 = boot filing system $9B37 EQUW chkcom-$01 ;Svc $04 = unrecognised OSCLI $9C97 EQUW return-$01 ;Svc $05 = unrecog. interrupt $8626 EQUW return-$01 ;Svc $06 = break $8626 EQUW return-$01 ;Svc $07 = unrecognised OSBYTE $8626 EQUW unkwrd-$01 ;Svc $08 = unrecognised OSWORD $9CCE EQUW dohelp-$01 ;Svc $09 = *HELP $9C9F EQUW relmem-$01 ;Svc $0A = absolute wksp claim $9CB2 EQUW L9D18 -$01 ;Svc $21 = resv abs wksp HAZEL $9D18 EQUW L9D1F -$01 ;Svc $22 = resv priv wksp HAZEL $9D1F EQUW return-$01 ;Svc $23 = report top priv wksp $8626 EQUW L9D28 -$01 ;Svc $24 = abs wksp HAZEL count $9D28 EQUW L9D2B -$01 ;Svc $25 = retn filing sys info $9D2B .inifsy ;Service call $12 = initialise FS JSR savita CPY #$04 ;if number of FS to initialise = 4 BEQ init ;then initialise DFS RTS ;else exit .pmsg ;Service call $03 = boot filing system JSR savita STY itemp ;save boot flag in scratch space LDA #$7A ;call OSBYTE $7A = scan keyboard from $10+ JSR osbyte TXA ;test returned key code BMI L9B54 ;if N=1 no key is pressed, so init and boot CMP #$32 ;else if key pressed is D BEQ L9B4F ;then register keypress, init and boot CMP #$61 ;else if key pressed is not Z BNE L9B0E ;then exit JSR LA9FB ;else set up i8271/MOS 1.20 emulation: .L9B4F LDA #$78 ;OSBYTE $78 = write keys pressed information JSR osbyte .L9B54 LDA itemp ;a=boot flag passed to service call JSR vstrng EQUS "Acorn 1770 DFS" EQUB $0D EQUB $0D ;iff A=0 then force cold start, enable boot BRA sinit0 ;65C02 instruction .init LDA #$FF ;$FF = allow warm start, disable boot .sinit0 JSR wopa ;have A=0 returned on exit .L9B70 PHA ;save cold start flag LDA #$06 ;FSC 6 = new filing system starting up JSR osfscm ;issue Filing System call LDA fdcdat LDX #$0D ;7 vectors to replace: .init0 LDA vtabb,X ;copy addresses of extended vector handlers STA filev,X ;to FILEV,ARGSV,BGETV,BPUTV,GBPBV,FINDV,FSCV DEX ;loop until 7 vectors transferred BPL init0 LDA #$A8 ;call OSBYTE $A8 = get ext. vector table addr JSR readby STX temp+$00 ;set up pointer to vector table STY temp+$01 LDX #$07 ;7 vectors to transfer LDY #$1B ;y = $1B = offset of FILEV in extended vector table: .init1 LDA vtabf-$1B,Y ;get LSB action address from table STA (temp),Y ;store in extended vector table INY LDA vtabf-$1B,Y ;get MSB action address from table STA (temp),Y ;store in extended vector table INY LDA romid ;get our ROM slot number STA (temp),Y ;store in extended vector table INY DEX ;loop until 7 vectors transferred BNE init1 STY catdrv ;no catalogue in workspace STY olddrv ;redundant STX fdrive ;[D]current drive = 0 LDA #$FF STA LC287 ;both drives uncalibrated LDY #$03 .L9BB4 STA LC28B,Y ;clear bad tracks, $FF = rogue value DEY BPL L9BB4 LDX #$0F ;service call $0F = vectors claimed JSR doswcl ;call OSBYTE $8F = issue service call JSR suspri ;set up pointer to private page LDY #colds-mainws ;test cold start flag in private page LDA (temp),Y BPL initcl ;if b7=0 then force a cold start PLA ;else test cold start flag passed to us PHA BEQ initcl ;if =$00 then force a cold start LDY #memflg ;else test shared workspace possession flag LDA (temp),Y BMI bootit ;if b7=1 then we have the workspace, proceed to boot JSR getmem ;else issue service call $0A to claim the workspace LDY #$00 ;else offset into private page = $00: .init2 LDA (temp),Y ;get byte of private page CPY #$C0 ;if offset = $C0 or above BCC init3 STA mainws,Y ;then store in persistent main workspace BCS init4 ;and branch (always) .init3 STA seqmap,Y ;else store in channel workspace .init4 DEY ;loop until entire private page restored BNE init2 LDA #$A0 ;start at offset $A0, workspace for channel $15: .init6 TAY ;transfer offset to Y PHA ;save offset on stack LDA #$3F ;clear CBF=buffer contains PTR, CBU=buffer changed JSR clrbit ;formerly (<v1.20) left set while stowing PLA STA seqdah,Y ;set buffer LBA out of range to force re-reading SBC #$1F ;c=0 from clrbit; subtract $20 from offset BNE init6 ;loop until channels $11..$15 reset BEQ bootit ;then proceed to boot (always) .initcl ;Initialise DFS from cold JSR getmem ;issue service call $0A to claim shared workspace LDA #$24 STA defqua ;set default directory = "$" STA libqua ;set library directory = "$" LDY #$00 STY defdsk ;set default drive = 0 STY libdsk ;set library drive = 0 LDY #$00 STY dcbmap ;no channels open LDX #$03 ;[D] TYA .L9C16 STA LC2DE,X ;clear 40-track flags for drives 3..1 DEX BNE L9C16 DEY ;y=$FF STY enaflg ;*commands are not *ENABLEd STY monflg ;*OPT 1,0 quiet operation STY seqsem ;*SPOOL and *EXEC files are non-critical .bootit JSR L8EF4 ;[D]set Tube presence flag PLA ;restore cold start/boot flag BNE noauto ;if >0 then exit LDA #$04 ;else enable inverting bad track reg. on read error ORA LC2DE STA LC2DE JSR L93A9 ;load catalogue with execute privilege LDA #$FB ;disable inverting bad track reg. on read error AND LC2DE STA LC2DE LDA option ;get boot option/top bits volume size JSR sfour ;shift A right 4 places BNE aboot2 ;if boot option = 0 .noauto RTS ;then exit .aboot2 LDY #>load ;point XY to command "L.!BOOT" LDX #<load CMP #$02 ;if boot option = 1 then execute this command BCC aboot3 BEQ arun ;if boot option = 2 then execute "!BOOT" LDX #<exec BNE aboot3 ;branch (always) .arun LDX #<run ;else option >= 3; execute "E.!BOOT" .aboot3 JMP oscli ;call OSCLI and exit. .savpri ;Service call $02 = reserve private workspace LDA priptr,X ;space ends at $DC00, highest valid alloc = $DA CMP #$DB ;if we got our two pages in HAZEL BCC L9C66 ;during call $21, then initialise TYA ;else put private page in main memory instead STA priptr,X ;replace private page pointer .L9C66 PHY ;65C02 instruction STA temp+$01 ;set up pointer to private page LDA #$00 STA temp+$00 LDA #$FD ;OSBYTE $FD = read/write last reset type JSR readby ;call OSBYTE with X=$00, Y=$FF DEX ;now X=$FF soft break, $00 power on, $01 hard break TXA LDY #colds-mainws AND (temp),Y ;and modified reset type with cold start flag STA (temp),Y ;b7=0 force cold start after power on/CTRL BREAK PHP INY ;y=memflg PLP BPL notgot ;if okay for warm start LDA (temp),Y ;then private page contents valid BPL notgot ;if we have the shared workspace JSR savmem ;then copy it to the private page .notgot LDA #$00 ;b7=0 we don't own the shared workspace STA (temp),Y ;write to memflg offset of private page LDA #$02 ;a=$02, restore service call number LDX romid ;get paged ROM slot number as offset into table PLY ;65C02 instruction BIT priptr,X ;65C02 instruction BMI L9C96 ;if private page in main memory INY ;then claim two pages of main memory INY .L9C96 RTS .chkcom ;Service call $04 = unrecognised *command JSR savita ;save AXY LDX #<(initbl-comtab-$03) ;point to utility section of command table .L9C9C JMP wname0 ;execute matching command. .dohelp ;Service call $09 = *HELP JSR savita LDA (linptr),Y ;y points to non-space character LDX #<(hlptab-comtab-$03) ;point to *HELP keyword section of command table CMP #$0D ;if keyword specified BNE L9C9C ;then display help on matching keyword TYA ;else put command line offset in A for saving INX ;x = <(hlptab-comtab-$01) INX LDY #$01 ;1 entry to print JMP help1 ;print list of *HELP keywords. ;[BUG] service call $0A overwrites private page with garbage ;if DFS does not own absolute workspace .relmem ;Service call $0A = absolute workspace claimed JSR suspri ;set up pointer to private page LDY #$00 ;y=$00 ensure all files up-to-date on disc JSR nsrnow ;ensure a file/all files JSR savmem ;copy shared workspace to private page JSR suspri ;set up pointer again (clobbered during ensure) LDY #memflg LDA #$00 ;always claim call since past gatekeeping STA (temp),Y ;b7=0 we don't own the shared workspace RTS ;unreachable code LDA #$0A .unkswz ;Have current value of A returned on exit TSX STA stack+$05,X RTS .unkwrd ;Service call $08 = unrecognised OSWORD JSR savita ;save AXY JSR wopa ;have A=0 returned on exit LDY worda ;get OSWORD reason code in Y BMI unkswz ;if >=$80 then put call number back, pass call on CPY #$7D ;else if less than $7D BCC unkswz ;then pass call on to lower ROMs LDX wordx ;can save 2 bytes (swap) STX userpt+$00 ;else save pointer to user's control block LDX wordy ;(as inner OSWORD/OSBYTE calls will destroy) STX userpt+$01 INY ;if Y doesn't turn negative then it's $7D or $7E BPL gtdsks ;so handle disc queries separately LDX userpt+$00 ;else OSWORD $7F. point XY to user's control block LDY userpt+$01 JMP L9163 ;and jump to OSWORD $7F handler. .gtdsks ;OSWORD $7D/$7E JSR setdef ;set current drive and directory = default JSR getdir ;load volume catalogue L4 INY ;if Y turns negative BMI getdsz ;then it was $7E; branch LDY #$00 ;else point to first byte of user's control block LDA cycno ;get cycle number of catalogue and return to user STA (userpt),Y ;can save 1 byte (BEQ $9D15) RTS .getdsz ;OSWORD $7E return size of current volume LDA #$00 ;LSB of volume size = $00 TAY ;point to first byte of user's control block STA (userpt),Y ;write LSB volume size INY ;y=$01 LDA dirhig+$07 ;get LSB volume size in sectors from catalogue STA (userpt),Y ;write 3MSB volume size INY ;y=$02 LDA dirhig+$06 ;get boot option/top bits volume size AND #$03 ;extract volume size in b1,b0 STA (userpt),Y ;write 2MSB volume size INY ;y=$03 LDA #$00 ;DFS volumes < 16 MiB STA (userpt),Y ;clear MSB volume size RTS .L9D18 ;Service call $21 = reserve abs wksp in HAZEL CPY #$CA ;need 10 pages BCS L9D1E ;if high water mark is less LDY #$CA ;then set it to HAZEL + 10 pages .L9D1E RTS .L9D1F ;Service call $22 = reserve priv wksp in HAZEL TYA ;[BUG]Y may be too high OR too low at this point STA priptr,X ;set private page pointer to Y anyway LDA #$22 ;restore call number INY ;claim two pages of HAZEL INY ;and clean up during service call $02. RTS .L9D28 ;Service call $24 = abs wkspace in HAZEL count DEY ;bid for two pages in HAZEL DEY ;leftovers from abs+private offered in call $23 RTS .L9D2B ;Service call $25 = return FS information LDX #L9D51-L9D3B-$01 ;22 bytes to write: .L9D2D LDA L9D3B,X ;get byte of reversed table STA (linptr),Y ;store forwards in MOS reserved area INY ;increment MOS pointer DEX ;decrement table pointer BPL L9D2D ;loop until 22 bytes copied LDA #$25 ;restore service call number LDX romid ;restore paged ROM slot number in X RTS ;pass updated Y to next ROM ;Filing system information block, in reverse .L9D3B EQUB $04,$15,$11 ;FS number, highest, lowest file handles EQUS " CSID" ;FS name EQUB $04,$15,$11 ;FS number, highest, lowest file handles EQUS " KSID" ;FS name .L9D51 ;On receiving service call $26, DFS is already deselected and its ;files ensured to disc: the Terminal ROM has called OSBYTE $8D (*ROM) ;which issued FSC $06. This handler as written would close all files ;if the cold start flag were set, but otherwise achieve nothing; ;although its clearing of CBF and CBU at this point would be harmless. ;Even so, this routine has no entry in the jump table and therefore ;*SHUT does not close files on DFS volumes. ;unreachable code ;service call $26 = *SHUT command issued PHY ;65C02 instruction LDA #$FF ;$FF = allow warm start, disable boot JSR L9B70 ;initialise DFS PLY ;65C02 instruction LDX romid LDA #$26 RTS .wfile ;OSFILE JSR savit ;save XY PHA ;push A JSR clrwld ;disallow wildcard characters in filename STX temp+$00 ;set up pointer from XY STX fcbadr+$00 STY temp+$01 STY fcbadr+$01 LDX #$00 ;destination offset = 0 LDY #$00 ;source offset = 0 JSR shfttw ;copy filename pointer word to work; X=Y=2 .wfile4 JSR shftbo ;copy one word to work, one word to hiwork CPY #$12 ;loop until 16 bytes copied, 18 total BNE wfile4 PLA ;transfer call number to X TAX INX ;increment for use as index CPX #filjph-filjpl ;was call number $FF or 0..7? BCS wfile3 ;if not then exit LDA filjph,X ;else get action address high byte PHA ;save on stack LDA filjpl,X ;get action address low byte PHA ;save on stack .wfile3 LDA #$00 ;a=0 on entry to routine RTS ;jump to action address .wfscm ;FSC CMP #fschtb-fscltb ;if call outside range 0..8 BCS wfile3 ;then exit STX ytemp ;else save X TAX ;transfer call number to X as index LDA fschtb,X ;get action address high byte PHA ;save on stack LDA fscltb,X ;get action address low byte PHA ;save on stack TXA ;restore call number to A LDX ytemp ;restore X on entry .wbgpbr RTS ;jump to action address .wbgpb ;OSGBPB CMP #wgptbh-wgptbl BCS wbgpbr ;if call number >=9 then return JSR savita ;else save AXY JSR wopa ;have A=0 returned on exit STX btemp+$00 ;save OSGBPB block pointer in workspace STY btemp+$01 TAY ;transfer call number to Y for use as index JSR wbrest ;execute OSGBPB call PHP BIT tumflg ;[D]if Tube present BPL L9DBE JSR L8F2F ;then release Tube .L9DBE PLP RTS .wbrest LDA wgptbl,Y ;get low byte of action address from table STA qtemp+$00 LDA wgptbh,Y ;get high byte of action address from table STA qtemp+$01 LDA wbrwtb,Y ;get microcode byte from table LSR A ;push bit 0 as C PHP LSR A ;push bit 1 as C PHP STA ctemp ;store Tube service call number as bits 0..5 JSR makatp ;set up pointer to user's OSGBPB block LDY #$0C ;13 bytes to copy, $0C..$00: .wbgpb0 LDA (atemp),Y ;copy user's OSGBPB block STA dosram,Y ;to workspace DEY ;loop until 13 bytes copied BPL wbgpb0 LDA dosram+$03 ;and high bytes of address AND dosram+$04 ;a=$FF if address is in the host ORA notube ;a=$FF if Tube absent ($10D6=NOT MOS flag!) CLC ADC #$01 ;set A=0, C=1 if transferring to/from host BEQ wbgpba ;if A>0 JSR clatub ;then claim Tube CLC LDA #$FF ;and set A=$FF, C=0, transferring to/from Tube .wbgpba STA tumflg ;set Tube transfer flag LDA ctemp ;set A=0 if writing user mem, A=1 if reading BCS wbgpb9 ;if transferring to/from Tube LDX #<(dosram+$01) ;then point XY to OSGBPB data address LDY #>(dosram+$01) JSR tubadr ;call Tube service to open Tube data channel .wbgpb9 PLP ;set C=microcode b1 BCS wbgpbb ;if reading/writing data then transfer it PLP ;else C=microcode b0 (=0), pop off stack .qjmi JMP (qtemp) ;and jump to action address. .wbgpbb LDX #$03 ;4 bytes to copy, 3..0: .wbgpb8 LDA dosram+$09,X ;copy OSGBPB pointer field STA vtemp,X ;to zero page DEX BPL wbgpb8 LDX #vtemp ;point X to pointer in zero page LDY dosram+$00 ;set Y=channel number LDA #$00 ;set A=0, read PTR not EXT PLP ;set C=microcode b0 BCS wbgpb1 ;if C=0 JSR vstar ;then call OSARGS 1,Y set PTR. .wbgpb1 JSR vradr ;call OSARGS 0,Y return PTR LDX #$03 ;4 bytes to copy, 3..0: .wbgpb7 LDA vtemp,X ;copy pointer in zero page STA dosram+$09,X ;to OSGBPB pointer field DEX BPL wbgpb7 .wcbat0 JSR comwrk ;invert OSGBPB length field BMI wbgpb4 ;and branch into loop (always) .wbgpb3 LDY dosram+$00 ;set Y = channel number JSR qjmi ;transfer byte / element BCS wbgpb6 ;if attempted read past EOF then finish LDX #$09 ;else set X = $09, point to OSGBPB pointer JSR zerinc ;increment pointer .wbgpb4 LDX #$05 ;set X = $05, point to OSGBPB length field JSR zerinc ;increment OSGBPB length field (inverted) BNE wbgpb3 ;if not overflowed to zero then loop CLC ;else set C = 0, no read past EOF: .wbgpb6 PHP JSR comwrk ;invert OSGBPB length field LDX #$05 ;add one to get two's complement (0 -> 0) JSR zerinc ;thus, number of elements not transferred LDY #$0C ;13 bytes to copy, offsets 0..$C: JSR makatp ;set up pointer to user's OSGBPB block .wbgpb5 LDA dosram,Y ;copy OSGBPB block back to user memory STA (atemp),Y DEY BPL wbgpb5 PLP RTS .wcbat ;OSGBPB 8 = read filenames in default dir JSR setdef ;set current vol/dir = default, set up drive JSR L93B1 ;ensure current volume catalogue loaded LDA #<wcbatr ;replace action address with wcbatr STA qtemp+$00 ;= return one filename LDA #>wcbatr STA qtemp+$01 BNE wcbat0 ;and return requested number of filenames. .wcbatr ;Return one filename (called during OSGBPB 8) LDY dosram+$09 ;set Y = catalogue pointer (0 on first call) .wcbat4 CPY dirlen ;compare with no. files in catalogue BCS wcbat2 ;if out of files return C=1, read past EOF LDA modify,Y ;else get directory character of cat entry JSR caps ;set C=0 iff character in A is a letter EOR qualif ;compare with current directory character BCS wcbat5 ;if directory character is a letter AND #$DF ;then ignore case. .wcbat5 AND #$7F ;mask off attribute bit b7 BEQ wcbat3 ;if catalogue entry not in current directory JSR step ;then add 8 to Y BNE wcbat4 ;and loop (always) .wcbat3 LDA #$07 ;else write 7 to user memory JSR wbwrit ;= length of filename STA temp ;set counter to 7 .wcbat1 LDA catlow,Y ;get character of leaf name JSR wbwrit ;write byte to user memory INY ;increment catalogue pointer DEC temp ;loop until 7 characters transferred BNE wcbat1 ;(Y is 7 up, inc at wbgpb3 puts pointer 8 up) CLC ;c=0, did not run out of filenames: .wcbat2 STY dosram+$09 ;put updated cat ptr in OSGBPB pointer field LDA cycno ;return catalogue cycle no. in channel field STA dosram+$00 RTS .rdtco ;OSGBPB 5 = read title, boot option and drive JSR setdef ;set current vol/dir = default, set up drive JSR L93B1 ;ensure current volume catalogue loaded LDA #$0C ;write 12 to user memory JSR wbwrit ;= length of title LDY #$00 ;set offset to 0 .rdtc0 CPY #$08 ;if writing characters 8..11 BCS rdtc1 ;then fetch from second catalogue sector LDA dirlow,Y ;else get characters 0..7 from first sector BCC rdtc2 ;and write to user memory (always) .rdtc1 LDA dirhig-$08,Y ;get characters 8..11 from offsets 0..3 .rdtc2 JSR wbwrit ;write to user memory INY CPY #$0C ;loop until 12 characters written BNE rdtc0 LDA option ;get boot option/top bits volume size JSR sfour ;shift A right 4 places JSR wbwrit ;write boot option to user memory LDA fdrive ;get current drive JMP wbwrit ;write to user memory and exit .rdbir ;OSGBPB 6 = read default (CSD) drive and dir JSR wowrit ;write binary 1 to user memory LDA defdsk ;get default drive ORA #$30 ;convert to ASCII digit JSR wbwrit ;write drive identifier to user memory JSR wowrit ;write binary 1 to user memory LDA defqua ;get default directory character BNE wbwrit ;write it to user memory and exit .rlbir ;OSGBPB 7 = read library drive and directory JSR wowrit ;write binary 1 to user memory LDA libdsk ;get library drive ORA #$30 ;convert to ASCII digit JSR wbwrit ;write drive identifier to user memory JSR wowrit ;write binary 1 to user memory LDA libqua ;get library directory character BNE wbwrit ;write it to user memory and exit .adrld ;Set up pointer to user I/O memory PHA ;can save 2 bytes LDA dosram+$01 STA ztemp+$00 LDA dosram+$02 STA ztemp+$01 LDX #$00 ;offset = 0 for indexed indirect load/store PLA RTS .adrinc ;Increment OSGBPB address field JSR savita ;save AXY LDX #$01 ;set X = $01, point to OSGBPB data address: .zerinc ;Increment OSGBPB field LDY #$04 .zerin0 INC dosram,X BNE zerin1 INX DEY BNE zerin0 .zerin1 RTS ;return Z=1 iff field overflows .comwrk ;Invert OSGBPB length field LDX #$03 .wbgpb2 LDA #$FF EOR dosram+$05,X STA dosram+$05,X DEX BPL wbgpb2 RTS .makatp ;Set up pointer to user's OSGBPB block LDA btemp+$00 STA atemp+$00 LDA btemp+$01 STA atemp+$01 .wbgtr0 RTS .wowrit ;Write binary 1 to user memory LDA #$01 BNE wbwrit ;OSGBPB 3 = set pointer and read data ;OSGBPB 4 = read data .wbgtr JSR wbget ;call OSBGET; read byte from file BCS wbgtr0 ;if end-of-file reached return C=1, else: .wbwrit ;Write data byte to user memory BIT tumflg ;test Tube flag BPL wbwri0 ;if Tube not in use then write to I/O memory STA reg3 ;else put byte in R3DATA BMI adrinc ;and increment OSGBPB address field (always) .wbwri0 JSR adrld ;set up pointer to user I/O memory STA (ztemp,X) ;store byte at pointer and increment address JMP adrinc ;can save 3 bytes (join) ;OSGBPB 1 = set pointer and write data ;OSGBPB 2 = write data .wbptr JSR wbread ;get byte from user memory JSR wbput ;call OSBPUT; write byte to file CLC ;return C=0 no end-of-file condition RTS .wbread ;Read data byte from user memory BIT tumflg ;test Tube transfer flag BPL wbrea0 ;if b7=0 then read from I/O memory LDA reg3 ;else read from R3DATA JMP adrinc ;increment OSGBPB address field .wbrea0 JSR adrld ;set up pointer to user I/O memory LDA (ztemp,X) ;read byte from user I/O memory JMP adrinc ;increment OSGBPB address field .wstus ;FSC 8 = *command has been entered BIT enaflg ;if *ENABLEd flag b7=0 (i.e. byte = 0 or 1) BMI clrwld DEC enaflg ;then enable this command, not the ones after: .clrwld ;Disallow wildcard characters in filename LDA #$FF STA dashop .setwl0 STA wildch RTS .setwld ;Allow wildcard characters in filename LDA #$2A STA dashop LDA #$23 BNE setwl0 .frdcat ;OSFILE 5 = read catalogue information JSR tryfil ;ensure file exists JSR chukbk ;return catalogue information to OSFILE block LDA #$01 ;return A=1, file found RTS .fdefil ;OSFILE 6 = delete file JSR tryflc ;ensure unlocked file exists JSR chukbk ;return catalogue information to OSFILE block JSR delfil ;delete catalogue entry BCC dort1a ;write volume catalogue, return A=1 .fwrcat ;OSFILE 1 = write catalogue information ;[BUG] can set attributes on open file JSR tryfil ;ensure unlocked file exists JSR mvilod ;set load address from OSFILE block JSR mviexe ;set exec address from OSFILE block BVC dort1b ;branch to set attributes and write (always) ;[D]swapped vs DFS 1.20 .fwrexe ;OSFILE 3 = write execution address JSR tryfil ;ensure unlocked file exists JSR mviexe ;set exec address from OSFILE block BVC dort1a ;branch to write catalogue (always) .fwrlod ;OSFILE 2 = write load address JSR tryfil ;ensure unlocked file exists JSR mvilod ;set load address from OSFILE block BVC dort1a ;branch to write catalogue (always) .fwratt ;OSFILE 4 = write file attributes JSR tryfil ;ensure file exists JSR chkopn ;ensure file not open (mutex) .dort1b JSR mviatt ;set file attributes from OSFILE block .dort1a JSR titend ;write volume catalogue (=JMP dirout) LDA #$01 ;return A=1, file found RTS .mvilod ;Set load address from OSFILE block JSR savita ;save AXY LDY #$02 ;set offset = 2 LDA (temp),Y ;get LSB load address from OSFILE block STA cathig+$00,X ;store in catalogue entry INY ;increment offset; Y=3 LDA (temp),Y ;get 3MSB load address STA cathig+$01,X ;store in catalogue entry INY ;increment offset; Y=4 LDA (temp),Y ;get 2MSB load address ASL A ;extract b17,b16, place in b3,b2 ASL A EOR cathig+$06,X ;XOR with existing top bits AND #$0C ;mask b3,b2; A=....XX.. BPL mviin0 ;branch to update top bits (always) .mviexe ;Set exec address from OSFILE block JSR savita ;save AXY LDY #$06 ;set offset = 6 LDA (temp),Y ;get LSB exec address from OSFILE block STA cathig+$02,X ;store in catalogue entry INY ;increment offset; Y=7 LDA (temp),Y ;get 3MSB exec address STA cathig+$03,X ;store in catalogue entry INY ;increment offset; Y=8 LDA (temp),Y ;get 2MSB load address ROR A ;extract b17,b16, place in b7,b6 ROR A ROR A EOR cathig+$06,X ;XOR with existing top bits AND #$C0 ;mask b7,b6; A=XX...... .mviin0 EOR cathig+$06,X ;XOR old top bits with A; 6 bits old, 2 new STA cathig+$06,X ;set top bits exec/length/load/start sector CLV ;return V=0 RTS .mviatt ;Set file attributes from OSFILE block JSR savita ;save AXY LDY #$0E ;set Y=14, offset of file attributes LDA (temp),Y ;get LSB of file attributes AND #$0A ;test b3=file locked, b1=writing denied ;NB b2..b0 are in opposite sense to RISC OS ;where they enable execute, write, read resp. ;this is well-documented in DFS and RISC OS BEQ mviat0 ;if either is set LDA #$80 ;then b7=1 file locked .mviat0 EOR modify,X ;else b7=0 file unlocked. get directory char AND #$80 ;from catalogue entry EOR modify,X ;preserve b6..0, replace b7 from A STA modify,X ;save directory char with new lock attribute RTS .tryflc ;Ensure unlocked file exists JSR tryfl1 ;test if file exists BCC tryfl2 ;if not then return A=0 from caller, else: .chklok ;Ensure file not locked LDA modify,Y ;if directory character b7=1 BPL chkopr .delprt JSR estrng ;then raise "File locked" error. EQUB $C3 EQUS "Locked" EQUB $00 .chkopl ;Ensure file not locked or open (mutex) JSR chklok ;ensure file not locked .chkopn ;Ensure file not open (mutex) JSR savita ;save AXY JSR cmpfil ;find free channel and check for clashes BCC tryfl3 ;if file not open then return JMP filopn ;else raise "Locked" error. .tryfil ;Ensure file exists JSR tryfl1 ;test if file exists BCS tryfl3 ;if present then return, else: .tryfl2 ;Return A=0 from caller PLA ;discard return address on stack (ew!) PLA LDA #$00 ;return A=0 as if from caller. .chkopr RTS .tryfl1 ;Test if file exists JSR frmnam ;set current file from argument pointer JSR lookup ;search for file in catalogue BCC tryfl3 ;if file not found then exit C=0 TYA ;else transfer catalogue pointer to X: TAX .tryfl0 ;Set up pointer to user's OSFILE block LDA fcbadr+$00 STA temp+$00 LDA fcbadr+$01 STA temp+$01 .tryfl3 RTS .getlsz ;Get start and size of user memory LDA #$83 ;call OSBYTE $83 = read OSHWM JSR osbyte STY frpage ;save MSB LDA #$84 ;call OSBYTE $84 = read HIMEM JSR osbyte TYA SEC ;save MSB SBC frpage STA frsize ;subtract MSB of OSHWM RTS ;save result = no. pages of user memory. .getmem ;Claim shared workspace JSR suspri ;[D]not sending service call $0A LDY #colds-mainws ;set up pointer to private page LDA #$FF ;b7=1 to allow a warm start STA (temp),Y ;save in private page STA colds ;and main workspace INY ;y=memflg STA (temp),Y ;b7=1 iff we own the shared workspace RTS .suspri ;Set up pointer to private page PHA LDA #$00 ;clear LSB, always start on page boundary STA temp+$00 LDX romid LDA priptr,X ;get private page number from table STA temp+$01 ;store MSB of pointer PLA RTS .clrkey ;Call *FX 15,1 = clear input buffer JSR savita ;save AXY LDA #$0F LDX #$01 LDY #$00 BEQ bytjmp .wriwde ;Call OSBYTE $03 = specify output stream in A TAX .wriwdx ;Call OSBYTE $03 = specify output stream LDA #$03 BNE bytjmp .ackesc ;Call OSBYTE $7E = acknowledge ESCAPE condition JSR savita ;save AXY LDA #$7E BNE bytjmp .doswcl ;Call OSBYTE $8F = issue service call LDA #$8F BNE bytjmp ;unreachable code ;Call OSBYTE $FF = read/write startup options LDA #$FF .readby LDX #$00 LDY #$FF .bytjmp JMP osbyte ;Table of addresses of extended vector handlers .vtabb EQUW $FF1B ;FILEV, $0212 = $FF1B EQUW $FF1E ;ARGSV, $0214 = $FF1E EQUW $FF21 ;BGETV, $0216 = $FF21 EQUW $FF24 ;BPUTV, $0218 = $FF24 EQUW $FF27 ;GBPBV, $021A = $FF27 EQUW $FF2A ;FINDV, $021C = $FF2A EQUW $FF2D ;FSCV, $021E = $FF2D ;Table of action addresses for extended vector table .vtabf EQUW wfile ;E FILEV, evt + $1B = $9D5D EQUB $00 EQUW wargs ;E ARGSV, evt + $1E = $974C EQUB $00 EQUW wbget ;E BGETV, evt + $21 = $985C EQUB $00 EQUW wbput ;E BPUTV, evt + $24 = $994A EQUB $00 EQUW wbgpb ;E GBPBV, evt + $27 = $9DA1 EQUB $00 EQUW wfind ;E FINDV, evt + $2A = $95BD EQUB $00 EQUW wfscm ;E FSCV, evt + $2D = $9D8E EQUB $00 ;Table of action addresses for FSC calls 0..11, low bytes .fscltb EQUB <(wfopt -$01) ;FSC 0 = *OPT $89F8 EQUB <(wfeof -$01) ;FSC 1 = read EOF state $9825 EQUB <(wnota -$01) ;FSC 2 = */ $8832 EQUB <(wname -$01) ;FSC 3 = unrecognised *cmd $86C0 EQUB <(wnota -$01) ;FSC 4 = *RUN $8832 EQUB <(wdcat -$01) ;FSC 5 = *CAT $848E EQUB <(wfdie -$01) ;FSC 6 = new FS starting up $94FF EQUB <(whlim -$01) ;FSC 7 = valid file handles $94FA EQUB <(wstus -$01) ;FSC 8 = *command entered $9F73 EQUB <(ex -$01) ;FSC 9 = *EX $8238 EQUB <(info -$01) ;FSC 10 = *INFO $8257 EQUB <(wnota -$01) ;FSC 11 = *RUN from library $8832 ;Table of action addresses for FSC calls 0..11, high bytes .fschtb EQUB >(wfopt -$01) EQUB >(wfeof -$01) EQUB >(wnota -$01) EQUB >(wname -$01) EQUB >(wnota -$01) EQUB >(wdcat -$01) EQUB >(wfdie -$01) EQUB >(whlim -$01) EQUB >(wstus -$01) EQUB >(ex -$01) EQUB >(info -$01) EQUB >(wnota -$01) ;Table of action addresses for OSFILE calls $FF,0..7, low bytes .filjpl EQUB <(loader-$01) ;OSFILE $FF = load file $87DD EQUB <(saver -$01) ;OSFILE 0 = save file $881B EQUB <(fwrcat-$01) ;OSFILE 1 = wr. catalog info $9FA1 EQUB <(fwrlod-$01) ;OSFILE 2 = wr. load address $9FB4 EQUB <(fwrexe-$01) ;OSFILE 3 = wr. exec address $9FAC EQUB <(fwratt-$01) ;OSFILE 4 = wr. attributes $9FBC EQUB <(frdcat-$01) ;OSFILE 5 = read catalog info $9F8D EQUB <(fdefil-$01) ;OSFILE 6 = delete file $9F96 EQUB <(dirdo -$01) ;OSFILE 7 = create file $8A3D ;Table of action addresses for OSFILE calls $FF,0..7, high bytes .filjph EQUB >(loader-$01) EQUB >(saver -$01) EQUB >(fwrcat-$01) EQUB >(fwrlod-$01) EQUB >(fwrexe-$01) EQUB >(fwratt-$01) EQUB >(frdcat-$01) EQUB >(fdefil-$01) EQUB >(dirdo -$01) ;Table of action addresses for OSGBPB calls 0..8, low bytes .wgptbl EQUB <return ;OSGBPB 0 = no operation $8626 EQUB <wbptr ;OSGBPB 1 = set PTR and write $9F58 EQUB <wbptr ;OSGBPB 2 = write data $9F58 EQUB <wbgtr ;OSGBPB 3 = set PTR and read $9F41 EQUB <wbgtr ;OSGBPB 4 = read data $9F41 EQUB <rdtco ;OSGBPB 5 = read title/opt/drv $9EAF EQUB <rdbir ;OSGBPB 6 = read CSD drv/dir $9EDE EQUB <rlbir ;OSGBPB 7 = read lib'y drv/dir $9EF1 EQUB <wcbat ;OSGBPB 8 = read CSD filenames $9E63 ;Table of action addresses for OSGBPB calls 0..8, high bytes .wgptbh EQUB >return EQUB >wbptr EQUB >wbptr EQUB >wbgtr EQUB >wbgtr EQUB >rdtco EQUB >rdbir EQUB >rlbir EQUB >wcbat ;Table of microcode bytes for OSGBPB calls 0..8 .wbrwtb EQUB $04 ;%000001 0 . to memory, special handler EQUB $02 ;%000000 1 0 from memory, xfer data, set PTR EQUB $03 ;%000000 1 1 from memory, xfer data, leave PTR EQUB $06 ;%000001 1 0 to memory, xfer data, set PTR EQUB $07 ;%000001 1 1 to memory, xfer data, leave PTR EQUB $04 ;%000001 0 . to memory, special handler EQUB $04 ;%000001 0 . to memory, special handler EQUB $04 ;%000001 0 . to memory, special handler EQUB $04 ;%000001 0 . to memory, special handler .help ;*HELP DFS TYA ;save command line offset LDX #<(comtab-comtab-$01);point to DFS command table LDY #$10 ;16 entries to print .help1 PHA ;save command line offset JSR vstrng ;print DFS banner EQUB $0D EQUS "DFS 2.24" EQUB $0D STX comtxt ;save command table offset STY vtemp+$01 ;[D]using counter in zp .help0 LDA #$00 STA etemp ;no error message being built print to screen LDY #$02 ;y=2 print two spaces JSR LA1E5 ;print number of spaces in Y JSR psyntx ;print command name and syntax JSR pcrlf ;print newline DEC vtemp+$01 ;decrement count of entries BNE help0 ;loop until none remain PLA ;restore command line offset to Y TAY .help2 LDX #<(hlptab-comtab-$03);point to *HELP keyword table JMP wname0 ;scan next argument for *HELP keywords ;unreachable code ;was *HELP UTILS TYA LDX #<(initbl-comtab-$01);point to utility command table LDY #$01 ;1 entry to print BNE help1 .nohelp ;Unrecognised *HELP keyword JSR setupr ;call GSINIT with C=0 BEQ psynt4 ;if no argument present then return .nohlp1 JSR rdchr ;call GSREAD BCC nohlp1 ;until end of argument (discarding it) BCS help2 ;then scan next argument (always) .chksyn ;Call GSINIT with C=0 and require argument JSR setupr ;call GSINIT with C=0 BNE psynt4 ;if argument present then return, else: .synerr ;Raise "Syntax: " error JSR fstrng EQUB $DC EQUS "Syntax: " STX etemp ;x>0, printing to error message, suppress TAB JSR psyntx ;print command name and syntax LDA #$00 ;$00 = error message terminator byte JSR phelpc ;append NUL to error message JMP errbuf ;jump to BRK to raise error .psyntx ;Print command name and syntax LDX comtxt ;get command table offset LDA #$09 ;[D]9 characters in command name column STA ztemp .syner1 INX ;increment offset LDA comtab,X ;get byte of command name BMI syner0 ;if terminator reached then print syntax JSR phelpc ;else print character in A (OSASCI) JMP syner1 ;and loop .syner0 LDY ztemp ;[D] CPY #$0C ;if number of spaces remaining <> 12 (??) BEQ LA1A2 JSR LA1E5 ;then print number of spaces in Y .LA1A2 INX ;skip action address INX STX comtxt ;update command table offset LDA comtab,X ;get syntax byte JSR psynt5 ;print syntax element JSR sfour ;shift A right 4 places: .psynt5 ;Print syntax element JSR savita ;save AXY AND #$0F ;mask b3..0 current syntax element BEQ psynt4 ;if null element then return TAY ;else transfer to Y for use as counter LDA #$20 ;print a space JSR phelpc ;print character in A (OSASCI) LDX #$FF ;set offset=$FF going to 0: .psynt2 INX ;increment offset LDA argtbl,X ;get character of syntax element table BPL psynt2 ;loop until b7=1 DEY ;decrement number of elements(+1) to skip BNE psynt2 ;when Y=0 we've reached correct element: AND #$7F ;mask off start-of-element marker in b7 .psynt3 JSR phelpc ;print character in A (OSASCI) INX ;increment offset LDA argtbl,X ;get character of syntax element table BPL psynt3 ;loop until start of next element reached RTS ;then exit .phelpc ;Print character to screen or error message JSR savita ;save AXY LDX etemp ;get pointer to end of error message BEQ phlpc0 ;if zero then print to screen INC etemp ;else increment pointer STA errbuf,X ;and store character at old pointer .psynt4 RTS .phlpc0 DEC ztemp ;[D]else decrement no. spaces to next TAB JMP pchr ;and print character in A (OSASCI) .LA1E5 ;Print number of spaces in Y LDA etemp ;if error message being built BNE LA1F1 ;then return LDA #$20 ;else print a space .LA1EB JSR phelpc ;print character to screen or error message DEY ;loop until Y = 0 BNE LA1EB .LA1F1 RTS .argtbl ;Table of syntax elements EQUS $BC,"fsp>" EQUS $BC,"afsp>" EQUS $A8,"L)" EQUS $BC,"source> <dest.>" EQUS $BC,"old fsp> <new fsp>" EQUS $A8,"<dir>)" EQUS $A8,"<drive>)" EQUS $BC,"title>" EQUS $BC,"drive> (40)(80)" ;[D] EQUS $B4,"0/80" ;[D] EQUS $A8,"<drive>)..." ;[D] EQUS $A8,"<rom>)" ;[D] EQUS $FF .compct ;*COMPACT JSR readrv ;select specified or default volume JSR vstrng ;print "Compacting :" EQUS "Compacting :" STA fdriv ;set as source drive STA tdriv ;set as destination drive JSR digout ;print hex nibble JSR pcrlf ;print newline LDY #$00 ;point Y to workspace of invalid channel $10 JSR vshut ;close file [BUG] does nothing; should be wshut JSR getlsz ;get start and size of user memory JSR getdir ;load volume catalogue L4 LDY dirlen ;get number of files in catalogue STY cpycat ;set as catalogue pointer LDA #$02 ;data area starts at LBA $0002 STA dstlo LDA #$00 STA dsthi .loopx LDY cpycat ;set Y to catalogue pointer JSR unstep ;subtract 8 from Y CPY #$F8 ;if we've reached end of catalogue BNE notdun LDA dirhig+$07 ;then get LSB volume size SEC ;subtract LSB destination LBA SBC dstlo ;i.e. start of free space PHA ;=LSB number of free sectors LDA dirhig+$06 ;get boot option/top bits volume size AND #$03 ;extract volume size in b1,b0 SBC dsthi ;subtract MSB start of free space JSR digout ;print hex nibble PLA ;restore LSB number of free sectors JSR bytout ;print hex byte JSR vstrng ;print " free sectors" + newline EQUS " free sectors" EQUB $0D NOP RTS ;exit. .notdun STY cpycat ;else set new catalogue pointer JSR inform ;print *INFO line if verbose LDY cpycat LDA cathig+$04,Y CMP #$01 LDA #$00 STA lodlo ;set LSB load address = 0 STA lenlo ;set LSB transfer size = 0 ADC cathig+$05,Y ;add C to 2MSB length, rounding up STA todolo ;store LSB length of file in sectors LDA cathig+$06,Y ;get top bits exec/length/load/start sector PHP ;save carry flag from addition JSR isolen ;extract length from b5,4 to b1,0 PLP ;restore carry flag ADC #$00 ;add C to MSB length, rounding up STA todohi ;store length in sectors in zero page LDA cathig+$07,Y ;get LSB start sector STA srclo ;set LSB source LBA LDA cathig+$06,Y ;get top bits exec/length/load/start sector AND #$03 ;extract b1,b0 of A STA srchi ;set MSB source LBA CMP dsthi ;compare with destination LBA BNE cmpct2 ;if unequal then compact file LDA srclo ;else compare LSBs source - destination LBA CMP dstlo BNE cmpct2 ;if unequal then compact file CLC ;else add file length to destination LBA ADC todolo STA dstlo ;store updated LSB destination LBA LDA dsthi ;= srchi ADC todohi ;carry out to MSB destination LBA STA dsthi JMP cmpct4 ;and loop for next file .cmpct2 ;Compact file LDA dstlo ;set LSB start sector = destination LBA STA cathig+$07,Y LDA cathig+$06,Y ;get top bits exec/length/load/start sector AND #$FC ;clear b1,b0 MSB start sector ORA dsthi ;replace with MSB destination LBA STA cathig+$06,Y ;set top bits exec/length/load/start sector LDA #$00 STA linno ;no catalogue entry waiting to be created STA L00A9 ;$00 = source and dest. are different drives ;(no swapping) JSR mvdkda ;copy source drive/file to destination JSR dirout ;write volume catalogue L4 .cmpct4 LDY cpycat JSR prtinf ;print *INFO line JMP loopx ;loop for next file .chkena ;Ensure *ENABLE active BIT enaflg ;test *ENABLE flag BPL chken0 ;if b7=0 then current command is enabled JSR sure ;else print "Go?" and ask user yes or no BEQ chkna1 ;if yes then print newline and return PLA ;else pop return address (ew!) PLA ;to return to caller's superroutine .chkna1 JMP pcrlf ;print newline and exit. .get2dr ;Parse and print source and dest. volumes JSR chksyn ;call GSINIT with C=0 and reject empty arg JSR getdrv ;parse volume spec STA fdriv ;store source volume JSR chksyn ;call GSINIT with C=0 and reject empty arg JSR getdrv ;parse volume spec STA tdriv ;store destination volume TYA ;save GSINIT offset in Y PHA LDA #$00 STA L00A9 ;$00 = source and dest. are different drives LDA tdriv ;get destination drive CMP fdriv ;compare with source drive BNE copyns ;if equal LDA #$FF ;then A=$FF STA L00A9 ;b7=1 source and dest. share drive (swapping) STA utemp ;b7=1 dest. disc in drive (ask for source) .copyns JSR getlsz ;get start and size of user memory JSR vstrng ;print "Copying from :" EQUS "Copying from :" LDA fdriv ;get source volume JSR digout ;print hex nibble JSR vstrng ;print " to :" EQUS " to :" LDA tdriv ;get destination volume JSR digout ;print hex nibble JSR pcrlf ;print newline PLA ;restore GSINIT offset to Y TAY CLC .chken0 RTS .chkdsf ;Select source volume JSR savita ;save AXY BIT L00A9 ;if source and dest. are different drives BPL chkds1 ;then return LDA #$00 ;else A=$00 = we want source disc BEQ chkds0 ;branch (always) .chkdst ;Select destination volume JSR savita ;save AXY BIT L00A9 ;if source and dest. are different drives BMI chkds2 ;can save 1 byte (BPL chken0) .chkds1 RTS ;then return .chkds2 LDA #$80 ;else A=$80 = we want destination disc .chkds0 CMP utemp ;compare wanted disc with disc in drive BEQ chkds1 ;if the same then do not prompt STA utemp ;else wanted disc is going into drive JSR vstrng ;print "Insert " EQUS "Insert " NOP BIT utemp ;if b7=1 BMI chkds3 ;then print "destination" JSR vstrng ;else print "source" EQUS "source" BCC chkds4 ;and branch (always) .chkds3 JSR vstrng ;print " destination" EQUS "destination" NOP .chkds4 JSR vstrng ;print " disk and hit a key" EQUS " disc and hit a key" NOP JSR clrkey ;call *FX 15,1 = clear input buffer JSR osrdch ;call OSRDCH, wait for input character BCS abort ;if ESCAPE was pressed then raise error, else: .pcrlf ;Print newline PHA LDA #$0D JSR pchr PLA RTS .LA403 ;Print " : " and ask user yes or no JSR vstrng EQUS " : " BCC getyn .sure ;Print "Go?" and ask user yes or no JSR vstrng EQUS "Go (Y/N) ? " NOP .getyn JSR clrkey ;call *FX 15,1 = clear input buffer JSR osrdch ;call OSRDCH, wait for input character BCS abort ;if ESCAPE was pressed then raise error AND #$5F ;else clear bit 7, make uppercase CMP #$59 ;is it "Y"? PHP ;save the answer BEQ getyn0 ;if so then print "Y" LDA #$4E ;else print "N" .getyn0 JSR pchr ;print character in A (OSASCI) PLP ;return Z=1 if "Y" or "y" pressed RTS .abort JMP escape ;acknowledge escape condition and raise error .nocop JMP noroom ;raise "Disc full" error .cpydsk ;*BACKUP JSR get2dr ;parse and print source and dest. volumes JSR chkena ;ensure *ENABLE active LDA #$00 STA srchi ;set source volume LBA = 0 STA dsthi STA dstlo ;set destination volume LBA = 0 STA srclo STA linno ;no catalogue entry waiting to be created JSR chkdsf ;select source volume LDA fdriv ;get source drive STA fdrive ;set as current drive JSR L93C0 ;load volume catalogue LDA dirhig+$07 ;get LSB source volume size STA todolo ;store LSB no. sectors to transfer LDA dirhig+$06 ;get boot option/top bits volume size AND #$03 ;extract volume size in b1,b0 STA todohi ;store MSB no. sectors to transfer JSR chkdst ;select destination volume LDA tdriv ;get destination drive STA fdrive ;set as current drive JSR L93C0 ;load volume catalogue LDA dirhig+$06 ;get boot option/top bits volume size AND #$03 ;extract volume size in b1,b0 CMP todohi ;compare MSBs dest volume size - source BCC nocop ;if dest < source then raise error BNE cpydk4 ;if dest > source then proceed LDA dirhig+$07 ;else compare LSBs dest - source CMP todolo BCC nocop ;if dest < source then raise error .cpydk4 JSR mvdkda ;copy source drive/file to destination JMP L93C0 ;load volume catalogue (which??) .cpyfil ;*COPY JSR setwld ;allow wildcard characters in filename JSR get2dr ;parse and print source and dest. volumes JSR chksyn ;call GSINIT with C=0 and require argument JSR getnam ;set current file from file spec JSR chkdsf ;select source volume LDA fdriv ;get source drive JSR dodriv ;select drive in A JSR errlok ;ensure matching file in catalogue .cpyfl3 LDA qualif ;save directory spec given to *COPY PHA LDA vtemp+$00 STA ltemp ;save cat. offset of found file in zero page JSR prtinf ;print *INFO line LDX #$00 .copyl LDA catlow,Y ;copy matching filename+dir to current file STA wrknam,X STA namtra,X ;and to workspace LDA cathig,Y ;copy matching file's catalogue information STA wrkcat-$01,X ;to OSFILE block (aligned lower than usual) STA tmpcat,X ;and to workspace INX INY CPX #$08 ;loop until 8 bytes of each field copied BNE copyl LDA wrkcat-$01+$06 ;get top bits exec/length/load/start sector JSR isolen ;extract b5,b4 of A STA lenhl-$01 ;set MSB length (really a new temp used like lenhl) LDA wrkcat-$01+$04 ;get LSB length CLC ;can save 1 byte, CMP #$01 ADC #$FF ;set C=1 iff file includes partial sector LDA wrkcat-$01+$05 ;get 2MSB length ADC #$00 ;round up to get LSB length in sectors STA todolo LDA lenhl-$01 ;get extracted MSB length ADC #$00 ;carry out to get MSB length in sectors STA todohi LDA tmpcat+$07 ;get LSB start LBA (also at wrkcat-$01+$07) STA srclo ;can save 1 byte (zp address above) LDA tmpcat+$06 ;get top bits exec/length/load/start sector AND #$03 ;extract b1,b0 of A STA srchi ;store MSB start LBA LDA #$FF STA linno ;catalogue entry is waiting to be created JSR mvdkda ;copy source drive/file to destination JSR chkdsf ;select source volume LDA fdriv ;get source drive JSR dodriv ;select drive in A JSR getdir ;load volume catalogue LDA ltemp ;restore cat. offset of found file STA vtemp+$00 ;to workspace PLA ;restore directory spec given to *COPY STA qualif JSR next ;find next matching file BCS cpyfl3 ;loop while match found, else exit RTS .regen ;Create destination catalogue entry JSR swpfcb ;swap work with tmpcin JSR chkdst ;select destination volume LDA tdriv STA fdrive LDA qualif ;save current directory PHA JSR getdir ;load volume catalogue L4 JSR lookw ;search for wrknam in catalogue BCC copyfe ;if found JSR delfil ;then delete catalogue entry .copyfe PLA ;restore current directory STA qualif ;set as current directory (what clobbers??) JSR decodl ;expand 18-bit load address to 32-bit JSR decode ;expand 18-bit exec address to 32-bit LDA wrkcat+$06 ;get top bits exec/length/load/start sector JSR isolen ;extract b5,b4 of A STA lenhl ;store MSB length JSR genfil ;create catalogue entry LDA wrkcat+$06 ;get top bits exec/length/load/start sector AND #$03 ;extract b1,b0 of A PHA ;save MSB start sector LDA wrkcat+$07 ;get LSB start sector PHA ;save LSB start sector JSR swpfcb ;swap work with tmpcin PLA STA dstlo ;store LSB start sector PLA STA dsthi ;store MSB start sector RTS .swpfcb ;Swap work with tmpcin LDX #$11 .swpfc0 LDA tmpcin,X LDY work,X STA work,X TYA ;can save 1 byte (STY work,X) STA tmpcin,X DEX BPL swpfc0 RTS .mvdkda ;Copy source drive/file to destination LDA #$00 STA lodlo ;set LSB load address = 0 STA lenlo ;set LSB transfer size = 0 BEQ cpyfl8 ;branch to avoid transferring nothing (removable??) .cpyfl5 LDA todolo ;compare remaining file size TAY ;- available memory CMP frsize LDA todohi SBC #$00 BCC sizet ;if remainder fits then Y=file size in pages LDY frsize ;else Y=size of available memory in pages .sizet STY lenhi ;set MSB transfer size = no. pages in Y LDA srclo ;set LBA = source volume LBA STA lbalo LDA srchi STA lbahi LDA frpage ;set MSB load address = start of user memory STA lodhi LDA fdriv ;get source drive STA fdrive ;set as current drive JSR chkdsf ;select source volume JSR LA5D1 ;set high word of OSFILE load address = $FFFF JSR blkrd ;read extended file L5 LDA tdriv ;get destination drive STA fdrive ;set as current drive BIT linno ;if catalogue entry is waiting to be created BPL cpyfl9 JSR regen ;then create destination catalogue entry LDA #$00 STA linno ;no catalogue entry waiting to be created .cpyfl9 LDA dstlo ;set LBA = destination volume LBA STA lbalo LDA dsthi STA lbahi LDA frpage ;set MSB save address = start of user memory STA lodhi JSR chkdst ;select destination volume JSR LA5D1 ;set high word of OSFILE load address = $FFFF JSR blkwr ;write extended file L5 LDA lenhi ;add transfer size to destination volume LBA CLC ADC dstlo STA dstlo BCC cpyfl6 ;carry out to high byte INC dsthi .cpyfl6 LDA lenhi ;add transfer size to source volume LBA CLC ADC srclo STA srclo BCC cpyfl7 ;carry out to high byte INC srchi .cpyfl7 SEC LDA todolo ;get LSB remaining size of file in sectors SBC lenhi ;subtract number of pages transferred STA todolo ;update LSB remaining size BCS cpyfl8 DEC todohi ;borrow in from MSB remaining size if req'd .cpyfl8 LDA todolo ORA todohi ;or MSB with LSB, Z=0 if pages remain BNE cpyfl5 ;if file transfer is incomplete then loop RTS .LA5D1 ;Set high word of OSFILE load address = $FFFF LDA #$FF ;redundant to $8B21, decodl STA ldlow+$02 STA ldlow+$03 RTS .verify ;*VERIFY LDA #$00 ;clear formatting flag BEQ LA5E3 ;branch (always) .form ;*FORM LDA #$FF STA catdrv ;forget catalogue in workspace .LA5E3 STA L00C9 ;set formatting flag STA LC290+$00 ;drive no.=0 if verifying, =$FF if formatting BPL LA604 ;if formatting JSR chksyn ;call GSINIT with C=0 and require argument JSR L8461 ;input number up to 3 digits STA LC29F ;store number of tracks to format BCS LA601 ;if number invalid then raise "Syntax: " error CMP #$23 ;else if 35 tracks requested BEQ LA604 ;then accept number of tracks CMP #$28 ;else if 40 tracks requested BEQ LA604 ;then accept number of tracks CMP #$50 ;else if 80 tracks requested BEQ LA604 ;then accept number of tracks .LA601 JMP synerr ;else raise "Syntax: " error .LA604 JSR setupr ;call GSINIT with C=0 STY L00CA ;store pointer to start of argument BNE LA656 ;if no argument present BIT L00C9 ;then select prompt BMI LA61A ;if formatting then ask "Format which drive ? " JSR vstrng ;else ask "Verify which drive ? " EQUS "Verify" BCC LA624 ;branch (always) .LA61A ;print "Format" JSR vstrng EQUS "Format" NOP .LA624 JSR vstrng ;print " which drive ? " EQUS " which drive ? " NOP JSR osrdch ;get character from console BCS LA67C ;if Escape pressed then raise "Escape" error CMP #$20 ;if control character input BCC LA67F ;then raise "Bad drive" error JSR pchr ;else echo character to console SEC ;convert ASCII digit to binary SBC #$30 BCC LA67F ;redundant CMP #$04 ;if not in range 0..3 BCS LA67F ;then raise "Bad drive" error STA fdrive ;else set current drive JSR pcrlf ;print newline LDY L00CA ;restore pointer to end of command line JMP LA659 .LA656 JSR getdrv ;argument present, select specified drive .LA659 STY L00CA ;store pointer to next argument BIT L00C9 ;if formatting BPL LA666 LDX fdrive ;then X=current drive LDA #$00 STA LC2DE,X ;clear 40-track flag for drive X .LA666 BIT LC290+$00 ;can save 1 byte (BIT L00C9) BPL LA671 ;if formatting JSR chkena ;then ensure *ENABLE active JSR getlsz ;get start and size of user memory .LA671 JSR LA682 ;format or verify current drive LDY L00CA ;restore pointer to next argument JSR setupr ;call GSINIT with C=0 BNE LA656 ;if argument present then format another drive RTS ;else exit .LA67C JMP escape ;raise "Escape" error .LA67F JMP drverr ;raise "Bad drive" error .LA682 BIT L00C9 ;if verifying BMI LA694 JSR vstrng ;then print "Verifying" EQUS "Verifying" BCC LA6A9 ;branch (always) .LA694 JSR LA78B ;else clear volume catalogue JSR vstrng ;print "Formatting" EQUS "Formatting" LDX fdrive ;get current drive STX LC290+$00 ;set drive parameter in high OSWORD $7F block .LA6A9 JSR vstrng ;print " drive " EQUS " drive " LDA fdrive ;get current drive JSR digout ;print hex nibble JSR vstrng ;print " track " EQUS " track " NOP BIT L00C9 ;if verifying BMI LA6D5 JSR LA7ED ;calculate number of tracks on current drive TXA ;test number of tracks containing data BNE LA6D2 ;if zero then nothing to do JMP pcrlf ;so print newline and skip to next drive .LA6D2 STA LC29F ;else store number of tracks to verify .LA6D5 LDA #$00 ;start at track 0 STA LC290+$07 ;1st parm, track number .LA6DA LDA #$08 ;print two backspaces JSR pchr ;to position cursor after "track " JSR pchr LDA LC290+$07 ;1st parm, track number JSR bytout ;print hex byte LDA #$06 ;5 attempts STA LC29D ;set attempt counter .LA6ED JSR LA75C ;set up OSWORD $7F control block for formatting BIT L00C9 ;if verifying BPL LA701 ;then verify only JSR LA7A7 ;else create ID table LDX #<LC290 ;point XY to high OSWORD $7F control block LDY #>LC290 JSR L9163 ;call OSWORD $7F TAX ;test result code (redundant) BNE LA729 ;if command failed then hard error, report .LA701 LDA #$00 STA LC290+$08 ;2nd parm, starting sector LDA LC290+$09 ;3rd parm, sector size+count AND #$1F ;mask off sector size code STA LC290+$09 LDA #$03 ;3 parameters STA LC290+$05 LDA #$5F ;$5F = verify data STA LC290+$06 JSR L93E6 ;check for escape condition LDX #<LC290 ;point XY to high OSWORD $7F control block LDY #>LC290 JSR L9163 ;call OSWORD $7F BEQ LA731 ;if succeeded then finish track DEC LC29D ;else decrement attempt counter BNE LA6ED ;if attempts remaining then loop .LA729 ;else hard error JSR vstrng ;print "?" EQUS "?" NOP JMP dknern ;translate result code to error .LA731 LDA LC29D ;get attempt counter CMP #$06 ;if done in one try then show clean track BEQ LA740 JSR vstrng ;else print "? " EQUS "? " NOP .LA740 BIT L00C9 ;if formatting BPL LA747 JSR LA798 ;then add 10 sectors to volume size .LA747 INC LC290+$07 ;increment track number LDA LC290+$07 ;get new track number CMP LC29F ;compare with number of tracks to process BNE LA6DA ;if less then process next track BIT L00C9 ;else test command type BPL LA759 ;if formatting JSR L93A5 ;then write volume catalogue as-is .LA759 JMP pcrlf ;print newline to finish. .LA75C ;Set up OSWORD $7F control block for formatting LDX #$00 STX LC290+$01 ;LSB data address = 0 STX LC290+$0A ;4th parm, gap5 = 0 DEX STX LC290+$03 ;high bytes of address = $FF STX LC290+$04 LDA frpage ;3MSB data address= OSHWM STA LC290+$02 LDA #$05 ;5 parameters STA LC290+$05 LDA #$63 ;$63 = format track STA LC290+$06 LDA #$2A STA LC290+$09 ;3rd parm, 10 * 256-byte sectors LDX #$10 LDY #$13 STX LC290+$0B ;5th parm, gap1 STY LC290+$08 ;2nd parm, gap3 RTS .LA78B ;Clear volume catalogue LDA #$00 TAY .LA78E STA dirlow,Y STA dirhig,Y INY BNE LA78E RTS .LA798 ;Add 10 sectors to volume size LDA #$0A ;10 sectors per track CLC ADC dirhig+$07 ;add to LSB volume size STA dirhig+$07 ;update LSB BCC LA7A6 ;carry out to MSB in bits 1,0 INC dirhig+$06 ;(previously cleared) .LA7A6 RTS .LA7A7 ;Create ID table LDA #$00 ;set up pointer to start of user memory STA temp+$00 ;clear LSB, start on page boundary LDA frpage ;get OSHWM STA temp+$01 ;store MSB of pointer LDA #$0A ;10 CHRN records to compose STA xtemp LDA LC290+$07 ;1st parm, track number BEQ LA7C3 ;if formatting track 0 then first sector = 0 LDY #$02 ;else get R parameter of first sector LDA (temp),Y CLC ;add track skew = 10 - 7 = 3 ADC #$07 ;same R occurs 3 sectors later JSR LA7E4 ;a := a mod 10 .LA7C3 TAX ;first sector of track to X LDY #$00 ;point to C field of first sector .LA7C6 LDA LC290+$07 ;1st parm, track number STA (temp),Y ;store cylinder number C INY LDA #$00 ;head number = 0 STA (temp),Y ;store head humber H INY TXA ;transfer sector number to A STA (temp),Y ;store record number R INY LDA #$01 ;size code = 1, 256-byte sector STA (temp),Y ;store size code N INY INX ;increment sector number JSR LA7E3 ;x := x mod 10 DEC xtemp ;loop until all CHRN records composed BNE LA7C6 RTS .LA7E3 ;x := x mod 10 TXA .LA7E4 ;a := a mod 10 SEC ;set carry flag for subtraction .LA7E5 SBC #$0A ;subtract 10 BCS LA7E5 ;until A underflows ADC #$0A ;c=0; undo last subtraction TAX ;leave positive remainder in A and X RTS .LA7ED ;Calculate number of tracks on current drive JSR L93A9 ;load catalogue with execute privilege LDA dirhig+$06 ;get boot option/top bits volume size AND #$03 ;extract volume size in b1,b0 TAX ;save MSB volume size in X LDA dirhig+$07 ;get LSB volume size LDY #$0A ;10 sectors per track STY temp ;can save 4 bytes LDY #$FF ;track number = $FF going to 0: .LA7FF SEC ;set carry flag for subtract .LA800 INY ;increment track number SBC temp ;SBC #$0A faster since temp=$0A BCS LA800 ;loop until LSB underflows DEX ;borrow from MSB BPL LA7FF ;loop until MSB underflows ADC temp ;c=0, add number of sectors per track PHA ;=starting sector or remainder, save TYA ;copy track number to X TAX ;can save 4 bytes (accumulate directly into X) PLA ;restore remainder BEQ LA811 ;if >0 INX ;then increment no. tracks containing data .LA811 RTS .free ;*FREE SEC BCS LA816 .map ;*MAP CLC .LA816 ROR L00C6 JSR readrv JSR getdir BIT L00C6 BMI LA837 JSR ustrng EQUS "Address : Length" EQUB $0D .LA837 LDA dirhig+$06 ;get boot option/top bits volume size AND #$03 ;extract volume size in b1,b0 STA todohi STA headhi LDA dirhig+$07 STA todolo SEC SBC #$02 STA headlo BCS LA84E DEC headhi .LA84E LDA #$02 STA baselo LDA #$00 STA basehi STA freelo STA freehi LDA dirlen AND #$F8 TAY BEQ LA88A BNE LA875 .LA864 JSR LA901 JSR unstep LDA todolo SEC SBC baselo LDA todohi SBC basehi BCC LA88A .LA875 LDA cathig-$01,Y SEC SBC baselo STA headlo PHP LDA cathig-$02,Y AND #$03 PLP SBC basehi STA headhi BCC LA864 .LA88A STY frecat BIT L00C6 BMI LA899 LDA headlo ORA headhi BEQ LA899 JSR LA8DD .LA899 LDA headlo CLC ADC freelo STA freelo LDA headhi ADC freehi STA freehi LDY frecat BNE LA864 BIT L00C6 BPL LA8DC TAY LDX freelo LDA #$F8 SEC SBC dirlen JSR LA92C JSR ustrng EQUS "Free" EQUB $0D LDA todolo SEC SBC freelo TAX LDA todohi SBC freehi TAY LDA dirlen JSR LA92C JSR ustrng EQUS "Used" EQUB $0D NOP .LA8DC RTS .LA8DD LDA basehi JSR LA9E9 LDA baselo JSR LA9E1 JSR ustrng EQUS " : " LDA headhi JSR LA9E9 LDA headlo JSR LA9E1 LDA #$0D JSR osasci .LA901 LDA cathig-$02,Y PHA JSR isolen STA basehi PLA AND #$03 CLC ADC basehi STA basehi LDA cathig-$04,Y BEQ LA919 ;can save 1 byte (CMP#1;LDA#0) LDA #$01 .LA919 CLC ADC cathig-$03,Y BCC LA921 ;a=0 on overflow INC basehi ;if this INC, then not the other .LA921 CLC ADC cathig-$01,Y STA baselo BCC LA92B INC basehi .LA92B RTS .LA92C JSR sthree JSR LA9DE JSR ustrng EQUS " Files " STX intwa+$01 STY intwa+$02 TYA JSR LA9E9 TXA JSR LA9E1 JSR ustrng EQUS " Sectors " LDA #$00 STA intwa+$00 STA intwa+$03 LDX #$1F ;32 bits to shift STX bitcnt LDX #$09 ;[BUG]should be 5 for efficiency .LA960 STA buffer,X DEX BPL LA960 .LA966 ASL intwa+$00 ROL intwa+$01 ROL intwa+$02 ROL intwa+$03 LDX #$00 LDY #$09 ;[BUG]should be 5 .LA972 LDA buffer,X ROL A CMP #$0A BCC LA97C SBC #$0A .LA97C STA buffer,X INX DEY BPL LA972 DEC bitcnt BPL LA966 LDY #$20 LDX #$05 .LA98B BNE LA98F LDY #$2C .LA98F LDA buffer,X BNE LA99C CPY #$2C BEQ LA99C LDA #$20 BNE LA9A1 .LA99C LDY #$2C CLC ADC #$30 .LA9A1 JSR osasci CPX #$03 BNE LA9AC TYA JSR osasci .LA9AC DEX BPL LA98B JSR ustrng EQUS " Bytes " NOP RTS .ustrng STA L00B3+$00 PLA STA L00AE+$00 PLA STA L00AE+$01 LDA L00B3+$00 PHA TYA PHA LDY #$00 .ustrlp JSR tmpinc LDA (L00AE),Y BMI ustrnx JSR osasci JMP ustrlp .ustrnx PLA TAY PLA CLC JMP (L00AE) .LA9DE JSR L8426 .LA9E1 PHA JSR sfour JSR LA9E9 PLA .LA9E9 JSR digut1 JMP osasci .pdspc JSR pspace .pspace PHA LDA #$20 JSR osasci PLA CLC RTS .LA9FB ;Z-BREAK JSR savita LDA #$40 STA LC2DE LDA #$A8 JSR readby STX L00B0+$00 STY L00B0+$01 LDY #$0F LDA #$4C STA LC2E2+$00 LDA bytev+$00 STA LC2E2+$01 LDA bytev+$01 STA LC2E2+$02 PHP SEI LDA #$0F STA bytev+$00 LDA #$FF STA bytev+$01 LDA #<LAA3B STA (L00B0),Y INY LDA #>LAA3B STA (L00B0),Y INY LDA romid STA (L00B0),Y PLP RTS .LAA3B ;OSBYTE handler CMP #$00 BEQ LAA50 CMP #$81 BNE LAA4D CPY #$FF BNE LAA4D CPX #$00 BNE LAA4D DEX RTS .LAA4D JMP LC2E2 .LAA50 PHP SEI LDA LC2E2+$01 STA bytev+$00 LDA LC2E2+$02 STA bytev+$01 LDA #$00 LDX #$01 PLP RTS ;Start of SRAM 1.04 .LAA64 EQUS $0A,"SRAM 1.04",$0D,$0A EQUS " SRDATA <id.>",$0D,$0A EQUS " SRLOAD <filename> <sram address> (<id.>) (Q)",$0D,$0A EQUS " SRREAD <dest. start> <dest. end> <sram start> (<id.>)",$0D,$0A EQUS " SRROM <id.>",$0D,$0A EQUS " SRSAVE <filename> <sram start> <sram end> (<id.>) (Q)",$0D,$0A EQUS " SRWRITE <source start> <source end> <sram start> (<id.>)",$0D,$0A EQUS "End addresses may be replaced by +<length>",$0D,$0A .LAB9F ;Paged ROM service JSR L9ADE PHA TAX LDA L00B8+$00 PHA LDA L00B8+$01 PHA TYA PHA TXA LDX romid JSR LB1FB BIT L00B8+$01 BPL LABBA BVC LABF7 BVS LABBC .LABBA BVS LABF7 .LABBC CMP #$08 BNE LABF0 LDA worda CMP #$43 BNE LABD1 JSR LACB3 .LABC9 TSX LDA #$00 STA stack+$04,X BEQ LABF7 .LABD1 CMP #$42 BNE LABF7 LDY #$09 .LABD7 LDA ($F0),Y STA L00BC-$08,Y DEY CPY #$08 BCS LABD7 .LABE1 LDA ($F0),Y STA L00B0,Y DEY BPL LABE1 CLI JSR LB6C0 JMP LABC9 .LABF0 CMP #$02 BNE LAC03 JSR LB263 .LABF7 PLA TAY PLA STA L00B8+$01 PLA STA L00B8+$00 PLA LDX romid RTS .LAC03 CMP #$06 BNE LAC15 LDY #$FF LDA (L00B8),Y CMP #$4E BNE LABF7 JSR LAFD7 JMP LABF7 .LAC15 CMP #$04 BNE LAC32 JSR LB3C5 ;Service call $04 = unrecognised OSCLI BCS LABF7 ASL A BEQ LABF7 TAX LDA LB53D-($01*$02)+$00,X STA L00B0+$00 LDA LB53D-($01*$02)+$01,X STA L00B0+$01 JSR LACAF JMP LABC9 .LAC32 CMP #$07 BNE LAC4F LDA worda CMP #$44 BNE LAC47 LDY #$EE .LAC3E LDA (L00B8),Y AND #$3F STA wordx JMP LABC9 .LAC47 CMP #$45 BNE LABF7 LDY #$FD BNE LAC3E .LAC4F CMP #$09 BNE LABF7 LDA #$0D JSR LB479 BCS LAC7E LDX #$00 .LAC5C LDA LAC6A,X JSR oswrch INX CPX #$14 BNE LAC5C .LAC67 JMP LABF7 .LAC6A EQUS $0A,"SRAM 1.04",$0D,$0A EQUS " SRAM",$0D,$0A .LAC7E JSR LB3C5 BCC LAC8F LDA (linptr),Y CMP #$2E BNE LAC67 JSR LB4B5 JMP LAC92 .LAC8F TAX BNE LAC67 .LAC92 JSR LB477 BCS LAC67 LDY #$00 ;can save 2 bytes by printing whole page last .LAC99 LDA LAA64+$0000,Y JSR oswrch INY BNE LAC99 .LACA2 LDA LAA64+$0100,Y JSR oswrch INY CPY #<(LAB9F-LAA64) BNE LACA2 BEQ LAC67 .LACAF JMP ($00B0) ;unreachable code RTS .LACB3 JSR LB1FB LDA #$EE STA L00B8+$00 LDY #$0B .LACBC LDA ($F0),Y CPY #$00 BNE LACCC AND #$C0 STA L00BC LDA (L00B8),Y AND #$3F ORA L00BC .LACCC STA (L00B8),Y DEY BPL LACBC CLI .LACD2 JSR LB1FB LDA #$00 TAY LDX #L00BA JSR osargs PHA JSR LB1FB LDY #$F2 LDA (L00B8),Y TAX INY LDA (L00B8),Y JSR LB22B BVS LACFC LDY #$F1 LDA (L00B8),Y TAY CPY #$14 BCC LAD0B .LACF7 LDX #$00 JMP LB2CB .LACFC JSR LB086 STY L00BA+$00 LDY #$F3 STA (L00B8),Y TXA DEY STA (L00B8),Y LDY L00BA+$00 .LAD0B JSR LB0CF TAX TYA LDY #$F1 STA (L00B8),Y TXA LDY #$EE EOR (L00B8),Y AND #$40 BNE LACF7 PLA TAX BNE LAD26 LDX #$02 JMP LB2CB .LAD26 PHA JSR LB8AC PLA CMP #$04 BCS LADA9 JSR LB22B BPL LAD64 JSR LAFB3 JSR LAFEC BNE LAD60 BEQ LAD41 .LAD3E JSR LB044 .LAD41 LDY #$FA LDA (L00B8),Y TAY JSR osbget JSR LB1FB LDY #$F2 JSR LB20D TAX LDY #$F1 LDA (L00B8),Y TAY TXA JSR LB116 JSR LAFEC BEQ LAD3E .LAD60 JSR LAFD7 RTS .LAD64 JSR LAFD3 JSR LAFFB BEQ LAD60 BNE LAD71 .LAD6E JSR LB044 .LAD71 LDY #$F4 LDA (L00B8),Y SEC SBC #$01 STA (L00B8),Y CMP #$FF BNE LAD86 INY LDA (L00B8),Y SEC SBC #$01 STA (L00B8),Y .LAD86 LDX #$F6 LDY #$F2 JSR LB20F LDY #$F1 LDA (L00B8),Y TAY JSR osrdsc TAX LDY #$FA LDA (L00B8),Y TAY TXA JSR osbput JSR LB1FB JSR LAFFB BNE LAD6E BEQ LAD60 .LADA9 LDY #$F9 LDA (L00B8),Y BMI LADCD DEY ORA (L00B8),Y BNE LADF5 LDA #$00 STA (L00B8),Y LDA #$01 INY STA (L00B8),Y LDY #$F6 LDA #$00 STA (L00B8),Y LDX L00B8+$01 INX TXA INY STA (L00B8),Y JMP LADF5 .LADCD LDA #$84 JSR osbyte TYA PHA TXA PHA LDA #$83 JSR osbyte JSR LB1FB STX L00BA+$00 STY L00BA+$01 LDY #$F6 JSR LB21C PLA SEC SBC L00BA+$00 LDY #$F8 STA (L00B8),Y PLA SBC L00BA+$01 INY STA (L00B8),Y .LADF5 JSR LB22B BMI LADFD JMP LAEC1 .LADFD JSR LAFB3 TSX TXA SEC SBC #$10 TAX TXS LDY #$F0 LDA (L00B8),Y PHA DEY LDA (L00B8),Y PHA DEX LDY #$01 LDA #$05 JSR osfile JSR LB1FB TSX LDA stack+$0B,X LDY #$F4 STA (L00B8),Y STA L00BA+$00 LDA stack+$0C,X INY STA (L00B8),Y STA L00BA+$01 LDA stack+$0D,X ORA stack+$0E,X BEQ LAE3A .LAE35 LDX #$01 JMP LB2CB .LAE3A JSR LB23D BIT LAF65 LDA L00BA+$00 ORA L00BA+$01 BNE LAE4A .LAE46 JSR LAFD7 RTS .LAE4A LDX #$BC LDY #$F8 JSR LB20F LDY #L00BA JSR LAF71 BCS LAE5C JSR LAF66 CLV .LAE5C LDY #$FB JSR LB21C BVC LAE98 JSR LAFD7 TSX TXA SEC SBC #$0B TAX TXS LDA #$00 PHA LDA #$FF PHA PHA LDY #$F7 LDA (L00B8),Y PHA DEY LDA (L00B8),Y PHA LDY #$F0 LDA (L00B8),Y PHA DEY LDA (L00B8),Y PHA TSX INX LDY #$01 LDA #$FF JSR osfile JSR LB1FB JSR LB23D JMP LAE9D .LAE98 LDA #$04 JSR LAF7E .LAE9D LDX #$B1 LDY #$F6 JSR LB20F LDX #$B3 LDY #$F2 JSR LB20F LDX #$BE LDY #$FB JSR LB20F SEC JSR LB199 LDX #$B3 JSR LB003 BEQ LAE46 CLV JMP LAE4A .LAEC1 JSR LAFD3 BIT LAF65 PHP .LAEC8 LDY #$F4 JSR LB20D JSR LAFFB BNE LAED7 .LAED2 PLP JSR LAFD7 RTS .LAED7 LDX #$BC LDY #$F8 JSR LB20F LDY #L00BA JSR LAF71 BCS LAEEB JSR LAF66 PLP CLV PHP .LAEEB LDY #$FB JSR LB21C LDX #$B1 LDY #$F2 JSR LB20F LDX #$B3 LDY #$F6 JSR LB20F LDX #$BE LDY #$FB JSR LB20F CLC JSR LB199 LDX #$B1 JSR LB003 PLP PHP BVS LAF1D LDA #$02 JSR LAF7E PLP CLV PHP JMP LAEC8 .LAF1D JSR LAFD7 LDA #$FF PHA PHA LDY #$F6 JSR LB20D LDY #$FB LDA L00BA+$00 CLC ADC (L00B8),Y TAX LDA L00BA+$01 INY ADC (L00B8),Y PHA TXA PHA LDA #$FF PHA PHA LDA L00BA+$01 PHA LDA L00BA+$00 PHA LDA #$FF LDX #$08 .LAF47 PHA DEX BNE LAF47 LDY #$F0 LDA (L00B8),Y PHA DEY TSX LDA (L00B8),Y PHA LDY #$01 LDA #$00 JSR osfile JSR LB1FB JSR LB23D JMP LAED2 .LAF65 EQUB $40 .LAF66 LDA $00,X STA $0000,Y LDA $01,X STA $0001,Y RTS .LAF71 LDA $01,X CMP $0001,Y BNE LAF7D LDA $00,X CMP $0000,Y .LAF7D RTS .LAF7E PHA PHA PHA PHA LDA #$00 PHA PHA LDY #$FC LDA (L00B8),Y PHA DEY LDA (L00B8),Y PHA LDA #$FF PHA PHA LDY #$F7 LDA (L00B8),Y PHA DEY LDA (L00B8),Y PHA TSX LDY #$FA LDA (L00B8),Y PHA LDA stack+$09,X LDY #$01 JSR osgbpb LDX #$0D JSR LB23F JSR LB1FB RTS .LAFB3 LDA #$40 .LAFB5 PHA LDY #$EF LDA (L00B8),Y TAX INY LDA (L00B8),Y TAY PLA JSR osfind TAX BNE LAFCB LDX #$04 JMP LB2CB .LAFCB LDY #$FA JSR LB1FB STA (L00B8),Y .LAFD2 RTS .LAFD3 LDA #$80 BNE LAFB5 .LAFD7 LDY #$FA LDA (L00B8),Y BEQ LAFD2 PHA LDA #$00 STA (L00B8),Y PLA TAY LDA #$00 JSR osfind JMP LB1FB .LAFEC LDY #$FA LDA (L00B8),Y TAX LDA #$01 JSR LB23A JSR LB1FB TXA RTS .LAFFB LDY #$F4 LDA (L00B8),Y INY ORA (L00B8),Y RTS .LB003 STX L00BC LDY #$FB JSR LB20D LDY #$F4 LDA (L00B8),Y SEC SBC L00BA+$00 STA (L00B8),Y STA L00BA+$00 INY LDA (L00B8),Y SBC L00BA+$01 STA (L00B8),Y STA L00BA+$01 ORA L00BA+$00 BEQ LB043 LDX L00BC JSR LB22B BVC LB03A LDA $01,X CMP #$C0 BCC LB03A LDA #$10 STA $00,X LDA #$80 STA $01,X JSR LB070 .LB03A LDX L00BC LDY #$F2 JSR LB21E LDA #$FF .LB043 RTS .LB044 LDX #$BD LDY #$F2 JSR LB20F INC L00BD BNE LB061 INC L00BE BEQ LB06D JSR LB22B BVC LB061 LDA L00BE CMP #$C0 BNE LB061 JSR LB070 .LB061 LDA L00BD LDY #$F2 STA (L00B8),Y LDA L00BE INY STA (L00B8),Y RTS .LB06D JMP LAE35 .LB070 LDY #$F1 LDA (L00B8),Y CLC ADC #$01 CMP #$08 BCS LB06D LDY #$F1 STA (L00B8),Y TAY JSR LB0CF BEQ LB06D RTS .LB086 LDY #$10 .LB088 CMP LB0AF-$10,Y BCC LB09F BNE LB097 PHA TXA CMP LB0AB-$10,Y PLA BCC LB09F .LB097 INY CPY #$14 BCC LB088 JMP LAE35 .LB09F PHA TXA CLC ADC LB0B3-$10,Y TAX PLA ADC LB0B7-$10,Y RTS ;Table of mappings from pseudo-addresses to sideways RAM banks .LB0AB EQUB $F0,$E0,$D0,$C0 .LB0AF EQUB $3F,$7F,$BF,$FF .LB0B3 EQUB $10,$20,$30,$40 .LB0B7 EQUB $80,$40,$00,$C0 .LB0BB CPY #$10 BCS LB0C0 RTS .LB0C0 TYA SEC SBC #$0C TAY RTS ;unreachable code TYA AND #$01 LDY #$FE ORA (L00B8),Y TAY RTS .LB0CF JSR LB0BB TYA TAX LDA LB0F7,Y PHA LDY #$EE AND (L00B8),Y BNE LB0E9 LDA (L00B8),Y AND #$C0 CMP #$80 BEQ LB0E9 JMP LAE35 .LB0E9 PLA LDY #$FD AND (L00B8),Y PHA TXA TAY PLA BEQ LB0F6 LDA #$FF .LB0F6 RTS ;Table of sideways RAM banks installed in the Master 128 .LB0F7 EQUB $00,$00,$00,$00 EQUB $01,$02,$04,$08 EQUB $00,$00,$00,$00 EQUB $00,$00,$00,$00 .LB107 ;SWRAM write code copied to private page STY romid STY romsw LDY #$00 STA (L00BA),Y STX romid STX romsw RTS .LB116 STA L00BF TXA PHA TYA PHA LDX romid LDA priptr,X STA L00B0+$01 INC L00B0+$01 LDA #$00 STA L00B0+$00 LDY #$0E .LB12B LDA LB107,Y STA (L00B0),Y DEY BPL LB12B PLA PHA TAY LDA L00BF JSR LACAF PLA TAY PLA TAX LDA L00BF RTS .LB142 ;SWRAM transfer code pushed on stack STA romid STA romsw .LB147 LDA (L00B1),Y STA (L00B3),Y INY BNE LB153 INC L00B1+$01 INC L00B3+$01 DEX .LB153 CPY L00B5+$00 BNE LB147 TXA BNE LB147 PLA STA romid STA romsw JMP LB182 .LB163 LDA L00B5+$00 ORA L00B5+$01 BEQ LB198 LDX #$20 .LB16B LDA LB142,X PHA DEX BPL LB16B TSX LDA romid PHA LDA #$01 PHA TXA PHA LDA L00B0a+$00 LDX L00B5+$01 LDY #$00 RTS .LB182 LDX #$21 JSR LB23F LDX #$02 .LB189 LDA L00B1,X CLC ADC L00B5+$00 STA L00B1,X BCC LB194 INC L00B1+$01,X .LB194 DEX DEX BPL LB189 .LB198 RTS .LB199 LDY #$F1 LDA (L00B8),Y STA L00B0a+$00 LDX L00BE LDY L00BF LDA #$00 ROL A ASL A STA L00B7 INC L00B7 JSR LB22B BVS LB1BD BVC LB1B6 .LB1B2 LDX L00BE LDY L00BF .LB1B6 STX L00B5+$00 STY L00B5+$01 JMP LB163 .LB1BD LDA #$00 SEC LDX L00B7 SBC L00B0a,X STA L00B5+$00 LDA #$C0 SBC L00B0a+$01,X STA L00B5+$01 LDX #$B5 LDY #$BE JSR LAF71 BCS LB1B2 LDA L00BE SEC SBC L00B5+$00 STA L00BE LDA L00BF SBC L00B5+$01 STA L00BF JSR LB163 LDA #$10 LDX L00B7 STA L00B0a,X LDA #$80 STA L00B0a+$01,X JSR LB070 LDY #$F1 LDA (L00B8),Y STA L00B0a+$00 JMP LB1BD .LB1FB PHA TXA PHA LDA #$00 STA L00B8+$00 LDX romid LDA priptr,X STA L00B8+$01 PLA TAX PLA RTS .LB20D LDX #L00BA .LB20F PHA LDA (L00B8),Y STA $00,X INY LDA (L00B8),Y STA $01,X DEY PLA RTS .LB21C LDX #L00BA .LB21E PHA LDA $00,X STA (L00B8),Y INY LDA $01,X STA (L00B8),Y DEY PLA RTS .LB22B PHA TYA PHA LDY #$EE LDA (L00B8),Y STA L00F6 ;romptr+$00 used as a temp PLA TAY PLA BIT L00F6 RTS .LB23A JMP (fscv) .LB23D ;Pop 18 bytes from stack LDX #$12 .LB23F ;Pop X bytes from stack STX L00F7 ;romptr+$01 used as a temp PLA TAY PLA STA L00F6 ;romptr+$00 used as a temp TSX TXA CLC ADC L00F7 TAX TXS LDA L00F6 PHA TYA PHA RTS .LB253 ;Header copied to pseudo-addressed RAM banks RTS EQUB $00,$00 RTS EQUB $00,$00 EQUB $02 EQUB $0C EQUB $FF EQUS "RAM" .LB25F EQUB $00 EQUS "(C)" .LB263 LDA #$00 LDY #$FD STA (L00B8),Y LDY #$EE STA (L00B8),Y LDY #$FA STA (L00B8),Y LDY #$FF LDA #$4E STA (L00B8),Y LDY #$0F .LB279 LDA LB0F7,Y BEQ LB2C7 TYA PHA LDA #$08 STA romptr+$00 STA L00BA+$00 LDA #$80 STA romptr+$01 STA L00BA+$01 JSR osrdsc STA L00BD PLA PHA TAY LDA L00BD EOR #$FF JSR LB116 JSR osrdsc CMP L00BD BEQ LB2C5 PLA PHA TAX LDY #$EE LDA (L00B8),Y ORA LB0F7,X STA (L00B8),Y TXA TAY LDA L00BD JSR LB116 JSR LB356 CMP #$02 BNE LB2C5 LDA LB0F7,Y LDY #$FD ORA (L00B8),Y STA (L00B8),Y .LB2C5 PLA TAY .LB2C7 DEY BPL LB279 RTS .LB2CB LDA #$00 STA errbuf+$00 LDA LB350,X STA errbuf+$01 LDA LB349+$01,X STA L00BF LDY LB349,X LDX #$00 .LB2E0 LDA LB2F4,Y STA stack+$02,X INX INY CPY L00BF BCC LB2E0 LDA #$00 STA stack+$02,X JMP errbuf .LB2F4 EQUS "Illegal parameter" EQUS "Illegal address" EQUS "No filing system" EQUS "Bad command" EQUS "File not found" EQUS "RAM occupied" .LB349 ;Table of error message offsets EQUB $00,$11,$20,$30 EQUB $3B,$49,$55 .LB350 ;Table of error numbers EQUB $80,$81,$82,$FE EQUB $D6,$83 .LB356 TXA PHA TYA PHA LDX #$07 STX romptr+$00 LDA #$80 STA romptr+$01 JSR osrdsc STA romptr+$00 LDX #$00 .LB369 STX L00BF PLA PHA TAY JSR osrdsc LDX L00BF CMP LB25F,X BNE LB3BE INC romptr+$00 BNE LB37E INC romptr+$01 .LB37E INX CPX #$04 BCC LB369 LDA #$02 STA L00BF LDX #$0F LDA #$80 STA romptr+$01 .LB38D STX romptr+$00 PLA PHA TAY JSR osrdsc LDX romptr+$00 CMP LB253,X BNE LB3A9 .LB39C DEX CPX #$06 BCS LB38D .LB3A1 CLC .LB3A2 PLA TAY PLA TAX LDA L00BF RTS .LB3A9 CPX #$0A ;if compare fails on 2nd character of title BNE LB3B8 CMP #$4F ;and the character found is "O"... BNE LB3B8 LDA #$01 STA L00BF JMP LB39C .LB3B8 LDA #$00 STA L00BF BEQ LB3A1 .LB3BE LDA #$FF STA L00BF SEC BCS LB3A2 .LB3C5 JSR LB46F TYA PHA LDX #$00 .LB3CC BIT LAF65 .LB3CF LDA (linptr),Y AND #$DF CMP #$0D BEQ LB3E5 CMP LB506,X BNE LB3F9 .LB3DC INX LDA LB506,X BEQ LB407 INY BNE LB3CF .LB3E5 INX LDA LB506,X BNE LB3E5 PLA PHA TAY INX INX LDA LB506,X BNE LB3CC PLA TAY SEC RTS .LB3F9 LDA (linptr),Y CMP #$2E BNE LB40E BVS LB3E5 .LB401 INX LDA LB506,X BNE LB401 .LB407 PLA LDA LB506+$01,X INY CLC RTS .LB40E ORA #$20 CMP LB506,X BNE LB3E5 CLV BVC LB3DC .LB418 TXA PHA JSR LB46F LDA #$00 STA L00BC STA L00BD STA L00BE STA L00BF SEC PHP .LB429 LDA (linptr),Y CMP #$30 BCC LB465 CMP #$3A BCC LB43D CMP #$47 BCS LB465 CMP #$41 BCC LB465 SBC #$07 .LB43D SEC SBC #$30 PLP PHP PHA LDX #$04 .LB445 ASL L00BC ROL L00BD BVC LB44F ROL L00BE ROL L00BF .LB44F BCS LB461 DEX BNE LB445 PLA ORA L00BC STA L00BC PLP CLC PHP INY BEQ LB462 BCC LB429 .LB461 PLA .LB462 PLP SEC PHP .LB465 PLP PLA TAX RTS .LB469 INY BNE LB46F JMP LB4AD .LB46F LDA (linptr),Y CMP #$20 BEQ LB469 CLC RTS .LB477 LDA #$0D .LB479 PHA JSR LB46F PLA CMP (linptr),Y BNE LB485 CLC INY RTS .LB485 SEC RTS .LB487 JSR LB46F TYA PHA CLC ADC linptr+$00 LDY #$EF STA (L00B8),Y LDA linptr+$01 ADC #$00 INY STA (L00B8),Y PLA TAY BIT LAF65 .LB49F LDA (linptr),Y CMP #$20 BEQ LB4B2 CMP #$0D BEQ LB4B2 CLV INY BNE LB49F .LB4AD LDX #$03 JMP LB2CB .LB4B2 BVS LB4AD RTS .LB4B5 INY BEQ LB4AD RTS .LB4B9 STX L00BF JSR LB46F LDA (linptr),Y LDX #$03 .LB4C2 CMP LB4FE,X BCS LB4F6 CMP LB4FA,X BCC LB4F3 SBC LB502,X JSR LB4B5 CMP #$01 BNE LB4EA LDA (linptr),Y CMP #$36 BCS LB4E8 CMP #$30 BCC LB4E8 SBC #$26 JSR LB4B5 JMP LB4EA .LB4E8 LDA #$01 .LB4EA PHA JSR LB46F PLA LDX L00BF CLC RTS .LB4F3 DEX BPL LB4C2 .LB4F6 LDX L00BF SEC RTS ;Tables of ASCII to ROM bank mappings ; $30..$39 "0".."9" -> $00..$09 ; $41..$46 "A".."F" -> $0A..$0F ; $57..$5A "W".."Z" -> $10..$13 remapped to found RAM banks ; $77..$7A "w".."z" -> $0D..$10 [BUG] .LB4FA EQUB $30,$41,$57,$77 .LB4FE EQUB $3A,$47,$5B,$7B .LB502 EQUB $30,$37,$47,$6A .LB506 EQUS "sram" EQUB $00,$00 EQUS "SRlOAD" EQUB $00,$01 EQUS "SRsAVE" EQUB $00,$02 EQUS "SRwRITE" EQUB $00,$03 EQUS "SRReAD" EQUB $00,$04 EQUS "SRdATA" EQUB $00,$05 EQUS "SRRoM" EQUB $00,$06 EQUB $00 .LB53D EQUW LB549 ;*SRLOAD $B549 EQUW LB54D ;*SRSAVE $B54D EQUW LB5DA ;*SRWRITE $B5DA EQUW LB5DE ;*SRREAD $B5DE EQUW LB63E ;*SRDATA $B63E EQUW LB688 ;*SRROM $B688 .LB549 ;*SRLOAD LDA #$C0 BNE LB54F .LB54D ;*SRSAVE LDA #$40 .LB54F PHA JSR LB487 CLV JSR LB418 BCS LB572 STY L00BA+$00 LDX #$BC LDY #$F2 JSR LB21E LDY L00BA+$00 PLA PHA BMI LB593 LDA #$2B JSR LB479 PHP CLV JSR LB418 .LB572 BCS LB5D7 STY L00BA+$00 PLP BCC LB58C LDY #$F2 SEC LDA L00BC SEC SBC (L00B8),Y STA L00BC INY LDA L00BD SBC (L00B8),Y BCC LB5D7 STA L00BD .LB58C LDX #$BC LDY #$F4 JSR LB21E .LB593 LDY L00BA+$00 JSR LB4B9 STY L00BA+$00 BCS LB5A4 LDY #$F1 STA (L00B8),Y PLA AND #$80 PHA .LB5A4 PLA STA L00BA+$01 LDY #$EE LDA (L00B8),Y AND #$3F ORA L00BA+$01 STA (L00B8),Y LDY L00BA+$00 JSR LB46F LDA (linptr),Y AND #$DF LDX #$00 CMP #$51 BNE LB5C5 JSR LB4B5 LDX #$FF .LB5C5 JSR LB477 BCS LB5D7 LDY #$F8 LDA #$00 STA (L00B8),Y INY TXA STA (L00B8),Y JMP LACD2 .LB5D7 JMP LB4AD .LB5DA ;*SRWRITE LDA #$C0 BNE LB5E0 .LB5DE ;*SRREAD LDA #$40 .LB5E0 PHA BIT LAF65 JSR LB418 BCS LB5D7 LDX #$03 .LB5EB LDA L00BC,X STA L00B1,X DEX BPL LB5EB LDA #$2B JSR LB479 BCS LB5FA CLV .LB5FA JSR LB418 BCS LB5D7 BVC LB61A SEC LDX #$00 SEC .LB605 LDA L00BC,X SBC L00B1,X STA L00BC,X INX TXA AND #$04 BEQ LB605 LDA L00BE ORA L00BF BEQ LB61A JMP LAE35 .LB61A LDA L00BC STA L00B5+$00 LDA L00BD STA L00B5+$01 CLV JSR LB418 BCS LB5D7 JSR LB4B9 BCS LB633 STA L00B7 PLA AND #$BF PHA .LB633 JSR LB477 BCS LB5D7 PLA STA L00B0a+$00 JMP LB6C0 .LB63E ;*SRDATA JSR LB4B9 .LB641 BCS LB5D7 PHA JSR LB477 BCS LB5D7 PLA TAY JSR LB0CF BNE LB66B JSR LB356 TAX BNE LB65B LDX #$05 JMP LB2CB .LB65B STY L00BF LDA LB0F7,Y LDY #$FD ORA (L00B8),Y STA (L00B8),Y LDY L00BF JSR LB66F .LB66B JSR LB8D1 RTS .LB66F LDX #$0F STX L00BA+$00 LDA #$80 STA L00BA+$01 .LB677 LDA LB253,X CPX #$01 BNE LB67F TYA .LB67F JSR LB116 DEX STX L00BA+$00 BPL LB677 RTS .LB688 ;*SRROM JSR LB4B9 BCS LB641 PHA JSR LB477 BCS LB641 PLA TAY JSR LB0CF BEQ LB6B9 .LB69A STY L00BC JSR LB66F LDA #$0A STA L00BA+$00 LDA #$4F JSR LB116 LDA LB0F7,Y EOR #$FF LDY #$FD AND (L00B8),Y STA (L00B8),Y LDY L00BC JSR LB8D1 RTS .LB6B9 JSR LB356 TAX BNE LB69A RTS .LB6C0 LDA L00B0a+$00 AND #$C0 STA L00BE LDY #$EE LDA (L00B8),Y AND #$3F ORA L00BE STA (L00B8),Y BIT L00B0a+$00 BVS LB6DD LDY L00B7 CPY #$14 BCC LB6E8 .LB6DA JMP LACF7 .LB6DD LDX L00BC LDA L00BD JSR LB086 STX L00BC STA L00BD .LB6E8 JSR LB0CF PHA TYA LDY #$F1 STA (L00B8),Y PLA EOR L00B0a+$00 AND #$40 BNE LB6DA JSR LB8AC JSR LB8A0 BCS LB722 .LB700 LDX #$B5 LDY #$BE JSR LAF66 ROL L00B0a+$00 BCC LB715 LDX #$BC LDY #$B3 .LB70F JSR LAF66 JMP LB199 .LB715 LDX #$B1 LDY #$B3 JSR LAF66 LDX #$BC LDY #$B1 BNE LB70F .LB722 LDA L00B3+$00 AND L00B3+$01 CMP #$FF BEQ LB700 LDA L00BC PHA LDA L00BD PHA LDX #$03 .LB732 LDA L00B1,X STA L00BA,X DEX BPL LB732 LDX #$B5 LDY #$F4 JSR LB21E BIT L00B0a+$00 BMI LB747 JMP LB7C8 .LB747 PLA STA L00B3+$01 PLA STA L00B3+$00 .LB74D LDX #$BE LDY #$F4 JSR LB20F LDA L00BF BNE LB787 LDX L00BE BEQ LB7C7 LDA #$00 STA (L00B8),Y INC L00B8+$01 JSR LB88A LDA #$00 LDX #<L00BA LDY #>L00BA JSR tubadr LDY #$0B JSR LB898 NOP NOP .LB775 LDA reg3 STA (L00B8),Y LDX #$08 JSR LB89C INY EQUB $CC EQUW L00BE ;CPY L00BE BNE LB775 BEQ LB7B1 .LB787 LDA #$00 STA L00BE LDA #$01 STA L00BF INC L00B8+$01 JSR LB88A LDA #$06 LDX #<L00BA LDY #>L00BA JSR tubadr LDY #$08 JSR LB898 NOP NOP .LB7A4 LDA reg3 STA (L00B8),Y JSR LB8AB ;wait 6 microseconds LDA $00 ;wait 1.5 microseconds INY ;increment and loop back BNE LB7A4 ;taking 10 microseconds per byte .LB7B1 JSR LB892 LDX #$B8 LDY #$B1 JSR LAF66 DEC L00B8+$01 SEC JSR LB199 JSR LB856 JMP LB74D .LB7C7 RTS .LB7C8 PLA STA L00B1+$01 PLA STA L00B1+$00 .LB7CE LDX #$BE LDY #$F4 JSR LB20F LDA L00BF BNE LB7E1 LDX L00BE BEQ LB7C7 LDA #$01 BNE LB7EB .LB7E1 LDA #$00 STA L00BE LDA #$01 STA L00BF LDA #$07 .LB7EB PHA INC L00B8+$01 LDX #$B8 LDY #$B3 JSR LAF66 LDA L00BE PHA DEC L00B8+$01 CLC JSR LB199 PLA STA L00BE PLA CMP #$01 BNE LB82E LDA #$00 LDY #$F4 STA (L00B8),Y INC L00B8+$01 JSR LB88A LDA #$01 LDX #<L00BA LDY #>L00BA JSR tubadr LDY #$00 .LB81C LDA (L00B8),Y STA reg3 LDX #$08 JSR LB89C NOP INY CPY L00BE BNE LB81C BEQ LB84B .LB82E INC L00B8+$01 JSR LB88A LDA #$07 LDX #<L00BA LDY #>L00BA JSR tubadr LDY #$00 .LB83E LDA (L00B8),Y STA reg3 LDX #$03 .LB845 DEX BNE LB845 INY BNE LB83E .LB84B JSR LB892 DEC L00B8+$01 JSR LB856 JMP LB7CE .LB856 LDX #$01 INC L00BA,X BNE LB861 INX CPX #$04 BCC LB856 .LB861 LDY #$F5 LDA (L00B8),Y SEC SBC #$01 BCC LB889 STA (L00B8),Y JSR LAFFB BEQ LB889 LDX L00B7 JSR LB22B BVC LB889 LDA L00B1,X CMP #$C0 BCC LB889 LDA #$10 STA L00B0a,X LDA #$80 STA L00B1,X JSR LB070 .LB889 RTS .LB88A LDA #$C0+srtbid JSR tubadr BCC LB88A RTS .LB892 LDA #$80+srtbid JSR tubadr RTS .LB898 DEY BNE LB898 RTS .LB89C DEX BNE LB89C RTS .LB8A0 LDA #$EA LDX #$00 LDY #$FF JSR osbyte CPX #$FF .LB8AB RTS .LB8AC JSR LB22B BPL LB8D0 BVS LB8D0 LDA #$00 PHA LDY #$F1 LDA (L00B8),Y .LB8BA PHA LDA #$AA LDX #$00 LDY #$FF JSR osbyte JSR LB1FB STX L00BA+$00 STY L00BA+$01 PLA TAY PLA STA (L00BA),Y .LB8D0 RTS .LB8D1 LDA #$02 PHA TYA BPL LB8BA ;Padding EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1,-1,-1,-1,-1,-1,-1 EQUD -1,-1 EQUB -1 .end save "dfs224.bin",lang,end