Name !gameMTX.Magrom2 ; MAGROM 2 source code ; V0 01 First attempt to load miltipart MTX Files ; V0.02 Basic laoder, Chunks of the basic/OS copied from Memotech source need to be at specific addresses ; V0.03 High memory wedge to replace call to &0AAE ; V0.04 Graphic 2 loading screen ; V0.05 loading speed improvements page_port EQU 0 port EQU &FB ;complete system variables list CTRBADR EQU &FA52 LSTPG EQU &FA7A VARNAM EQU &FA7B VALBOT EQU &FA7D CALCBOT EQU &FA7F CALCST EQU &FA81 KBDBUF EQU &FA83 USYNT EQU &FA85 USER EQU &FA89 spare_var EQU &FA8C IOPL EQU &FA8F REALBY EQU &FA90 KBFLAG EQU &FA91 STKLIM EQU &FA92 SYSTOP EQU &FA94 SSTACK EQU &FA96 USERINT EQU &FA98 NODLOC EQU &FA9B FEXPAND EQU &FA9E USERNOD EQU &FAA1 NBTOP EQU &FAA4 NBTPG EQU &FAA6 BASTOP EQU &FAA7 BASTPG EQU &FAA9 BASBOT EQU &FAAA BASTPO EQU &FAAC ARRTOP EQU &FACC BASELIN EQU &FACF BASLNP EQU &FAD1 PAGE EQU &FAD2 CRNTPG EQU &FAD3 PGN1 EQU &FAD4 PGN2 EQU &FAD5 PGTOP EQU &FAD6 GOSTACK EQU &FAD8 GOPTR EQU &FB41 GOSNUM EQU &FB43 FORCOUNT EQU &FB44 CTYSLT EQU &FB45 DATAAD EQU &FB46 DATAPG EQU &FB48 DESAVE EQU &FB49 START EQU &FB4B SETCALL EQU &FD48 RICHJL EQU &FD4B USRRST EQU &FD4E USERIO EQU &FD51 USERROR EQU &FD54 CLOCK EQU &FD57 INTFFF EQU &FD5E CASBAUD EQU &FD5F MIDVAL EQU &FD60 RETSAVE EQU &FD61 VAZERO EQU &FD65 VERIF EQU &FD67 TYPE EQU &FD68 CONTFLG EQU &FD69 CONTAD EQU &FD6A CONTPG EQU &FD6C ASTACK EQU &FD6D TMPHL EQU &FD6F TMPA EQU &FD71 STACCT EQU &FD73 PRORPL EQU &FD75 IOPR EQU &FD76 AUTOIN EQU &FD77 AUTOST EQU &FD79 AUTOCT EQU &FD7B LASTKY EQU &FD7C LASTASC EQU &FD7D LASTDR EQU &FD7E RNSEED EQU &FD7F BREAK EQU &FD81 COMMAND EQU &FD82 ERRPOS EQU &FD84 FLAGS1 EQU &FD86 ITYPE EQU &FD87 MAFD EQU &FD89 MBCD EQU &FD8B MDED EQU &FD8D MHLD EQU &FD8F MAF EQU &FD91 MBC EQU &FD93 MDE EQU &FD95 MHL EQU &FD97 MIX EQU &FD99 MIY EQU &FD9B MSP EQU &FD9D MPC EQU &FD9F MEMPOINT EQU &FDA1 WCHJUMP EQU &FDA3 POINTERR EQU &FDA5 DADD EQU &FDA6 INDEX EQU &FDA8 DBYTE EQU &FDAA LINKER EQU &FDAC EDIT EQU &FDAD LENGTH EQU &FDAE DETYPE EQU &FDAF DTYPE EQU &FDB0 DISAD EQU &FDB1 DPROG EQU &FDB3 LABTABL EQU &FDB5 APROG EQU &FDB7 ENDTAB EQU &FDB9 COMMENT EQU &FDBB COMAD EQU &FDBC ADLABEL EQU &FDBE INDEXLAB EQU &FDC1 DATALAB EQU &FDC3 DBLABEL EQU &FDC6 BASEM EQU &FDC7 CURLAB EQU &FDC9 SPARE_VAR2 EQU &FDC8 ACC1 EQU &FDCC OP1 EQU &FDD1 OP11 EQU &FDD2 YORN EQU &FDD7 SIGN EQU &FDD8 MEM1 EQU &FDD9 COPY EQU &FDDE INTTAB EQU &FDF2 GASH EQU &FE02 TEMP EQU &FE04 CHAN EQU &FE14 FREQ EQU &FE16 VOL EQU &FE18 WKAREA EQU &FE1A BSSTR EQU &FE3F SPEED EQU &FE4B SPBASE EQU &FE4C MVDIST EQU &FE4D NOSPR EQU &FE4E DLSPNO EQU &FE4F PLSPNO EQU &FE50 MVNO EQU &FE51 DELSPR EQU &FE52 VCOUNT EQU &FE53 VDPSTS EQU &FE54 SPRTBL EQU &FE55 SMBYTE EQU &FF55 LENLO EQU &FF56 LENHI EQU &FF57 VINTFLG EQU &FF58 CHPTR EQU &FF59 CURSCR EQU &FF5B SCRN0 EQU &FF5D SCRN1 EQU &FF6C SCRN2 EQU &FF7B SCRN3 EQU &FF8A SCRN4 EQU &FF99 SCRN5 EQU &FFA8 SCRN6 EQU &FFB7 SCRN7 EQU &FFC6 TYPBL EQU &FFD5 OVRLAY EQU &FFED IJTABLE EQU &FFF0 page_local EQU &FFF8 datarom EQU &FFF9 pointer_local EQU &FFFA memory_limit EQU &10000 getln1 equ &06de stacks equ &0744 ofreq EQU &08C6 killsnd EQU &093A ijinit equ &097f init125 equ &0996 ; the first 8k isn't used for game data ;and appears int he memory map at 04000 in bank 0 org 0 offset &4000 .pixel_data insert comp_scr .colour_data insert comp_col DB 0,1,2,3,4,5,6,7 offset ; Standard rom header for autorun rom org &2000 ;if bytes 0 - 7 are 8-1 resp. autoboot rom via &2010 on power up/reset ;but after high memory cleared, any variables set will be retained DB 8 DB 7 DB 6 DB 5 DB 4 DB 3 DB 2 DB 1 NOP ; 4 nops needed to align code NOP NOP NOP ; BASIC's ROM command enters at &200C JP run NOP ;final alignment NOP ;boot entry point &2010 org &2010 ; first test for space pressed ; can exit via a return as the startup code ; is entered via a call. LD A,&7F OUT (5),A IN A,(6) AND 1 ret NZ ;no spacebar check if entering from "ROM 7" command ;enters here to ensure a clean stack. .run DI call move_wedge ;setup the replacement CALL &0AAE code ;set up the basic environment as the "new" rom is isntended to support ;games that include basic, but at thatis point that's not been set up by the OS ;duplicates the actions of the code in the OS ROM at &205 ; make sure we're in the correct page (0 for 32k, 1 for 64k, 3 for 128k; 4 or 11 for 384k ; (Andy's revised rom on REMEMOrizor sets lstpg to 4, instead of 11. However all 11 full pages still exist) ; or the data rom wont be acessible ld a,(lstpg) and &0f cp 4 jr nz,change_page ld a,11 .change_page ld b,a ;V1.05 changes: save the ram page number ld a,(page) ld (page_local),A and &70 ;get the current rom page - won't always be 7 any more or b ;add back the ram page ld (datarom),A ;at boot entered with the rom paged in and ram set to page 0 .basics rst &28 db &42 ;this is the MTX VDINIT routine, whcih sets up the VDP. xor a ld (scrn5+3),A ;make VS5 fill the whole screen ? ld a,&28 ld (scrn5+5),A RST &10 DB &4C ;select VS4 and clear ld a,&F1 ;set the border to black out (2),A ld a,&87 out (2),A ;print a sign on message call welcome_page Call welcome_beep ;call killsnd LD BC,&0002 CALL setinit .newent call ijinit LD A,(LSTPG) OR A LD HL,&4000 LD (BASBOT),HL JR NZ,mwnt1 ADD HL,HL .mwnt1 LD (NBTOP),HL LD (BASTOP),HL LD (BASTPO),HL LD (VAZERO),HL XOR A LD (NBTPG),A LD (BASTPG),A .basic1 LD HL,&000D LD (LABTABL),HL .basic4 ;CALL switch0 CALL killvar ;.basic2 ;CALL switch0 CALL stacks call init125 .basic ld SP,(SSTACK) .done call &79 jr z,done ; try and load something cp +ASC"A" ;look for A-S pressed jr lo done CP +ASC"T" JR HS done sub +ASC"A" ;convert to a number 0-15 add a,a add a,a ;x4 ld c,a ld b,0 ld ix,directory ;add tothe table base address add ix,bc ld A,(ix+0) ld l,(ix+1) ld h,(ix+2) ;HLA is 24 bit adrress of game nn within the rom ld (pointer_local),HL ld (pointer_local+2),a ;this is the ROM code on return from loading .sload call splod1 xor a call load LD HL,(RETSAVE+2) ;run55 (both of these are in rom 0) PUSH HL LD HL,(RETSAVE) ;run5 PUSH HL LD DE,(DESAVE) ;RET ;need to get into rom 0 before rutting the RET instruction to call run5 ld a,(page) and &8F jzero the rom bits jp &07d2 ;jump to rom code that does ;ld (page),A ;out (0),A ;RET .splod1 LD HL,(CALCST) LD (HL),&FF INC HL LD (CALCST),HL ;RST &28 ; Utility routine ;DB &BB ; call EVALSE (&3E7E) RET .directory DD game1 DD game2 DD game3 DD game4 DD game5 DD game6 DD game7 DD game8 DD game9 DD game10 DD game11 DD game12 DD game13 DD game14 DD game15 DD game16 DD game17 DD game18 DD game19 ;end of directory marker DD 0 .welcome_page ld a,0 out (port),A ld a,(datarom) ld (page),A out (0),A LD HL,pixel_data LD de,&1800 ld BC &4000 call decomp LD HL,colour_data LD de,&1800 ld BC &6000 call decomp ld a,(page_local) ld (page),A out (0),A ret .decomp LD A,c OUT (2),A LD A,b OUT (2),A .decomp_loop ld a,(hl) inc hl ;check for compression marker cmp &ff jr z,compressed out (1),a dec de ld a,d or e jr nz,decomp_loop ret .compressed ;get the data byte ld c,(hl) inc hl ;get the count ld b,(hl) inc hl .comp_loop ld a,c out (1),a dec de ;check to see if we're end of the bitmap ld a,d or e ret z DJNZ comp_loop jr decomp_loop .welcome_beep ;now make the hello! beep ld hl,20000 call beep_hl ld hl,0 call delay call killsnd ld hl,20000 call delay ld hl,28000 call beep_hl ld hl,30000 call delay call killsnd ret .delay PUSH HL PUSH BC .delay_loop DEC HL LD A,H OR L JR NZ,delay_loop POP BC POP HL RET .beep_hl push AF push BC LD A,L AND &0F OR &80 OUT (6),A ; SEND TONE 1 + 4 BITS OF FREQUENCY NOP IN A,(3) LD A,L SRL A SRL A SRL A SRL A LD C,A LD A,H SLA A SLA A SLA A SLA A OR C AND &3F ; REMAINING 10 BITS OF FREQUENCY OUT (6),A NOP IN A,(3) LD A,&90 ; ATTENUATION 0DB TONE 1 NOP NOP NOP NOP OUT (6),A NOP IN A,(3) pop bc pop AF RET ;local versions of routines called by LOAD org &25CD .ddbcm1 RST &28 ; Utility routine DB &AE ; call BSTPHL (&0679) DEC HL DEC HL .ddbcm PUSH HL RST &08 ; LD DE,(HL): HL+=2 POP HL PUSH DE EX DE,HL ADD HL,BC EX DE,HL LD (HL),E INC HL LD (HL),D INC HL POP DE RET .transf1 LD A,(CRNTPG) PUSH AF DEC A EX AF,AF' POP AF JR NZ,trn1 EX AF,AF' .trn1 LD (PGN1),A EX AF,AF' LD (PGN2),A PUSH BC .trnlp LD A,(PGN1) CALL pgslct LD A,(DE) PUSH AF LD A,(PGN2) CALL pgslct POP AF LD (HL),A INC HL INC DE DEC BC LD A,B OR C JR NZ,trnlp POP BC RET .cmpln RST &08 ; LD DE,(HL): HL+=2 PUSH DE RST &08 ; LD DE,(HL): HL+=2 EX DE,HL AND A SBC HL,BC EX DE,HL POP DE PUSH AF ADD HL,DE DEC HL DEC HL DEC HL DEC HL POP AF RET .findlin XOR A .fndln1 LD (BASLNP),A CALL pgslc1 CALL lcbsbt .fndnxt LD (BASELIN),HL CALL tpch1 JR Z,nextpg CALL cmpln RET Z RET NC JR fndnxt .nextpg LD A,(BASTPG) RST &28 ; Utility routine DB &AF ; call PGCHK (&0671) JR Z,nxtp1 LD A,(CRNTPG) INC A JP fndln1 .nxtp1 XOR A INC A RET .pgslc2 LD A,(CRNTPG) .pgslc1 LD (CRNTPG),A .pgslct PUSH HL LD L,A LD A,(PAGE_local) AND &F0 ADD A,L LD (PAGE),A out (page_port),A LD A,(BASTPG) RST &28 ; Utility routine DB &AF ; call PGCHK (&0671) JR NZ,nbstp LD HL,(BASTOP) JR nbstp1 .nbstp RST &28 ; Utility routine DB &AE ; call BSTPHL (&0679) PUSH DE RST &08 ; LD DE,(HL): HL+=2 EX DE,HL POP DE .nbstp1 LD (PGTOP),HL POP HL RET .pgchk1 LD A,(NBTPG) .pgchk PUSH BC LD B,A LD A,(CRNTPG) CP B POP BC RET .bstphl PUSH DE PUSH AF LD A,(CRNTPG) ADD A,A LD E,A LD D,&00 LD HL,BASTPO ADD HL,DE POP AF POP DE RET .findjp AND &7F PUSH BC LD C,A LD B,&00 ADD HL,BC ADD HL,BC LD C,(HL) INC HL LD H,(HL) LD L,C POP BC RET .rmtphl LD HL,&BFF4 LD A,(LSTPG) RST &28 ; Utility routine DB &AF ; call PGCHK (&0671) RET NZ LD HL,(STKLIM) PUSH DE LD DE,&0080 AND A SBC HL,DE POP DE RET .lcbsbt LD HL,(BASBOT) LD A,(LSTPG) CALL pgchk RET NZ LD A,H ADD A,&40 LD H,A RET .tpch1 PUSH HL PUSH DE LD DE,(PGTOP) AND A SBC HL,DE POP DE POP HL RET ORG &27b7 .setinit JR NZ,outr XOR A LD B,A CP C JR NZ,conok .outr RST &28 ; Utility routine DB &22 ; Generate error no 34 .conok PUSH DE LD H,B LD L,C ADD HL,HL ADD HL,BC ADD HL,HL ADD HL,HL PUSH HL ADD HL,HL ADD HL,HL INC H PUSH BC LD B,H LD C,L CALL chkstk POP BC EX DE,HL LD HL,CTRBADR PUSH HL XOR A SBC HL,DE LD (STKLIM),HL EX DE,HL POP HL LD B,&04 .sloop LD (HL),A INC HL LD (HL),E INC HL LD (HL),D INC HL LD (HL),C INC HL LD (HL),A INC HL INC HL INC HL INC HL INC HL LD (HL),A INC HL EX (SP),HL EX DE,HL ADD HL,DE EX DE,HL EX (SP),HL DJNZ sloop POP HL POP DE RET .killvar PUSH DE LD HL,(NBTOP) LD A,(NBTPG) CALL lratova LD (ARRTOP),HL LD (ARRTOP+2),A LD DE,(NBTOP) LD A,(NBTPG) LD B,A LD HL,&C000 LD A,(LSTPG) OR A SBC HL,DE SBC A,B JR NC,normal2 EX DE,HL LD A,B JR sprtrs .normal2 ADD HL,DE ADC A,B .sprtrs LD (VARNAM),HL LD (HL),&FF INC HL LD (VALBOT),HL LD (CALCBOT),HL LD (CALCST),HL POP DE RET ;replacement inout routine ;"load" DE bytes to (HL) .inout DI kill interrupts for safety push BC ;save the page value - as this needs to work in paged rom ld a,(page) ld (page_local),a ld c,a ld a,(datarom) ld b,A .inout1 ld a,d or e jr z inout_done ;ZERO BLOCK DEC DE CONVERT DE TO 2 8 BIT COUNTERS INC D INC E ;routine to get a byte from the paged rom ;is page map independant so should allow MTX512 games to be included ;on entry pointer_local = the 24 bit address, of which 19 are valid ;format = xxxxxppp ppoooooo oooooooo x dont care, p rom page, 0 offset within the page .get_rombyte push de push HL ld a,B ;(datarom) out (page_port),A ;set the hardware ld hl,(pointer_local) ;get the 24 bit address to HLA ld a,(pointer_local+2) ld E,a ;low byte requires no processing INC A jr NZ set_address INC HL ld (pointer_local),HL DEC HL .set_address ld (pointer_local+2),a ld D,L SET 6,D ;mask off the 2 page bits RES 7,D ;the rom is paged in at 4000-7FFF so need to add the offset ;DE now hold the position within memory of the required byte add hl,hl add hl,hl ;shift the 5 page bits into H ld a,H and &1F ;A now has the page number out (port),A ld a,(DE) ;get the byte ld d,a ;save the return value temporarily ld a,c (page_local) ;restore the original memory layout out (page_port),a pop HL ld (hl),d ;get the return value back pop de inc hl dec E JR NZ GET_ROMBYTE dec D JR NZ GET_ROMBYTE .inout_done ld (page),a pop BC EI RET .move_wedge ld hl,wedge ld de,&FCAE ld BC,32 LDIR RET ;position independant ram resident inout call routine be moved to run at FCAE .wedge push AF ld a,(page) push AF ld a,(page_local) ld (page),A out (0),A call inout pop af ld (page),A out (0),A pop AF RET ;replacement basic loader inital import lifted straight from Memotech rom sources .load PUSH AF ;save the load/verify indicator XOR A LD (VERIF),A INC A LD (TYPE),A CALL setsound PUSH HL EXX POP HL LD DE,&0012 ;load 18 bytes FF, 15 bytes of name + 2 byte pointer for the vatiables block PUSH AF PUSH DE PUSH HL CALL inout ;updates pointers, so need to save HL and DE POP HL POP DE LD A,(HL) ;the first byte of the header should be &FF CP &FF NOP ;remove invalid file re-try NOP CALL compname ;print the name for diagnostics EX AF,AF' POP AF NOP ;remove branch on LOAD with no filename NOP EX AF,AF' NOP ;remove branch on non matching filename NOP ADD HL,DE ;offset for the next block is stored in the last 2 bytes DEC HL DEC HL RST &08 ; LD DE,(HL): HL+=2 DE is now holding the load address for the next block POP AF ;restore load/verify indicator LD (VERIF),A ; AND A NOP ;remove branch to verify code NOP RST &10 ; output routine DB &89 ; send 9 bytes to the screen DS "LOADING" DB &0D DB &0A ;JR join ;skip over some save and verify bits .join LD HL,LSTPG ;save the last page - in case the new file cam from a system with LD A,(HL) ;a different amount of memory PUSH AF PUSH HL LD HL,(SYSTOP) AND A SBC HL,DE EX DE,HL CALL inout ;load the system variables, from the value at the end of the name block, up to (SYSTOP) POP HL ;LTSPG LD B,(HL) ;get the loaded program's memory size POP AF LD (HL),A ;restore ours PUSH BC ;save the original program's memory size LD DE,(ARRTOP) LD A,(ARRTOP+2) LD B,A LD HL,(VAZERO) LD C,&00 EXX .morebas CALL block ;load in eack block of basic code JR NZ,endbas CALL inout JR morebas ;last block is the ordinary variales .endbas POP BC ;get the save memory size CALL adjval LD HL,(CALCST) LD DE,(VARNAM) AND A SBC HL,DE EX DE,HL JP inout ;ret at the end of inout returns to the interpreter .setsound XOR A LD (CHAN),A CALL killsnd LD A,&01 LD (FREQ),A CALL ofreq CALL find1s PUSH AF PUSH BC LD A,C CP &0E ;max filename length +1 JR NC,notok AND B JR Z,lenok .notok LD BC,&000E PUSH DE POP HL ADD HL,BC .lenok LD A,C LD C,&20 .bloop INC A CP &0F LD (HL),C INC HL JR NZ,bloop DEC DE LD (CALCST),DE POP BC POP AF RET .compname EXX PUSH DE PUSH HL LD B,&0E .com1z LD A,(DE) CP (HL) JR NZ,coout INC HL INC DE DJNZ com1z .coout POP HL PUSH HL PUSH AF RST &10 ; output routine DB &88 ; send 7 bytes to the screen DB 12 DS "FOUND: " LD B,&0F INC HL ;skip the &FF byte .achar LD A,(HL) ;then print the next 15 that were "loaded" INC HL RST &28 DB &AC ; CALL printx but page rom safe NOP DJNZ achar RST &10 ; output routine DB &82 ; send 2 bytes to the screen DB &0D DB &0A POP AF POP HL POP DE EXX RET ;the original routines for this section live in paged rom, so need to be duplicated org &2c8D .restent LD A,(CRNTPG) PUSH AF PUSH DE PUSH BC CALL getln1 POP BC JR Z,rest1 LD A,B OR C JR Z,rest1 RST &28 ; Utility routine DB &2A ; Generate error no 42 .rest1 LD (DATAAD),HL LD A,(CRNTPG) SET 7,A LD (DATAPG),A POP DE POP AF RST &28 ; Utility routine DB &B1 ; call PGSLC1 (&0647) RET org &3299 .chkstk PUSH DE PUSH HL LD HL,(CALCST) ADD HL,BC JR C,nospace .chkst1 LD DE,(STKLIM) SCF SBC HL,DE POP HL POP DE RET C .nospace RST &28 ; Utility routine DB &23 ; G .adjval LD A,H CP &C0 JR NC,djvl0 LD HL,&C000 .djvl0 PUSH HL LD A,(LSTPG) CP B JR Z,djvl3 CALL adjdes JR C,djvl1 LD A,B LD B,&C0 JR djvl2 .djvl1 LD B,&40 .djvl2 LD (CRNTPG),A LD C,&00 LD A,(NBTPG) CALL pgchk JR NZ,djvl3 LD HL,NBTOP CALL ddbcm CALL bstphl CALL ddbcm LD A,(BASTPG) CALL pgchk JR NZ,djvl3 LD HL,BASTOP CALL ddbcm XOR A CALL pgslc1 .djvl3 POP HL LD DE,(VARNAM) AND A SBC HL,DE .DJVL4 LD B,H LD C,L LD HL,VARNAM LD A,&04 .djlp CALL ddbcm DEC A JR NZ,djlp RET org &34FE .ramppgc LD A,C .srampg ;original code assumed that ROM 0 was paged in - not the case with magrom ld c,a ld a,(PAGE) and &70 add A,C LD (PAGE),A OUT (&00),A RET org &3577 .savepage EX AF,AF' LD A,(PAGE) EX AF,AF' LD IX,LSTPG PUSH DE RL H ADC A,A OR A RR H LD DE,&4000 ADD HL,DE CP (IX+&00) JR NZ,noadj .adx ADD HL,DE .noadj POP DE RET .lratova AND &0F LD IX,LSTPG CP (IX+&00) LD DE,&C000 JR NZ,ntlast LD DE,&8000 .ntlast ADD HL,DE RL H SRA A RR H RET .inclra INC HL .inclr1 LD IX,LSTPG CP (IX+&00) RET Z PUSH DE LD DE,&4000 ADD HL,DE JR C,incl1 SBC HL,DE POP DE RET .incl1 INC A ADD HL,DE CP (IX+&00) JR NZ,noadj JR adx .block EXX LD A,B INC A JR Z,quitnz LD A,B OR D OR E JR NZ,block1 .quitnz INC A EXX RET .block1 PUSH HL PUSH DE CALL ramppgc LD A,D SUB &40 LD D,A LD A,B SBC A,&00 LD B,A JR C,end1 POP AF LD A,H ADD A,&40 LD H,A LD A,C CALL inclr1 LD C,A PUSH HL LD HL,&4000 EX (SP),HL .end1 XOR A EXX POP DE POP HL RET .adjdes PUSH AF PUSH BC LD HL,(DESAVE) EX AF,AF' LD A,H CP &FB JR NC,djvlb EX AF,AF' AND A LD A,B LD BC,&4000 JR Z,djvla AND A JR NZ,djvlb LD B,&C0 .djvla ADD HL,BC LD (DESAVE),HL .djvlb POP BC POP AF RET org &3fE9 .find1s LD HL,(CALCST) .finds DEC HL LD B,(HL) DEC HL LD C,(HL) PUSH HL AND A SBC HL,BC POP DE EX DE,HL LD A,B OR C RET NOLIST ORG &4000 .game1 insert pass.attack/m2 .game2 insert pass.combat/m2 .game3 insert pass.chamberoids/M2 .game4 insert pass.ddanger/m2 .game5 insert pass.drive_c5/M2 .game6 insert pass.felix/m2 .game7 insert pass.flummox/m2 .game8 insert pass.formula_1/m2 .game9 insert pass.goldmine/m2 .game10 insert pass.highway/m2 .game11 insert pass.jack/m2 .game12 insert pass.pothole/m2 .game13 insert pass.quantum/m2 .game14 insert pass.Sepulcri/mtx .game15 insert pass.snappo/mtx .game16 insert pass.sonofpete/m2 .game17 insert pass.soul/M2 .game18 insert pass.timeband/mtx .game19 insert pass.wall/mtx ;insert pass.Johnnyreb/m2 ;insert pass.frankie/m2 ;insert pass.ffreddy/m2 ;insert pass.doodlebug/m2 ;insert pass.hunchy/mtx LIST .endrom nop org &7FFFF .last_byte NOP END