1000 REM ******************* Start *************************
 1001 REM **    SBC6502 Erika0 - 32kB RAM + chip 8255A     **
 1002 CLEAR:PD=31000:PE=31032:POKE 15,80:REM 80column.
 1003 REM   PD adr31000-31031 = 32byte PROM data content   **
 1004 REM ***************************************************
 1005 REM PE adr31032-31039=8byte(one byte to bit conversion)
 1006 REM ***************************************************
 1007 CWR=32771:PA=32768:PB=32769:PC=32770
 1008 REM CWR register,PA=adress portA,PB=port B,PC=port C
 1009 REM ****** Initialize port A, B, C (chip 8255) ********
 1010 POKE CWR,137: REM CWR register port A,B=OUT,Port C=IN
 1011 POKE PA,0:POKE PB,0:REM PA=null, PB=null
 1012 REM ******************* Options ***********************
 1013 PRINT CHR$(12):REM CLS-for HyperTerminal
 1014 PRINT TAB(19);"Turn on the power to the programmer !":GOSUB 2000 
 1020 Z=0:X=0:Y=0:POKE PB,0:GOSUB 8760
 1100 PRINT: PRINT TAB(30);"Your choice:";:INPUT A$
 1110 IF A$="H" THEN 4200
 1120 IF A$="D" THEN 4300
 1130 IF A$="R" THEN 5000
 1140 IF A$="T" THEN 6000
 1150 IF A$="V" THEN 8000
 1160 IF A$="W" THEN 7000
 1180 IF A$="S" THEN 1500
 1190 IF A$="Q" THEN 8804
 1200 PRINT " Bad input !":PRINT A$:GOSUB 2000:GOTO 1020 
 1500 REM --- Subroutine Igis R.Tester part1 --- 
 1510 PRINT CHR$(12):POKE 15,80:REM CLS-for HyperTerminal
 1515 PRINT TAB(7);"Reprogramming an already programmed PROM."
 1520 PRINT TAB(17);"(S - special mode.)":PRINT
 1525 PRINT " You carry out  this reprogramming  at  your  own  risk.
 1530 PRINT " Only a 0 value can  be overwritten  to a value of 1. An
 1535 PRINT " already  entered  1 value  cannot be overwritten to 0 !
 1540 PRINT " In this special mode,the standard overwrite protections
 1550 PRINT " of the already programmed ROM are disabled.":PRINT
 1555 PRINT " It is assumed that you know what you are doing," 
 1556 PRINT TAB(22);"good luck !":PRINT
 1560 IF PEEK(31044)=0 THEN PRINT TAB(21);"Insert PROM !"
 1561 IF PEEK(31044)=36 THEN PRINT TAB(21);"Insert PROM !"
 1575 PRINT:PRINT TAB(20);"Continue Y/N ";
 1576 INPUT A$
 1580 IF A$="N" THEN 1020
 1590 IF A$="Y" THEN Z=1:GOTO 7020:REM JUMP TO DIRECT WRITE PROM
 1600 REM ___________________________________________________
 2000 REM ************** Waiting subroutines  ***************
 2010 FOR F=0 TO 10000:NEXT F:RETURN
 2050 FOR F=0 TO 150:NEXT F:RETURN
 2100 FOR F=0 TO 500:NEXT F:RETURN
 3500 REM ****** Subroutine - conversion byte to bit ********
 3510 PRINT:PRINT "Conversion byte";A;"(dec) to bit:"
 3520 S=PEEK (PE+0):PRINT "b0:";S:GOSUB 3700
 3540 S=PEEK (PE+1):PRINT "b1:";S:GOSUB 3700
 3560 S=PEEK (PE+2):PRINT "b2:";S:GOSUB 3700
 3570 S=PEEK (PE+3):PRINT "b3:";S:GOSUB 3700
 3580 S=PEEK (PE+4):PRINT "b4:";S:GOSUB 3700
 3590 S=PEEK (PE+5):PRINT "b5:";S:GOSUB 3700
 3600 S=PEEK (PE+6):PRINT "b6:";S:GOSUB 3700
 3610 S=PEEK (PE+7):PRINT "b7:";S:GOSUB 3700 
 3620 RETURN
 3700 REM ************ Subroutine for burning ***************
 3701 IF S=0 THEN RETURN:REM 0=no programmming bit
 3702 REM description line number:
 3703 REM line 3720 - chip under voltage, relay on, waiting
 3704 REM line 3720 - port A, bit7=1  
 3705 REM line 3730 - adress to PA + bit data to port B
 3706 REM line 3730 - port A, bit7=1, relay on
 3707 REM line 3740 - Ucc=5V/10.5V, CS=1
 3708 REM line 3740 - port A, bit7=1, bit6=1, bit5=1,relay on
 3709 REM line 3750 - programming pulse =17msec.
 3710 REM line 3750 - Ucc=10.5V, CS=0, relay=on
 3711 REM line 3760 - end prog.pulse
 3712 REM line 3760 - Ucc=10.5V/5V, CS=1
 3713 REM line 3770 - Ucc=5V, CS=0, PB=0, relay=on
 3714 REM line 3770 - Ucc=0V, relay=off, waiting
 3720 POKE PA,128:GOSUB 2050
 3730 POKE PA,(A+128):POKE PB,S
 3740 POKE PA,(A+224):REM 128+64+32
 3750 POKE PA,(A+192):FOR F=0 TO 43:NEXT F
 3760 POKE PA,(A+160)
 3770 POKE PA,128:POKE PB,0:POKE PA,0:GOSUB 2050
 3990 RETURN
 4000 REM ******* Subroutine for computing CRC data ***Y***** 
 4010 L=0
 4019 FOR G=PD TO PD+31:Q=PEEK(G):L=L+Q:NEXT G
 4040 RETURN
 4100 REM ******** Subroutine for CRC data in line **********   
 4110 RESTORE:L=0
 4120 FOR G=PD TO PD+31
 4130 READ M:POKE G,M
 4140 Q=PEEK(G):L=L+Q
 4150 NEXT G
 4160 RETURN
 4200 REM *************** Hexa input data ******************* 
 4202 GOSUB 4900:F=PD:B$="0123456789ABCDEF":N=0:S=0
 4203 PRINT "Adress:  data:":PRINT "(hex)    (hex)"
 4206 L=N AND 15:H=(N-L)/16
 4207 PRINT" :";:PRINT MID$(B$,H+1,1)MID$(B$,L+1,1);"     ";:INPUT A$
 4208 IF LEN (A$)=1 OR LEN (A$)>2 THEN GOSUB 4290:GOTO 4207
 4227 IF LEFT$ (A$,1)="F" THEN S=240
 4228 IF LEFT$ (A$,1)="E" THEN S=224
 4229 IF LEFT$ (A$,1)="D" THEN S=208
 4230 IF LEFT$ (A$,1)="C" THEN S=192
 4231 IF LEFT$ (A$,1)="B" THEN S=176
 4232 IF LEFT$ (A$,1)="A" THEN S=160
 4233 IF LEFT$ (A$,1)="9" THEN S=144
 4234 IF LEFT$ (A$,1)="8" THEN S=128
 4235 IF LEFT$ (A$,1)="7" THEN S=112
 4236 IF LEFT$ (A$,1)="6" THEN S=96
 4237 IF LEFT$ (A$,1)="5" THEN S=80
 4238 IF LEFT$ (A$,1)="4" THEN S=64
 4239 IF LEFT$ (A$,1)="3" THEN S=48
 4240 IF LEFT$ (A$,1)="2" THEN S=32
 4241 IF LEFT$ (A$,1)="1" THEN S=16
 4242 IF LEFT$ (A$,1)="0" THEN S=0
 4244 IF RIGHT$ (A$,1)="F" THEN S=S+15
 4245 IF RIGHT$ (A$,1)="E" THEN S=S+14
 4246 IF RIGHT$ (A$,1)="D" THEN S=S+13
 4247 IF RIGHT$ (A$,1)="C" THEN S=S+12
 4248 IF RIGHT$ (A$,1)="B" THEN S=S+11
 4249 IF RIGHT$ (A$,1)="A" THEN S=S+10
 4250 IF RIGHT$ (A$,1)="9" THEN S=S+9
 4251 IF RIGHT$ (A$,1)="8" THEN S=S+8
 4252 IF RIGHT$ (A$,1)="7" THEN S=S+7
 4253 IF RIGHT$ (A$,1)="6" THEN S=S+6
 4254 IF RIGHT$ (A$,1)="5" THEN S=S+5
 4255 IF RIGHT$ (A$,1)="4" THEN S=S+4
 4256 IF RIGHT$ (A$,1)="3" THEN S=S+3
 4257 IF RIGHT$ (A$,1)="2" THEN S=S+2
 4258 IF RIGHT$ (A$,1)="1" THEN S=S+1
 4259 IF RIGHT$ (A$,1)="0" THEN S=S+0
 4260 POKE F,S:F=F+1:N=N+1
 4279 IF F=PD+32 THEN GOSUB 8700:PRINT:GOTO 8800
 4280 GOTO 4206
 4290 REM *** Subroutine for information about input data ***
 4291 PRINT TAB(31);" Out of range !!!":GOSUB 2010:RETURN
 4300 REM *************** Dec input data ********************
 4301 F=PD:S=0:GOSUB 4900
 4302 PRINT "Adress:      data:":PRINT "(dec)        (dec)"
 4303 PRINT S,:INPUT Q: IF Q>255 THEN GOSUB 4290:GOTO 4302
 4304 POKE F,Q: F=F+1:S=S+1
 4305 IF F=PD+32 THEN GOSUB 8700:PRINT:GOTO 8800
 4308 GOTO 4303
 4900 REM ******* Subroutine for input PROM DATA Name ******* 
 4910 PRINT TAB(19);"(     Name lenght = max.40 characters    )"
 4920 PRINT TAB(3);"PROM DATA NAME:";:INPUT C$
 4930 IF LEN (C$)>40 THEN GOSUB 4290: GOTO 4910
 4940 PRINT:RETURN
 4950 REM ***************************************************
 5000 PRINT:PRINT "   - Read PROM and Write to Data line -":CRC=0
 5010 POKE PB,0:QW=0:A=0:POKE PA,128:REM PROM is energized
 5030 GOSUB 2050
 5035 QW=128+A
 5040 POKE PA,QW:OC=PEEK(PC)
 5060 POKE (PD+A),OC
 5080 CRC=CRC+OC
 5090 A=A+1
 5100 IF A=32 THEN GOTO 5120
 5110 GOTO 5035
 5120 IF CRC=0 THEN PRINT:PRINT"     BLANK  PROM !":GOTO 5160
 5130 IF CRC>0 THEN PRINT:PRINT "     ACTIVE PROM !":PRINT
 5140 POKE PA,0: POKE PB,0:REM PROM is without power
 5150 IF CRC>0 THEN GOSUB 4900:GOSUB 8700:PRINT:GOSUB 8800:END
 5160 POKE PA,0: POKE PB,0:GOSUB 2000:GOTO 1020
 5170 REM ***************************************************
 6000 PRINT:PRINT "        Test - read blank PROM ";
 6005 POKE PB,0: REM Port B=0 
 6010 QW=0:A=0:POKE PA,128:REM PROM is energized
 6030 GOSUB 2050:REM Delay to Relay ON
 6035 QW=128+A
 6040 POKE PA,QW:OC=PEEK(PC)
 6050 IF OC=0 THEN 6070
 6060 PRINT " Not a blank PROM ! - Insert new PROM !"
 6065 POKE PA,0:POKE PB,0:GOSUB 2000:GOTO 1020
 6070 A=A+1:IF A=32 THEN GOTO 6100
 6090 GOTO 6035
 6100 PRINT " Good - a blank PROM !":POKE PA,0:POKE PB,0
 6105 IF Z=1 THEN 7020
 6110 GOSUB 2000:GOTO 1020
 7000 REM ****************** PROM WRITING *******************
 7010 PRINT CHR$(12):REM CLS-for HyperTerminal
 7012 PRINT"                  WRITING PROM 74188 ...":PRINT
 7015 Z=1:GOTO 6000
 7020 GOSUB 9000:PRINT:PRINT " Name Data file:";C$
 7030 GOSUB 9005:PRINT " CRC=";CRC
 7035 IF CRC=0 THEN PRINT " No valid data !":GOSUB 2000:GOTO 1020
 7040 PRINT:PRINT TAB(18)" Programming PROM - continue Y/N";:INPUT A$
 7045 IF A$="N" THEN 1020
 7050 IF A$="Y" THEN 7070
 7060 PRINT:PRINT " Bad input !":GOSUB 2000:GOTO 7000
 7070 QW=0:A=0
 7100 RESTORE
 7110 REM ********** Reading Data line to program ***********
 7120 FOR G=PD TO PD+31:READ M:POKE G,M:NEXT G
 7200 REM ********** One byte to bit conversion ************* 
 7210 POKE PA,128:POKE PB,0:GOSUB 2050
 7310 A=0:QW=0
 7320 FOR G=PD TO PD+31
 7330 Q=PEEK(G):K=Q
 7340 FOR F=PE TO PE+7:POKE F,0:NEXT F
 7400 IF K>=128 THEN POKE (PE+7),128:K=K-128
 7410 IF K>=64 THEN POKE (PE+6),64:K=K-64
 7420 IF K>=32 THEN POKE (PE+5),32:K=K-32
 7430 IF K>=16 THEN POKE (PE+4),16:K=K-16
 7440 IF K>=8 THEN POKE (PE+3),8:K=K-8
 7450 IF K>=4 THEN POKE (PE+2),4:K=K-4
 7460 IF K>=2 THEN POKE (PE+1),2:K=K-2
 7470 IF K>=1 THEN POKE (PE+0),1:K=K-1
 7480 GOSUB 3500
 7490 A=A+1:GOSUB 2050
 7720 NEXT G
 7725 PRINT:PRINT "End programming ...":GOSUB 2000
 7726 PRINT:PRINT "Verifying ..."
 7730 POKE PA,0:POKE PB,0:A=0:QW=0:GOSUB 2000
 7990 GOTO 8080
 8000 REM *********** VERIFYING PROM - DATA line ************
 8010 RESTORE
 8015 POKE PA,128:POKE PB,0:GOSUB 2050:A=0:L=0:QW=0
 8020 FOR G=PD TO PD+31
 8030 READ M:POKE G,M
 8040 Q=PEEK(G):L=L+Q
 8050 NEXT G
 8080 A=0:FOR G=PD TO PD+31:QW=128+A
 8090 POKE PA,QW:Q=PEEK(PC):R=PEEK(G)
 8091 PRINT"Adress(dec):  (PC):       (PROM):"
 8095 PRINTA,Q,R
 8100 IF Q=R THEN 8120
 8110 PRINT " Problem: PROM  <>  Data line !!!":X=1
 8120 A=A+1:NEXT G
 8121 IF Y=1 AND X=1 THEN PRINT" Sorry, bad PROM ...":POKE PA,0:END
 8122 IF Y=1 AND X=2 THEN 8130
 8125 IF L=0 THEN PRINT" Blank PROM !!!":POKE PA,0:GOSUB 2000:GOTO 1020
 8126 IF X=1 THEN PRINT " New attempt to burn, please wait.":POKE PA,0
 8127 IF X=1 THEN Y=0:POKE PA,0:GOSUB 2000:X=X+1
 8128 IF X=2 THEN Y=1:POKE PA,0:GOSUB 2000:GOTO 7200
 8130 PRINT:PRINT " Verifying O.K !":POKE PA,0:GOSUB 2000:GOTO 1020
 8700 PRINT:PRINT"**** Subroutine PROM 74188 line data generator ****"
 8702 PRINT
 8711 PRINT "9000 C$=";CHR$(34);C$;CHR$(34);":ID=32:RETURN"
 8712 PRINT "9001 DATA";:FOR G=PD TO (PD+6):PRINT PEEK(G);",";
 8713 NEXT G:PRINT PEEK(PD+7)
 8714 PRINT "9002 DATA";:FOR G=(PD+8) TO (PD+14):PRINT PEEK(G);",";
 8715 NEXT G:PRINT PEEK(PD+15)
 8716 PRINT "9003 DATA";:FOR G=(PD+16) TO (PD+22):PRINT PEEK(G);",";
 8717 NEXT G:PRINT PEEK(PD+23)
 8718 PRINT "9004 DATA";:FOR G=(PD+24) TO (PD+30):PRINT PEEK(G);",";
 8719 NEXT G:PRINT PEEK(PD+31)
 8720 GOSUB 4000
 8730 PRINT "9005 CRC=";L;":RETURN";":REM CRC in (dec) form !":PRINT
 8735 PRINT"***************************************************"
 8740 RETURN
 8760 REM **************** Subroutine MENU ******************
 8761 PRINT CHR$(12):REM CLS-for HyperTerminal
 8762 PRINT TAB(16);"*-- 74188 PROM programmer ---- Igi(c)2021 -----*"
 8763 PRINT TAB(16);"*-- 04.01.2021, ver.1.03, SBC6502 - 4.00MHz ---*"
 8764 PRINT TAB(16);"*     (D) - dec input data to Data line        *"
 8765 PRINT TAB(16);"*     (H) - hex input data to Data line        *"
 8766 PRINT TAB(16);"*     (R) - reading PROM to Data line          *"
 8767 PRINT TAB(16);"*     (T) - test blank PROM                    *"
 8768 PRINT TAB(16);"*     (V) - verify data PROM - Data line       *"
 8769 PRINT TAB(16);"*     (W) - write data PROM from Data line     *"
 8770 PRINT TAB(16);"*     (S) - special mode,reprogramming PROM    *"
 8771 PRINT TAB(16);"*";TAB(63);"*"
 8772 PRINT TAB(16);"*     (Q) - quit program                       *"
 8773 PRINT TAB(16);"*------------ Data line file name: ------------*"
 8774 GOSUB 9000:PRINT TAB(16);"*   ";C$;TAB(63);"*"
 8775 PRINT TAB(16);"*----------------------------------------------*"
 8776 GOSUB 4100:IF L=0 THEN GOTO 8780
 8777 GOSUB 9005:IF L<>CRC THEN GOTO 8900
 8778 PRINT TAB(16);"*    Valid data in memory !    CRC=";CRC;TAB(63)"*"
 8779 GOTO 8781
 8780 PRINT TAB(16);"*  No valid data in memory !  CRC=";CRC;TAB(63)"*"
 8781 PRINT TAB(16);"*----------------------------------------------*"
 8782 RETURN
 8800 REM ************** Info for (D),(H),(R) ***************
 8801 PRINT "    Save this data (lines 9000-9005) in the"
 8802 PRINT "          specified line positions,"
 8803 PRINT "       and then run the program again !":PRINT:PRINT
 8804 PRINT:PRINT " End program ...":END
 8900 REM ***************** Verify problem ******************
 8901 PRINT
 8902 PRINT " Problem ..."
 8903 PRINT " Bad verification result, difference in:"
 8904 PRINT " Computer        Data line"
 8905 PRINT " data CRC:  < >    CRC:"
 8910 PRINT " L=";L;:PRINT"   CRC=";CRC:END
 8990 REM *********** PROM 74188 data lines *****************
 9000 C$=" Test file, all DATA bytes =0":ID=32:RETURN
 9001 DATA 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
 9002 DATA 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
 9003 DATA 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
 9004 DATA 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
 9005 CRC=0:RETURN:REM CRC in dec form !
 9006 REM ********************* End *************************