home *** CD-ROM | disk | FTP | other *** search
/ ftp.update.uu.se / ftp.update.uu.se.2014.03.zip / ftp.update.uu.se / pub / rainbow / msdos / decus / RB128 / tstmsk.txt < prev    next >
Text File  |  1995-06-04  |  7KB  |  324 lines
  1. /
  2. /   A program for "simul8" that
  3. /   searches through blocks 0-3 of the simulated disc for
  4. /   words that, when masked with 00&7 octal, equal 0043 octal.
  5. /
  6. /   The program prints each disc block number (as an octal
  7. /   number).
  8. /   This block number is followed by a list of index
  9. /   numbers of those words in that block which
  10. /   which satisfy the mask-&-test condition, together with the (unmasked)
  11. /   values in those words. (Word index numbers and values are
  12. /   also to be printed in octal).
  13. /
  14. /   program discdump;
  15. /   var
  16. /    blockno : integer;
  17. /    buffer  : array[0..127] of integer;
  18. /    mask  : integer;
  19. /    val   : integer;
  20. /    count   : integer;
  21. /
  22. / procedure read_disc();
  23. / begin
  24. /    seek_disc_block(blockno);
  25. /    wait_for_seek_flag();
  26. /    read_disc_into(buffer);
  27. /    wait_for_disc_read_flag();
  28. / end;
  29. /
  30. / procedure test&mask();
  31. / var
  32. /   word : integer;
  33. /   temp : integer;
  34. / begin
  35. /
  36. /    word := 0;
  37. /    repeat
  38. /       temp := buffer[word] && mask;
  39. /       if (temp = val) then
  40. /          writeln(word: oct,' : ',buffer[word]: oct); {outputs in octal }
  41. /       word := word+1;
  42. /    until (word=128);
  43. /    writeln;
  44. / end;
  45. /
  46. /
  47. /   begin
  48. /    blockno := 0;
  49. /    count   := -4;
  50. /    mask  := O0077; { octal constant 0077 }
  51. /    val   := O0043; { octal value  0043 }
  52. /
  53. /    repeat
  54. /       read_disc();
  55. /       writeln('Disc block ',blockno: oct); { output blockno inoctal }
  56. /       test&mask();
  57. /       blockno := blockno+1;
  58. /       count := count+1;
  59. /    until (count=0);
  60. /
  61. /   end.
  62. /
  63. /
  64. *20
  65. blckno, 0 / disc block currently being processed
  66. buffer, dbuff / where data read from disc gets stored
  67. count,  0 / count of blocks processed
  68. mask,   0 / mask to be used
  69. val, 0 / value sought
  70. *200
  71. start,  cla cll
  72. /    blockno := 0;
  73. /    count   := -4;
  74. /    mask  := O0077; { octal constant 0077 }
  75. /    val   := O0043; { octal value  0043 }
  76.    dca blckno
  77.    tad four
  78.    cia
  79.    dca count
  80.    tad smask
  81.    dca mask
  82.    tad sval
  83.    dca val
  84. /    repeat
  85. /       read_disc();
  86. /       writeln('Disc block ',blockno: oct); { output blockno inoctal }
  87. /       test&mask();
  88. /       blockno := blockno+1;
  89. /       count := count+1;
  90. /    until (count=0);
  91. loop,   tad blckno
  92.    jms i prddsc
  93. /  writeln('Disc block : ',blckno);
  94.    tad amsg1
  95.    jms i pmsg
  96.    tad blckno
  97.    jms i pocto
  98.    tad amsg2
  99.    jms i pmsg
  100.    jms i ptstms
  101. /  check for termination of loop
  102.    isz blckno
  103.    nop
  104.    isz count
  105.    jmp loop
  106. /  final writeln
  107.    tad amsg2
  108.    jms i pmsg
  109.    hlt
  110. four,   4
  111. sval,   0043 / fixed value sought
  112. smask,  0077 / fixed mask to be used
  113. pocto,  octo / pointer to octal number printing routine
  114. pmsg,   msg  / pointer to message printing routine
  115. ptstms, tstmsk  / pointer to mask&test routine
  116. prddsc, rddsc   / pointer to disc reading routine
  117. amsg1,  m1   / address of message 1 ('Disc block : ')
  118. amsg2,  m2   / address of message 2 (couple of newlines)
  119. / - - - - - - -- - - - - - -- - - - - - -- - - - - - -- - - - - - -
  120. *400
  121. /  Disc read routine, enter with desired block number
  122. /  in acc.
  123. / procedure read_disc();
  124. / begin
  125. /    seek_disc_block(blockno);
  126. /    wait_for_seek_flag();
  127. /    read_disc_into(buffer);
  128. /    wait_for_disc_read_flag();
  129. / end;
  130. /
  131. rddsc, 0
  132.    dlsk  / start seek for block
  133.    cla
  134. wait1,  dssf / wait for seek flag to set indicating block found
  135.    jmp wait1
  136.    dscf  / clear flag
  137.    tad buffer
  138.    dlma  / load disc address register with memory location for data
  139.    cla
  140.    drd
  141. wait2,  dtsf / wait for flag to set indicating transfer complete
  142.    jmp wait2
  143.    dtcf
  144.    jmp i rddsc
  145. / - - - - - - -- - - - - - -- - - - - - -- - - - - - -- - - - - - -
  146. / standard tty output, and a message printing routine
  147. put, 0
  148.    tls
  149. putl,   tsf
  150.    jmp putl
  151.    cla cll
  152.    jmp i put
  153. / - - - - - - -- - - - - - -- - - - - - -- - - - - - -- - - - - - -
  154. /
  155. / message, get address in acc on entry,
  156. / print all characters in a message; message characters stored
  157. / one per word starting at given address, terminated by a
  158. / word containing zero.
  159. msg, 0
  160.    dca mptr
  161. lmsg,   tad i mptr
  162.    sna
  163.    jmp i msg        / found zero word end mark
  164.    jms put
  165.    isz mptr
  166.    nop
  167.    jmp lmsg
  168. mptr,   0
  169. / - - - - - - -- - - - - - -- - - - - - -- - - - - - -- - - - - - -
  170. /
  171. / print an octal number passed in acc
  172. /
  173. octo,   0
  174.    dca oval
  175. /  mask out each 3-bit group in turn
  176. /
  177. /  first, pick on bits 0-1-2,
  178. /  shift these left, via link
  179.    tad oval
  180.    rtl
  181.    rtl
  182.    jms oput
  183. /
  184. /  now pick on 3-4-5, these have to be
  185. /  laboriously right shifted
  186.    tad oval
  187.    rtr
  188.    rtr
  189.    rtr
  190.    jms oput
  191. /
  192. /  now, bits 6-7-8,
  193.    tad oval
  194.    rtr
  195.    rar
  196.    jms oput
  197. /
  198. /  and finally, 9-10-11
  199.    tad oval
  200.    jms oput
  201.    jmp i octo
  202. oval,   0
  203. / - - - - - - -- - - - - - -- - - - - - -- - - - - - -- - - - - - -
  204. /
  205. / oput,
  206. /  mask off 3 least sig bits of acc
  207. /  convert octal digit left into character
  208. /  send it
  209. oput,   0
  210.    and seven
  211.    tad zeroch
  212.    jms put
  213.    jmp i oput
  214. seven,  7
  215. zeroch, 60
  216. / - - - - - - -- - - - - - -- - - - - - -- - - - - - -- - - - - - -
  217. *600
  218. /  search through buffer,
  219. /
  220. / procedure test&mask();
  221. / var
  222. /   word : integer;
  223. /   temp : integer;
  224. / begin
  225. /
  226. /    word := 0;
  227. /    repeat
  228. /       temp := buffer[word] && mask;
  229. /       if (temp = val) then
  230. /          writeln(word: oct,' : ',buffer[word]: oct); {outputs in octal }
  231. /       word := word+1;
  232. /    until (word=128);
  233. /    writeln;
  234. / end;
  235. /
  236. /
  237. tstmsk, 0
  238.    cla cll
  239. /  set up counter, this can serve as
  240. /  both the index number of the word
  241. /  and for testing for completion of loop
  242.    dca word
  243. /  set a pointer to the array, since we'll be
  244. /  scanning through array in sequence might
  245. /  as well just use a pointer that gets incremented
  246. /  rather than code for accessing arbitrary element
  247.    tad buffer
  248.    dca tptr
  249. tloop,  tad i tptr   / get next element
  250.    and mask    / select bits
  251.    cia
  252.    tad val     / test for equality with val
  253.    sza cla
  254.    jmp tend
  255. /  ok, the value of current word when tested under
  256. /  mask equals that sought, so need printouts
  257.    tad word     / index number of word
  258.    jms i tpocto  / print in octal
  259.    tad amsg3     / the address of message ' : '
  260.    jms i tpmsg
  261.    tad i tptr    / the value
  262.    jms i tpocto
  263.    tad amsg4     / the address of the "newline" message
  264.    jms i tpmsg
  265. /
  266. /  end of tstmsk loop,
  267. /     need i) update tptr
  268. /       ii) increment index
  269. /        iii) check for termination
  270. tend,   isz tptr   / increments tptr
  271.    nop      / (unnecessary caution, tptr won't get out of range)
  272.    iac
  273.    tad word
  274.    dca word
  275.    tad word
  276.    cia
  277.    tad c200
  278.    sza cla
  279.    jmp tloop
  280. /  finished this block,
  281. /  print an extra newline then return from subroutine
  282.    tad amsg4
  283.    jms i tpmsg
  284.    jmp i tstmsk
  285. tpmsg,  msg
  286. tpocto, octo
  287. c200,   0200
  288. amsg4,  m2
  289. amsg3,  m3
  290. tptr,   0
  291. word,  0
  292. / - - - - - - -- - - - - - -- - - - - - -- - - - - - -- - - - - - -
  293. *1000
  294. /  Messages,
  295. /  m1 = 'Disc block : '
  296. m1,  104   / D
  297.    151   / i
  298.    163   / s
  299.    143   / c
  300.     40   / space
  301.    142   / b
  302.    154   / l
  303.    157   / o
  304.    143   / c
  305.    153   / k
  306.    40    / space
  307.    72    / :
  308.    40    / space
  309.    0
  310. /
  311. / m2,   newline
  312. m2,  15
  313.     12  / may need cr lf combination, depends on your op-sys
  314.    0
  315. / m3, ' : '
  316. m3,  40
  317.    72
  318.    40
  319.    0
  320. / - - - - - - -- - - - - - -- - - - - - -- - - - - - -- - - - - - -
  321. *1200
  322. dbuff, 0
  323. $
  324.