10
20
30
40
50
60
70
80
90
100
110
120
130
140
150
160
170
180 :
190 IFPAGE<>&3B00:PRINT"Wrong version of BASIC":END
200 test%=FALSE:VER$="1.26":DATE$="01 Mar 2009"
210 PROCassm1:PROCassm2
220 END
230 :
240 DEFPROCassm1
250 OSFILE=&FFDD:OSFIND=&FFCE:OSBPUT=&FFD4
260 OSBGET=&FFD7:OSARGS=&FFDA:OSGBPB=&FFD1:OSRDCH=&FFE0
270 OSWRCH=&FFEE:OSWORD=&FFF1:OSBYTE=&FFF4:oscli=&FFF7
280 ctrl=&374D
290 :
300
310 ChkEscape=&366E
320 :
330 FOR P=0 TO 1
340 P%=FNaddr(&011B):[OPT P*3 :\ Pass command to OSCLI
350 JP oscli:]
360 :
370 P%=FNaddr(&0143):[OPT P*3 :\ Get host environment
380 CALL InitEnv:]
390 :
400 P%=FNaddr(&019D):[OPT P*3 :\ Print '>' prompt
410 CALL PrPrompt:]
420 :
430 P%=FNaddr(&01D6):[OPT P*3 :\ Input a line
440 CALL RdLine:]
450 :
460 P%=FNaddr(&06A1):[OPT P*3 :\ Check for Escape
470 CALL ChkEscape:]
480 :
490 P%=FNaddr(&07A6):[OPT P*3 :\ Look for Save filename
500 CALL SaveFindName:]
510 :
520 P%=FNaddr(&07FE):[OPT P*3 :\ In error handler
530 NOP:NOP:NOP:]
540 P%=FNaddr(&080A):[OPT P*3
550 NOP:NOP:NOP:NOP:NOP:]
560 :
570 P%=FNaddr(&095A):[OPT P*2 :\ Print char
580 CALL OSWRCH:]
590 :
600 P%=FNaddr(&0DAE):[OPT P*3 :\ Check for Escape
610 CALL ChkEscape:]
620 :
630 P%=FNaddr(&0D06):[OPT P*3 :\ Check for EXT#= as well as PTR#=
640 DEFW SetExtPtr:]
650 :
660 P%=FNaddr(&0DDC):[OPT P*3 :\ Don't CLOSE#0 on END
670 NOP:NOP:NOP:]
680 :
690 P%=FNaddr(&0E18):[OPT P*3 :\ OSCLI
700 CALL oscli:]
710 :
720 P%=FNaddr(&0E20):[OPT P*3 :\ *command
730 CALL oscli:]
740 :
750 P%=FNaddr(&0E63):[OPT P*3 :\ Check for Escape
760 CALL ChkEscape:]
770 :
780 P%=FNaddr(&0F8E):[OPT P*3 :\ PRINT#
790 PUSH DE:CALL &1E46:EX AF,AF'
800 JP M,PrString
810 POP DE:PUSH BC
820 CP 5:JP Z,PrReal :\ &05=real, &04=int
830 LD A,&40:CALL &328E :\ &40=Integer
840 CALL PutH1:CALL PutL1
850 CALL PutH2:CALL PutL2
860 POP BC:JR FNaddr(&0F84) :\ Loop for next item
870 :
880 .PrString
890 LD H,&38:LD L,E:POP DE
900 XOR A:CALL &328E :\ &00=String
910 LD A,L:CALL &328E :\ Length
920 .PrStringLp
930 INC L:DEC L:JR Z,FNaddr(&0F84)
940 DEC L:LD A,(HL):CALL &328E :\ Char
950 JR PrStringLp
960 :
970 NOP:NOP:NOP:NOP :\ Four spare bytes
980 ]:PROCchk(&0FCC)
990 :
1000 P%=FNaddr(&12E9):[OPT P*3 :\ INPUT#
1010 PUSH AF:PUSH HL
1020 OR A:JP M,InpString
1030 CALL &32AB:CP &FF:JP Z,InpReal
1040 CALL GetH1:CALL GetL1
1050 CALL GetH2:CALL GetL2
1060 LD C,0
1070 .AssignVal
1080 POP IX:POP AF
1090 PUSH DE:CALL &15EA:POP DE
1100 JR FNaddr(&12D7) :\ Loop to fetch another item
1110 :
1120 .InpString
1130 CALL &32AB:CALL &32AB :\ Fetch Type,Length
1140 PUSH AF:LD L,A:LD H,&38
1150 .InpStringLp
1160 INC L:DEC L:JP Z,InpStrEnd
1170 DEC L:CALL &32AB:LD (HL),A :\ Char
1180 JR InpStringLp
1190 :
1200 .PrPrompt
1210 LD A,&3E:JP OSWRCH :\ Print '>' prompt
1220 ]:PROCchk(&132A)
1230 :
1240 P%=FNaddr(&13A3):[OPT P*3 :\ No SPC before INPUT
1250 JR FNaddr(&13A8):]
1260 :
1270 P%=FNaddr(&13AF):[OPT P*3 :\ Input a line
1280 CALL RdLine:]
1290 :
1300
1310
1320 :
1330 P%=FNaddr(&149B):[OPT P*3 :\ PTR#=, EXT#=
1340 JP WriteArgs:]
1350 :
1360 P%=FNaddr(&14B0):[OPT P*3 :\ Check TIME=/TIME$=
1370 JP SetTime:]
1380 :
1390 P%=FNaddr(&1521):[OPT P*3 :\ VDU x,
1400 CALL OSWRCH:]
1410 :
1420 P%=FNaddr(&1530):[OPT P*3 :\ VDU x
1430 CALL OSWRCH:]
1440 :
1450 P%=FNaddr(&1D8A):[OPT P*3 :\ Separate OPENIN/OPENUP/OPENOUT
1460 DEFW openin:]
1470 P%=FNaddr(&1DC8):[OPT P*3
1480 DEFW openup:DEFW openout:]
1490 :
1500 P%=FNaddr(&1FDC):[OPT P*3 :\ Check for functions in &C6+ range
1510 JP NC,CheckFunction:]
1520 :
1530 P%=FNaddr(&2192):[OPT P*3
1540 LD A,13:LD (DE),A:POP AF :\ CR-terminate OPEN string
1550 LD HL,&3800:CALL OSFIND :\ Call OSFIND to open
1560 ]
1570 :
1580 P%=FNaddr(&21AF):[OPT P*3 :\ Check =TIME/=TIME$
1590 JP GetTime:]
1600 :
1610 P%=FNaddr(&264C):[OPT P*3 :\ =GET/GET$
1620 CALL OSRDCH:]
1630 :
1640 P%=FNaddr(&3169):[OPT P*3
1650 .OsfileHigh
1660 LD A,&82:CALL OSBYTE :\ Get addr high word
1670 LD (ctrl+4),HL:RET
1680 :
1690 ]:PROCchk(&3172):[OPT P*3 :\ Save BASIC program
1700 CALL SaveTryOsfile:RET NC :\ Try using OSFILE
1710 CALL SaveCreate :\ Create an empty file
1720 LD A,&80:CALL OSFIND :\ Open file for output
1730 AND A:JP Z,CantOpen
1740 LD H,A:LD A,13:CALL OSBPUT :\ Initial CR
1750 CALL SaveWriteLp :\ Save with BPUTs
1760 XOR A:JP OSFIND
1770 :
1780 .SaveWriteLp :\ Save program using BPUTs
1790 LD A,(DE):AND A :\ Get LEN
1800 LD A,&FF:JP Z,OSBPUT :\ If &00, output end-of-prog and return
1810 INC DE:INC DE :\ Point to HI
1820 CALL PutByte :\ Put HI
1830 CALL PutByteDec :\ Put LO
1840 CALL PutByteDec :\ Put LEN
1850 INC DE:INC DE:INC DE :\ Point to text
1860 .SaveWrite
1870 CALL PutByte:INC DE :\ Put each byte
1880 CP 13:JR NZ,SaveWrite
1890 JR SaveWriteLp
1900 :
1910 .PutByteDec
1920 DEC DE
1930 .PutByte
1940 LD A,(DE):JP OSBPUT
1950 :
1960 .report
1970 CALL &FFE7:JP &0CE2 :\ Put NL before REPORT
1980 :
1990 NOP:NOP :\ Two spare bytes
2000 :
2010 ]:PROCchk(&31BB):[OPT P*3 :\ Load BASIC program =&31BB
2020 LD (ctrl),HL:LD (ctrl+2),DE :\ HL=>filename, DE=address
2030 CALL OsfileHigh
2040 XOR A:LD (ctrl+6),A
2050 DEC A:CALL CallOsfile :\ Load to PAGE (was +1)
2060 PUSH DE:POP HL :\ DE=load, HL=PAGE
2070 LD A,(DE):CP 13:JR NZ,LoadOk:\ Z80-style BASIC program
2080 INC DE :\ 6502-style program has to be reordered
2090 .LoadLoop :\ HL=><CR>+1, DE=><CR>+1
2100 INC DE:INC DE:LD A,(DE):LD (HL),A:\ LEN
2110 DEC DE:LD A,(DE):LD B,A :\ LO
2120 DEC DE:LD A,(DE) :\ HI
2130 INC HL:LD (HL),B :\ LO
2140 INC HL:LD (HL),A :\ HI
2150 INC A:JR Z,LoadEnd :\ End of BASIC program
2160 INC H:JR Z,LoadEnd :\ Gone past top of memory
2170 DEC H:JR LoadLine
2180 :
2190 ]:PROCchk(&31EB):[OPT P*3 :\ CLOSE =&31EB
2200 XOR A:LD H,E:JP OSFIND
2210 :
2220 .LoadLine :\ HL=>HI(80), DE=>HI(65)
2230 INC DE:INC DE:INC DE :\ DE=>TEXT(65)
2240 DEC HL:DEC HL :\ HL=>LEN(80)
2250 .LoadLineSpc
2260 LD A,(DE):CP 32:JR NZ,LoadLineText
2270 DEC (HL):INC DE:JR LoadLineSpc:\ Skip space, dec length
2280 .LoadLineText
2290 INC HL:INC HL:INC HL :\ HL=>TEXT(80)
2300 .LoadTextLoop
2310 LD A,(DE):LD (HL),A :\ Copy text
2320 INC HL:INC DE
2330 CP 13:JR NZ,LoadTextLoop :\ HL=>(CR)+1, DE=>(CR)+1
2340 JR LoadLoop
2350 :
2360 .LoadEnd
2370 DEC HL:DEC HL:LD (HL),0
2380 .LoadOk
2390 SCF:RET :\ Flag OK and exit
2400 :
2410 .SaveCreate :\ Try to create empty file
2420 LD (ctrl),HL:PUSH HL
2430 PUSH DE:XOR A:LD E,A:CALL OSARGS
2440 CP 4:JR C,SaveCreateTape :\ CFS, can't create
2450 POP DE:PUSH DE:INC DE
2460 LD (ctrl+10),DE
2470 EX DE,HL:INC HL:ADD HL,BC
2480 .SaveOsfile
2490 LD (ctrl+14),HL:CALL OsfileHigh
2500 LD (ctrl+12),HL:LD (ctrl+16),HL
2510 LD HL,&FFFF
2520 LD (ctrl+4),HL:LD (ctrl+8),HL
2530 LD HL,&FB00:LD (ctrl+2),HL
2540 LD H,0:LD (ctrl+6),HL
2550 XOR A:CALL CallOsfile:AND A
2560 .SaveCreateTape
2570 POP DE:POP HL:RET :\ On return, C=CFS, NC=DISK, etc
2580 :
2590 .CallOsfile
2600 LD HL,ctrl:JP OSFILE
2610 :
2620 .CantOpen
2630 LD A,192:CALL &07D6:DEFM "Can't save file":NOP
2640 :
2650 .openin :LD A,&40:JR open
2660 .openout:LD A,&80:JR open
2670 .openup :LD A,&C0:.open:JP &218E
2680 :
2690 .WriteArgs
2700 POP BC :\ BC=0/18 EXT/PTR, A=chn, DEHL=value
2710 LD (ctrl+2),DE:LD E,A
2720 LD A,C:AND A:LD A,1 :\ If C<>0, do PTR=
2730 JR NZ,WriteArgs2:LD A,3 :\ C=0, do EXT=
2740 .WriteArgs2
2750 CALL CallArgsHL:JP &0DAA
2760 NOP
2770 :
2780 ]:PROCchk(&328E):[OPT P*3 :\ BPUT =&328E
2790 PUSH HL:LD H,E:CALL OSBPUT
2800 POP HL:RET
2810 :
2820 .CheckFunction
2830 CP &EB:JR Z,FuncRdMode
2840 CP &E0:JR Z,FuncRdEnd
2850 CP &F6:JP Z,FuncRdReport
2860 JP &2186 :\ Unrecognised extra function - Mistake
2870 :
2880 .FuncRdEnd
2890 LD HL,(&3AE2):JP &2186
2900 :
2910 ]:PROCchk(&32AB):[OPT P*3 :\ BGET =&32AB
2920 PUSH HL:LD H,E:CALL OSBGET
2930 POP HL:RET
2940 :
2950 .FuncRdMode
2960 LD A,&87:CALL &FFF4
2970 LD L,H:JP &2184
2980 :
2990 .EofEnd
3000 LD A,127:LD L,E
3010 CALL OSBYTE:LD A,L
3020 CPL:AND A:RET
3030 ]:PROCchk(&32C5):[OPT P*3 :\ =EOF =&32C5
3040 JR EofEnd
3050 :
3060 NOP:NOP:NOP:NOP:NOP :\ five spare bytes
3070 :
3080 ]:PROCchk(&32CC):[OPT P*3 :\ =EXT =&32CC
3090 LD A,2
3100 .ReadArgs
3110 LD HL,0:LD (ctrl+2),HL
3120 CALL CallArgsHL
3130 LD HL,(ctrl)
3140 LD DE,(ctrl+2):RET
3150 :
3160 .OsByte00
3170 LD HL,0:JP OSBYTE :\ Osbyte A,0,0
3180 :
3190 ]:PROCchk(&32E5):[OPT P*3 :\ =PTR =&32E5
3200 XOR A:JR ReadArgs
3210 :
3220 .CheckCommand
3230 CP &95:JP Z,&0E5F :\ Enter assembler
3240 CP &DC:JP NZ,&0E41 :\ Not EXT=
3250 LD C,0 :\ Flag this is EXT=
3260 .SetExtPtr
3270 PUSH BC:JP &148C :\ Save cmd, evaluate
3280 :
3290 .CallArgsHL
3300 LD (ctrl),HL
3310 LD HL,ctrl:JP OSARGS
3320 :
3330 .GetTime :\ =TIME$/TIME
3340 LD A,(IY+0):CP ASC"$"
3350 JR Z,GetDate
3360 CALL &2FC0:JP &21B2
3370 .GetDate
3380 INC IY
3390 LD HL,&3800:LD (HL),0
3400 LD A,14:CALL &FFF1
3410 LD A,(HL):LD E,A
3420 AND A:JR Z,GetDate2
3430 LD E,24:.GetDate2
3440 LD D,&38:LD A,&80:RET
3450 :
3460 .SetTime :\ TIME$/TIME=
3470 LD A,(IY+0):CP ASC"$"
3480 JR Z,SetDate
3490 CALL &1758:JP &14B3
3500 .SetDate
3510 INC IY:CALL &1758
3520 CALL &1F5F:\ get string
3530 LD A,E:AND A:JR Z,SetDateNull
3540 PUSH DE:LD H,D:LD L,E
3550 LD C,E:LD B,0:DEC HL
3560 LDDR:POP DE
3570 .SetDateNull
3580 LD HL,&3800:LD (HL),E
3590 LD A,15:CALL &FFF1
3600 JP &0DAA
3610 :
3620 .FuncRdReport :\ =REPORT
3630 LD A,(IY+0):CP ASC"$"
3640 JR NZ,RdReport:INC IY
3650 .RdReport
3660 LD HL,(&3AEE):LD DE,&3800
3670 .RdReportLp
3680 LD A,(HL):LD (DE),A
3690 INC DE:INC HL
3700 BIT 7,E:JR NZ,RdReportEnd
3710 AND A:JR NZ,RdReportLp
3720 DEC E
3730 .RdReportEnd
3740 LD A,&80:RET
3750 :
3760 .PrReal
3770 LD A,&FF:CALL &328E :\ &FF=real
3780 CALL PutL2:CALL PutH2
3790 CALL PutL1:CALL PutH1
3800 POP BC:LD A,C:AND A
3810 JR Z,PrRealExp:INC A :\ Put exponent into 6502 form
3820 .PrRealExp
3830 CALL &328E:JP &0F84
3840 :
3850 .PutH1:LD A,H:JP &328E
3860 .PutL1:LD A,L:JP &328E
3870 .PutH2:EXX:LD A,H:EXX:JP &328E
3880 .PutL2:EXX:LD A,L:EXX:JP &328E
3890 :
3900 .InpStrEnd
3910 POP AF:LD L,A
3920 POP IX:POP AF:PUSH DE:EX DE,HL
3930 CALL &1611:POP DE:JP &12D7
3940 .InpReal
3950 CALL GetL2:CALL GetH2
3960 CALL GetL1:CALL GetH1
3970 CALL &32AB:LD C,A
3980 CP 2:JP C,AssignVal
3990 DEC C
4000 JP AssignVal
4010 :
4020 .GetH1:CALL &32AB:LD H,A:RET
4030 .GetL1:CALL &32AB:LD L,A:RET
4040 .GetH2:CALL &32AB:EXX:LD H,A:EXX:RET
4050 .GetL2:CALL &32AB:EXX:LD L,A:EXX:RET
4060 :
4070 .SaveFindName
4080 LD A,(IY+0):CP 13:JP NZ,&1F5F
4090 LD HL,(&3ADC):INC HL:INC HL:INC HL
4100 CALL SaveSkipSpc:CP &F4:JP NZ,&1F5F
4110 CALL SaveSkipSpc:CP ASC">":JP NZ,&1F5F
4120 LD DE,&3800
4130 .SaveName3
4140 LD A,(HL):LD (DE),A:INC DE:INC HL
4150 CP 13:JR NZ,SaveName3:RET
4160 .SaveSkipSpc
4170 LD A,(HL):INC HL:CP 32:JR Z,SaveSkipSpc
4180 RET
4190 :
4200 .SaveTooBig
4210 POP HL:SCF:RET
4220 :
4230 .SaveTryOsfile :\ Try saving with OSFILE
4240 PUSH HL:LD HL,(&3AE2) :\ END
4250 ADD HL,BC:JR C,SaveTooBig
4260 LD A,H:INC A
4270 LD HL,0:ADD HL,SP
4280 CP H:JR NC,SaveTooBig
4290 POP HL:LD (ctrl),HL
4300 LD HL,(&3AE2):LD (HL),13:INC HL
4310 .SaveCopy
4320 INC DE:INC DE:LD A,(DE):LD (HL),A:INC HL
4330 CP &FF:JR Z,CopyEnd
4340 DEC DE:LD A,(DE):LD (HL),A:INC HL
4350 DEC DE:LD A,(DE):LD (HL),A
4360 AND A:JR Z,CopyEndZero
4370 INC HL:INC DE:INC DE:INC DE
4380 .CopyLine
4390 LD A,(DE):LD (HL),A:INC HL
4400 INC DE:CP 13:JR NZ,CopyLine
4410 JR SaveCopy
4420 .CopyEndZero
4430 DEC HL:DEC HL
4440 LD (HL),&FF:INC HL
4450 .CopyEnd
4460 LD DE,(&3AE2):LD (ctrl+10),DE
4470 PUSH HL:PUSH HL:JP SaveOsfile
4480 :
4490 .Error1
4500 LD HL,(&FF82):PUSH HL :\ Push FAULT pointer
4510 .Error2
4520 POP HL:LD A,(HL):INC HL :\ Get error number
4530 PUSH HL:JP &07D6 :\ Register error
4540 :
4550 .ChkEscape
4560 LD A,(&FF80):OR A:RET P :\ No Escape state
4570 .MkEscape
4580 LD A,&7E:CALL OSBYTE
4590 JP &0E84 :\ Generate Escape error
4600 :
4610 .InitEnv
4620 LD A,&C3:LD (&38),A :\ Init RST &38 vector
4630 LD HL,Error2:LD (&39),HL
4640 LD HL,Error1:LD (&FFFA),HL :\ Init BRKV vector
4650 LD A,&E5:CALL OsByte00
4660 LD A,&E6:CALL OsByte00
4670 CALL GetCmdLine:PUSH AF :\ Save cmd flag
4680 LD A,&84:CALL OSBYTE:EX DE,HL :\ DE=MEMTOP -> HIMEM
4690 LD A,&83:CALL &FFF4 :\ HL=MEMBOT -> PAGE
4700 LD L,0:LD A,H:CP &3B :\ Check if MEMBOT is too low
4710 JR NC,InitPageOk
4720 LD H,&3B :\ Force MEMBOT=end of ws
4730 .InitPageOk
4740 POP AF:RET :\ NZ=param present
4750 :
4760 .RdLine :\ Read a line of input
4770 LD IX,&374D
4780 LD (IX+0),L:LD (IX+1),H
4790 LD (IX+2),&FF :\ max=255 chars
4800 LD (IX+3),&20:LD (IX+4),&FF :\ chars &20-&FF
4810 LD A,&DA:CALL OsByte00 :\ Clear scroll counter
4820 XOR A:LD HL,&374D:CALL OSWORD :\ Read line
4830 JR C,MkEscape:XOR A:RET :\ Generate Escape if escape set
4840 :
4850 .GetCmdLine :\ Final code, so expandable
4860 XOR A:LD DE,&3800:LD HL,&80 :\ DE=strbuf, HL=cmdbuf
4870 LD C,(HL):INC HL :\ Get cmd length
4880 CP C:JR Z,GetNoCmd:LDIR :\ Copy command pars if present
4890 .GetNoCmd
4900 EX DE,HL:LD (HL),13:RET :\ Put terminating <cr>
4910 :
4920 .SpareStart :\ Where spare space starts
4930 ]NEXT
4940 :
4950 P%=FNaddr(&0E3D):[OPT P*3:JP CheckCommand:NOP:]
4960
4970
4980 :
4990 PRINT"Saving Z80BAS"
5000 IF NOT test% OSCLI"**SAVE Z80BAS 100 "+STR$~SpareStart
5010 ENDPROC
5020 DEFFNaddr(A%):IF test% THEN =A%+&A000 ELSE =A%
5030 DEFPROCchk(A%):IFP%-(test% AND&A000)<>A%:PRINT"Misalignment at ";~A%;" (";~P%;")"
5040 ENDPROC
5050 :
5060 DEFPROCassm2
5070 DIM mcode% &11F:start=&B000
5080 ServStart=SpareStart
5090 Patch=&F5AE :
5100 ExecPatch=&F823 :
5110 FOR P=0 TO 1
5120 P%=start:O%=mcode%
5130 [OPT P*3+4
5140 JR LangZ80:DEFB &B0
5150 DEFB &4C:DEFW &8000+ServStart
5160 DEFB &E8
5170 DEFB copy-start
5180 DEFB VAL VER$
5190 DEFM "Z80 BASIC"
5200 DEFB 0
5210 DEFM VER$+" ("+DATE$+")"
5220 .copy
5230 DEFB 0
5240 DEFM "(C)J.G.Harston"
5250 DEFB 0
5260 DEFW start:DEFW 0
5270 DEFB 0:\ Align to &803A:
5280 \
5290 \ This point NEEDS TO BE at &803A
5300 \ For 6502/Z80 lang entry to work
5310 .LangZ80
5320 LD HL,start+&100:LD DE,&100
5330 LD BC,&3660:LDIR :\ Copy language part to TPA
5340 LD A,&2A:LD (&F8E4),A :\ LD HL,(nn) opcode
5350 LD HL,6:JR LangX:NOP
5360 :
5370 \ This point NEEDS TO BE at &B050
5380 \ For 6502/Z80 lang entry to work
5390 \ Lang6502
5400 DEFB &A2:DEFB &00 :\ LDX #0
5410 DEFB &20:DEFW PrMessage-&3000 :\ JSR PrMessage
5420 DEFB &AE:DEFW &190+187 :\ LDX OS_Basic
5430 DEFB &E4:DEFB &F4 :\ CPX &F4
5440 DEFB &D0:DEFB &01 :\ BNE P%+3
5450 DEFB &CA :\ DEX
5460 DEFB &A9:DEFB &8E :\ LDA #142
5470 DEFB &4C:DEFW &FFF4 :\ JMP OSBYTE
5480 :
5490 .PrMessage
5500 DEFB &BD:DEFW &8000+ServStart+3:\ LDA MsgBase,X
5510 DEFB &F0:DEFB &06 :\ BEQ PrMsgEnd
5520 DEFB &20:DEFW &FFE3 :\ JSR OSASCI
5530 DEFB &E8 :\ INX
5540 DEFB &D0:DEFB &F5 :\ BNE PrMessage
5550 DEFB &60 :\ RTS
5560 :
5570 \DEFB &4C:\DEFW &8000+ServStart+3:\ JMP &B783
5580 :
5590 .LangX
5600 LD (&F8E5),HL :\ Make Osbyte84 do LD HL,(6)
5610 LD A,&C3:DEC HL:LD (HL),A :\ Put JP opcode at &0005
5620 LD HL,&E9E1:LD (&E),HL :\ Create LD HL,PC at &E
5630 LD HL,&1919:LD (&FC83),HL :\ Set correct length for
5640 LD (&FC96),HL :\ Osword14,15
5650 LD HL,&F000:LD (&6),HL :\ Put JP HIMEM at &0005
5660 LD DE,Header:LD BC,15
5670 EX DE,HL:LDIR :\ Copy header to HIMEM
5680 :
5690 LD DE,Patch+1:LD (&FFF8),DE :\ Redirect OSCLI to patched code
5700 DEC DE :\ Point to Patch area
5710 LD BC,PatchEnd-PatchStart:LDIR:\ Copy Patch code
5720 LD DE,ExecPatch:LD BC,6:LDIR:\ Patch RunExec code
5730 :
5740 XOR A:LD (&FCA3),A :\ Turn full OSCLI on
5750 LD (&80),A:LD A,&80 :\ Look for command line
5760 LD HL,GBPBTable:CALL &FFD1 :\ &80 will have length, &81.. name
5770 :
5780 LD A,90:LD HL,&0209:CALL &FFF4:\ Ask myself if Break occured
5790 BIT 6,L:LD A,138:LD HL,&CA00:\ and restore Break type
5800 CALL NZ,&FFF4 :\ *FX138,0,&CA if Break occured
5810 EI:JP &100 :\ Enter Z80Basic
5820 :
5830 .Header
5840 RET:RET:RET:JP &FFB9:DEFB &E8:NOP
5850 DEFB 3:DEFM "BASIC":NOP
5860 :
5870 .PatchStart
5880 RET :\ Kill INIT_FF routine
5890 .NewOsc
5900 LD (Patch+&C),SP:LD SP,&F60E:\ Patch OSCLI code
5910 CALL &F6B7:LD SP,0:RET :\ Save SP, call, and restore
5920 :
5930 .RunExec1
5940 POP HL :\ Enter pure code - balance stack
5950 .RunExec2
5960 JP Z,&F4A9 :\ Check ROM header - not Z80 code
5970 CP A:LD HL,(&FCA8): :\ Z=1, flag stack as balanced
5980 JP (HL) :\ Enter code
5990 .PatchEnd
6000 :
6010 JP RunExec2-PatchStart+Patch:\ Check ROM code
6020 JP RunExec1-PatchStart+Patch:\ Balance stack
6030 :
6040 .GBPBTable
6050 DEFB 0:DEFW &80:DEFW 0
6060 \DEFW 0:\DEFW 0:\DEFW 0:\DEFW 0:\ This can be trimmed to fit
6070 :
6080 DEFM STRING$(&B100-P%,CHR$0)
6090 :
6100 \ Must be within &B100
6110 ]NEXT
6120 PRINT'"Saving Z80 BASIC base code"
6130 IF NOT test% OSCLI"**SAVE Z80R1 "+STR$~mcode%+" "+STR$~O%+" "+STR$~start+" "+STR$~start
6140 ENDPROC