/ / 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 $