home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib37a.dsk / NOVEMBER.1989 / NIBBLE.ASM2.bas < prev   
BASIC Source File  |  2023-02-26  |  12KB  |  181 lines
  1. 10  REM  **************************
  2. 20  REM  *  NIBBLE.ASM2           *
  3. 30  REM  * BY KENNETH A. PLUM     *
  4. 40  REM  * COPYRIGHT(C) 1989      *
  5. 50  REM  * MINDCRAFT PUBL. CORP.  *
  6. 60  REM  * CONCORD, MA 01742      *
  7. 70  REM  **************************
  8. 80  REM 
  9. 90 EF = 0: ONERR  GOTO 1690
  10. 100  GOTO 1110
  11. 110  REM    EVALUATE ARGUMENT SUBROUTINE
  12. 120 AG(0) = 1:AG(1) = 0:AG(2) = 0:AG$(1) = "":AG$(2) = "":L = 1:L1 = 1:L2 =  LEN(AG$(0))
  13. 130 T$ =  MID$ (AG$(0),L,1): IF   NOT (T$ = "+"  OR T$ = "-")  AND L < = L2  THEN L = L +1: GOTO 130
  14. 140  IF L <L2  THEN AG$(1) =  LEFT$(AG$(0),L -1):AG$(2) =  MID$ (AG$(0),L +1):AG(0) = 2:L2 = 1 +( MID$ (AG$(0),L,1) = "-"): GOTO 160
  15. 150 L2 = 0:AG$(1) = AG$(0)
  16. 160 T$ =  LEFT$(AG$(L1),1): IF T$ = "*"  THEN AG(L1) = PC +2 *(CI%(CC) = 2): GOTO 280
  17. 170  IF T$ =  CHR$(34)  THEN AG(L1) =  ASC( MID$ (AG$(L1),2,1)): GOTO 280
  18. 180  IF T$ <"A"  AND T$ < >":"  THEN  GOTO 240: REM  NOT LABEL, TRY NUMBER
  19. 185  ON (T$ = ":") GOTO 190: & S,AG$(L1),GL$(1),GM,H: GOTO 220
  20. 190 H = 0: FOR L = LR +1 TO GM: IF  LEFT$(GL$(L),1) < >T$  THEN L = GM
  21. 200  IF GL$(L) = AG$(L1)  THEN H = L:L = GM
  22. 210  NEXT 
  23. 220  IF GL$(H) < >AG$(L1)  THEN ER = 8:AG(0) = 65535: GOTO 310
  24. 230 AG(L1) = GA(H): GOTO 280
  25. 240  IF T$ = "$"  THEN  FOR L =  LEN(AG$(L1)) TO 2  STEP  -1:AG(L1) = AG(L1) +( ASC( MID$ (AG$(L1),L,1)) -48 -7 *( MID$ (AG$(L1),L,1) >"@")) *(16 ^( LEN(AG$(L1)) -L)): NEXT : GOTO 280
  26. 250  IF T$ = "%"  THEN  FOR L =  LEN(AG$(L1)) TO 2  STEP  -1:AG(L1) = AG(L1) +(( ASC( MID$ (AG$(L1),L,1)) -48) *(2 ^( LEN(AG$(L1)) -L))): NEXT : GOTO 280
  27. 260  IF T$ >"/"  AND T$ <":"  THEN AG(L1) =  VAL(AG$(L1)): GOTO 280
  28. 270 ER = 1
  29. 280  IF AG(0) = 2  AND L1 = 1  AND ER = 0  THEN L1 = 2: GOTO 160
  30. 290  IF AG(0) = 1  THEN AG(0) = AG(1): GOTO 310
  31. 300 AG(0) = AG(1) +AG(2) *(L2 = 1) -AG(2) *(L2 = 2)
  32. 310  IF AG(0) <0  OR AG(0) >65535  THEN ER = 2:AG(0) = 65535
  33. 320  RETURN 
  34. 330  REM   GET ADDRESS MODE SUBROUTINE
  35. 340 AM = 0: IF (CC >46  AND CC <51)  AND (PL$(2) = ""  OR PL$(2) = "A")  THEN AM = 1: RETURN 
  36. 350  IF  LEFT$(PL$(2),1) = "#"  THEN AM = 2: RETURN 
  37. 360  IF  LEFT$(PL$(2),1) = "("  THEN AM = 3 +( RIGHT$(PL$(2),3) = ",X)") +2 *( RIGHT$(PL$(2),3) = "),Y"): RETURN 
  38. 370 AG$(0) = PL$(2):A =  RIGHT$(AG$(0),2) = ",X":A1 =  RIGHT$(AG$(0),2) = ",Y": IF (A  OR A1)  THEN AG$(0) =  LEFT$(AG$(0), LEN(AG$(0)) -2)
  39. 380  GOSUB 120: REM    EVAL THAT OPERAND  
  40. 390 AM = 9: IF AG(0) <256  AND ER = 0  THEN AM = 6
  41. 400 AM = AM +(A = 1) +2 *(A1 = 1) +3 *(A1 = 1  AND AM = 6  AND CC < >52  AND CC < >55): RETURN 
  42. 410  REM   ASSEMBLE LINE SUBROUTINE
  43. 420 LC = 0:ER = 0:CD = 0:CV = 0: IF PL$(0) = ""  THEN 490
  44. 430  IF   NOT PN  AND GM = LX  THEN  PRINT D$"CLOSE": PRINT  CHR$(7): PRINT "More than "LX" labels defined...": PRINT "Assembler terminating.": GOTO 1640
  45. 440 LM = LM +1: IF   NOT PN  THEN GM = LM
  46. 450  IF   NOT PN  THEN GL$(GM) = PL$(0):GA(GM) = PC
  47. 460 T$ =  LEFT$(PL$(0),1): IF T$ < >":"  THEN LR = LM
  48. 470  ON (PN)  OR T$ = ":"  OR GM = 1 GOTO 490: & S,PL$(0),GL$(1),GM -1,H
  49. 480  IF H >0  THEN ER = 3
  50. 490  & S,PL$(1),MN$(1),92,CC
  51. 500  IF CC = 0  THEN ER = 5: RETURN 
  52. 510  ON CI%(CC) GOTO 530,550,600,630,680,760,820,890,970,1010,1030,1060
  53. 520  REM   SINGLE OPS
  54. 530 CD = SC%(CC):LC = 1: ON PN GOTO 1080: RETURN 
  55. 540  REM   BRANCH OPS
  56. 550 LC = 2: IF   NOT PN  THEN  RETURN 
  57. 560 CD = BC%(CC -31):AG$(0) = PL$(2): GOSUB 120
  58. 570 A1 = PC +2:CV = AG(0) -A1: IF CV >127  OR CV < -128  THEN ER = 6
  59. 580 CV = CV +256 *(CV <0): GOTO 1080
  60. 590  REM   JSR
  61. 600 LC = 3: IF   NOT PN  THEN  RETURN 
  62. 610 CD = 32:AG$(0) = PL$(2): GOSUB 120:CV = AG(0): GOTO 1080
  63. 620  REM   JMP
  64. 630 LC = 3: IF   NOT PN  THEN  RETURN 
  65. 640 AG$(0) = PL$(2):CD = 76: IF  LEFT$(AG$(0),1) = "("  THEN CD = 108:AG$(0) =  MID$ (AG$(0),2, LEN(AG$(0)) -2)
  66. 650  IF  RIGHT$(AG$(0),2) = ",X"  THEN CD = 124:AG$(0) =  LEFT$(AG$(0), LEN(AG$(0)) -2)
  67. 660  GOSUB 120:CV = AG(0): GOTO 1080
  68. 670  REM   MULTIOPS
  69. 680  GOSUB 340: IF AM = 0  OR MC%(CC -46,AM) = 0  THEN ER = 7: RETURN 
  70. 690 LC = 1 +(AM >1) +(AM >8): IF   NOT PN  THEN  RETURN 
  71. 700  IF AM >5  OR AM = 1  THEN 740: REM    DON'T NEED TO RE-EVALUATE 
  72. 710 AG$(0) = PL$(2): IF  LEFT$(PL$(2),1) = "("  THEN AG$(0) =  MID$ (AG$(0),2, LEN(AG$(0)) -2): IF  RIGHT$(AG$(0),2) = ",X"  OR  RIGHT$(AG$(0),2) = "),"  THEN AG$(0) =  LEFT$(AG$(0), LEN(AG$(0)) -2)
  73. 720  IF  LEFT$(AG$(0),1) = "#"  THEN AG$(0) =  MID$ (AG$(0),2): IF  LEFT$(AG$(0),1) = "<"  THEN AG$(0) =  MID$ (AG$(0),2)
  74. 730  GOSUB 120: IF  LEFT$(PL$(2),2) = "#<"  THEN AG(0) =  INT(AG(0)/256)
  75. 740 CD = MC%(CC -46,AM):CV = AG(0): GOTO 1080
  76. 750  REM   STRING OPS
  77. 760 LC =  LEN(PL$(2)) -2 +(CC = 72): IF   NOT PN  THEN  RETURN 
  78. 770 AG$(0) =  MID$ (PL$(2),2, LEN(PL$(2)) -2):L1 = 0: IF CC = 72  THEN L1 = 1: POKE BP, LEN(AG$(0))
  79. 780  FOR L = (CC <77) + LEN(AG$(0)) *(CC = 77) TO (CC = 77) + LEN(AG$(0)) *(CC <77)  STEP (CC <77) -(CC = 77):A1 =  ASC( MID$ (AG$(0),L,1))
  80. 790  POKE BP +L1,A1 +64 *(CC = 76  AND A1 <64) -64 *(CC = 75  AND A1 >63) +128 *(MB  AND ((CC <74  OR CC = 77)  OR (CC = 74  AND L < LEN(AG$(0))))) +128 *(MB = 0  AND CC = 74  AND L =  LEN(AG$(0)))
  81. 800 L1 = L1 +1: NEXT : RETURN 
  82. 810  REM   BYT,HBY,DDB,DBY,DW,ADR
  83. 820 LC = 1 +(CC >79): IF   NOT PN  THEN  RETURN 
  84. 830 AG$(0) = PL$(2): GOSUB 120: IF CC = 78  THEN AG(0) = AG(0) - INT(AG(0)/256) *256
  85. 840  IF CC = 79  THEN AG(0) =  INT(AG(0)/255)
  86. 850  IF CC = 80  OR CC = 81  THEN AG(0) = (AG(0) - INT(AG(0)/256) *256) *256 + INT(AG(0)/256)
  87. 860 CV = AG(0): POKE BP,CV - INT(CV/256) *256: IF LC >1  THEN  POKE BP +1, INT(CV/256)
  88. 870  RETURN 
  89. 880  REM   DFB,HEX
  90. 890 LC = 0: FOR L1 = 1 TO  LEN(PL$(2)):LC = LC +( MID$ (PL$(2),L1,1) = ","): NEXT :LC = LC +1: IF   NOT PN  THEN  RETURN 
  91. 900 A = 1:P = 1:A1 = 0
  92. 910  IF  MID$ (PL$(2),P,1) < >","  THEN P = P +1: IF P < LEN(PL$(2))  THEN 910
  93. 920  IF P =  LEN(PL$(2))  THEN P = P +1
  94. 930 AG$(0) =  MID$ (PL$(2),A,P -A): IF CC = 85  THEN AG$(0) = "$" +AG$(0)
  95. 940  GOSUB 120: POKE BP +A1,(AG(0) *(AG(0) <256)): IF P < LEN(PL$(2))  THEN P = P +1:A = P:A1 = A1 +1: GOTO 910
  96. 950  RETURN 
  97. 960  REM   DS,DFS
  98. 970  IF PL$(2) = "!"  THEN L = PC - INT(PC/256) *256:LC = 256 -L *(L < >0): GOTO 990
  99. 980 AG$(0) = PL$(2): GOSUB 120:LC = AG(0)
  100. 990  IF   NOT PN  THEN  RETURN 
  101. 1000  FOR L = 0 TO LC: POKE BP +L,0: NEXT : RETURN 
  102. 1010 MB = (PL$(2) = "ON"): RETURN : REM   MSB
  103. 1020  REM   EQU,=
  104. 1030  IF PN  THEN  RETURN 
  105. 1040 AG$(0) = PL$(2): GOSUB 120:GA(GM) = AG(0): RETURN 
  106. 1050  REM   ORG
  107. 1060 AG$(0) = PL$(2): GOSUB 120:PC = AG(0): IF   NOT GS  THEN BA = PC:GS = 1
  108. 1070  RETURN : REM   MAIN ROUTINE DOES CHN
  109. 1080  POKE BP,CD: POKE BP +1,CV - INT(CV/256) *256: IF LC = 3  THEN  POKE BP +2, INT(CV/256)
  110. 1090  RETURN 
  111. 1100  REM  PROGRAM ENTRY POINT
  112. 1110  POKE 34,7: HOME :TL = 0:LM = 0:LR = 0:GM = 0:EF = 2: PRINT D$Q$H$
  113. 1120  REM    READ SOURCE FILE
  114. 1130  PRINT : PRINT "Insert disk with "F$: PRINT "and press <RET> to continue or <SPACE> to abort ";: GET T$: PRINT : IF T$ < > CHR$(13)  THEN 1630
  115. 1140 EF = 3: PRINT D$"VERIFY"F$: PRINT D$Q$F$: PRINT : PRINT "Reading "F$;
  116. 1150  GOSUB 1660: PRINT D$"FRE"
  117. 1160 EF = 4: IF  PEEK(112) - PEEK(110) <4  THEN  PRINT D$"FRE"
  118. 1170  PRINT D$R$F$: & I,E$: IF E$ = ""  THEN E$ = "*"
  119. 1180 T$ =  LEFT$(E$,1):CM = (T$ = "*"  OR T$ = ";"): IF   NOT (CM)  THEN  & P,E$,PL$(0)
  120. 1190 TL = TL +1: PRINT ".";: PRINT D$W$H$: IF CM  THEN  PRINT E$: GOTO 1160
  121. 1200  FOR L = 0 TO 3: PRINT PL$(L): NEXT : PRINT D$
  122. 1210  IF PL$(1) = "CHN"  THEN  PRINT D$C$F$:F$ =  MID$ (PL$(2),2, LEN(PL$(2)) -2): GOTO 1140
  123. 1220 EF = 6: GOSUB 420:PC = PC +LC:ET = ET +(ER >1  AND ER <6)
  124. 1230  IF ER >1  AND ER <6  THEN  PRINT  CHR$(7): PRINT EM$(ER)" in line "TL: PRINT TL"   ";: FOR L = 0 TO 3: PRINT PL$(L)" ";: NEXT : PRINT 
  125. 1250  GOTO 1160: REM   Trap End-of-file to end loop.
  126. 1260  IF ET >0  THEN  PRINT  CHR$(7);ET" Errors detected": PRINT "Assemble anyway ? (Y/N) ";: GET T$: PRINT : IF T$ = "N"  OR T$ = "n"  THEN 1630
  127. 1270  REM   SECOND PASS
  128. 1280  PRINT : PRINT "Put OBJECT disk in drive and press <RET> to continue"
  129. 1290  PRINT "or <SPACE> to abort";: GET T$: PRINT : IF T$ = " "  THEN 1640
  130. 1300  PRINT : PRINT "Do you want hard copy? (Y/N) ";: GET T$:HC = (T$ = "Y"  OR T$ = "y"): PRINT : PRINT 
  131. 1310  IF HC  THEN  PRINT : PRINT "Prepare printer and press <RET> ";: GET T$: HOME : PRINT  CHR$(21): PRINT : PRINT D$"PR#1": PRINT  CHR$(27)"N";
  132. 1320  PRINT "Source file is "SF$: PRINT "Object file is "BF$: PRINT 
  133. 1330 EF = 7:PC = 1
  134. 1340  PRINT D$"FRE": PRINT D$Q$H$: PRINT D$"BSAVE "BF$",A"BA",L1":EF = 8
  135. 1350 PC = 0:ET = 0:LR = 0:LM = 0:PN = 1: FOR SN = 1 TO TL:LC = 0
  136. 1360  IF  PEEK(112) - PEEK(110) <4  THEN  PRINT D$"FRE"
  137. 1370  PRINT D$R$H$: & I,PL$(0):T$ =  LEFT$(PL$(0),1):CM = (T$ = "*"  OR T$ = ";"): IF   NOT (CM)  THEN  FOR L = 1 TO 3: & I,PL$(L): NEXT 
  138. 1380  ON ((CM = 1)  OR PL$(1) = "CHN") GOTO 1400: GOSUB 420
  139. 1390  IF ER  THEN  PRINT EM$(ER)" in line "SN:ET = ET +1:PP = PP +1: IF PP =  >60  AND HC  THEN PP = 0: FOR L = 1 TO 6: PRINT : NEXT 
  140. 1400  & H,PC,T$: PRINT T$;" ";: IF   NOT LC  THEN  PRINT "         ";: GOTO 1440: REM     9 SPACES 
  141. 1410  FOR L1 = 0 TO 2: IF L1 <LC  THEN A =  PEEK(BP +L1): & H,A,T$: PRINT  RIGHT$(T$,2);" ";
  142. 1420  IF L1 > = LC  THEN  PRINT "   ";
  143. 1430  NEXT 
  144. 1440  PRINT  RIGHT$("000" + STR$(SN),4);" ";: IF CM  THEN  PRINT PL$(0):PP = PP +1: GOTO 1510
  145. 1450 E$ = "": FOR L1 = 0 TO 3:E$ = E$ +PL$(L1) +" ": IF  LEN(PL$(L1)) <NL(L1)  THEN E$ = E$ + LEFT$(CL$,NL(L1) - LEN(PL$(L1)))
  146. 1460  NEXT : IF  LEN(E$) >60  THEN E$ =  LEFT$(E$,60)
  147. 1470  PRINT E$:PP = PP +1:L1 = 3: IF LC <4  THEN 1510
  148. 1480  PRINT "     ";: FOR A1 = 0 TO 7: IF A1 +L1 <LC  THEN  & H, PEEK(BP +L1 +A1),T$: PRINT  RIGHT$(T$,2);" ";: REM    5 SPACES 
  149. 1490  NEXT : PRINT :PP = PP +1: IF PP =  >60  AND HC  THEN PP = 0: FOR L = 1 TO 6: PRINT : NEXT 
  150. 1500 L1 = L1 +8: IF LC >L1 +1  THEN 1480
  151. 1510 PC = PC +LC:BP = BP +LC
  152. 1520  IF BP >BS +250  THEN  PRINT D$"BSAVE "BF$",A"BS",L"BP -BS",B"BL:BL = BL +(BP -BS):BP = BS
  153. 1530  IF HC  THEN  IF PP =  >60  THEN  FOR L = 1 TO 6: PRINT : NEXT :PP = 0
  154. 1540  NEXT SN
  155. 1550  IF BP >BS  THEN  PRINT D$"BSAVE "BF$",A"BS",L"BP -BS",B"BL:BL = BL +(BP -BS):BP = BS
  156. 1560  PRINT D$C$H$: PRINT D$"DELETE"H$
  157. 1570  REM   ASSEMBLY COMPLETE
  158. 1580  PRINT : PRINT "Assembly complete": PRINT "Errors ";ET: PRINT "Length ";: & H,BL,T$: PRINT "$"T$: PRINT : PRINT : IF HC  THEN  PRINT  CHR$(12): PRINT : PRINT : PRINT 
  159. 1590  PRINT "Labels defined: ";GM: PRINT :A1 = 1: FOR L1 = 0 TO GM
  160. 1600  ON GL$(L1) = "" GOTO 1620: PRINT  LEFT$(GL$(L1) +"        ",9);: IF GA(L1) >65535  OR GA(L1) <0  THEN GA(L1) = 65535: REM   8 SPACES 
  161. 1610  & H,GA(L1),T$: PRINT T$"   ";:A1 = A1 +1: IF A1 = 6  THEN A1 = 1: IF HC  THEN  PRINT : REM      3 SPACES  
  162. 1620  NEXT : PRINT : PRINT 
  163. 1630  IF HC  THEN  TEXT : HOME 
  164. 1640  PRINT D$"CLOSE": CALL 48888: END 
  165. 1650  REM   STRIP PARAMETERS FROM FILENAME
  166. 1660  FOR P = 1 TO  LEN(F$): IF  MID$ (F$,P,1) = ","  THEN F$ =  LEFT$(F$,P -1)
  167. 1670  NEXT : RETURN 
  168. 1680  REM   ERROR HANDLER
  169. 1690  PRINT  CHR$(4)"CLOSE": PRINT  CHR$(7): ON  PEEK(222) <22 GOTO 1720: IF  PEEK(222) = 77  THEN  PRINT : PRINT "Out of memory. Assembler terminating.": GOTO 1630
  170. 1700  IF  PEEK(222) = 255  THEN  PRINT "CTRL-C pressed to terminate program.": GOTO 1630
  171. 1710  PRINT : PRINT "ERROR # " PEEK(222)" IN LINE " PEEK(218) +256 * PEEK(219): GOTO 1630
  172. 1720 ER =  PEEK(222): POKE 216,0: CALL  -3288: ONERR  GOTO 1690
  173. 1730  IF EF = 4  AND ER = 5  THEN  GOTO 1260
  174. 1740  PRINT : PRINT PM$(ER): PRINT 
  175. 1750  IF EF = 2  THEN  PRINT "While opening temp file in /RAM"
  176. 1760  IF EF = 4  THEN  PRINT "While reading your file / writing temp file"
  177. 1770  IF EF = 7  THEN  PRINT "While opening object code file"
  178. 1780  IF EF = 3  OR EF = 7  THEN  PRINT "Press <RET> to retry or <SPACE> to abort";: GET T$: PRINT 
  179. 1790  IF EF = 3  THEN  ON (T$ =  CHR$(13)) GOTO 1130: GOTO 1630
  180. 1800  IF EF = 7  THEN  IF T$ =  CHR$(13)  THEN  GOTO 1340
  181. 1810  POKE 216,0: GOTO 1630