S-C ProDOS Interface 3.0 -- SCI/SC.LOAD.SAVE
1000 *SAVE SC.LOAD.SAVE
1010 *--------------------------------
1020 DASH
1030 LDA GET.SET.PARMS+4 GET FILE TYPE
1040 CMP #$06 BINARY?
1050 BEQ .3 ...YES, BRUN
1060 CMP #$04 TEXT?
1070 BNE .1 ...NO, TRY SYS
1080 JMP EXEC ...YES, EXEC
1090 *--------------------------------
1100 .1 CMP #$FF SYS FILE?
1110 BEQ .2 ...YES, BRUN IT
1120 LDA #$0D "FILE TYPE MISMATCH"
1130 SEC
1140 RTS
1150 *---RUN SYS FILE-----------------
1160 .2 JSR CLOSE.ALL.FILES
1170 JSR CLOSE.EXEC.FILE
1180 LDA #0
1190 STA VAL.A
1200 LDX #6 RELEASE $8000-$B7FF
1210 .4 STA BITMAP+16,X
1220 DEX
1230 BPL .4
1240 LDA #$01 RELEASE $B800-$BEFF
1250 STA BITMAP+23 B800.BFFF
1260 LDA /$2000 A$2000
1270 STA VAL.A+1
1280 LDA #$FF T=SYS
1290 STA VAL.T
1300 LDA #$80 SIGNAL FOUND T,A, AND PATHNAME
1310 STA FBITS+1
1320 LDA #$05
1330 STA FBITS
1340 .3 JMP BRUN
1350 *--------------------------------
1360 WARM.DOS
1370 JSR CLOSE.ALL.FILES
1380 JSR CROUT
1390 JMP SC.SOFT
1400 *--------------------------------
1410 * LOAD A SOURCE PROGRAM
1420 *--------------------------------
1430 LOAD
1440 JSR ALLOCATE.UPPER.BUFFER
1450 BCS .5
1460 LDA #$01 READ
1470 LDX #$FA FILE TYPE
1480 JSR OPEN.A.FILE
1490 BCS .5 ...ERROR
1500 *---GET LENGTH OF FILE-----------
1510 LDA SC.INFLAG
1520 ASL
1530 BPL .1 ...NOT .INBx
1540 AND #$7F
1550 STA MISC.PARMS+3
1560 LDA #0
1570 STA MISC.PARMS+2
1580 BEQ .2 ...ALWAYS
1590 .1 JSR MLI.D1 GET LENGTH OF FILE
1600 BCS .5 ...ERROR
1610 *---FIGURE LOAD ADDRESS----------
1620 .2 SEC
1630 LDA SC.HIMEM
1640 SBC MISC.PARMS+2
1650 STA READ.WRITE.PARMS+2
1660 STA VAL.A
1670 TAX
1680 LDA SC.HIMEM+1
1690 SBC MISC.PARMS+3
1700 STA READ.WRITE.PARMS+3
1710 STA VAL.A+1
1720 TAY
1730 *---CHECK FOR ROOM IN RAM--------
1740 BMI .6 ADDRESS>$7FFF MEANS NO ROOM
1750 TXA
1760 CMP SC.LOMEM
1770 TYA
1780 SBC SC.LOMEM+1
1790 BCC .6 ...BELOW LOMEM
1800 *---READ FILE--------------------
1810 LDA MISC.PARMS+2
1820 STA READ.WRITE.PARMS+4
1830 LDA MISC.PARMS+3
1840 STA READ.WRITE.PARMS+5
1850 JSR MLI.CA READ THE FILE
1860 BCS .5
1870 *---CLOSE UNLESS .INBx-----------
1880 BIT SC.INFLAG
1890 BVS .4 ...IT IS .INBx
1900 .3 JSR MLI.CC CLOSE THE FILE
1910 BCS .5
1920 *--------------------------------
1930 .4 LDX VAL.A+1
1940 LDY VAL.A
1950 STX SC.PP+1
1960 STY SC.PP
1970 .5 RTS
1980 .6 LDA #$0E "PROGRAM TOO LARGE"
1990 SEC
2000 RTS
2010 *--------------------------------
2020 * SAVE SOURCE PROGRAM ON DISK
2030 *--------------------------------
2040 SAVE
2050 BCC .1 ...FILE ALREADY HERE
2060 LDA #$FA FILE TYPE "INT"
2070 STA VAL.T
2080 STA GET.SET.PARMS+4
2090 LDA #$C3
2100 STA GET.SET.PARMS+3
2110 LDA SC.PP START OF PROGRAM
2120 STA CREATE.PARMS+5
2130 STA GET.SET.PARMS+5
2140 LDA SC.PP+1
2150 STA CREATE.PARMS+6
2160 STA GET.SET.PARMS+6
2170 JSR MAKE.A.FILE CREATE A NEW FILE
2180 BCS .2 ...ERROR
2190 .1 JSR ALLOCATE.UPPER.BUFFER
2200 BCS .2
2210 LDA #$02
2220 LDX #$FA
2230 JSR OPEN.A.FILE
2240 BCS .2 ...ERROR
2250 *---GET LENGTH-------------------
2260 SEC GET LENGTH
2270 LDA SC.HIMEM
2280 SBC SC.PP
2290 TAX
2300 STA MISC.PARMS+2
2310 LDA SC.HIMEM+1
2320 SBC SC.PP+1
2330 TAY
2340 STA MISC.PARMS+3
2350 LDA #0
2360 STA MISC.PARMS+4
2370 *---WRITE THE FILE---------------
2380 LDA SC.PP
2390 STA READ.WRITE.PARMS+2
2400 LDA SC.PP+1
2410 STA READ.WRITE.PARMS+3
2420 STX READ.WRITE.PARMS+4
2430 STY READ.WRITE.PARMS+5
2440 JSR MLI.CB WRITE DATA ON FILE
2450 BCS .2 ...ERROR
2460 JSR MLI.D0 SET EOF (TRUNCATE OLD LONGER FILE)
2470 BCS .2 ...ERROR
2480 JSR MLI.CC CLOSE THE FILE
2490 BCS .2 ...ERROR
2500 *---UPDATE FILE INFO-------------
2510 LDA SC.PP+1
2520 LDX SC.PP
2530 CMP GET.SET.PARMS+6
2540 BNE .3
2550 CPX GET.SET.PARMS+5
2560 CLC
2570 BNE .3
2580 .2 RTS
2590 .3 STX GET.SET.PARMS+5
2600 STA GET.SET.PARMS+6
2610 LDA #0
2620 STA GET.SET.PARMS+10
2630 STA GET.SET.PARMS+11
2640 STA GET.SET.PARMS+12
2650 STA GET.SET.PARMS+13
2660 JMP SET.FILE.INFO
2670 *--------------------------------
2680 CREATE
2690 LDX #0
2700 LDY #0 AuxType = 0000 unless specified
2710 LDA FBITS+1
2720 BPL .1 ...no A-value specified
2730 LDX VAL.A use A-value for AuxType
2740 LDY VAL.A+1
2750 .1 STX CREATE.PARMS+5
2760 STY CREATE.PARMS+6
2770 LDA FBITS
2780 AND #$04
2790 BNE MAKE.A.FILE
2800 LDA #$0F
2810 STA VAL.T
2820
2830 MAKE.A.FILE
2840 LDA VAL.T
2850 STA CREATE.PARMS+4
2860 LDX #$C3
2870 LDY #$01 SEEDLING
2880 CMP #$0F
2890 BNE .1
2900 LDY #$0D DIRECTORY
2910 .1 STX CREATE.PARMS+3
2920 STY CREATE.PARMS+7
2930 JMP MLI.C0 CREATE
2940 *--------------------------------
2950 RENAME LDA FBITS
2960 AND #$02 PATH 2?
2970 BEQ .1 ...NO, ERROR
2980 JMP MLI.C2 RENAME
2990 .1 JMP ERR.SYNTAX
3000 *--------------------------------
3010 LOCK JSR GET.FILE.INFO
3020 BCS RTS3
3030 LDA GET.SET.PARMS+3
3040 AND #$3C
3050 ORA #$01
3060 BNE LKUNLK ...ALWAYS
3070 UNLOCK JSR GET.FILE.INFO
3080 BCS RTS3
3090 LDA #$C3
3100 ORA GET.SET.PARMS+3
3110 LKUNLK STA GET.SET.PARMS+3
3120 JMP SET.FILE.INFO
3130 *--------------------------------
3140 PREFIX
3150 LDX #0
3160 LDA FBITS+1
3170 AND #$04
3180 BNE .1 ...SPECIFIED S/D
3190 LDA FBITS SEE IF SPECIFIED PATHNAME
3200 LSR
3210 BCC .3 ...NO, SO PRINT CURRENT PREFIX
3220 .1 JMP MLI.C6 SET PREFIX
3230 *---PRINT CURRENT PREFIX---------
3240 .2 LDA PATHNAME.ONE.BUFFER+1,X
3250 ORA #$80
3260 JSR COUT
3270 INX
3280 .3 CPX PATHNAME.ONE.BUFFER
3290 BCC .2
3300 JSR CROUT
3310 CLC
3320 RTS3 RTS
3330 *--------------------------------
3340 NOPREFIX
3350 LDA #0
3360 STA PATHNAME.ONE.BUFFER
3370 JMP MLI.C6 SET PREFIX
3380 *--------------------------------
3390 BSAVE
3400 BCC .2 ...EXISTING FILE
3410 LDA FBITS+1
3420 AND #$B0 A-EL
3430 CMP #$90 Require A and either E or L
3440 BCC .3 ...Neither E nor L
3450 LDA VAL.A
3460 STA CREATE.PARMS+5
3470 STA GET.SET.PARMS+5
3480 LDA VAL.A+1
3490 STA CREATE.PARMS+6
3500 STA GET.SET.PARMS+6
3510 *---T=BIN unless specified-------
3520 LDA FBITS
3530 AND #$04
3540 BNE .1 ...TYPE SPECIFIED
3550 LDA #$06 ...NO TYPE, ASSUME BINARY
3560 STA VAL.T
3570 .1 LDA VAL.T
3580 STA GET.SET.PARMS+4
3590 *--------------------------------
3600 JSR MAKE.A.FILE
3610 BCS .4
3620 JSR GET.FILE.INFO
3630 BCS .4
3640 .2 LDA #$02
3650 BNE B.COMMON ...ALWAYS
3660
3670 .3 LDA #$06 "PATH NOT FOUND"
3680 SEC
3690 .4 RTS
3700 *--------------------------------
3710 BRUN
3720 JSR BLOAD
3730 BCS .1
3740 JSR .2
3750 CLC
3760 .1 RTS
3770 .2 JMP (READ.WRITE.PARMS+2)
3780 *--------------------------------
3790 BLOAD
3800 LDA #$01
3810 B.COMMON
3820 PHA
3830 JSR ALLOCATE.UPPER.BUFFER
3840 PLA
3850 BCS .3
3860 LDX #$06
3870 JSR OPEN.A.FILE
3880 BCS .3
3890 LDX VAL.A
3900 LDY VAL.A+1
3910 LDA FBITS+1
3920 BMI .1 ...ADDRESS SPECIFIED
3930 LDX GET.SET.PARMS+5
3940 LDY GET.SET.PARMS+6
3950 LDA FBITS DON'T ALLOW DEFAULT ADDRESS
3960 AND #$04 ON NON-BINARY FILES
3970 BEQ .0 ...T not specified, so it is BIN
3980 LDA VAL.T T specified, better be BIN or SYS
3990 CMP #$06 is it BIN?
4000 BEQ .0 ...yes, use AuxType value
4010 CMP #$FF is it SYS?
4020 BNE .4 ...no, error
4030 LDX #$2000 ...type SYS, assume A$2000
4040 LDY /$2000
4050 .0 LDA FBITS+1
4060 .1 STX READ.WRITE.PARMS+2
4070 STY READ.WRITE.PARMS+3
4080 LDX VAL.L
4090 LDY VAL.L+1
4100 AND #$30
4110 BEQ .5
4120 EOR #$30
4130 BEQ .4
4140 AND #$10
4150 BEQ .7
4160 LDA VAL.E
4170 SEC
4180 SBC VAL.A
4190 TAX
4200 LDA VAL.E+1
4210 SBC VAL.A+1
4220 TAY
4230 INX
4240 BNE .2
4250 INY
4260 .2 BCS .7
4270 LDA #$02 "RANGE ERROR"
4280 SEC
4290 .3 RTS
4300 *--------------------------------
4310 .4 LDA #$0B "INVALID PARAMETER"
4320 SEC
4330 RTS
4340 *--------------------------------
4350 .5 JSR MLI.D1 GET EOF
4360 BCS .6
4370 LDX MISC.PARMS+2
4380 LDY MISC.PARMS+3
4390 LDA MISC.PARMS+4
4400 BEQ .7
4410 LDA #$0E "PROGRAM TOO LARGE"
4420 .6 SEC
4430 RTS
4440 *--------------------------------
4450 .7 STX READ.WRITE.PARMS+4
4460 STY READ.WRITE.PARMS+5
4470 LDA FBITS+1
4480 AND #$40
4490 BEQ .10
4500 LDX #$02
4510 .8 LDA VAL.B,X
4520 STA MISC.PARMS+2,X
4530 DEX
4540 BPL .8
4550 .9 JSR MLI.CE SET MARK
4560 LDX COMMAND.NUMBER
4570 BCC .10
4580 CMP #$02
4590 BNE .6
4600 CPX #CN.BSAVE
4610 BNE .6
4620 JSR MLI.D0 SET EOF
4630 BCC .9
4640 RTS
4650 *--------------------------------
4660 .10 LDX COMMAND.NUMBER
4670 CPX #CN.BSAVE
4680 BNE .12 ...NOT BSAVE
4690 JSR MLI.CB ...BSAVE
4700 BCS .13 ...ERROR
4710 .11 JMP MLI.CC
4720 .12 JSR MLI.CA READ
4730 BCC .11 ...GOOD, CLOSE
4740 .13 RTS
4750 *--------------------------------