0 ; ** COMPUTE! ** JUL 84 ** PAGE 140 **
0200 ;EQUATES
0210 ICBC = $342
0220 ICBAL = $344
0230 ICBAH = $345
0240 ICBLL = $348
0250 ICBLH = $349
0260 ICBAX = $34A+16
0270 MEMLO = $2E7
0280 LBUF = $580
0290 INBUF = $F3
0300 CIX = $F2
0310 FR0 = $D4
0320 FR1 = $E0
0330 GETR = $05
0340 GETC = $07
0350 PUTC = $0B
0360 PUTR = $09
0370 OPEN = $03
0380 CLOSE = $0C
0390 AXIO = $0C
0400 AXOUT = $08
0410 AXAP = $09
0420 AXDR = $06
0430 FR0Z = $DA44
0440 IFP = $D9AA
0450 FPI = $D9D2
0460 FPASC = $D8E6
0470 FMOVE = $DDB6
0480 ASCFP = $D800
0490 LO = $00FF
0500 HI = $0100
0510 CIO = $E456
0520 WARMST = $E474
0530 DOSVEC = $0A
0540 DOSINI = $0C
0550 OLDDOS = $179F
0560 JMPINI = $1705
0570 JMPRUN = $1708
0580 ;
0590 ;
0600  *= $1CFC ;change this addr for
0610 ;larger versions of DOS2.0S
0620 ;
0630 ;
0640 ST JSR CLSE ;to be sure
0650  STY CIX ;set f.p. pointer
0660  DEY
0670  STY $2E3;clear INIT/RUN
0680  STY $2E1
0690  STY $FF ;reset load flag
0700  LDX #LBUF&LO ;init flt. pt.
0710  LDY #LBUF/HI
0720  STX INBUF
0730  STY INBUF+1
0740 DISCMD LDY #TAB1-CMDTAB-1
0750 L1 TYA ;DISPLAY COMMANDS
0760  PHA
0770  LDA CMDTAB,Y
0780  JSR PRINT
0790  PLA
0800  TAY
0810  DEY
0820  BPL L1
0830  LDA #AXOUT ;init aux
0840  STA ICBAX
0850  JSR GTREC ;get command
0860  LDY #3 ; GET COMMAND
0870  LDA LBUF
0880 L2 CMP TAB1,Y
0890  BEQ SPECMD
0900  DEY
0910  BPL L2
0920 DIR CMP #'D ;DIRECTORY
0930  BNE WDS
0940  LDA #06
0950  STA ICBAX
0960  JSR ASKDN ;drive #?
0970  JSR OPN ;open
0980 L3 LDX #$10
0990  JSR GTREC ;get formatted line
1000  JSR PTREC0 ;print it
1010  BPL L3
1020 SPECMD LDA TAB2,Y ;SPECIAL CMDS
1030  PHA ;save cmd
1040  CMP #$FE ;check if format
1050  BEQ FMT
1060  JSR PFN
1070 EX PLA ;retrieve command
1080  JSR EXCMD ;do it
1090  BPL ST
1100 FMT LDA #'? ;FORMAT
1110  JSR PRINT ;sure?
1120  JSR GTREC
1130  LDA LBUF
1140  CMP #'Y ;is there a yes?
1150 B1 BNE ST ;if not start over
1160  JSR ASKDN ;get drive#
1170  BMI EX ;execute
1180 ASKDN LDA #'D ;GET DRIVE#
1190  JSR PRINT
1200  LDA #'#
1210  JSR PRINT
1220  JSR GTREC
1230  LDA LBUF
1240  STA ADRDIR+1 ;change D#
1250  STA ADRDOS+1 ;just in case WDS
1260  LDY #6
1270 L4 LDA ADRDIR,Y ;move filename
1280  STA (INBUF),Y
1290  DEY
1300  BPL L4
1310  RTS
1320 PFN LDA #'F ;PROMPT FILENAME
1330  JSR PRINT
1340  LDA #'N
1350  JSR PRINT
1360  LDA #'?
1370  JSR PRINT
1380  JMP GTREC
1390 WDS CMP #'W ;WRITE DOS.SYS
1400  BNE LOD
1410  JSR ASKDN
1420  INY
1430 L5 LDA ADRDOS,Y
1440  STA (INBUF),Y
1450  DEY
1460  BNE L5
1470  JSR OPN
1480  BPL B1
1490 LOD CMP #'L
1500  BNE SAV
1510  STA $FF
1520  JSR PFN
1530  LSR ICBAX ;8>4
1540  JSR OPN
1550 L6 JSR GETCR2 ;get hdr in pairs
1560  LDA #$FF ;check headr and-
1570  CMP FR0 ;disregard #FF'S
1580  BNE SK2
1590  CMP FR0+1
1600  BEQ L6
1610 SK2 JSR FMOVE ;FP0 TO FP1
1620  JSR GETCR2
1630  JSR SUBTR ;subtr HI-LO &execute
1640  JSR CHKIN
1650  BEQ L6
1660 CHKIN LDA $2E3
1670  BEQ SK12
1680  JSR JMPINI
1690  LDA #0
1700  STA $2E3
1710 SK12 RTS
1720 SAV CMP#'S ;SAVE FUNCTION
1730  BNE RUN
1740  JSR PFN
1750  LDY #$FF ;check if append (/)
1760 L7 INY
1770  LDA (INBUF),Y
1780  CMP #'/
1790  BNE SK4
1800  INC ICBAX ;9=append
1810  LDA #$9B
1820  STA (INBUF),Y
1830 SK4 CMP #$9B
1840  BNE L7
1850  JSR OPN ;open for write
1860  LDA #$FF ;start headr
1870  STA FR0
1880  STA FR0+1
1890  JSR PUTCR2 ;write it
1900  JSR INPCON ;get from#
1910  JSR PUTCR2 ;write it
1920  JSR FMOVE ;store it
1930  JSR INPCON ;get to#
1940  JSR PUTCR2 ;write it
1950  JSR SUBTR ;find len and save
1960  BPL B2 ;the rest
1970 RUN CMP #'@ ;RUN
1980  BNE CART
1990  JSR INPCON ;get #
2000  JMP (FR0) ;jump indirectly
2010 CART CMP #'C ;CARTRIDGE
2020  BNE ADOS
2030  JMP WARMST
2040 ADOS CMP#'! ;ESC TO ATARI DUP
2050  BNE HEX
2060  LDA #$40 ;reset DOSINI for no-
2070  STA DOSINI ;trouble later
2080  LDA #$15
2090  STA DOSINI+1
2100  JSR $1540 ;fast reset DOSVEC
2110  JMP OLDDOS
2120 HEX CMP #'$ ;HEX TO DEC
2130  BNE DEC
2140  JSR HASCI ;hex to int
2150  JSR IASC ;int to dec
2160  BPL B2
2170 DEC CMP #'. ;DEC TO HEX
2180  BNE B2
2190  JSR DASCI ;dec to int
2200  JSR IHASC ; int to hex
2210 B2 BPL LSTCNC+2
2220 OPN LDA #OPEN ;IOCB MAIN SETUPS
2230 EXCMD LDX #$10
2240  BNE GTR2
2250 PTREC0 LDX #0
2260 PTREC LDA #PUTR
2270  BNE GTR2
2280 GETREC0
2290 GTREC LDA #GETR
2300 GTR2 STA ICBC,X
2310  LDA #$1E ;max rec length
2320  STA ICBLL,X
2330  LDA #LBUF/HI
2340  STA ICBAH,X
2350  LDA #LBUF&LO
2360 PGIN STA ICBAL,X
2370  LDA #0
2380  STA ICBLH,X
2390 ICB JSR CIO ;let the OS take over
2400  BMI ERR
2410 RTN2 RTS
2420 PUTCR2 LDA #PUTC
2430  BNE GETC2
2440 GETCR2 LDA #GETC
2450 GETC2 LDX #$10
2460  STA ICBC,X
2470  LDA #2
2480 JG STA ICBLL,X
2490  LDA #0
2500  STA ICBAH,X
2510  LDA #FR0
2520  BNE PGIN
2530 CLSE LDA #CLOSE
2540  BPL EXCMD
2550 PRINT STA FR0
2560  LDX #0
2570  LDA #PUTC
2580  STA ICBC,X
2590  LDA #1
2600  BPL JG
2610 ERR CPY #$03 ;ERR next read OK
2620  BEQ RTN2
2630  CPY #$88 ;ERR EOF OK too
2640  BEQ CINI
2650  TYA  ;store ERR
2660  PHA
2670  LDA #$C5 ;inverted E for error
2680  JSR PRINT
2690  JSR FR0Z ;clear FP0
2700  PLA  ;retrieve ERR
2710  STA FR0
2720  JSR IASC ;int to dec
2730 LSTCNC PLA ;clr stack of return
2740  PLA
2750  JMP ST ;do no pass GO
2760 CINI LDA $FF
2770  BEQ LSTCNC
2780  JSR CHKIN
2790 JRUN LDA $2E1
2800  BEQ LSTCNC
2810  JSR JMPRUN
2820  BNE LSTCNC
2830 INPCON LDA #'@ ;HEX OR DEC# TYPE
2840  JSR PRINT ;the @ means AT/TO
2850  JSR GTREC
2860  LDY LBUF
2870  CPY #'.
2880  BEQ DASCI
2890  CPY #'$
2900  BEQ HASCI
2910  BNE ERR ;bad input
2920 DASCI JSR ASCFP ;DEC TO INT
2930  JMP FPI
2940 HASCI JSR FR0Z ;HEX TO INT
2950  LDY #1
2960 LB LDA (INBUF),Y
2970  CMP #$9B
2980  BEQ RTN
2990  SEC  ;convert each digit
3000  SBC #$30
3010  CMP #$0A
3020  BMI SK7
3030  SBC #7
3040 SK7 LDX #4 ;times 16
3050 LA ASL FR0
3060  ROL FR0+1
3070  DEX
3080  BNE LA
3090  ORA FR0 ;add in new bits
3100  STA FR0
3110  INY
3120  BPL LB
3130 RTN RTS
3140 IHASC LDY #0 ;INT TO HEX SUBRT
3150  LDX #1
3160 LC LDA #$F0 ;hi mask
3170  AND FR0,X
3180  LSR A ;roll into low bits
3190  LSR A
3200  LSR A
3210  LSR A
3220  JSR CONVH ;go conv to digit
3230  LDA #$0F ;lo mask
3240  AND FR0,X
3250  JSR CONVH
3260  DEX
3270  BPL LC ;one more time
3280  BMI LE ;set eol and rtn
3290 CONVH CMP #$0A ;INT TO HEX DIGIT
3300  BMI SK9
3310  ADC #6 ;carry set
3320 SK9 ADC #$30 ;carry clr
3330  STA (INBUF),Y
3340  INY
3350  RTS
3360 IASC JSR IFP ;INT TO DEC
3370  JSR FPASC
3380 AREC LDY #0 ;CLR HI BIT/MAKE REC
3390 L9 LDA (INBUF),Y
3400  INY
3410  CMP #$80 ;find hi bit char
3420  BMI L9
3430  AND #$7F ;mask it
3440  DEY
3450  STA (INBUF),Y
3460  INY
3470 LE LDA #$9B ;set EOL
3480  STA (INBUF),Y
3490  JMP PTREC0
3500 SUBTR INC FR0 ;inclusive so inc
3510  BNE SK5 ;TO address
3520  INC FR0+1
3530 SK5 LDX #$10
3540  LDA FR1
3550  STA ICBAL,X
3560  LDA FR1+1
3570  STA ICBAH,X
3580  SEC ;CALC LENGTH
3590  LDA FR0
3600  SBC FR1
3610  STA ICBLL,X ;STORE AT IOCB
3620  LDA FR0+1
3630  SBC FR1+1
3640  JMP ICB+3 ;exec same cmd as last
3650 ;
3660 ;
3670 INIT JSR $1540 ;SRESET INIT
3680 JI LDA #END&LO
3690  STA MEMLO
3700  LDA #END/HI
3710  STA MEMLO+1
3720  LDA #ST&LO
3730  STA DOSVEC
3740  LDA #ST/HI
3750  STA DOSVEC+1
3760  RTS
3770 ;
3780 ;
3790 CMDTAB
3795 ;all spaces are one space
3800  .BYTE ">",$9B,$9B,"SD",$A1
3810  .BYTE " $>",$AE," .>",$A4
3820  .BYTE " SD",$D7," NR",$C0
3830  .BYTE " DO",$CC," VA",$D3
3840  .BYTE "TR",$C3," TM",$C6
3850  .BYTE " SR",$C5," MN",$D2
3860  .BYTE " *N",$D5," KL",$AA
3870  .BYTE " RI",$C4,$9B
3880 TAB1
3890  .BYTE "RE*UF"
3900 TAB2
3910  .BYTE $20,$21,$23,$24,$FE
3920 ADRDIR
3930  .BYTE "D1:*.*",$9B
3940 ADRDOS
3950  .BYTE "D1:DOS.SYS",$9B
3960 END
3965 ;end after boot init executed
3970 ;
3980 ;
3990 INIT1 LDA #INIT&LO ;BOOT INIT
4000  STA DOSINI
4010  LDA #INIT/HI
4020  STA DOSINI+1
4030  JMP JI
4040 ;
4050 ;
4060  *= $2E2 ;LOAD AND GO INIT ADR
4070  .WORD INIT1
4080  .END

.