/
/   A program for "simul8" that
/   searches through blocks 0-3 of the simulated disc for
/   words that, when masked with 00&7 octal, equal 0043 octal.
/
/   The program prints each disc block number (as an octal
/   number).
/   This block number is followed by a list of index
/   numbers of those words in that block which
/   which satisfy the mask-&-test condition, together with the (unmasked)
/   values in those words. (Word index numbers and values are
/   also to be printed in octal).
/
/   program discdump;
/   var
/    blockno : integer;
/    buffer  : array[0..127] of integer;
/    mask  : integer;
/    val   : integer;
/    count   : integer;
/
/ procedure read_disc();
/ begin
/    seek_disc_block(blockno);
/    wait_for_seek_flag();
/    read_disc_into(buffer);
/    wait_for_disc_read_flag();
/ end;
/
/ procedure test&mask();
/ var
/   word : integer;
/   temp : integer;
/ begin
/
/    word := 0;
/    repeat
/       temp := buffer[word] && mask;
/       if (temp = val) then
/          writeln(word: oct,' : ',buffer[word]: oct); {outputs in octal }
/       word := word+1;
/    until (word=128);
/    writeln;
/ end;
/
/
/   begin
/    blockno := 0;
/    count   := -4;
/    mask  := O0077; { octal constant 0077 }
/    val   := O0043; { octal value  0043 }
/
/    repeat
/       read_disc();
/       writeln('Disc block ',blockno: oct); { output blockno inoctal }
/       test&mask();
/       blockno := blockno+1;
/       count := count+1;
/    until (count=0);
/
/   end.
/
/
*20
blckno, 0 / disc block currently being processed
buffer, dbuff / where data read from disc gets stored
count,  0 / count of blocks processed
mask,   0 / mask to be used
val, 0 / value sought
*200
start,  cla cll
/    blockno := 0;
/    count   := -4;
/    mask  := O0077; { octal constant 0077 }
/    val   := O0043; { octal value  0043 }
   dca blckno
   tad four
   cia
   dca count
   tad smask
   dca mask
   tad sval
   dca val
/    repeat
/       read_disc();
/       writeln('Disc block ',blockno: oct); { output blockno inoctal }
/       test&mask();
/       blockno := blockno+1;
/       count := count+1;
/    until (count=0);
loop,   tad blckno
   jms i prddsc
/  writeln('Disc block : ',blckno);
   tad amsg1
   jms i pmsg
   tad blckno
   jms i pocto
   tad amsg2
   jms i pmsg
   jms i ptstms
/  check for termination of loop
   isz blckno
   nop
   isz count
   jmp loop
/  final writeln
   tad amsg2
   jms i pmsg
   hlt
four,   4
sval,   0043 / fixed value sought
smask,  0077 / fixed mask to be used
pocto,  octo / pointer to octal number printing routine
pmsg,   msg  / pointer to message printing routine
ptstms, tstmsk  / pointer to mask&test routine
prddsc, rddsc   / pointer to disc reading routine
amsg1,  m1   / address of message 1 ('Disc block : ')
amsg2,  m2   / address of message 2 (couple of newlines)
/ - - - - - - -- - - - - - -- - - - - - -- - - - - - -- - - - - - -
*400
/  Disc read routine, enter with desired block number
/  in acc.
/ procedure read_disc();
/ begin
/    seek_disc_block(blockno);
/    wait_for_seek_flag();
/    read_disc_into(buffer);
/    wait_for_disc_read_flag();
/ end;
/
rddsc, 0
   dlsk  / start seek for block
   cla
wait1,  dssf / wait for seek flag to set indicating block found
   jmp wait1
   dscf  / clear flag
   tad buffer
   dlma  / load disc address register with memory location for data
   cla
   drd
wait2,  dtsf / wait for flag to set indicating transfer complete
   jmp wait2
   dtcf
   jmp i rddsc
/ - - - - - - -- - - - - - -- - - - - - -- - - - - - -- - - - - - -
/ standard tty output, and a message printing routine
put, 0
   tls
putl,   tsf
   jmp putl
   cla cll
   jmp i put
/ - - - - - - -- - - - - - -- - - - - - -- - - - - - -- - - - - - -
/
/ message, get address in acc on entry,
/ print all characters in a message; message characters stored
/ one per word starting at given address, terminated by a
/ word containing zero.
msg, 0
   dca mptr
lmsg,   tad i mptr
   sna
   jmp i msg        / found zero word end mark
   jms put
   isz mptr
   nop
   jmp lmsg
mptr,   0
/ - - - - - - -- - - - - - -- - - - - - -- - - - - - -- - - - - - -
/
/ print an octal number passed in acc
/
octo,   0
   dca oval
/  mask out each 3-bit group in turn
/
/  first, pick on bits 0-1-2,
/  shift these left, via link
   tad oval
   rtl
   rtl
   jms oput
/
/  now pick on 3-4-5, these have to be
/  laboriously right shifted
   tad oval
   rtr
   rtr
   rtr
   jms oput
/
/  now, bits 6-7-8,
   tad oval
   rtr
   rar
   jms oput
/
/  and finally, 9-10-11
   tad oval
   jms oput
   jmp i octo
oval,   0
/ - - - - - - -- - - - - - -- - - - - - -- - - - - - -- - - - - - -
/
/ oput,
/  mask off 3 least sig bits of acc
/  convert octal digit left into character
/  send it
oput,   0
   and seven
   tad zeroch
   jms put
   jmp i oput
seven,  7
zeroch, 60
/ - - - - - - -- - - - - - -- - - - - - -- - - - - - -- - - - - - -
*600
/  search through buffer,
/
/ procedure test&mask();
/ var
/   word : integer;
/   temp : integer;
/ begin
/
/    word := 0;
/    repeat
/       temp := buffer[word] && mask;
/       if (temp = val) then
/          writeln(word: oct,' : ',buffer[word]: oct); {outputs in octal }
/       word := word+1;
/    until (word=128);
/    writeln;
/ end;
/
/
tstmsk, 0
   cla cll
/  set up counter, this can serve as
/  both the index number of the word
/  and for testing for completion of loop
   dca word
/  set a pointer to the array, since we'll be
/  scanning through array in sequence might
/  as well just use a pointer that gets incremented
/  rather than code for accessing arbitrary element
   tad buffer
   dca tptr
tloop,  tad i tptr   / get next element
   and mask    / select bits
   cia
   tad val     / test for equality with val
   sza cla
   jmp tend
/  ok, the value of current word when tested under
/  mask equals that sought, so need printouts
   tad word     / index number of word
   jms i tpocto  / print in octal
   tad amsg3     / the address of message ' : '
   jms i tpmsg
   tad i tptr    / the value
   jms i tpocto
   tad amsg4     / the address of the "newline" message
   jms i tpmsg
/
/  end of tstmsk loop,
/     need i) update tptr
/       ii) increment index
/        iii) check for termination
tend,   isz tptr   / increments tptr
   nop      / (unnecessary caution, tptr won't get out of range)
   iac
   tad word
   dca word
   tad word
   cia
   tad c200
   sza cla
   jmp tloop
/  finished this block,
/  print an extra newline then return from subroutine
   tad amsg4
   jms i tpmsg
   jmp i tstmsk
tpmsg,  msg
tpocto, octo
c200,   0200
amsg4,  m2
amsg3,  m3
tptr,   0
word,  0
/ - - - - - - -- - - - - - -- - - - - - -- - - - - - -- - - - - - -
*1000
/  Messages,
/  m1 = 'Disc block : '
m1,  104   / D
   151   / i
   163   / s
   143   / c
    40   / space
   142   / b
   154   / l
   157   / o
   143   / c
   153   / k
   40    / space
   72    / :
   40    / space
   0
/
/ m2,   newline
m2,  15
	12  / may need cr lf combination, depends on your op-sys
   0
/ m3, ' : '
m3,  40
   72
   40
   0
/ - - - - - - -- - - - - - -- - - - - - -- - - - - - -- - - - - - -
*1200
dbuff, 0
$
