home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib24b.dsk / BASIC.ASSEMBLER.bas < prev    next >
Encoding:
BASIC Source File  |  1990-01-01  |  16.4 KB  |  363 lines
  1. 10  REM   ********1.9.85********
  2. 20  REM   *   BASIC.ASSEMBLER  *
  3. 30  REM   *  BY  JOHN WHITNEY  *
  4. 40  REM   * COPYRIGHT (C) 1984 *
  5. 50  REM   * BY MICROSPARC, INC *
  6. 60  REM   * LINCOLN, MA. 01773 *
  7. 65  REM   *   BASIC.ASSEMBLER  *
  8. 66  REM   *  MODIFICATIONS BY  *
  9. 67  REM   *    ALBERT BAKER    *
  10. 70  REM   **********************
  11. 80  DATA   ADC,0,109,101,105,125,121,97,113,117,0,0,0
  12. 90  DATA   AND,0,45,37,41,61,57,33,49,53,0,0,0
  13. 100  DATA   ASL,10,14,6,0,30,0,0,0,22,0,0,0
  14. 110  DATA   BCC,0,0,0,0,0,0,0,0,0,0,144,0
  15. 120  DATA   BCS,0,0,0,0,0,0,0,0,0,0,176,0
  16. 130  DATA   BEQ,0,0,0,0,0,0,0,0,0,0,240,0
  17. 140  DATA   BIT,0,44,36,0,0,0,0,0,0,0,0,0
  18. 150  DATA   BMI,0,0,0,0,0,0,0,0,0,0,48,0
  19. 160  DATA   BNE,0,0,0,0,0,0,0,0,0,0,208,0
  20. 170  DATA   BPL,0,0,0,0,0,0,0,0,0,0,16,0
  21. 180  DATA   BRK,0,0,0,0,0,0,0,0,0,0,0,0
  22. 190  DATA   BVC,0,0,0,0,0,0,0,0,0,0,80,0
  23. 200  DATA   BVS,0,0,0,0,0,0,0,0,0,0,112,0
  24. 210  DATA   CLC,24,0,0,0,0,0,0,0,0,0,0,0
  25. 220  DATA   CLD,216,0,0,0,0,0,0,0,0,0,0,0
  26. 230  DATA   CLI,88,0,0,0,0,0,0,0,0,0,0,0
  27. 240  DATA   CLV,184,0,0,0,0,0,0,0,0,0,0,0
  28. 250  DATA   CMP,0,205,197,201,221,217,193,209,213,0,0,0
  29. 260  DATA   CPX,0,236,228,224,0,0,0,0,0,0,0,0
  30. 270  DATA   CPY,0,204,196,192,0,0,0,0,0,0,0,0
  31. 280  DATA   DEC,0,206,198,0,222,0,0,0,214,0,0,0
  32. 290  DATA   DEX,202,0,0,0,0,0,0,0,0,0,0,0
  33. 300  DATA   DEY,136,0,0,0,0,0,0,0,0,0,0,0
  34. 310  DATA   EOR,0,77,69,73,93,89,65,81,85,0,0,0
  35. 320  DATA   INC,0,238,230,0,254,0,0,0,246,0,0,0
  36. 330  DATA   INX,232,0,0,0,0,0,0,0,0,0,0,0
  37. 340  DATA   INY,200,0,0,0,0,0,0,0,0,0,0,0
  38. 350  DATA   JMP,0,76,0,0,0,0,0,0,0,0,0,108
  39. 360  DATA   JSR,0,32,0,0,0,0,0,0,0,0,0,0
  40. 370  DATA   LDA,0,173,165,169,189,185,161,177,181,0,0,0
  41. 380  DATA   LDX,0,174,166,162,0,190,0,0,0,182,0,0
  42. 390  DATA   LDY,0,172,164,160,188,0,0,0,180,0,0,0
  43. 400  DATA   LSR,74,78,70,0,94,0,0,0,86,0,0,0
  44. 410  DATA   NOP,234,0,0,0,0,0,0,0,0,0,0,0
  45. 420  DATA   ORA,0,13,5,9,29,25,1,17,21,0,0,0
  46. 430  DATA   PHA,72,0,0,0,0,0,0,0,0,0,0,0
  47. 440  DATA   PHP,8,0,0,0,0,0,0,0,0,0,0,0
  48. 450  DATA   PLA,104,0,0,0,0,0,0,0,0,0,0,0
  49. 460  DATA   PLP,040,0,0,0,0,0,0,0,0,0,0,0
  50. 470  DATA   ROL,42,46,38,0,62,0,0,0,54,0,0,0
  51. 480  DATA   ROR,106,110,102,0,126,0,0,0,118,0,0,0
  52. 490  DATA   RTI,64,0,0,0,0,0,0,0,0,0,0,0
  53. 500  DATA   RTS,96,0,0,0,0,0,0,0,0,0,0,0
  54. 510  DATA   SBC,0,237,229,233,253,249,225,241,245,0,0,0
  55. 520  DATA   SEC,56,0,0,0,0,0,0,0,0,0,0,0
  56. 530  DATA   SED,248,0,0,0,0,0,0,0,0,0,0,0
  57. 540  DATA   SEI,120,0,0,0,0,0,0,0,0,0,0,0
  58. 550  DATA   STA,0,141,133,0,157,153,129,145,149,0,0,0
  59. 560  DATA   STX,0,142,134,0,0,0,0,0,0,150,0,0
  60. 570  DATA   STY,0,140,132,0,0,0,0,0,148,0,0,0
  61. 580  DATA   TAX,170,0,0,0,0,0,0,0,0,0,0,0
  62. 590  DATA   TAY,168,0,0,0,0,0,0,0,0,0,0,0
  63. 600  DATA   TSX,186,0,0,0,0,0,0,0,0,0,0,0
  64. 610  DATA   TXA,138,0,0,0,0,0,0,0,0,0,0,0
  65. 620  DATA   TXS,154,0,0,0,0,0,0,0,0,0,0,0
  66. 630  DATA   TYA,152,0,0,0,0,0,0,0,0,0,0,0
  67. 635 LO =  PEEK(106) *256 + PEEK(105):HI =  PEEK(116) *256 + PEEK(115)
  68. 640  HOME : VTAB 22: PRINT "** COPYRIGHT 1984 BY MICROSPARC, INC. **"
  69. 650  VTAB 3: INVERSE : PRINT "BASIC ASSEMBLER": NORMAL : PRINT 
  70. 660  GOSUB 2350
  71. 670  CALL  -958
  72. 680 SA = 36864
  73. 690  HIMEM: 35840
  74. 700 D$ =  CHR$(4): VTAB 7: CALL  -958: INPUT "SOURCE FILE TO LOAD: ";PR$: IF  LEN(PR$) = 0  OR  LEN(PR$) >15  OR  VAL(PR$) >0  THEN 700
  75. 710  ONERR  GOTO 730
  76. 720  PRINT D$"VERIFY";PR$: PRINT D$"OPEN";PR$: PRINT D$"READ";PR$: POKE 216,0: GOTO 740
  77. 730  POKE 216,0: PRINT  CHR$(7)"THAT FILE IS NOT ON THIS DISK.": PRINT "PRESS ANY KEY TO CONTINUE.": GET K$: PRINT : GOTO 700
  78. 740  INPUT IN$: IF  MID$ (IN$,10,3) = "EOF"  THEN  PRINT D$"CLOSE": GOTO 780
  79. 750 NI = NI +1
  80. 760  IF  LEFT$(IN$,8) < >"        "  THEN NL = NL +1
  81. 770  GOTO 740
  82. 780  DIM OP(56,12),OP$(56)
  83. 790  DIM IN$(NI),MD(NI),LB$(NI),TP$(NI),LN(NI),LO(NI +1)
  84. 800  DIM LF$(NL),AF(NL),LR$(NL),DR(NL)
  85. 810  RESTORE 
  86. 820  VTAB 12: CALL  -958: PRINT "FIRST PASS:"
  87. 830  PRINT D$"OPEN"PR$: PRINT D$"READ "PR$
  88. 840  INPUT LA$: IF  MID$ (LA$,10,3) < >"ORG"  OR  LEN(LA$) <14  THEN  PRINT : PRINT D$"CLOSE "PR$: PRINT  CHR$(7): PRINT "SOURCE CODE MUST BEGIN WITH 'ORG'": GOTO 2270
  89. 850 N = 1:HX$ =  MID$ (LA$,14): IF  LEFT$(HX$,1) = "$"  THEN  GOSUB 2580:LA = DT: GOTO 870
  90. 860 LA =  VAL(HX$)
  91. 870  FOR N = 2 TO NI
  92. 880  INPUT IN$:IN$ =  LEFT$(IN$,29)
  93. 882  VTAB 12: HTAB 13: PRINT N: CALL  -868: PRINT IN$
  94. 885  IF  LEFT$(IN$,1) = "*"  THEN LO(N) = AD:IN$(N) = "*": GOTO 950: REM  IGNORE LINES STARTING WITH "*"
  95. 890  IF  LEN(IN$) >14  THEN HX$ =  MID$ (IN$,14): GOSUB 2580:IN$ =  LEFT$(IN$,13) +HX$
  96. 900  REM  THIS LINE INTENTIONALLY DELETED
  97. 910 IN$ =  LEFT$(IN$ +"                                         ",41)
  98. 920  REM   THE ABOVE STATEMENT HAS 41 SPACES BETWEEN THE QUOTES
  99. 930  IF  LEFT$(IN$,8) < >"        "  THEN  GOSUB 1110
  100. 940  GOSUB 1280
  101. 950  NEXT 
  102. 960  PRINT D$"CLOSE "PR$
  103. 970 LO(NI +1) = AD
  104. 980  GOSUB 1690
  105. 990  VTAB 14: CALL  -958: PRINT "SECOND PASS:"
  106. 1000  FOR N = 2 TO NI
  107. 1010  VTAB 14: HTAB 13: PRINT N
  108. 1020  GOSUB 1750
  109. 1030  NEXT 
  110. 1040  PRINT : PRINT "ASSEMBLY COMPLETE": PRINT :L = LO(N -1) +LN(N -1)
  111. 1050  IF LA +L <HI  AND (LO <(LA))  THEN 1090
  112. 1060  IF LA +L <LO  AND LA >2049  THEN  PRINT "OBJECT CODE MAY OVERLAP BASIC ASSEMBLER": PRINT "BASIC ASSEMBLER WILL BE CLEARED.": GOTO 1090
  113. 1070  IF LA <2049  THEN 1090
  114. 1080  PRINT "OBJECT CODE OVERLAPS DOS. YOU MUST": PRINT "RE-LOCATE IT FROM THE PRESENT LOCATION": PRINT "ADDRESS: ";SA: PRINT "LENGTH: ";L: END 
  115. 1090  PRINT "SAVING ";PR$;".OBJ,A";LA;",L";L: PRINT D$"OPEN B.A.TEMP": PRINT D$"CLOSE": PRINT D$"DELETE B.A.TEMP": PRINT D$"OPEN B.A.TEMP": PRINT D$"WRITE B.A.TEMP": PRINT "BSAVE ";PR$;".OBJ,A";SA;",L";L
  116. 1100  PRINT "BLOAD ";PR$;".OBJ,A"LA: PRINT "BSAVE ";PR$;".OBJ,A";LA;",L";L
  117. 1102  IF (LA >2049  AND LA +L <LO)  THEN  PRINT "FP"
  118. 1105  PRINT D$"CLOSE": PRINT : PRINT "PRINT A PROGRAM LISTING? (Y/N) ==> ";: GET IN$: PRINT IN$: IF IN$ = "Y"  THEN  GOSUB 10000
  119. 1107  PRINT D$"EXEC B.A.TEMP": END 
  120. 1110  REM   PROCESS LABELS
  121. 1120  FOR P = 1 TO 8
  122. 1130  IF  MID$ (IN$,P,1) = " "  THEN 1150
  123. 1140  NEXT 
  124. 1150 P = P -1
  125. 1160  IF  MID$ (IN$,10,3) < >"EQU"  THEN 1240
  126. 1170 NF = NF +1
  127. 1180 LF$(NF) =  LEFT$(IN$,P)
  128. 1190 AF(NF) =  VAL( MID$ (IN$,14, LEN(IN$) -13))
  129. 1200 XL =  LEN( STR$(AF(NF))) +14
  130. 1210  IF XL > =  LEN(IN$)  THEN 1270
  131. 1220  IF  MID$ (IN$,XL,1) = "!"  THEN XA = AF(NF): GOSUB 2500
  132. 1230  GOTO 1270
  133. 1240 NR = NR +1
  134. 1250 LR$(NR) =  LEFT$(IN$,P)
  135. 1260 DR(NR) = AD +LA
  136. 1270  RETURN 
  137. 1280  REM   PROCESS LENGTH
  138. 1290 P = 14
  139. 1300 IN$(N) =  MID$ (IN$,10,3)
  140. 1310 LO(N) = AD
  141. 1315  IF IN$(N) = "ASC"  THEN  GOSUB 2800: GOTO 1670
  142. 1320  IF IN$(N) = "EQU"  THEN 1680
  143. 1330  IF IN$(N) = "DRS"  THEN LN(N) =  VAL( MID$ (IN$,14)): GOSUB 2300: GOTO 1670
  144. 1340  IF  MID$ (IN$,14,1) = " "  THEN MD(N) = 1: GOTO 1460
  145. 1350 P = 15
  146. 1360  IF  MID$ (IN$,P,1) < >" "  AND  MID$ (IN$,P,1) < >","  AND  MID$ (IN$,P,1) < >")"  THEN P = P +1: GOTO 1360
  147. 1365  IF IN$(N) = "HEX"  THEN LB$(N) =  MID$ (IN$,14,P -14):LN(N) = ( VAL(LB$(N)) <256 *1) +( VAL(LB$(N)) >255) *2: GOTO 1670
  148. 1370  IF  MID$ (IN$,P,3) = ",X "  THEN MD(N) = 5: GOTO 1460
  149. 1380  IF  MID$ (IN$,P,3) = ",Y "  THEN MD(N) = 6: GOTO 1460
  150. 1390  IF  MID$ (IN$,P,3) = ",X)"  THEN MD(N) = 7: GOTO 1460
  151. 1400  IF  MID$ (IN$,P,3) = ")  "  THEN MD(N) = 12: GOTO 1460
  152. 1410  IF  MID$ (IN$,P,3) = "),Y"  THEN MD(N) = 8: GOTO 1460
  153. 1420  IF  MID$ (IN$,14,1) = "#"  THEN MD(N) = 4: GOTO 1460
  154. 1430  IF  MID$ (IN$,14,1) = "<"  THEN MD(N) = 13: GOTO 1460
  155. 1440  IF  MID$ (IN$,14,1) = ">"  THEN MD(N) = 14: GOTO 1460
  156. 1450 MD(N) = 2
  157. 1460  IF  MID$ (IN$,10,1) = "B"  AND  MID$ (IN$,10,3) < >"BIT"  AND  MID$ (IN$,10,3) < >"BRK"  THEN MD(N) = 11:LB$(N) =  MID$ (IN$,14,P -14):TP$(N) = "R": GOTO 1640
  158. 1470  IF MD(N) < >4  THEN 1480: REM  FOLLOWING CODE ADDED BY AL BAKER FOR INSTRUCTIONS LIKE LDA #BELL WITH A LABEL AS AN IMMEDIATE OPERAND
  159. 1472 LB$(N) =  MID$ (IN$,15,P -15):TP$(N) = "F": FOR I = 1 TO NF: IF LF$(I) = LB$(N)  THEN 1476
  160. 1474  NEXT : GOTO 1660
  161. 1476  IF AF(I) >255  THEN  PRINT "VALUE OF IMMEDIATE OPERAND >255 ==>(# "N")": GOTO 2200
  162. 1478 LB$(N) =  STR$(AF(I)): GOTO 1660
  163. 1480  IF MD(N) = 13  OR MD(N) = 14  THEN LB$(N) =  MID$ (IN$,15,P -15): GOTO 1520
  164. 1490  IF MD(N) = 7  OR MD(N) = 8  OR MD(N) = 12  THEN LB$(N) =  MID$ (IN$,15,P -15): GOTO 1520
  165. 1500 LB$(N) =  MID$ (IN$,14,P -14)
  166. 1510  IF MD(N) = 1  THEN TP$(N) = "F": GOTO 1640
  167. 1520  FOR I = 1 TO NF
  168. 1530  IF LF$(I) = LB$(N)  THEN TP$(N) = "F":LB$(N) =  STR$(AF(I)): GOTO 1600
  169. 1540  NEXT 
  170. 1550  FOR I = 1 TO NR
  171. 1560  IF LR$(I) = LB$(N)  THEN TP$(N) = "D":LB$(N) =  STR$(DR(I)): GOTO 1600
  172. 1570  NEXT 
  173. 1580 TP$(N) = "U": FOR P = 2 TO  LEN(LB$(N)): IF  MID$ (LB$(N),P,1) = "+"  OR  MID$ (LB$(N),P,1) = "-"  THEN  GOTO 1585
  174. 1582  NEXT : GOTO 1600
  175. 1585 : FOR J = 1 TO NF: IF LF$(J) =  LEFT$(LB$(N),P -1)  THEN TP$(N) = "F":LB$(N) =  STR$(AF(J) + VAL( MID$ (LB$(N),P))): ON ( VAL(LB$(N)) <256) *1 +( VAL(LB$(N)) > = 256) *2 GOTO 1610,1640
  176. 1590  NEXT 
  177. 1600  IF TP$(N) < >"F"  OR AF(I) > = 256  THEN 1640
  178. 1610  IF MD(N) = 2  AND IN$(N) < >"JMP"  AND IN$(N) < >"JSR"  THEN MD(N) = 3
  179. 1620  IF MD(N) = 5  THEN MD(N) = 9
  180. 1630  IF MD(N) = 6  AND (IN$(N) = "LDX"  OR IN$(N) = "STX")  THEN MD(N) = 10
  181. 1640  IF MD(N) = 1  THEN LN(N) = 1: GOTO 1670
  182. 1650  IF MD(N) = 2  OR MD(N) = 5  OR MD(N) = 6  OR MD(N) = 12  THEN LN(N) = 3: GOTO 1670
  183. 1660 LN(N) = 2
  184. 1670 AD = AD +LN(N)
  185. 1680  RETURN 
  186. 1690  REM   BUILD OP CODE TABLE
  187. 1700  VTAB 13: CALL  -958: FLASH : PRINT "              ";: REM  14 SPACES
  188. 1710  FOR N = 1 TO 56: READ OP$(N): FOR I = 1 TO 12: READ OP(N,I): NEXT : NEXT 
  189. 1720  PRINT 
  190. 1730  VTAB 13: INVERSE : PRINT "              ": NORMAL 
  191. 1740  RETURN 
  192. 1750  REM   FIND OP CODE
  193. 1755  IF IN$(N) = "*"  THEN 2190: REM  IGNORE LINES STARTING WITH "*"
  194. 1760  IF IN$(N) = "DRS"  OR IN$(N) = "EQU"  THEN 2190
  195. 1762  IF IN$(N) = "ASC"  THEN  FOR J = 1 TO LN(N): POKE LO(N) +SA +J -1, ASC( MID$ (LB$(N),J,1)) +128: NEXT J: GOTO 2190
  196. 1765  IF IN$(N) = "HEX"  AND LN(N) = 1  THEN  POKE LO(N) +SA, VAL(LB$(N)): GOTO 2190
  197. 1767  IF IN$(N) = "HEX"  AND LN(N) = 2  THEN  POKE LO(N) +SA, VAL(LB$(N))/256: POKE LO(N) +SA +1, VAL(LB$(N)) -(256 * PEEK(LO(N) +SA)): GOTO 2190
  198. 1770  FOR I = 1 TO 56
  199. 1780  IF OP$(I) = IN$(N)  THEN 1820
  200. 1790  NEXT 
  201. 1800  PRINT "INVALID INSTRUCTION ==> (# "N")"
  202. 1810  GOTO 2200
  203. 1820  IF (MD(N) = 13  OR MD(N) = 14)  AND OP(I,4) < >0  THEN 1870
  204. 1830  IF OP(I,MD(N)) < >0  THEN 1870
  205. 1840  IF IN$(N) = "BRK"  AND MD(N) = 1  THEN 1870
  206. 1850  PRINT "INVALID ADDRESS MODE ==> (# "N")"
  207. 1860  GOTO 2200
  208. 1870  IF TP$(N) < >"U"  AND TP$(N) < >"R"  THEN 2010
  209. 1880  FOR P = 2 TO  LEN(LB$(N))
  210. 1890  IF  MID$ (LB$(N),P,1) = "+"  OR  MID$ (LB$(N),P,1) = "-"  THEN 1920
  211. 1900  NEXT 
  212. 1910 P = P +1
  213. 1920  IF TP$(N) = "R"  THEN 2020
  214. 1930  FOR J = 1 TO NF
  215. 1940  IF LF$(J) =  LEFT$(LB$(N),P -1)  THEN TP$(N) = "F":LB$(N) =  STR$(AF(J) + VAL( MID$ (LB$(N),P))): GOTO 2080
  216. 1950  NEXT 
  217. 1960  FOR J = 1 TO NR
  218. 1970  IF LR$(J) =  LEFT$(LB$(N),P -1)  THEN TP$(N) = "D":LB$(N) =  STR$(DR(J) + VAL( MID$ (LB$(N),P))): GOTO 2080
  219. 1980  NEXT 
  220. 1990  PRINT "INVALID LABEL ==> (# "N")"
  221. 2000  GOTO 2200
  222. 2010  IF TP$(N) < >"R"  THEN 2080
  223. 2020  FOR J = 1 TO NR
  224. 2030  IF LR$(J) =  LEFT$(LB$(N),P -1)  THEN LB$(N) =  STR$(DR(J)) + MID$ (LB$(N),P): GOTO 2060
  225. 2040  NEXT 
  226. 2050  GOTO 1990
  227. 2060 LB$(N) =  STR$( VAL(LB$(N)) -(LO(N +1) +LA))
  228. 2070  IF  VAL(LB$(N)) >127  OR  VAL(LB$(N)) < -128  THEN  PRINT "INVALID RELATIVE ADDRESS ==> (# "N")": PRINT "= "LB$(N): GOTO 2200
  229. 2080  IF MD(N) = 13  THEN  POKE LO(N) +SA,OP(I,4):LB$(N) =  STR$( INT( VAL(LB$(N))/256)): GOTO 2120
  230. 2090  IF MD(N) = 14  THEN  POKE LO(N) +SA,OP(I,4):LB$(N) =  STR$( VAL(LB$(N)) -(256 * INT( VAL(LB$(N))/256))): GOTO 2120
  231. 2100  POKE LO(N) +SA,OP(I,MD(N))
  232. 2110  IF LN(N) = 1  THEN 2190
  233. 2120  IF LN(N) = 2  AND  VAL(LB$(N)) >255  THEN  PRINT "INVALID LENGTH, > 255 ==> (# "N")": GOTO 2200
  234. 2130  IF  VAL(LB$(N)) > = 0  THEN 2160
  235. 2140 LB = 256 + VAL(LB$(N))
  236. 2150 LB$(N) =  STR$(LB)
  237. 2160  IF LN(N) = 2  THEN  POKE LO(N) +SA +1, VAL(LB$(N)): GOTO 2190
  238. 2170  POKE LO(N) +SA +2, VAL(LB$(N))/256
  239. 2180  POKE LO(N) +SA +1, VAL(LB$(N)) -(256 * PEEK(LO(N) +SA +2))
  240. 2190  RETURN 
  241. 2200  REM   FIND STATEMENT FOR ERROR
  242. 2210  PRINT D$"OPEN "PR$: PRINT D$"READ "PR$
  243. 2220  FOR X = 1 TO N
  244. 2230  INPUT IN$
  245. 2240  NEXT 
  246. 2250  PRINT D$"CLOSE "PR$
  247. 2260  PRINT IN$
  248. 2270  VTAB 22: CALL  -958: INPUT "DO YOU WISH TO EDIT THE FILE? (Y/N)";K$: IF K$ = "Y"  THEN  PRINT D$"RUN SOURCE.EDITOR"
  249. 2280  IF K$ = "N"  THEN  HOME : END 
  250. 2290  PRINT  CHR$(7): GOTO 2270
  251. 2300  REM    CHECK DRS FOR CONSTANTS
  252. 2310 XL =  LEN( STR$(LN(N))) +14
  253. 2320  IF XL > =  LEN(IN$)  THEN  RETURN 
  254. 2330  IF  MID$ (IN$,XL,1) = "!"  THEN XA = LO(N) +SA: GOSUB 2500
  255. 2340  RETURN 
  256. 2350  DIM PN(15)
  257. 2360 PN(1) = 66:PN(2) = 89:PN(3) = 32
  258. 2370 PN(4) = 74:PN(5) = 79:PN(6) = 72
  259. 2380 PN(7) = 78:PN(8) = 32:PN(9) = 87
  260. 2390 PN(10) = 72:PN(11) = 73:PN(12) = 84
  261. 2400 PN(13) = 78:PN(14) = 69:PN(15) = 89
  262. 2410  FOR VN = 1 TO 15
  263. 2420  VTAB 5
  264. 2430  FOR VO = VN TO 1  STEP  -1
  265. 2440  PRINT  CHR$(PN(16 -VO));
  266. 2450  NEXT VO
  267. 2460  PRINT 
  268. 2470  NEXT VN
  269. 2480  PRINT 
  270. 2490  RETURN 
  271. 2500  REM    INSTALL CONSTANTS
  272. 2510 XL = XL +1
  273. 2520  IF XL > LEN(IN$)  THEN  RETURN 
  274. 2530  IF  MID$ (IN$,XL,1) = "!"  THEN  RETURN 
  275. 2540  POKE XA, ASC( MID$ (IN$,XL,1))
  276. 2550 XA = XA +1
  277. 2560  GOTO 2500
  278. 2570  REM  HEX CONVERSION
  279. 2580 HF = 0:DT = 0
  280. 2590  FOR K = 1 TO  LEN(HX$)
  281. 2600  IF  MID$ (HX$,K,1) = "$"  THEN HV$ =  MID$ (HX$,K): IF  LEN(HV$) >1  THEN HV$ =  MID$ (HV$,2): GOTO 2620
  282. 2610  NEXT K: RETURN 
  283. 2620 HV$ = HV$ +" ": FOR K2 = 1 TO 5: IF  MID$ (HV$,K2,1) < >" "  AND  MID$ (HV$,K2,1) < >"."  AND  MID$ (HV$,K2,1) < >")"  THEN  NEXT : GOTO 2670: REM  OPERAND TOO LONG
  284. 2622  IF K2 = 1  THEN 2670: REM  NULL HEX STRING
  285. 2625 HV$ =  RIGHT$("000" +HV$, LEN(HV$) +(5 -K2))
  286. 2630  FOR K1 = 1 TO 4
  287. 2640 HD =  ASC( MID$ (HV$,K1,1))
  288. 2650 HD = HD -48: IF HD >9  THEN HD = HD -7: IF HD > = 10  AND HD < = 15  THEN 2680
  289. 2660  IF HD > = 0  AND HD < = 9  THEN 2680
  290. 2670  PRINT D$"CLOSE": PRINT "OPERAND ERROR IN LINE:";N: GOTO 2260
  291. 2680 DT = DT +HD *(16 ^(4 -K1))
  292. 2690  NEXT 
  293. 2700  IF K >1  THEN HX$ =  LEFT$(HX$,K -1) + STR$(DT) + MID$ (HX$,K +K2): GOTO 2720
  294. 2710 HX$ =  STR$(DT) + MID$ (HX$,K2 +1)
  295. 2720  RETURN 
  296. 2799 :
  297. 2800  REM  CHECK FOR ASC CONSTANTS
  298. 2801 :
  299. 2810 Q$ = "'":LB$(N) =  MID$ (IN$,15,15): IF  MID$ (IN$,14,1) < >Q$  THEN 2900
  300. 2820  FOR XL = 15 TO 1  STEP  -1: IF  MID$ (LB$(N),XL,1) < >" "  THEN 2840
  301. 2830  NEXT 
  302. 2840  IF  MID$ (LB$(N),XL,1) < >Q$  THEN 2900
  303. 2850 LB$(N) =  LEFT$(LB$(N),XL -1):LN(N) = XL -1: RETURN 
  304. 2900  PRINT "MISSING QUOTE IN ASC STRING ==> (#"N")": PRINT D$"CLOSE"PR$: GOTO 2200
  305. 9970 :
  306. 9980  REM  PRINT OUT ASSEMBLED LISTING
  307. 9990 :
  308. 10000  DEF  FN HX(X) = X - INT(X/16) *16
  309. 10010  DIM HD$(16)
  310. 10020  FOR I = 0 TO 9:HD$(I) =  CHR$(48 +I): NEXT : FOR I = 10 TO 15:HD$(I) =  CHR$(55 +I): NEXT 
  311. 10030  PRINT D$"PR#1": PRINT  CHR$(27)"E"
  312. 10040  REM  LINE 10030 SETS 12 CPI, 96-CHAR LINE FOR C. ITOH PROWRITER & APPLE IMAGEWRITER
  313. 10050  REM  EPSON MX-80: '10030 PRINT D$"PR#1":PRINT CHR$(15)' SETS COMPRESSED MODE, 132 CHAR LINE
  314. 10060 P = 1:TL$ =  LEFT$("BASIC.ASSEMBLER FILE " +PR$ +"                                                                 ",89) +"PAGE ": GOSUB 10550
  315. 10070  REM  65 SPACES BETWEEN QUOTES ABOVE
  316. 10080  PRINT D$"OPEN "PR$
  317. 10090  PRINT D$"READ "PR$
  318. 10100  FOR N = 1 TO NI
  319. 10110  INPUT IN$
  320. 10120  IF IN$(N) = "ASC"  THEN 10330
  321. 10130 X = LO(N) +LA
  322. 10140 PL$ = HD$( FN HX(X/4096)) +HD$( FN HX(X/256)) +HD$( FN HX(X/16)) +HD$( FN HX(X)) +":"
  323. 10150  IF LN(N) = 0  THEN 10200
  324. 10160  FOR I = 1 TO LN(N)
  325. 10170 X =  PEEK(LO(N) +SA +(I -1))
  326. 10180 PL$ = PL$ +HD$( FN HX(X/16)) +HD$( FN HX(X)) +" "
  327. 10190  NEXT I
  328. 10200 PL$ =  LEFT$(PL$ +"          ",14)
  329. 10210  ON  LEN( STR$(N)) GOSUB 10290,10300,10310
  330. 10220  PRINT PL$ +FIL$ + STR$(N) +" " + LEFT$(IN$,78)
  331. 10230 LN = LN +1: IF LN = 56  THEN  GOSUB 10540: REM  PAGE HEADER
  332. 10240  NEXT N
  333. 10250  PRINT D$"CLOSE": PRINT : PRINT "SUCCESSFUL ASSEMBLY -- NO ERRORS"
  334. 10260  PRINT "ASSEMBLED OUTPUT IN FILE ";PR$;".OBJ,A$";HD$( FN HX(LA/4096));HD$( FN HX(LA/256));HD$( FN HX(LA/16));HD$( FN HX(LA));
  335. 10270  PRINT ",L$";HD$( FN HX(L/4096));HD$( FN HX(L/256));HD$( FN HX(L/16));HD$( FN HX(L)): PRINT  CHR$(12): PRINT D$"PR#0"
  336. 10280  RETURN 
  337. 10290 FIL$ = "  ": RETURN : REM  1 DIGIT LINE NUMBER
  338. 10300 FIL$ = " ": RETURN : REM  2 DIGIT LINE NUMBER
  339. 10310 FIL$ = "": RETURN : REM  3 DIGIT LINE NUMBER
  340. 10320 :
  341. 10330  REM  SPECIAL CODE FOR ASC
  342. 10340 :
  343. 10350  FOR C = 0 TO LN(N) -1  STEP 3
  344. 10360 X = LO(N) +C +LA
  345. 10370 PL$ = HD$( FN HX(X/4096)) +HD$( FN HX(X/256)) +HD$( FN HX(X/16)) +HD$( FN HX(X)) +":"
  346. 10380  FOR I = 1 TO 3
  347. 10390  IF C +I >LN(N)  THEN 10430
  348. 10400 X =  PEEK(LO(N) +SA +C +(I -1))
  349. 10410 PL$ = PL$ +HD$( FN HX(X/16)) +HD$( FN HX(X)) +" "
  350. 10420  NEXT I
  351. 10430 PL$ =  LEFT$(PL$ +"          ",14)
  352. 10440  ON  LEN( STR$(N)) GOSUB 10290,10300,10310
  353. 10450 PL$ = PL$ +FIL$ + STR$(N) +" "
  354. 10460  IF C = 0  THEN PL$ = PL$ + LEFT$(IN$,78)
  355. 10470  PRINT PL$
  356. 10480 LN = LN +1: IF LN = 56  THEN  GOSUB 10540: REM  PAGE HEADER
  357. 10490  NEXT C
  358. 10500  GOTO 10240
  359. 10510 :
  360. 10520  REM  PRINT HEADER
  361. 10530 :
  362. 10540  PRINT  CHR$(12)
  363. 10550  PRINT TL$;P;: PRINT :P = P +1:LN = 0: RETURN