home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / DRI-archive / roche / SCB.BAS < prev    next >
BASIC Source File  |  2009-12-11  |  10KB  |  246 lines
  1. 10 REM SCB.BAS  by Emmanuel ROCHE
  2. 20 '
  3. 30 hc$ = "N"  ' Default = no HardCopy (hc$)
  4. 40 PRINT
  5. 50 INPUT "SCB: Do you want a hardcopy (Y/N) : " ; hc$
  6. 60 hc$ = UPPER$ (hc$)
  7. 70 '
  8. 80 IF CHR$ (PEEK (&H151) ) = "2" THEN mallard = 2 : GOTO 160  ' Version 1.29
  9. 90 IF CHR$ (PEEK (&H151) ) = "3" THEN mallard = 3 : GOTO 160  ' Version 1.39
  10. 100 '
  11. 110 PRINT
  12. 120 PRINT CHR$ (7) ; "Bad version of Mallard-80 BASIC"
  13. 130 PRINT
  14. 140 END
  15. 150 '
  16. 160 IF hc$ = "Y" AND mallard = 2 THEN POKE 8792,205
  17. 170 IF hc$ = "Y" AND mallard = 3 THEN POKE 29161,205
  18. 180 '
  19. 190 '-----------------------------------
  20. 200 '
  21. 210 GOTO 310  ' Press RETURN to Continue
  22. 220 '
  23. 230 IF hc$ = "Y" THEN GOTO 290
  24. 240 PRINT
  25. 250 PRINT "Press RETURN to Continue " ;
  26. 260 ret$ = INKEY$ : IF ret$ = "" THEN GOTO 260
  27. 270 PRINT
  28. 280 PRINT
  29. 290 RETURN
  30. 300 '
  31. 310 GOTO 390  ' Address, then address (inverted)
  32. 320 '
  33. 330 PRINT RIGHT$ ("0000" + HEX$ (x), 5) ; "H: " ;
  34. 340 IF PEEK (x + 1) > &H9F THEN PRINT "0" ; ELSE PRINT " " ;
  35. 350 PRINT RIGHT$ ("0" + HEX$ (PEEK (x + 1) ), 2) ;
  36. 360 PRINT RIGHT$ ("0" + HEX$ (PEEK (x) ), 2) ; "H " ;
  37. 370 RETURN
  38. 380 '
  39. 390 GOTO 460  ' Address, then byte
  40. 400 '
  41. 410 PRINT RIGHT$ ("0000" + HEX$ (x), 5) ; "H:   " ;
  42. 420 IF PEEK (x) > &H9F THEN PRINT "0" ; ELSE PRINT " " ;
  43. 430 PRINT RIGHT$ ("0" + HEX$ (PEEK (x) ), 2) ; "H " ;
  44. 440 RETURN
  45. 450 '
  46. 460 GOTO 710  ' Address, then address (inverted), then binary of address
  47. 470 '
  48. 480 GOSUB 330  ' Address, then address (inverted)
  49. 490 a = PEEK (x + 1)
  50. 500 GOSUB 570  ' Decimal --> binary conversion
  51. 510 PRINT RIGHT$ ("0000000" + bina$, 8) ;
  52. 520 a = PEEK (x)
  53. 530 GOSUB 570  ' Decimal --> binary conversion
  54. 540 PRINT RIGHT$ ("0000000" + bina$, 8) ; "B " ;
  55. 550 RETURN
  56. 560 '
  57. 570 REM Binary subroutine
  58. 580 '
  59. 590 bina$ = ""
  60. 600 b$ = "01"
  61. 610 xx = 0
  62. 620 bb = a
  63. 630 cc = bb / 2
  64. 640 IF cc < 1 THEN xx = 1
  65. 650 cc = (cc - INT (bb / 2) ) * 2
  66. 660 bina$ = MID$ (b$, cc + 1, 1) + bina$
  67. 670 IF xx = 1 THEN RETURN
  68. 680    bb = INT (bb / 2)
  69. 690    GOTO 630
  70. 700 '
  71. 710 GOTO 800  ' Drive search chain subroutine
  72. 720 '
  73. 730 IF PEEK (x) = &HFF THEN PRINT "End of search chain )" ; : GOTO 760
  74. 740 IF PEEK (x) = &H0  THEN PRINT "Default drive )" ; : GOTO 760
  75. 750 PRINT CHR$ (&H40 + PEEK (x) ) ; " )" ;
  76. 760 RETURN
  77. 770 '
  78. 780 '---------------------------
  79. 790 '
  80. 800 DEF FN deek (x) = PEEK (x) + 256 * PEEK (x + 1)
  81. 810 '
  82. 820 scb = FN deek (1) - 103  ' 100 bytes before the BIOS
  83. 830 '
  84. 840 PRINT
  85. 850 PRINT "System Control Block"
  86. 860 PRINT "--------------------"
  87. 870 PRINT
  88. 880 '
  89. 890 x = scb + &H0  : GOSUB 410 : PRINT "RO ???"
  90. 900 x = scb + &H1  : GOSUB 410 : PRINT "RO ???"
  91. 910 x = scb + &H2  : GOSUB 410 : PRINT "RO ???"
  92. 920 x = scb + &H3  : GOSUB 410 : PRINT "RO ???"
  93. 930 x = scb + &H4  : GOSUB 410 : PRINT "RO ???"
  94. 940 x = scb + &H5  : GOSUB 410 : PRINT "RO BDOS Version Number."
  95. 950 x = scb + &H6  : GOSUB 410 : PRINT "RW Reserved for user use."
  96. 960 x = scb + &H7  : GOSUB 410 : PRINT "RW (Use these four bytes"
  97. 970 x = scb + &H8  : GOSUB 410 : PRINT "RW  for your own flags"
  98. 980 x = scb + &H9  : GOSUB 410 : PRINT "RW  and data.)"
  99. 990 x = scb + &HA  : GOSUB 410 : PRINT "RO ???"
  100. 1000 x = scb + &HB  : GOSUB 410 : PRINT "RO ???"
  101. 1010 x = scb + &HC  : GOSUB 410 : PRINT "RO ???"
  102. 1020 x = scb + &HD  : GOSUB 410 : PRINT "RO ???"
  103. 1030 x = scb + &HE  : GOSUB 410 : PRINT "RO ???"
  104. 1040 x = scb + &HF  : GOSUB 410 : PRINT "RO SUBMIT drive. ( " ; : GOSUB 740
  105. : PRINT
  106. 1050 x = scb + &H10 : GOSUB 330 : PRINT "RW Program Error Return Code. " ;
  107. 1060 code = FN deek (x)
  108. 1070 IF code = &H0 THEN PRINT "(CCP loaded the program.)"
  109. 1080 IF (code > &H0) AND (code < &HFF00) THEN PRINT "(Successful return)"
  110. 1090 IF (code > &HFEFF) AND (code < &HFF80) THEN PRINT "(Unsuccessful
  111. return)"
  112. 1100 IF (code > &HFF7F) AND (code < &HFFFD) THEN PRINT "(Reserved)"
  113. 1110 IF code = &HFFFD THEN PRINT "(Fatal BDOS error.)"
  114. 1120 IF code = &HFFFE THEN PRINT "(The user typed a CTRL-C.)"
  115. 1130 '
  116. 1140 GOSUB 230  ' Press RETURN to Continue
  117. 1150 '
  118. 1160 x = scb + &H12 : GOSUB 410 : PRINT "RO Page address of multiple line
  119. RSX."
  120. 1170 x = scb + &H13 : GOSUB 410 : PRINT "RO CCP Default Disk. ( " ; CHR$
  121. (&H41 + PEEK (x) ) ; " )"
  122. 1180 x = scb + &H14 : GOSUB 410 : PRINT "RO CCP Default User. (" ; PEEK (x)
  123. ; ")"
  124. 1190 x = scb + &H15 : GOSUB 330 : PRINT "RO Pointer to multiple line in
  125. RSX."
  126. 1200 x = scb + &H17 : GOSUB 410 : GOSUB 520 : PRINT "RO BDOS-CCP Flags."
  127. 1210 x = scb + &H18 : GOSUB 410 : GOSUB 520 : PRINT "RO BDOS-CCP Flags."
  128. 1220 x = scb + &H19 : GOSUB 410 : GOSUB 520 : PRINT "RO BDOS-CCP Flags."
  129. 1230 x = scb + &H1A : GOSUB 410 : PRINT "RW Console Width. (" ; PEEK (x) + 1
  130. ; "columns )"
  131. 1240 x = scb + &H1B : GOSUB 410 : PRINT "RO Console Column Position. (" ;
  132. PEEK (x) ; ")"
  133. 1250 x = scb + &H1C : GOSUB 410 : PRINT "RW Console Page Length. (" ; PEEK
  134. (x) ; "lines )"
  135. 1260 x = scb + &H1D : GOSUB 410 : PRINT "RO ???"
  136. 1270 x = scb + &H1E : GOSUB 330 : PRINT "RO Pointer to first  command line
  137. text."
  138. 1280 x = scb + &H20 : GOSUB 330 : PRINT "RO Pointer to second command line
  139. text."
  140. 1290 x = scb + &H22 : GOSUB 480 : PRINT "RW CONIN  Redirection Vector.
  141. (@CIVEC)"
  142. 1300 x = scb + &H24 : GOSUB 480 : PRINT "RW CONOUT Redirection Vector.
  143. (@COVEC)"
  144. 1310 x = scb + &H26 : GOSUB 480 : PRINT "RW AUXIN  Redirection Vector.
  145. (@AIVEC)"
  146. 1320 x = scb + &H28 : GOSUB 480 : PRINT "RW AUXOUT Redirection Vector.
  147. (@AOVEC)"
  148. 1330 x = scb + &H2A : GOSUB 480 : PRINT "RW LSTOUT Redirection Vector.
  149. (@LOVEC)"
  150. 1340 '
  151. 1350 GOSUB 230  ' Press RETURN to Continue
  152. 1360 '
  153. 1370 x = scb + &H2C : GOSUB 410 : PRINT "RW Page Mode. " ;
  154. 1380 IF PEEK (x) = &H0 THEN PRINT "(One page at a time)" ELSE PRINT "(Use
  155. CTRL-S/CTRL-Q)"
  156. 1390 x = scb + &H2D : GOSUB 410 : PRINT "RO ???"
  157. 1400 x = scb + &H2E : GOSUB 410 : PRINT "RW " ;
  158. 1410 IF PEEK (x) = &H0  THEN PRINT "CTRL-H  is a backspace character
  159. (moves back and deletes)."
  160. 1420 IF PEEK (x) = &HFF THEN PRINT "CTRL-H  is a rub/del character
  161. (echoes the deleted character)."
  162. 1430 x = scb + &H2F : GOSUB 410 : PRINT "RW " ;
  163. 1440 IF PEEK (x) = &H0  THEN PRINT "rub/del echoes the deleted character."
  164. 1450 IF PEEK (x) = &HFF THEN PRINT "rub/del is interpreted as a CTRL-H
  165. (moves back and deletes)."
  166. 1460 x = scb + &H30 : GOSUB 410 : PRINT "RO SUBMIT mode keyboard status?"
  167. 1470 x = scb + &H31 : GOSUB 410 : PRINT "RO ???"
  168. 1480 x = scb + &H32 : GOSUB 410 : PRINT "RO ???"
  169. 1490 x = scb + &H33 : GOSUB 480 : PRINT "RW Console Mode."
  170. 1500 x = scb + &H35 : GOSUB 330 : PRINT "RO Address of BD0S 128-byte buffer.
  171. (@BNKBF)"
  172. 1510 x = scb + &H37 : GOSUB 410 : PRINT "RW Output Delimiter Character. " ;
  173. 1520 IF (PEEK (x) < &H20) OR (PEEK (x) > &H7E) THEN PRINT ELSE PRINT "( " ;
  174. CHR$ (PEEK (x) ) ; " )"
  175. 1530 x = scb + &H38 : GOSUB 410 : PRINT "RW List Output Flag. " ;
  176. 1540 IF PEEK (x) = &H0 THEN PRINT "(No printer echo)" : GOTO 1570
  177. 1550 IF PEEK (x) = &H1 THEN PRINT "(Printer echo)" : GOTO 1570
  178. 1560 PRINT CHR$ (7) ; "ERROR: Bad byte value !!!"
  179. 1570 x = scb + &H39 : GOSUB 410 : PRINT "RO Keyboard lock byte?"
  180. 1580 x = scb + &H3A : GOSUB 330 : PRINT "RO Address of System Control
  181. Block."
  182. 1590 x = scb + &H3C : GOSUB 330 : PRINT "RO Current DMA Address. (@CRDMA)"
  183. 1600 x = scb + &H3E : GOSUB 410 : PRINT "RO Current Disk. ( " ; CHR$ (&H41 +
  184. PEEK (x) ) ; " )  (@CRDSK)"
  185. 1610 x = scb + &H3F : GOSUB 330 : PRINT "RO Pointer to FCB in use by BDOS.
  186. (@VINFO)"
  187. 1620 x = scb + &H41 : GOSUB 410 : PRINT "RO (Flag to above pointer)
  188. (@RESEL)"
  189. 1630 x = scb + &H42 : GOSUB 410 : PRINT "RO BDOS function number (" ; PEEK
  190. (x) ; ") at last disk error."
  191. 1640 x = scb + &H43 : GOSUB 410 : PRINT "RO BDOS function number (" ; PEEK
  192. (x) ; ") for error message. (@FX)"
  193. 1650 '
  194. 1660 GOSUB 230  ' Press RETURN to Continue
  195. 1670 '
  196. 1680 x = scb + &H44 : GOSUB 410 : PRINT "RO Current User Number. (" ; PEEK
  197. (x) ; ")  (@USRCD)"
  198. 1690 x = scb + &H45 : GOSUB 330 : PRINT "RO Main file position entry
  199. storage?"
  200. 1700 x = scb + &H47 : GOSUB 330 : PRINT "RO ???"
  201. 1710 x = scb + &H49 : GOSUB 410 : PRINT "RO ???"
  202. 1720 x = scb + &H4A : GOSUB 410 : PRINT "RW BDOS Multi-Sector Count. (" ;
  203. PEEK (x) ; ")  (@MLTIO)"
  204. 1730 x = scb + &H4B : GOSUB 410 : PRINT "RW BDOS Error Mode. ( " ;
  205. 1740 IF PEEK (x) = &HFF THEN PRINT "Return Error mode )" ;
  206. 1750 IF PEEK (x) = &HFE THEN PRINT "Return and Display mode )" ;
  207. 1760 PRINT "Default mode )" ;
  208. 1770 PRINT "  (@ERMDE)"
  209. 1780 x = scb + &H4C : GOSUB 410 : PRINT "RW Drive Search Chain. ( " ; :
  210. GOSUB 730 : PRINT
  211. 1790 x = scb + &H4D : GOSUB 410 : PRINT "RW ( " ; : GOSUB 730 : PRINT
  212. 1800 x = scb + &H4E : GOSUB 410 : PRINT "RW ( " ; : GOSUB 730 : PRINT
  213. 1810 x = scb + &H4F : GOSUB 410 : PRINT "RW ( " ; : GOSUB 730 : PRINT
  214. 1820 x = scb + &H50 : GOSUB 410 : PRINT "RW Temporary File Drive. ( " ; :
  215. GOSUB 730 : PRINT
  216. 1830 x = scb + &H51 : GOSUB 410 : PRINT "RO Error Drive. ( " ; : GOSUB 730 :
  217. PRINT "  (@ERDSK)"
  218. 1840 x = scb + &H52 : GOSUB 410 : PRINT "RO ???"
  219. 1850 x = scb + &H53 : GOSUB 410 : PRINT "RO ???"
  220. 1860 x = scb + &H54 : GOSUB 410 : PRINT "RO Open drive door flag. (@MEDIA)"
  221. 1870 x = scb + &H55 : GOSUB 410 : PRINT "RO ???"
  222. 1880 x = scb + &H56 : GOSUB 410 : PRINT "RO ???"
  223. 1890 x = scb + &H57 : GOSUB 410 : GOSUB 520 : PRINT "RO BDOS Flags.
  224. (@BFLGS)"
  225. 1900 '
  226. 1910 GOSUB 230  ' Press RETURN to Continue
  227. 1920 '
  228. 1930 x = scb + &H58 : GOSUB 330 : PRINT "RW Date in days since 1 Jan 78.
  229. (@DATE)"
  230. 1940 x = scb + &H5A : GOSUB 410 : PRINT "RW Hours   in BCD. (@HOUR)"
  231. 1950 x = scb + &H5B : GOSUB 410 : PRINT "RW Minutes in BCD. (@MIN)"
  232. 1960 x = scb + &H5C : GOSUB 410 : PRINT "RW Seconds in BCD. (@SEC)"
  233. 1970 x = scb + &H5D : GOSUB 330 : PRINT "RO Common Memory Base Address."
  234. 1980 x = scb + &H5F : GOSUB 410 : PRINT "RO Error message jump." ;
  235. 1990 IF PEEK (x) = &HC3 THEN PRINT "  ( JUMP " ; : x = scb + &H60 : GOSUB
  236. 340 : PRINT ")" ; "  (?ERJMP)" ELSE PRINT
  237. 2000 x = scb + &H60 : GOSUB 330 : PRINT "RO (Cf. above)"
  238. 2010 x = scb + &H62 : GOSUB 330 : PRINT "RO Address of current top of User
  239. TPA. (@MXTPA)"
  240. 2020 PRINT
  241. 2030 '
  242. 2040 IF hc$ = "Y" AND mallard = 2 THEN POKE 8792,195
  243. 2050 IF hc$ = "Y" AND mallard = 3 THEN POKE 29161,195
  244. 2060 '
  245. 2070 END
  246.