10
20
30
40
50
60
70 :
80 able%=able%OR64:
90 PRINT "Assembling S.HADFS6"
100 O%=P%-Block%+mcode%
110 [OPT0
120 \.gbpb0:\RTS:\ In previous source file
130 :
140 \ ======================================
150 \ OSGBPB - Multiple byte data read/write
160 \ ======================================
170 .gbpb
180 CMP #0:BEQ gbpb0
190 CMP #12:BCS gbpb0
200 JSR GrabAbs :\ Ensure we have workspace
210 STX blk+0:STY blk+1:STA argnum
220 LDY #12
230 .gbpbSetPtr
240 LDA (blk),Y:STA ptrstore-9,Y :\ ptrstore=new PTR
250 DEY:CPY #8:BNE gbpbSetPtr
260 LDA argnum
270 CMP #5:BCC P%+5:JMP gbpbInfo :\ Function 5+ - read disk info
280 LDA (blk),Y
290 BEQ P%+5:JMP gbpbExit :\ num>16M, can't transfer all in one go
300 JSR GetChn :\ A=channel, Y=0
310 LDX argnum:CPX #3:BCS gbpbIn :\ 3,4 - Read data
320 JSR CheckOutput:BNE gbpbNext :\ 1,2 - Write data
330 .gbpbIn
340 JSR CheckInput
350 .gbpbNext :\ X=>channel
360 LDA argnum:ROR A:BCC gbpbNoPtr :\ Odd functions change PTR
370 LDY #ptrstore:JSR argsY_01a :\ Set PTR
380 :
390 .gbpbNoPtr
400 LDY #5:CLC
410 LDA (blk),Y:ADC WS+&05,X:STA ptrstore+0:INY
420 LDA (blk),Y:ADC WS+&06,X:STA ptrstore+1:INY
430 LDA (blk),Y:ADC WS+&07,X:STA ptrstore+2:INY
440 LDA (blk),Y:ADC WS+&08,X:STA ptrstore+3 :\ ptrstore=PTR+num
450 BCS gbpbTooMany :\ Wrapping past end of a 4G file
460 LDY #ptrstore:JSR cmp_EXT:DEX:DEX:DEX:DEX :\ Is PTR+num>EXT ?
470 BCC gbpbTooMany:LDY #5 :\ PTR+num>EXT, jump to do num=EXT-PTR
480 .gbpbSetTrans
490 LDA (blk),Y:STA ptrstore-5,Y :\ PTR+num<=EXT, use requested num
500 INY:CPY #9:BNE gbpbSetTrans :\ ptrstore=number to transfer
510 CLC:BCC gbpbInfo :\ CLC=not EOF
520 .gbpbTooMany
530 SEC
540 LDA WS+&09,X:SBC WS+&05,X:STA ptrstore+0 :\ PTR+num>EXT, use EXT-PTR instead
550 LDA WS+&0A,X:SBC WS+&06,X:STA ptrstore+1
560 LDA WS+&0B,X:SBC WS+&07,X:STA ptrstore+2
570 LDA WS+&0C,X:SBC WS+&08,X:STA ptrstore+3 :\ ptrstore=end-PTR, number to transfer
580 SEC :\ SEC=EOF
590 .gbpbInfo
600 PHP:LDY #5:LDA (blk),Y:STA len+0:DEY :\ len+0 set for gbpb5+
610 .gbpbAddrLp
620 LDA (blk),Y:STA addr-1,Y:DEY:BNE gbpbAddrLp :\ Copy address to addr
630 TXA:PHA:JSR CheckAddr:PLA:TAX :\ Page requested memory in, preserve X=>chaninfo
640 :
650 LDA argnum:ASL A:TAY
660 LDA gbpbTable-2,Y:STA argtmp+0
670 LDA gbpbTable-1,Y:STA argtmp+1
680 LDA argnum:PLP:JSR JumpAT:LDY #4 :\ Call GBPB subroutine
690 .AddrToCtrlLp
700 LDA addr-1,Y:STA (blk),Y:DEY:BNE AddrToCtrlLp:\ Copy updated address back to control block
710 .gbpbExit
720 LDA #0:LDX blk+0:LDY blk+1:RTS
730 .JumpAT:JMP (argtmp)
740 :
750 .gbpbTable
760 EQUW gbpb1:EQUW gbpb2:EQUW gbpb3
770 EQUW gbpb4:EQUW gbpb5:EQUW gbpb6
780 EQUW gbpb7:EQUW gbpb8:EQUW gbpb9
790 EQUW gbpb10:EQUW gbpb11
800 :
810 \ On entry to OSGBPB routines,
820 \ addr =data address (forced to I/O if no Tube or screen)
830 \ ?len =number byte 0 for gbpb5+
840 \ ptrstore=number to transfer for gbpb1-4, always <16M
850 \ X =>channel info for gbpb1-4
860 \ Y =corrupted
870 \ A =function
880 \ Cy =EOF flag
890 \ On exit,
900 \ control block num and ptr updated
910 \ Cy =EOF flag
920 \ A,X,Y ignored
930 :
940 \ ----------------------------------------------
950 \ OSGBPB 1,2,3,4 - Write and Read multiple bytes
960 \ ----------------------------------------------
970 .gbpb1:.gbpb2:.gbpb3:.gbpb4
980 PHP:LDY #3 :\ Save EOF flag
990 .RWlp1
1000 LDA ptrstore,Y:PHA:DEY:BPL RWlp1 :\ Save number
1010 LDA WS+&05,X:BEQ RWZero :\ Already on a sector boundary
1020 LDA #0:SEC:SBC WS+&05,X:STA len+0 :\ Number of bytes to end of sector
1030 LDA ptrstore+1:ORA ptrstore+2
1040 ORA ptrstore+3:BNE RWok :\ More than one sector to transfer
1050 LDA ptrstore+0:CMP len+0:BCS RWok :\ number > remainder here
1060 STA len+0 :\ Use this instead
1070 .RWok
1080 JSR RWBytes:BEQ RWFinished :\ Now at sect boundary, jump if no more
1090 .RWZero
1100 JSR FindSector :\ sect=next sector in file
1110 LDA ptrstore+2:STA len+2 :\ len+1/2=number of sectors to transfer
1120 LDA ptrstore+1:STA len+1
1130 LDY argnum:CPY #3:LDA #0:ADC #&FF :\ Convert Y=1/2, 3/4 -> A=FF/00
1140 STA action
1150 TXA:PHA:JSR DiskMainGBPB:PLA:TAX :\ Transfer whole sectors, allowed to corrupt A,X,Y,P
1160 CLC
1170 LDA ptrstore+1:ADC WS+&06,X:STA WS+&06,X :\ PTR=PTR+number transfered
1180 LDA ptrstore+2:ADC WS+&07,X:STA WS+&07,X
1190 LDA ptrstore+3:ADC WS+&08,X:STA WS+&08,X :\ ptrstore=length-first, ie ?ptrstore=remainder
1200 LDA ptrstore:JSR RWBytesA :\ Transfer any remaining bytes
1210 .RWFinished
1220 LDY #0
1230 .RWlp2
1240 PLA:STA ptrstore,Y:INY:CPY #4:BNE RWlp2 :\ Restore number
1250 INY:SEC
1260 .RWSub
1270 LDA (blk),Y:SBC ptrstore-5,Y :\ num=num-actual transfered
1280 STA (blk),Y:INY:TYA:EOR #9:BNE RWSub
1290 LDA argnum:CMP #3:BCS RWEnd :\ Read, all done
1300 PLP:BCC RWEnd1 :\ Write at EOF, all done
1310 :
1320 \ Write remaining bytes, extending past EOF
1330 .RWLast
1340 DEY:LDA (blk),Y:STA ptrstore-5,Y :\ ptrstore=remaining number to write
1350 CPY #4:BNE RWLast
1360 .RWLastLp
1370 LDY #255:LDA ptrstore+1:ORA ptrstore+2
1380 ORA ptrstore+3:BNE RWLast3
1390 LDY ptrstore+0
1400 .RWLast3
1410 TYA:JSR RWBytesA:BNE RWLastLp:LDY #5
1420 .RWAddr
1430 STA (blk),Y:INY:CPY #9:BNE RWAddr:CLC :\ Returned num=0
1440 .RWEnd1
1450 PHP
1460 .RWEnd
1470 LDY #9
1480 .RWEndLp
1490 LDA WS+&05,X:STA (blk),Y:INY:INX :\ Return PTR
1500 CPY #13:BNE RWEndLp
1510 PLP:RTS:\ EOF flag
1520 :
1530 .RWBytesA:\ A=number to do
1540 STA len+0
1550 .RWBytes:\ ?len=number to do
1560 LDY #3
1570 .RWBytesLp
1580 LDA ptrstore,Y:PHA:DEY:BPL RWBytesLp :\ Save ptrstore
1590 LDA len+0:PHA:BEQ RWBytesZero :\ Save len, if nothing to transfer, exit
1600 TXA:PHA :\ Save pointer to channel info
1610 LDA addr+3:CMP #&FF:BEQ RWBytesIO :\ &FFxxxxxx, I/O memory
1620 BIT &27A:BPL RWBytesIO :\ No Tube, I/O memory
1630 :
1640 LDA argnum:CMP #3:LDA #0:ADC #0:PHA
1650 JSR TubeClaimDo
1660 JSR GetChn:TAY
1670 PLA:BNE RWTubeLoad
1680 .RWTubeSave
1690 LDA &FEE5:SEC:JSR putget1:\ bput without GrabAbs
1700 JSR UpdateCounters:BNE RWTubeSave
1710 BEQ RWTubeDone
1720 :
1730 .RWTubeLoad
1740 CLC:JSR putget1:STA &FEE5:\ bget without GrabAbs
1750 JSR UpdateCounters:BNE RWTubeLoad
1760 .RWTubeDone
1770 JSR TubeRelease
1780 .RWBytesDone
1790 PLA:TAX:\ Info ptr
1800 .RWBytesZero
1810 PLA:STA len+0:SEC:\ Number
1820 PLA:SBC len+0:STA ptrstore+0
1830 PLA:SBC #0:STA ptrstore+1 :\ num=num-number transfered
1840 PLA:SBC #0:STA ptrstore+2
1850 PLA:SBC #0:STA ptrstore+3
1860 ORA ptrstore+2:ORA ptrstore+1
1870 ORA ptrstore+0:RTS :\ Return EQ if nothing left to do
1880 :
1890 .RWBytesIO
1900 JSR ScreenOn:JSR GetChn:TAY :\ Allowed to corrupt A,Y,X,P
1910 LDX #addr:LDA argnum
1920 CMP #3:BCS RWLoadLp
1930 .RWSaveLp
1940 LDA (0,X):SEC:JSR putget1 :\ bput without GrabAbs
1950 JSR UpdateCounters:BNE RWSaveLp
1960 BEQ RWBytesEnd
1970 :
1980 .RWLoadLp
1990 CLC:JSR putget1:STA (0,X) :\ bget without GrabAbs
2000 JSR UpdateCounters:BNE RWLoadLp
2010 .RWBytesEnd
2020 JSR ScreenOff :\ Allowed to corrupt A,Y,X,P
2030 JMP RWBytesDone
2040 :
2050 .UpdateCounters
2060 LDA #1:JSR gbpbUpd:DEC len+0:RTS:\ addr=addr+1, len=len-1
2070 :
2080 :
2090 \ ------------------------------------
2100 \ OSGBPB 5,6,7 - Read disk information
2110 \ ------------------------------------
2120 .gbpb5:.gbpb6:.gbpb7
2130 PHA
2140 JSR CheckContext :\ Ensure a valid context
2150 JSR GetOptNum :\ Ensure usernum valid
2160 JSR CheckNames2 :\ Ensure context names in memory
2170 LDX #0:LDY #0
2180 PLA:CMP #6:BCS gbpb67 :\ Jump to read dir/lib names
2190 LDA #16:JSR CopyInfo :\ Copy disk name to buffer
2200 JSR GetOptNum2:JSR PutInInfo :\ Boot option
2210 LDA CSD+d:JSR PutInInfo :\ Drive number
2220 BNE gbpbLoader :\ Transfer to user memory
2230 :
2240 .gbpb67
2250 PHP:LDA #1:STA &F00 :\ Len=1
2260 LDA CSD+d :\ CSD drive
2270 PLP:PHP:BEQ P%+5:LDA LIB+d :\ LIB drive
2280 JSR DrvChr:STA &F01 :\ Drive character
2290 LDY #2:LDX #16 :\ Offset of CSD name
2300 PLP:PHP:BEQ P%+4:LDX #26 :\ Offset of LIB name
2310 JSR CopyInfo10 :\ Copy to buffer
2320 LDX #0 :\ &00 - Owner
2330 LDA PRIV:AND #8:BNE gbpb67b :\ Syst, Owner
2340 LDA OPTFLG :\ Get Ownership flags
2350 PLP:PHP:BEQ P%+3:ASL A :\ Move Owner flag to b7
2360 ASL A:BCC P%+3:DEX :\ If Public, X=&FF
2370 .gbpb67b
2380 PLP:TXA:JSR PutInInfo
2390 :
2400 \ Send data from &F00
2410 \ Y=length, addr=address
2420 \ ----------------------
2430 .gbpbLoader
2440 JSR ClearFSM :\ Claim FSM
2450 STY len+0:TYA:PHA:JSR LoadGbPb:PLA
2460 .gbpbUpd
2470 CLC:ADC addr+0:STA addr+0
2480 LDA #0:JMP UpdateAddrCy
2490 :
2500 \ Copy name information to FSM buffer
2510 \ -----------------------------------
2520 .CopyInfo10
2530 LDA #10
2540 .CopyInfo
2550 STA len+0:STA &F00,Y:TYA:PHA:INY:\ Max length
2560 .CopyInfoLp
2570 LDA DSKNAME,X:CMP #ASC"!"
2580 BCC CopyInfoEnd
2590 JSR PutInInfo:INX
2600 DEC len+0:BNE CopyInfoLp
2610 .CopyInfoEnd
2620 PLA:TAX:LDA &F00,X
2630 SEC:SBC len+0:STA &F00,X
2640 .gbpb9null
2650 RTS
2660 :
2670 :
2680 \ ---------------------------------------------------
2690 \ OSGBPB 8,9,10,11 - Read object names from directory
2700 \ ---------------------------------------------------
2710 \ A=8 - read <len><filename>
2720 \ A=9 - read <filename>00
2730 \ A=10 - read <load><exec><len><attr><type><filename>00<align>
2740 \ A=11 - read <load><exec><len><attr><type><sector><timestamp><filename>00<align>
2750 \ <exec><load.lo>
2760 \ A=12 - read <load><exec><len><attr><type><load DIV 256><filename>00<align>
2770 \
2780 \ A=9,10,11, XY+0 =0 - use CSD
2790 \ XY=0<>0 - use directory on opened channel
2800 \
2810 \ On entry, addr =address
2820 \ len =number to transfer
2830 \ ptrstore=index
2840 \ Uses ptrstore?0 = ret - returned index
2850 \ ptrstore?1 = index - current index
2860 \ ptrstore?2 = fcnt - number of items done
2870 \ ----------------------------------------------------
2880 .gbpb9:.gbpb10:.gbpb11
2890 CMP #10:BCS gbpb9null
2900 :]:IF _NoGBAddr%=0:z%=P%-gbpb9:P%=P%-z%:O%=O%-z%
2910 JSR GetChn:BEQ gbpb8 :\ Channel=0, use CSD
2920 JSR CheckChannel :\ Point to channel info
2930 AND #&10:BNE gbpb8a :\ Is a directory, use it
2940 JMP errNotDir :\ Otherwise, error (this gives XXX is not a dir)
2950 :
2960 .gbpb8
2970 LDX #CSD-(WS+1) :\ GBPB 8 always reads CSD
2980 .gbpb8a
2990 JSR CheckContext :\ Ensure context valid
3000 JSR GetOptNum:LDY #3 :\ Ensure usernum valid
3010 .gbpb8lp1
3020 LDA WS+4,X:STA sect,Y :\ sect=directory to use
3030 DEX:DEY:BPL gbpb8lp1
3040 LDA ret:STA index :\ Initialise index
3050 LDA #0:STA fcnt :\ Nothing transfered
3060 JSR GetDir :\ Load first directory chunk
3070 :
3080 .gbpb8dir
3090 JSR dirInit:BEQ gbpb8MT :\ Directory empty, Y=0, A=files
3100 LDA HDR+&0D:STA (blk),Y :\ Store cycle number
3110 .gbpb8lp2
3120 JSR dirNext:BEQ gbpb8next :\ Empty directory entry
3130 JSR DoIOwn:BPL gbpb8own :\ I own all entries
3140 LDY #7:LDA (fptr),Y:BMI gbpb8step :\ Private entry, step to next entry
3150 .gbpb8own
3160 LDX index:BEQ gbpb8found :\ index=0, use this entry, X=>start of info
3170 DEC index
3180 .gbpb8step
3190 DEC files
3200 .gbpb8next
3210 LDA files:BNE gbpb8lp2 :\ Step to next entry
3220 .gbpb8MT
3230 JSR NextChunk:BNE gbpb8dir :\ Load next chunk, loop until all done
3240 JSR gbpb8counter:SEC:RTS :\ No more entries
3250 :
3260 .gbpb8found
3270 .z%
3280 LDA argnum:AND #2:BEQ gbpb8name :\ 8,9 - no info block
3290 LDA blk+1:PHA:LDA blk+0:PHA :\ Save control block pointer
3300 LDA #&0E:STA blk+1:LDA #&FE:STA blk+0 :\ Point to our workspace
3310 JSR ConvertBlk0 :\ Get object information
3320 PLA:STA blk+0:PLA:STA blk+1 :\ Restore control block pointer
3330 TXA:STA &F10:LDY #0 :\ Object
3340 .gbpb8lp3
3350 LDA #0:STA &F11,Y :\ Clear object b8-b31
3360 LDA &F04,Y:STA &F18,Y :\ Copy exec to timestamp
3370 INY:CPY #5:BNE gbpb8lp3
3380 LDA &F00:STA &F1C:LDY #22 :\ Top byte of timestamp
3390 .gbpb8lp4
3400 LDA (fptr),Y:STA &F14-22,Y :\ Sector
3410 INY:CPY #25:BNE gbpb8lp4
3420 LDA HDR+&0C:AND #&80
3430 BMI P%+5:STA &F16 :\ SmallDir sector b16-b23
3440 LDA drive:STA &F17 :\ Sector drive number
3450 :]:IF _NoGBAddr%:z%=P%-z%:P%=P%-z%:O%=O%-z%
3460 :
3470 .gbpb8name
3480 LDY #0:LDA argnum
3490 CMP #9:PHP:BEQ gbpb8lp5 :\ GBPB 9 - store name at offset 0
3500 INX
3510 .z%
3520 BCC gbpb8lp5 :\ GBPB 8 - store name at offset 1
3530 LDX #&14:CMP #10:BEQ gbpb8lp5 :\ GBPB 10 - store name at offset &14
3540 LDX #&1D :\ GBPB 11 - store name at offset &1D
3550 :]:IF _NoGBAddr%:z%=P%-z%:P%=P%-z%:O%=O%-z%
3560 :
3570 .gbpb8lp5
3580 LDA (fptr),Y:AND #127 :\ Get filename character
3590 CMP #ASC"!":BCC gbpb8send :\ End of name
3600 STA &F00,X:INX:INY :\ Store it
3610 CPY #10:BNE gbpb8lp5 :\ Loop for up to 10 characters
3620 .gbpb8send
3630 PLP:BCS gbpb8send2 :\ GBPB 9,10,11 - zero terminated
3640 STY &F00:BCC gbpb8send3 :\ GBPB 8 - length prefix
3650 :
3660 .gbpb8send2
3670 LDA #0:STA &F00,X:INX :\ Insert zero terminator
3680 .z%
3690 LDA argnum:AND #2:BEQ gbpb8send3
3700 TXA:ADC #3:AND #&FC:TAX :\ Word align
3710 :]:IF _NoGBAddr%:z%=P%-z%:P%=P%-z%:O%=O%-z%
3720 :
3730 .gbpb8send3
3740 TXA:TAY:LDA len+0:PHA :\ Length
3750 JSR gbpbLoader :\ Send data to user memory
3760 PLA:STA len+0
3770 INC ret :\ Index to next
3780 INC fcnt :\ Number done
3790 DEC len+0 :\ Number to do
3800 LDY #9:LDA ret
3810 STA (blk),Y :\ Index
3820 JSR gbpb8counter
3830 CLC:LDA len+0:BEQ gbpb8end
3840 JMP gbpb8next
3850 :
3860 .gbpb8counter
3870 LDY #5:LDX len+0:LDA argnum
3880 AND #3:BEQ gbpb8send4
3890 LDX fcnt :\ 9,10,11 give num. returned, not num. not returned
3900 .gbpb8send4
3910 TXA:STA (blk),Y :\ Store number not returned (8) or number returned (9+)
3920 .gbpb8end
3930 RTS
3940 :
3950 \ PutInInfo and GetChn within fake module headers
3960 :
3970 ]
3980 PRINT CHR$11;STRING$(20,CHR$9);O%-mcode%;" bytes"
3990 > "S.HADFS7"