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