10 REM > ROMBasic 1.01
   20 REM Put BASIC program into sideways ROM module
   30 REM 1.00 05-Feb-2016 J.G.Harston
   40 REM 1.01 27-Jan-2024 Workaround for pre-BASIC IV
   50 :
   60 DIM S% 500:T%=S%
   70 INPUT "BASIC file:       "in$
   80 INPUT "Output ROM file:  "fname$
   90 INPUT "Command name:     "cmd$
  100 INPUT "Version string:   "ver$
  110 INPUT "Copyright string: (C)"cpy$
  120 PROCp(in$):PROCp(fname$):PROCp(cmd$):PROCp(ver$):PROCp(cpy$)
  130 CLEAR:DIM S% T%-S%:PROCassem(0):CLEAR:DIM S% T%-S%:PROCassem(2):PROCsm_table
  140 A$="*SAVE "+fname$+" "+STR$~(mcode%+M%)+" "+STR$~O%+" FFFF0000 FFFBBC00"
  150 PRINTA$;:OSCLIA$:PRINT
  160 END
  170 :
  180 DEFPROCp(A$):$T%=A$:T%=T%+LEN$T%+1:ENDPROC
  190 DEFFNg:B%=T%:T%=T%+LEN$T%+1:=$B%
  200 DEFPROCassem(pass%)
  210 T%=S%:in$=FNg:fname$=FNg:cmd$=FNg:ver$=FNg:cpy$=FNg
  220 ver%=VALver$:IFMID$(ver$,2,1)=".":ver%=16*VALLEFT$(ver$,1)+VALMID$(ver$,3,1)
  230 in%=OPENIN(in$):IFin%=0:PRINT"File '"in$"' not found":END
  240 size%=EXT#in%:CLOSE#in%
  250 DIM mcode% size%*2.5+300,L% -1
  260 OSWRCH=&FFE3:OSNEWL=&FFE7:OSBYTE=&FFF4:OS_CLI=&FFF7
  270 FOR pass%=pass% TO pass%+1
  280   opt%=FNsm_pass(pass%)+8+16
  290   [OPT opt%
  300   .RomStart
  310   BRK:EQUW RelocTable
  320   JMP Service
  330   EQUB &82:EQUB Copyright-RomStart
  340   .RomTitle
  350   EQUB ver%:EQUS cmd$
  360   EQUB &00 :EQUS ver$
  370   .Copyright
  380   EQUB &00:EQUS "(C)"+cpy$:EQUB 0
  390   :
  400   .Service
  410   CMP #4:BEQ Serv4          :\ *command
  420   CMP #9:BNE NotServ9       :\ Not *Help
  430   LDA (&F2),Y
  440   CMP #13:BNE Serv9Skip     :\ Not *Help <cr>
  450   JSR OSNEWL:LDX #0
  460   .Serv9Lp
  470   LDA RomTitle+1,X          :\ Print ROM title
  480   BNE P%+4:LDA #ASC" "      :\ Convert &00 to <spc>
  490   CMP #ASC"(":BEQ Serv9Done :\ End at '('
  500   JSR OSWRCH:INX:BNE Serv9Lp
  510   .Serv9Done
  520   JSR OSNEWL
  530   .Serv9Skip
  540   LDA #9
  550   .NotServ9
  560   RTS
  570   :
  580   .Serv4
  590   LDA &27A:BNE Serv4Exit       :\ Tube present, ignore
  600   TYA:PHA:DEY:LDX #&FF
  610   .Serv4Lp
  620   INX:INY:LDA (&F2),Y
  630   CMP #ASC".":BEQ Serv4Dot
  640   CMP #ASC"!":BCC Serv4End
  650   CMP RomTitle+1,X:BEQ Serv4Lp :\ Match with ROM title
  660   EOR #&20                     :\ Change case
  670   CMP RomTitle+1,X:BEQ Serv4Lp :\ Match with ROM title
  680   .Serv4Quit
  690   PLA:TAY                      :\ Restore Y
  700   .Serv4Exit
  710   LDA #4:RTS                   :\ Restore A and return unclaimed
  720   .Serv4End
  730   LDA RomTitle+1,X:BNE Serv4Quit
  740   DEY
  750   .Serv4Dot
  760   INY                          :\ Step past '.'
  770   :
  780   LDX #&FF
  790   .TreeLp1
  800   INX:LDA RomTitle+1,X         :\ Copy command name to string buffer
  810   STA &600,X:BNE TreeLp1
  820   .TreeLp2
  830   LDA (&F2),Y:STA &600,X       :\ Copy parameters
  840   INY:INX:CMP #13:BNE TreeLp2
  850   LDA #22:JSR OSWRCH           :\ MODE 7
  860   LDA #7:JSR OSWRCH
  870   LDA #&83:JSR OSBYTE
  880   STX &A8:STY &A9:LDY #3
  890   .TreeLp3
  900   LDA src-1,Y:STA &A9,Y
  910   DEY:BNE TreeLp3
  920   .TreeLp4
  930   LDA (&AA),Y:STA (&A8),Y
  940   INY:BNE TreeLp4
  950   INC &A9:INC &AB
  960   DEC &AC:BNE TreeLp4
  970   SEI:LDA #15:LDX #0:JSR OSBYTE
  980   LDX #6
  990   .TreeLp5
 1000   TXA:PHA
 1010   LDA Basic,X:STA &100,X
 1020   LDY Text,X
 1030   LDX #0:LDA #138:JSR OSBYTE
 1040   PLA:TAX:DEX:BPL TreeLp5
 1050   CLI:LDX #0:LDY #1:JMP OS_CLI
 1060   .Text
 1070   EQUS CHR$13+"NUR"+CHR$13+".O"
 1080   .Basic
 1090   EQUS "BASIC"+CHR$13
 1100   :
 1110   .src
 1120   EQUW src+3:EQUB (size%+255)DIV256
 1130   .file
 1140   ]
 1150   IF O%+size%<L%:OSCLI"Load "+in$+" "+STR$~O% ELSE PRINT"Data overrun"
 1160   P%=P%+size%:O%=O%+size%:RelocTable=P%
 1170 NEXT:ENDPROC
 1180 :
 1190 DEFFNsm_pass(pass%)
 1200 IFpass%=0:M%=0
 1210 IFpass%=1:M%=O%-mcode%
 1220 P%=&8100-128*(pass%AND2)
 1230 O%=mcode%+M%*(pass%AND2)DIV2
 1240 IFpass%=1:IF O%+M%*2.125>L%:PRINT"Code overrun":END
 1250 =VALMID$("4646",pass%+1,1)
 1260 :
 1270 DEFPROCsm_table
 1280 base80%=mcode%+M%:base81%=mcode%:byte%=0:count%=0:off%=0:REPEAT
 1290   byte80%=base80%?off%:byte81%=base81%?off%:IF off%>=M%:byte80%=&80:byte81%=&80
 1300   IF ((byte81%-byte80%) AND &FE)<>0:PRINT "ERROR: Offset by more than one page at &";~&8000+off%
 1310   IF (byte80% AND &C0)=&80:byte%=byte%DIV2+128*(byte81%-byte80%):count%=count%+1
 1320   IF count%=8:?O%=byte%:O%=O%+1:byte%=0:count%=0
 1330 off%=off%+1:UNTILoff%>=M% AND count%=0
 1340 ENDPROC