rA%s ~@,H7P0)HIN\K8*IH%=PIN\K8i>0U5$`"sE $Q(Y=\7SeV8*I0s' OyPᒜ$`LT#BgM3(d\W2E Q5; DSKDMP -- Disk maintenance program -*-PALX-*- ; rewritten by Richard L. Lawhorn Jr. 6/18/79 ; This version allows the use of multiple disk drives ; and is more versatile in allowing the addition of ; new types of disk drives. ; ; Also commands have/will be added to allow the manipulation of ; DOS files from one disk drive to another. This includes the ; use of bit maps and UFD/MFD fixing. Also commands to rename, ; delete, and add UFDs have been/will be added. ; ; NOTE: The following constants could change with the ; addition of a new type of disk drive. ; ; secbuf == maximum number of bytes on a single track ; on a disk drive. This number is a product ; the number of bytes per sector (block) and ; number of sectors per track. For the current ; defined disks: ; ; Type Bytes/sector Sectors/track SECBUF ; ; RK 512. 12. 6144. ; RX 128. 26. 3328. ; RL 256. 40. 10240. ; RP 512. 10. 5120. ; ; additional disks should be added to this ; table and secbuf should be set to the highest ; value in the SECBUF column. ; ; maxblk == maximum number of bytes per block on a disk ; drive. It should be the largest value in the ; bytes/sector column. ; secbuf==10240. maxblk==512. versio==%fnam2 ; save version number .TITLE DSKDMP ; define a few useful things and system configuration. .insrt pdp11;defs > ; insert stand alone stuff, including start up routines ; and tests. .insrt pdp11;sastuf > ; insert other useful stuff .insrt pdp11;stuff > ; change a few of the defs so the number of disk drives ; is correct. .if eq * nrl==2 nrk==1 nrx==0 nrp==2 .endc .if eq sys-sao nrl==0 nrk==0 nrx==1 nrp==0 .endc .if ne nrk rkdsr==177400 ; RK11 disk registers rkerr==177402 rkcsr==177404 rkwcr==177406 rkbar==177410 rkdar==177412 .endc .if ne nrp rpdsr==176710 rperr==176712 rpcsr==176714 rpwcr==176716 rpbar==176720 rpcar==176722 rpdar==176724 rpm1r==176726 rpm2r==176730 rpm3r==176732 rpsucr==176734 rpsilo==176736 .endc .if ne nrl rlcsr==174400 ; RL11 disk registers rlbar==174402 rldar==174404 rlmpr==174406 .endc .sbttl Drive Definitions .macro defdsk dnum,dnam,dtyp,ddrv,dblk,dsct,dtrk,dmfd,dbm,dnm .word dnam,dtyp .byte dnum,ddrv .word dblk,dsct,dtrk,dmfd,dbm,dnm ndisk==ndisk+1 .endm dsknam==0 ; Offset for disk name dsktyp==2 ; Offset for disk type dsknum==4 ; Offset for disk number dskdrv==5 ; Offset for disk drive number dlblk==6 ; Offset for number of bytes/block dnsect==10 ; Offset for number of sectors/track dntrak==12 ; Offset for number of tracks/disk dskmfd==14 ; Offset for MFD block number dskbmb==16 ; Offset for bit map block number dsknbm==20 ; Offset for number of bit maps ndisk==0 ; Number of disks on the system dsktab: .if ne nrp rp==1340 rp0==71436 rp1==71437 defdsk ndisk,rp0,rp,0,512.,10.,6300.,172723,172725,102 defdsk ndisk,rp1,rp,1,512.,10.,6300.,172723,172725,102 .endc .if ne nrk rk==1333 rk0==71126 rk1==71127 defdsk ndisk,rk0,rk,0,512.,12.,406.,11272,11273,5 defdsk ndisk,rk1,rk,1,512.,12.,406.,11272,11273,5 .endc .if ne nrx rx==1350 rx0==72136 rx1==72137 defdsk ndisk,rx0,rx,0,128.,26.,77.,2,3,3 defdsk ndisk,rx1,rx,1,128.,26.,77.,2,3,3 .endc .if ne nrl rl==1334 rl0==71176 rl1==71177 defdsk ndisk,rl0,rl,0,256.,40.,512.,47750,47752,26 defdsk ndisk,rl1,rl,1,256.,40.,512.,47750,47752,26 .endc .sbttl Command decoding start: dskdmp: jsr r5,typesc hlomsg-. prompt: mov #go,sp ; reset stack ptr, just in case.... clr silent ; turn output back on clr xonxof ; make sure ready to output clr more ; no more proc for echoing mov bkn,arg ; set initial arg -- val part mov bkn+2,arg+2 ; and DISK# part print ^"DSKDMP> " nxtcom: jsr r5,readc cmpb r0,#'0 if his,< cmpb r0,#'9 blos argcom > mov pc,r5 ; get ptr to comtab add #comtab-.,r5 ; .... loop < tst (r5)+ beq comerr ; at end of table cmp (r5)+,r0 rptl ne > c: add (r5),pc ; go process command comerr: print ^" ?? BAD CMD " br prompt .sbttl Immediate commands ; ? command - print help message. hlpcom: mov pc,more ; do more processing print ^^E Silences output. DSKDMP immediate commands: ^T Trace file blocks ^F List sector as directory ^G Abort and reinit dskdmp ^L Clear screen ^U List sector as MFD ^W Test RP11 controller : Set terminal type ! Divide & Logical and * Multiply + Add - Subtract = Type arg <#> Set arg (Any octal number) ? Print this info F Print available disks and the current one L Set arg: link to next block N Increment arg P Decrement arg S Search disk for word pattern U Set arg to block no. of MFD V Set current disk \ Mod. Like divide, but remainder | Logical or RBOUT Cancel command string Dskdmp deferred commands (Follow with carriage return): / Print contents of arg in core-image. Lf to open next. < Set core-image block # to arg. A Read all of the specified disk. B Convert block no. info to bit-map info. C Set typeout mode(s) for dump command. D Dump the contents of the sector in core. The device to print the dump is set by the : command. The modes to dump in (octal word, octal byte, ascii, and rad50) are set by the C command. E Initialize a disk to DOS format. G List all directories on a disk (not implemented). H read in the requested UFD (1st block). I Image transfer (copy disk). Asks for disk type to be copied. Transfers are one track at a time and if an error should occur user will be queried as to whether to continue or stop. J List all of a UFD. K Create a UFD. M Convert bit-map info to block no. O Delete file. Give a filename and directory name. Q Salvage disk (not available yet). R Read sector arg. T Transfer (copy) blocks from one disk to another, or the same type, of disk. (i.e. from RL to RL or RK to RK). W Write sector ARG. X Exit to BOOT. Y Transfer DOS files from one disk to another. Does a directory at a time, queries the user before transfering each file. Z Zero sector image in core. ] Allocate given block numbers. _ Enter mod-mode. Exit with X.  jmp prompt termcm: print ^"What terminal type? " jsr r5,ireadc ; get terminal type wanted cmp r0,#'T ; does user want a TTY if eq,< mov #%tntt,ttytyp ; set terminal type mov #132.,linel ; set line length print ^"TTY" ; tell user, a TTY was selected > cmp r0,#'V ; does user want a VT52 if eq,< mov #%tnvt,ttytyp ; set terminal type mov #80.,linel ; set line length mov #24.-1,pagel ; set page length sout ^"H" ; home up clr vpos ; set position to home clr hpos ; ... print ^"VT52" ; tell user a VT52 was selected > cmp r0,#'S ; does user want a SuperBee bne 1$ mov #%tnsb,ttytyp ; set terminal type mov #80.,linel ; set line length mov #25.-1,pagel ; set page length sout ^"H 1 1 1 1 1 1 1 1 1H" ; set tabs and leave cursor home clr vpos ; set position to home clr hpos ; ... print ^"SuperBee" ; tell user a SuperBee was selected 1$: print ^" " mov linel,swidth ; set the line width jmp prompt argcom: mov r0,reread ;reread digit that began no. jsr r5,rnumbr ;read number mov r0,arg ;set block number part of arg jmp nxtcom ; set ARG to be the MFD block number of disk number ARG+2 mfdcom: push r0 ; save register mov arg+2,r0 ; get pointer to disk structure mov dskmfd(r0),arg ; get MFD block number pop r0 ; restore register jmp nxtcom delcom: print ^"?? " jmp prompt inccom: inc arg jmp nxtcom deccom: dec arg jmp nxtcom clrcom: mov #31,r0 jsr r5,typec jmp nxtcom lnkcom: mov sector,arg ; link to next block print ^"=" push arg,arg+2 ; print new bk# as DISK:BLOCK # jsr pc,eql print ^" " jmp nxtcom addcom: jsr r5,rnum ; read number add r0,arg ; add to arg jmp nxtcom subcom: jsr r5,rnum ; read number sub r0,arg ; subtract it from arg jmp nxtcom mulcom: jsr r5,rnum ; read number mov r0,r1 mul arg,r1 mov r1,arg jmp nxtcom divcom: jsr r5,rnum ; read number tst r0 beq dvbig mov arg,r3 clr r2 div r0,r2 mov r2,arg jmp nxtcom remcom: jsr r5,rnum ; read number tst r0 beq dvbig mov arg,r3 clr r2 div r0,r2 mov r3,arg jmp nxtcom dvbig: print ^" * * * * * * * * * * * * * * * * * * * * * * * " jmp nxtcom andcom: jsr r5,rnum ; read number com r0 ; AND with arg bic r0,arg ; ... jmp nxtcom iorcom: jsr r5,rnum ; read number bis r0,arg ; IOR with arg jmp nxtcom ; The V command prompts for a disk name and sets the current disk to ; the one chosen. rmvcom: push r0 ; save register print ^" Disk: " jsr r5,rdsknm ; read a disk name jsr r5,dskchk ; verify that response is valid pop r0 ; check for negative response bmi 1$ ; negative number indicates an undefined disk mov r0,bkn+2 ; return value is disk number 1$: pop r0 ; restore register jsr pc,crlf jmp prompt ; next command ; The F command prints all the defined disks and the current one. fixcom: print ^" The following disks are defined: " jsr r5,lisdsk ; print the disk names print ^" The current disk is:" push arg,arg+2 ; EQL args: block number, disk number jsr pc,eql ; print the disk as DISK:BLOCK # jsr pc,crlf jmp prompt eqlcom: push arg,arg+2 ; print current args jsr pc,eql ; as DISK: BLOCK # jmp nxtcom ; Prints args as DISK: BLOCK #. Takes two arguments on the stack ; ; ARGS: VALS: ; (SP)-> disk entry ptr (SP)-> none ; block number eql: push r0,r1 ; save regs mov 6(sp),r0 ; get disk entry ptr mov dsknam(r0),r1 ; get name of disk jsr pc,rad50 ; print disk name print ^": " ; followed by a colon mov 10(sp),r0 ; OCTAL arg: block number to be printed jsr r5,octal ; ... pop r1,r0 ; restore regs pop (sp),(sp) ; remove args rts pc scom: print ^" Pattern = " jsr r5,rnumx ; read pattern mov r0,r5 print ^" Bit mask (0 => no change) = " jsr r5,rnumx ;mask, if 0 then no change mov r0,r4 ;mask init = -1 if eq,< mov mask,r4 ;no change in mask print ^" Bit mask = " mov r4,r0 ;print mask jsr r5,octal > mov r4,mask ;update mask com r4 ;complement r4 so can bic bic r4,r5 ;clear extraneous bits in pattern sread: push arg+2,arg ; DKRBLK args: disk no., block no. jsr r5,dkrblk ;read next sector mov #sector,r3 mov arg+2,r1 ; get disk entry ptr mov dlblk(r1),r1 ; get number of bytes per block asr r1 ; make length in words in sector loop < mov (r3)+,r2 ;next word in sector bic r4,r2 ;mask cmp r2,r5 ;pattern match? exitl eq ;yes sorl r1 inc arg ;yes, next block br sread > sub #sector+2,r3 ;correct address print ^" Match found, at " push arg,arg+2 ;print bk# jsr pc,eql print ^" Address of pattern = " mov r3,r0 jsr r5,octal jsr pc,crlf jmp prompt dircom: print ^"" ;clear screen mov pc,more ;do more processing mov #sector+2-22,r5 ;r5 will point to direc entries mov arg+2,r2 ; get disk entry ptr mov dlblk(r2),r2 ; get length of block in bytes add #sector,r2 ; calculate end of ufd loop < add #22,r5 ;next entry cmp r5,r2 ;end of sector in core? exitl his ;yes, done tst (r5) ;no, empty entry? rptl eq ;yes, try next entry mov r5,r0 ;print address within sector sub #sector,r0 jsr r5,octal mov #40,r0 ;print space then file name jsr r5,typec mov r5,r4 ;running ptr within entry mov (r4)+,r1 ;print file name jsr pc,rad50 mov (r4)+,r1 ;print file name jsr pc,rad50 mov #'.,r0 ;print dot between name,ext jsr r5,typec mov (r4)+,r1 jsr pc,rad50 jsr pc,crlf mov r5,r4 ;next print the 9 words of entry mov #9.,r3 ;in octal loop < mov (r4)+,r0 ;next word in entry jsr r5,octal ;type in octal mov #40,r0 ;print space jsr r5,typec sorl r3 > jsr pc,crlf rptl > jmp prompt ;next command dircm1: jsr r5,save6 ; save registers mov pc,more ;do more processing mov #sector+2-22,r5 ;r5 will point to direc entries mov arg+2,r2 ; get disk entry ptr mov dlblk(r2),r2 ; get length of block in bytes add #sector,r2 ; calculate end of ufd loop < add #22,r5 ;next entry cmp r5,r2 ;end of sector in core? exitl his ;yes, done tst (r5) ;no, empty entry? rptl eq ;yes, try next entry mov r5,r0 ;print address within sector sub #sector,r0 jsr r5,octal mov #40,r0 ;print space then file name jsr r5,typec mov r5,r4 ;running ptr within entry mov (r4)+,r1 ;print file name jsr pc,rad50 mov (r4)+,r1 ;print file name jsr pc,rad50 mov #'.,r0 ;print dot between name,ext jsr r5,typec mov (r4)+,r1 jsr pc,rad50 jsr pc,crlf mov r5,r4 ;next print the 9 words of entry mov #9.,r3 ;in octal loop < mov (r4)+,r0 ;next word in entry jsr r5,octal ;type in octal mov #40,r0 ;print space jsr r5,typec sorl r3 > jsr pc,crlf rptl > jsr r5,rest6 ; restore registers rts r5 ; List sector as MFD lstmfd: print ^"" ;clear screen mov pc,more ;do more processing mov #sector+2-10,r5 ;running ptr into mfd mov arg+2,r2 ; get disk entry ptr mov dlblk(r2),r2 ; get length of block in bytes add #sector,r2 ; calculate end of mfd loop < add #10,r5 ;next mfd slot cmp r5,r2 ;end of mfd? exitl his ;yes, done tst (r5) ;This slot free? rptl eq ;yes, goto next one mov r5,r0 ;no, get loc within sector sub #sector,r0 jsr r5,octal ;type octal loc of slot print ^": " mov (r5),r1 ;username (in rad50) jsr pc,rad50 ;type username print ^" " mov (r5),r0 ;username again jsr r5,octal ;username in octal (word) print ^" [" movb 1(r5),r1 ;username as x,x (bytes) jsr pc,tbyte print ^"," movb (r5),r1 jsr pc,tbyte print ^"] " mov 2(r5),r0 ;block# of user's ufd jsr r5,octal jsr pc,crlf rptl > jmp prompt lsmfd1: jsr r5,save6 ; save registers mov pc,more ; do more processing mov #sector+2-10,r5 ; running ptr into mfd mov arg+2,r2 ; get disk entry ptr mov dlblk(r2),r2 ; get length of block in bytes add #sector,r2 ; calculate end of mfd loop < add #10,r5 ; next mfd slot cmp r5,r2 ; end of mfd? exitl his ; yes, done tst (r5) ; This slot free? rptl eq ; yes, goto next one mov r5,r0 ; no, get loc within sector sub #sector,r0 jsr r5,octal ; type octal loc of slot print ^": " mov (r5),r1 ; username (in rad50) jsr pc,rad50 ; type username print ^" " mov (r5),r0 ; username again jsr r5,octal ; username in octal (word) print ^" [" movb 1(r5),r1 ; username as x,x (bytes) jsr pc,tbyte print ^"," movb (r5),r1 jsr pc,tbyte print ^"] " mov 2(r5),r0 ; block# of user's ufd jsr r5,octal jsr pc,crlf rptl > jsr r5,rest6 ; restore regs rts r5 .sbttl Deferred commands ; The following commands must be the last char in a line, followed by a ; carriage-return. The command will be cancelled if carriage-return does not ; follow the command. If it does follow, the command will then be executed. ; These are the commands which have a permanent effect or that simply should ; not be executed immediately. crcheck: ;read char, if cr echo lf, else quit jsr r5,readc cmp r0,#15 if ne,< jmp delcom ;abort command > rts pc ;and return ;;; Command to save a range of specified block numbers savcom: jsr pc,crcheck print ^" SAVE: Starting Block Number? " jsr r5,rnumx ; get starting block number in R0 mov r0,r1 ; save it print ^" SAVE: Ending Block Number? " jsr r5,rnumx ; get last block number mov r0,r2 ; save block number cmp r0,r1 ; end before start?? if lt,< print ^" Cannot save backwards!! " jmp prompt > print ^" Save from " mov r1,r0 ; get block number jsr r5,octals ; print it print ^" to " mov r2,r0 ; get block number jsr r5,octals ; print it print ^" ?" jsr r5,readc ; get response cmp r0,#'Y if ne,< print ^" Save aborted. " jmp prompt > loop < push bkn+2,r1 ; SAVBLK args: disk entry pointer, block number jsr r5,savblk ; save this block inc r1 ; next block cmp r1,r2 ; done?? rptl le ; not yet > print ^" Save completed. " jmp prompt ;;; TSTRP1 is a test of the RP11 controller (which is really an Emulex ;;; SC11/A that interfaces to two Kennedy Model 5303 42Mbyte Disk ;;; Drives. tstrp1: print ^" Really test the RP11???" jsr r5,readc ; confirm cmp r0,#'Y bne tstrpno ; he punted mov #1,@#rpcsr ; do a controller reset mov #rp11win,@#254 ; RP11 interrupt word (New PC) mov #340,@#256 ; PS for interrupt loop < tstb @#rpcsr ; controller ready?? exitl mi ; yes, if negative rptl > tst @#rpcsr ; errors?? if mi,< print ^"RP11 error occurred. " jmp prompt > spl 0 ; go to 0 to catch any interrupts mov #400,@#rpcar ; move to cylinder 400 mov #20111,@#rpcsr ; allow interrupts to happen, do a ; seek 1$: br 1$ ; wait for ever or until disk interrupts rp11win: add #4,sp ; remove stuff from stack print ^" The interrupt occurred. " mov #15,@#rpcsr ; do a home seek tstrpno: jmp prompt ; and we're done ; List all the known directories ladcom: jsr pc,crcheck ; check for CR print ^"List of Directories: " mov bkn+2,r1 ; get disk entry pointer push r1,dskmfd(r1) ; DKRBLK args: disk entry ptr, block no. jsr r5,dkrblk ; get first MFD block 1$: jsr r5,lsmfd1 ; print out this block of the MFD tst sector ; another block?? if ne,< push r1,sector ; DKRBLK args: disk entry ptr, block no. jsr r5,dkrblk ; get the next block br 1$ ; print this one > jmp prompt .sbttl UFD commands ; these commands manipulate UFDs ; read in the specified UFD rufdcm: jsr pc,crcheck ; check for CR print ^"Name of UFD : " jsr r5,rdsknm ; get name of UFD pop r1 ; val: rad50 of dir name jsr pc,crlf mov bkn+2,r2 ; get disk entry ptr push r2,r1 ; DUICLK args: disk entry ptr, dir name jsr r5,duiclk ; check to see if dir exists ; if it exists, it is read into UFDBLK pop * ; val: error code if eq,< ; no error mov dlblk(r2),r0 ; get number of words in block asr r0 ; make word count mov #ufdblk,r4 ; get pointer to UFD mov #sector,r5 ; get pointer to SECTOR loop < mov (r4)+,(r5)+ ; copy the directory block sorl r0 ; do all the words > mov ufdbln,bkn ; finally, save block number > jmp prompt ; List all the files in the UFD specified lufdcm: jsr pc,crcheck ; check for CR mov bkn+2,r1 ; get disk number print ^"Name of UFD? " jsr r5,rdsknm ; read in a name for the disk directory jsr pc,crlf pop r2 ; val: rad50 word if ne,< push r1,r2 ; DUICLK args: disk entry ptr, dir name jsr r5,duiclk ; see if this directory exists pop * ; val: error code if eq,< ; no error? mov #sector,r5 ; get to pointer mov #ufdblk,r4 ; get from pointer mov dlblk(r1),r3 ; get word count asr r3 ; ... loop < mov (r4)+,(r5)+ ; copy words sorl r3 ; done yet > 1$: jsr r5,dircm1 ; list this directory tst sector ; any more blocks (link) if ne,< push r1,sector ; DKRBLK arg: disk entry ptr, block no. jsr r5,dkrblk ; read in the next block br 1$ ; list it out > > > jmp prompt ; create a UFD cufdcm: jsr pc,crcheck ; check for CR mov bkn+2,r1 ; get disk number print ^"Name for new UFD? " jsr r5,rdsknm ; read in a name for the disk directory pop r2 ; val: rad50 word if eq,< jmp cufdbad ; not valid, punt > push r1,r2 ; DUICLK args: disk entry ptr, dir name jsr r5,duiclk ; see if this directory exists pop * ; val: error code if pl,< ; non-negative = directory exists jmp cufdex ; directory exists, punt > mov dskmfd(r1),ufdbln ; save block number of MFD push r1,ufdbln ; DKREAD args: disk entry ptr, block no. push dlblk(r1),#ufdblk ; DKREAD args: word count, address asr 2(sp) ; make word count jsr r5,dkread ; read in the M.F.D. block 2$: mov #ufdblk+2,r4 ; get pointer to first entry in MFD mov dlblk(r1),r0 ; get length of block sub #2,r0 ; minus 2 because of link word ash #-3,r0 ; get no. of slots in MFD (10 bytes per entry) loop < tst (r4) ; this entry free?? if eq,< push r1 ; DALLOC arg: disk entry ptr jsr r5,dalloc ; get a new block for this new UFD pop r3 ; val: block number mov r2,(r4) ; save dir name mov r3,2(r4) ; save block number mov #11,4(r4) ; number of entries in a UFD clr 6(r4) ; (not used) push r1,ufdbln ; DKWRIT args: disk entry ptr, block number push dlblk(r1),#ufdblk ; DKWRIT args: word count, address asr 2(sp) ; make word count jsr r5,dkwrit ; write out this block push r1,r3 ; DKREAD args: disk entry ptr, block number push dlblk(r1),#ufdbl0 ; DKREAD args: word count, address asr 2(sp) ; make word count jsr r5,dkread ; read in the new UFD block push #ufdbl0,dlblk(r1) ; ZBLOCK args: address, number of words asr (sp) ; to zero jsr r5,zblock ; make this block zero push r1,r3 ; DKWRIT args: disk entry ptr, block number push dlblk(r1),#ufdbl0 ; DKWRIT args: word count, address asr 2(sp) ; make word count jsr r5,dkwrit ; write out this block print ^" Created UFD. " br 1$ ; finished > add #10,r4 ; move to next entry in MFD sorl r0 > ; end of loop tst ufdblk ; another block to the MFD?? if eq,< ; no! push r1 ; DALLOC arg: disk entry ptr jsr r5,dalloc ; get a new block for the MFD pop r3 ; val: block number mov r3,ufdblk ; create link push r1,ufdbln ; DKWRIT args: disk entry ptr, block number push dlblk(r1),#ufdblk ; DKWRIT args: word count, address asr 2(sp) ; make word count jsr r5,dkwrit ; write out this block push r1,r3 ; DKREAD args: disk entry ptr, block number push dlblk(r1),#ufdblk ; DKREAD args: word count, address asr 2(sp) ; make word count jsr r5,dkread ; read in the new UFD block push #ufdblk,dlblk(r1) ; ZBLOCK args: address, number of words asr (sp) ; to zero jsr r5,zblock ; make this block zero mov r3,ufdbln ; save block number br 2$ ; find a new slot > else < mov ufdblk,ufdbln ; save block number for writing push r1,ufdblk ; DKREAD args: disk entry ptr, block no. push dlblk(r1),#ufdblk ; DKREAD args: word count, address asr 2(sp) ; make word count jsr r5,dkread ; get the next block of the MFD br 2$ ; look through this one > 1$: jmp prompt cufdbad: print ^" Not a legal UFD name. " jmp prompt cufdex: print ^" Directory already exists. " jmp prompt ; Delete from specified block number command. ddfcom: jsr pc,crcheck ; check for CR after command print ^"Starting block number of file to delete: " jsr r5,rnumbr ; read in starting block number print ^" Do you really want to delete the file starting at block number :" jsr r5,octal ; type number in octal print ^" ?" jsr r5,readc ; confirm cmp r0,#'Y if eq,< ; yes, do it push arg+2,r0 ; DDF args: disk entry ptr, starting ; block number jsr r5,ddf ; delete the file pop * ; val: error code print ^" File has been deleted." > jsr pc, crlf jmp prompt cstcom: jsr pc,crcheck ;set char-flag for dumping mov #cmsgp,r2 ;list of msgs clr r3 ;will form flags in r3 loop < mov (r2)+,r1 ;next msg exitl eq jsr r5,types ;ask about next mode jsr r5,readc ;set bit? clc cmpb #'Y,r0 ;yes. order for c-bit if eq,< sec ;yes, set bit > rol r3 ;bit into place rptl ;next msg and bit > mov r3,cflag jsr pc,crlf jmp prompt xitcom: jsr pc,crcheck ;exit to dsklod .exit ;"bit map command", takes arg and tells where in bit map it is btmcom: jsr pc,crcheck ;might as well follow Gene's conventions print ^" Map number = " clr r0 ; for DIV mov arg,r1 ; get block no. div #1700,r0 ; divide block no. by no. of blocks per map inc r0 ;add one since maps are 1 based, not 0 jsr r5,octals ;type it print ^" Byte offset = " mov r1,r0 ash #-3,r0 ; account for 8 bits per byte add #10,r0 ; add 10 to cover beginning of bit map jsr r5,octals print ^" Byte mask = " mov #1,r0 ;make into mask mov r1,r2 ;copy again bic #177770,r2 ;get bit offset if ne,< loop < asl r0 sorl r2 > > jsr r5,octal print ^" Word mask = " mov #1,r0 mov r1,r2 ;yet another copy bic #177760,r2 ;word mask this time if ne,< loop < asl r0 ;same again with 4 bits sorl r2 > > jsr r5,octal jsr pc,crlf jmp prompt mapcom: jsr pc,crcheck ;xlate from bit map info to bk# print ^"Map number = " jsr r5,rnumx asl r0 ;so can index into mpntab mov dbmtab(r0),r5 ;map base bk#=960.*(map#-1) print ^" Address of bit-map word within block = " jsr r5,rnumx sub #10,r0 ;word base bk#=(addr-8.)*8 ash #3,r0 mov r0,r4 print ^" Bit-map word mask = " jsr r5,rnumx mov #-1,r3 ;word bk# offset = log2(mask) sec ;so log2 will terminate if stupid user gives 0 as mask loop < inc r3 ror r0 ;log2 by counting div-by-2's rptl cc ;done log2 when c-bit set > print ^" Specified block# = " mov r5,r0 ;bk#=(map base)+(word base)+(wd offset) add r4,r0 add r3,r0 jsr r5,octals jsr pc,crlf jmp prompt ; T command. Transfer N sectors from one disk to another or to itself ; Must be the same type of disks. xfrcom: jsr pc,crcheck print ^"Transfer N sectors. From? " jsr r5,xfrask print ^" To? " jsr r5,xfrask mov 4(sp),r1 ; FROM disk entry ptr mov (sp),r2 ; TO disk entry ptr cmp dsktyp(r1),dsktyp(r2) ; are they the same type disk? bne xfrno ; no, go complain 1$: print ^" Number of sectors? " jsr r5,rnumx ;read #. cmp r0,#47777 if hi,< print ^"You've got to be kidding" br 1$ > loop < push r1,6+2(sp) ; DKRBLK args: disk entry ptr, block no. jsr r5,dkrblk ; read push r2,2+2(sp) ; DKWBLK args: disk entry ptr, block no. jsr r5,dkwblk ; write inc 6(sp) ; increment From block no. inc 2(sp) ; increment To block no. sorl r0 > print ^" Transfer done, OK. " jmp prompt xfrask: push (sp),(sp) ; create slots for return vals jsr r5,rnumx ; read address mov r0,4(sp) ; save it 1$: print ^" Which Disk: " jsr r5,rdsknm ; go read a disk name jsr r5,dskchk ; verify that it is a legal disk name pop r0 ; get disk entry ptr if mi,< ; if -1 returned then bad disk name print ^" Illegal disk name please try again." br 1$ > mov r0,2(sp) ; return disk entry ptr rts r5 xfrno: print ^" You cannot transfer blocks between different disk drives. (They must be the same type.)" rts r5 doscom: jsr pc,crcheck ; check to make sure last print ^" Write DOS format on which disk? " jsr r5,rdsknm ; read disk name jsr r5,dskchk ; check disk name pop r1 ; disk number bmi dosno ; if negative bad disk given .if ne nrk cmp #rk,dsktyp(r1) ; is it an RK disked that was specified?? beq dosgo ; no other drive types allowed .endc .if ne nrl cmp #rl,dsktyp(r1) ; Is it an RL01 type disk drive? beq dosgo ; yes, maybe we want to format this disk .endc .if ne nrx cmp #rx,dsktyp(r1) ; Is it an RX01 type disk drive beq dosgo ; yes, maybe we want to format this disk .endc .if ne nrp cmp #rp,dsktyp(r1) ; IS it an RP02 type disk drive? beq dosgo ; yes, maybe we want to format this disk .endc dosno: print ^" DOS Format operation aborted, due to error. " jmp prompt dosgo: print ^" Do you really want to write DOS format on " push r1 ; PRDISK arg: disk entry ptr jsr r5,prdisk ; print the disk name jsr r5,readc ; confirm cmp r0,#'Y bne dosno ; abort the operation ; R1 contains a ptr to the disk entry ; for the disk we are init'ing mov dsknbm(r1),r2 ; get the number of bit maps clr r3 ; start with first bit map loop < push r1,r3 ; DGBM args: disk entry ptr, map no. jsr r5,dgbm ; get this bit map pop r4 ; val: pointer to bit map buffer mov r4,r5 ; get pointer to increment mov dlblk(r1),r0 ; get number of bytes/block asr r0 ; make word count loop < clr (r5)+ ; clear this word and move to next sorl r0 ; done yet?? > inc r3 ; make number correct mov dskbmb(r1),(r4) ; save link block number add r3,(r4) ; make link correct mov r3,2(r4) ; save map number mov #74,4(r4) ; number of words used in map block (128.) mov dskbmb(r1),6(r4) ; save 1st map block number push r1 ; DRBM arg: disk entry pointer jsr r5,drbm ; write out this bit map sorl r2 ; do all of them > mov dsknbm(r1),r2 ; get number of maps clr r3 ; start out with number 0 loop < push r1,dskbmb(r1) ; SAVBLK arg: disk entry ptr, block no. add r3,(sp) ; compensate jsr r5, savblk ; save the bit map in bit map inc r3 ; next map number sorl r2 > .if ne nrx cmp #rx,dsktyp(r1) ; is this an RX01 disk if eq,< mov #3636,r3 ; fill the bit-map loop < push r1,r3 ; SAVBLK args: disk entry pointer,blck no. jsr r5, savblk ; save he non-existent block inc r3 ; next one cmp r3,#5500 ; done yet?? rptl ne ; no > > .endc ; ne rx .if ne nrp cmp #rp,dsktyp(r1) ; is this an RP02 disk if eq,< mov #173030,r3 ; fill the bit-map loop < push r1,r3 ; SAVBLK args: disk entry pointer, block no. jsr r5,savblk ; save the non-existant block inc r3 ; next one cmp r3,#173600 ; done yet?? rptl ne ; no > > .endc ; ne rp .if ne nrl cmp #rl,dsktyp(r1) ; is this an RL01 disk?? if eq,< mov #50000,r3 ; starting block number to allocate in bit-map loop < push r1,r3 ; SAVBLK args: disk entry pointer, block no. jsr r5,savblk ; save the non-existant block inc r3 ; next one cmp r3,#51200 ; done?? rptl ne > > .endc ; ne rl push r1,dskmfd(r1) ; SAVBLK args: disk entry pointer jsr r5, savblk ; allocate MFD mov dskmfd(r1),r2 ; get block number of disk MFD push r1,r2 ; DKREAD args: disk entry ptr, block no. push dlblk(r1),#ufdblk ; DKREAD args: word count, address asr 2(sp) ; make word count jsr r5,dkread ; read in the M.F.D. block mov #ufdblk,r5 ; get pointer to increment mov dlblk(r1),r0 ; get number of bytes/block asr r0 ; make word count loop < clr (r5)+ ; clear this word and move to next sorl r0 ; done yet?? > push r1,r2 ; DKWRIT args: disk entry ptr, block no. push dlblk(r1),#ufdblk ; DKWRIT args: word count, address asr 2(sp) ; make word count jsr r5,dkwrit ; write out the MFD mov #3,r2 ; save block numbers 0,1,2 loop < dec r2 ; one less block to do push r1 ; SAVBLK arg: disk entry ptr push r2 ; SAVBLK arg: block number to save jsr r5,savblk ; take this block for us tst r2 ; done??? rptl ne ; no > print ^" DOS Disk Format operation completed. " jmp prompt ; this is the A command. It reads all of the specified ; disk. (Useful for testing to see if the disk has any bad ; blocks on it.) (In other words a reliability test.) adkcom: jsr pc,crcheck ; check to make sure last print ^" Read which disk " jsr r5,rdsknm ; read disk name jsr r5,dskchk ; check disk name pop r0 ; disk number bmi adkno ; if negative bad disk given print ^" Reading all of " push r0 ; PRDISK arg: disk entry ptr jsr r5,prdisk ; print the disk name mov dnsect(r0),r5 ; get number of blocks/track mul dntrak(r0),r5 ; get number of blocks/drive mov r5,lsttrk ; save number of blocks mov dlblk(r0),r5 ; number of bytes per block asr r5 ; make word count mov dnsect(r0),numsct ; save the number of blocks per track mul dnsect(r0),r5 ; get number of words for 1 track jmp adkmsk ; start reading adkno: print ^" Illegal disk number, operation aborted. " jmp prompt ; do another command adkmsk: jsr pc,crlf ; print crlf ;Now do the read, 12 blocks at a time: clr r1 ; running block number loop < push r0,r1 ; DKREAD args: disk number,block number push r5,#imbuf ; DKREAD args: word count,address jsr r5, dkread ; read 1 track add numsct,r1 ; get block no. of next track cmp r1,lsttrk ; done last track number??? rptl lo > print ^" Read completed. " jmp prompt ; these read, write, or zero the core-image that is ; currently in core. rdcom: jsr pc,crcheck push arg+2,arg ; DKRBLK args: disk no., block no. jsr r5,dkrblk ; read in sector jmp prompt wrtcom: jsr pc,crcheck print ^"WRITE BLOCK NO. " push arg,arg+2 jsr pc,eql ; type DSK:BLOCK # print ^"? " jsr r5,readc cmp r0,#'Y if ne,< print ^"WRITE ABORTED " jmp prompt > push arg+2,arg ; DKWBLK args: disk no., block no. jsr r5,dkwblk jsr pc,crlf jmp prompt zrocom: jsr pc,crcheck ;zero sector image in core. mov pc,r0 add #sector-.,r0 mov arg+2,r1 ; get disk entry ptr mov dlblk(r1),r1 ; get number of bytes per block asr r1 ; make it word count, not byte loop < clr (r0)+ sorl r1 > jmp prompt zblock: push r0,r1 ; save regs mov 6(sp),r0 ; number of words to zero mov 10(sp),r1 ; starting address loop < clr (r1)+ ; clear this one and move to next sorl r0 ; done yet > pop r1,r0 ; restore regs pop (sp),(sp) ; remove args rts r5 ;More efficient than T, xfering 12 blocks (1 track) ;at a time. Does not seek before writing, but ;does do write check after each read or write. imtran: jsr pc,crcheck print ^" Image transfer (Copy one disk to another of the same type) Copy from which disk: " jsr r5,rdsknm ; read a disk name jsr r5,dskchk ; check the persons response pop r2 ; get disk entry ptr bmi imno ; if negative response then punt. print ^" Copy to which disk: " jsr r5,rdsknm ; read a disk name jsr r5,dskchk ; check the persons response pop r3 ; get disk entry ptr bmi imno ; if negative response then punt cmp dsktyp(r2),dsktyp(r3) ; see if the two disks are the same bne imno ; no the same type print ^" Transfering from " push r2 ; print from disk number jsr r5,prdisk ; print it print ^" to " push r3 ; print to disk number jsr r5,prdisk ; print it print ^". Do you really want to do this terrible thing? " jsr r5,readc ;confirm cmp r0,#'Y bne imno ;abort ;calculate the length of a track for word count on transfer mov dnsect(r2),r5 ; get number of blocks/track mul dntrak(r2),r5 ; get number of blocks/drive mov r5,lsttrk ; save number of blocks mov dnsect(r2),numsct ; save number of blocks/track mov dlblk(r2),r5 ; get no. of bytes/block asr r5 ; make word count mul dnsect(r2),r5 ; get number of words/track ; do the transfer clr r1 ; running bk#. loop < push r2,r1 ; DKREAD args: disk ptr, block, push r5,#imbuf ; DKREAD args: word count,address jsr r5,dkread ; read 1 track push r3,r1 ; DKWRIT args: disk ptr, block, push r5,#imbuf ; DKWRIT args: word count,address jsr r5,dkwrit ; copy that track to other disk add numsct,r1 ; get block number of next track cmp r1,lsttrk ; done last track? rptl lo > print ^" Image transfer completed ok. " jmp prompt imno: print ^" Image transfer aborted. " jmp prompt ; he gave some other answer numsct: .word 0 lsttrk: .word 0 ; The Q command salvages a DOS format disk. The disk to be salvaged ; is asked for and then the disk that they are to be put on is asked for. ; Note: These cannot be the same drive. ; This command assumes that the MFD exists on both disks and that any ; special areas of the target disk have been allocated. Such as system ; program space. salcom: jsr pc,crcheck ; check for carriage return print ^" Salvage which disk? " jsr r5,rdsknm ; read disk name to be salvaged jsr r5,dskchk ; get disk entry ptr pop disk0 ; save it bmi 1$ ; exit if minus print ^" Target disk? " jsr r5,rdsknm ; read target disk name jsr r5,dskchk ; get disk entry ptr pop disk1 ; save it bmi 1$ ; exit if minus cmp disk0,disk1 ; check to see if the two disks are the same beq 1$ ; yes, punt this print ^" Do you really want to salvage " push disk0 ; PRDISK arg: disk entry ptr jsr r5,prdisk ; print disk name print ^" ? " jsr r5,readc ; get response cmp r0,#'Y ; yes?????? beq salgo ; go for it....... 1$: print ^" Salvage operation aborted. " jmp prompt ; do another command salgo: jsr pc,crlf ; print out a CRLF mov disk0,r3 ; get disk entry ptr for salvaged disk push r3,dskmfd(r3) ; DKREAD args: disk entry ptr, block no. push dlblk(r3),#mfdblk ; DKREAD args: word count, address asr 2(sp) ; make it a word count mov 2(sp),dlblk0 ; save the number of words/block on this disk jsr r5,dkread ; read in the MFD mov dlblk0,r5 ; get number of words/block dec r5 ; minus 1 because of link word clr r4 ; for the following division div #11,r4 ; get number of entries/directory block mov r4,dnent0 ; save number of entries/block mov disk1,r1 ; get disk entry ptr for target disk push r1,dskmfd(r1) ; DKREAD args: disk entry ptr, block no. push dlblk(r1),#mfdbl1 ; DKREAD args: word count, address asr 2(sp) ; make it a word count mov 2(sp),dlblk1 ; save the number of words/block on this disk jsr r5,dkread ; read in the other MFD mov dlblk1,r5 ; get number of words/block dec r5 ; minus 1 due to link word clr r4 ; for the following division div #11,r4 ; 9. words per entry in a UFD mov r4,dnent1 ; save number of entries per directory ; start looking for directories in the MFD from the disk being salvaged ; and see if they are on the target disk. If so then query and proceed ; to salvage the directory. 1$: mov #mfdblk+2,r4 ; get ptr to the first entry in the MFD mov dlblk(r3),r2 ; get length of block sub #2,r2 ; minus 2 because of link word ash #-3,r2 ; get no. of slots in MFD (10 bytes per entry) loop < tst (r4) ; see if this is an entry if ne,< ; yes it is push r1,(r4) ; DUICLK args: disk entry ptr, dir name jsr r5,duiclk ; read in this directory from the target disk pop * ; val: got it in UFDBLK if mi,< ; if -1 then dir does not exist print ^" The directory " push (r4) ; print out dir name jsr pc,prad50 ; .... print ^" does not exist on " push r1 ; PRDISK arg: disk entry ptr jsr r5,prdisk ; print out disk name print ^". " br 3$ ; punt this dir > push r3,2(r4) ; DKREAD args: disk entry ptr, block number push dlblk(r3),#ufdbl0 ; DKREAD args: word count, address asr 2(sp) ; make it a word count jsr r5,dkread ; read in the UFD from disk being salvaged mov (r4),dirnm0 ; save directory names mov (r4),dirnm1 ; .... ; At this point both directories are read in. The directory from the ; disk being salvaged is in UFDBL0 and the UFD for the target disk ; is in UFDBLK. print ^" Do you want to salvage directory " push dirnm0 ; print out dir name jsr pc,prad50 ; ... print ^" ?" jsr r5,readc ; get response cmp r0,#'Y ; salvage this directory???? if eq,< ; yes jsr pc,crlf ; print out a crlf jsr r5,saldir ; salvage this directory > jsr pc,crlf ; print out a crlf > 3$: add #10,r4 ; move to next entry in the MFD sorl r2 ; do this many > tst mfdblk ; see if there is a link block if ne,< ; yes, there is one push r3,mfdblk ; DKREAD args: disk entry ptr, block no. push dlblk(r3),#mfdblk ; DKREAD args: word count, address jsr r5,dkread ; read in the next block br 1$ ; go back and handle the rest > print ^" Salvage completed. " jmp prompt ; go do another command saldir: jsr r5,save6 ; save all the registers 1$: mov #ufdbl0+2,r3 ; get ptr to UFD from disk being salvaged mov dnent0,r4 ; get number of entries in this directory loop < tst (r3) ; see if this is a filename bne 2$ ; .... tst 2(r3) ; .... bne 2$ ; .... tst 4(r3) ; .... beq 3$ ; not a file go to next entry 2$: jsr r5,filtst ; see if this file is all there pop * ; val: -1 if file pointed to by R3 ; is not a file. bmi 3$ ; not a file so punt this one jsr r5,dadden ; go add this to the dir on the target disk mov 12(r3),sblk0 ; save the block number we are reading push disk0,sblk0 ; DKREAD args: disk entry ptr, block no. push dlblk0,#sectr0 ; DKREAD args: word count, address jsr r5,dkread ; read in first block mov #sectr0+2,dfilp0 ; set ptr to the block read in clr dnumr0 ; set character count push disk1 ; DALLOC arg: disk entry ptr jsr r5,dalloc ; get a block number pop sblk ; save it mov dlblk1,r1 ; get number of words in a block mov #sector,r2 ; get ptr to sector loop < clr (r2)+ ; clear this location sorl r1 ; done > clr dnumr1 ; no words initially mov #sector+2,dfilp1 ; set ptr for first word to be written mov fent1,r1 ; get ptr to entry mov sblk,12(r1) ; set starting block number mov sblk,16(r1) ; set ending block number mov #1,14(r1) ; set length to 1 loop < jsr r5,getwrd ; get the next word from the file on disk 0 pop r0 ; got it exitl mi ; if negative then we are done push r0 ; WRTWRD arg: word to write jsr r5,wrtwrd ; write out this word rptl > ; done finally, now clean up the directory entry mov sblk,16(r1) ; set ending block number mov #233,20(r1) ; set protection code mov 6(r3),6(r1) ; copy the date mov 10(r3),10(r1) ; copy the byte count push disk1,ufdbln ; DKWRIT args: disk entry ptr, block number push dlblk1,#ufdblk ; DKWRIT args: word count, address jsr r5,dkwrit ; write out the UFD push disk1,sblk ; DKWRIT args: disk entry ptr, block number push dlblk1,#sector ; DKWRIT args: word count, address jsr r5,dkwrit ; write out the last block of the file 3$: add #22,r3 ; move to next entry in this UFD dec r4 ; done this one rptl ne ; another to do?????? > tst ufdbl0 ; see if there is a next block if ne,< ; yes get it push disk0,ufdbl0 ; DKREAD args: disk entry ptr,block no. push dlblk0,#ufdbl0 ; DKREAD args: word count, address jsr r5,dkread ; read in the next block br 1$ ; go do this part of the UFD > print ^"Salvage for this directory completed. " jsr r5,rest6 ; restore registers rts r5 filtst: push (sp),r0,r1,r2,r3,r4 ; save registers push disk0 ; print disk name jsr r5,prdisk ; print it out push dirnm0 ; print dirname jsr pc,prad50 ; ... print ^";" push (r3) ; print 1st part of filename jsr pc,prad50 ; ... push 2(r3) ; print 2nd part of filename jsr pc,prad50 ; ... print ^"." push 4(r3) ; print the extension part of filename jsr pc,prad50 ; ... mov disk0,r2 ; get disk entry ptr mov dnsect(r2),r1 ; get number of blocks/track mul dntrak(r2),r1 ; get number of blocks/drive cmp r1,12(r3) ; check to see if block number is in range bmi 1$ ; not in range, error cmp r1,16(r3) ; check to see if in range bmi 1$ ; not in range, error push r2,12(r3) ; DKREAD args: disk entry ptr, block no. push dlblk0,#sector ; DKREAD args: word count, address jsr r5,dkread ; read in the first block of the file mov #1,r0 ; initialize the count of blocks loop < tst sector ; another block????? if ne,< ; yes cmp r1,sector ; check to see if block is in range bmi 1$ ; not in range,error inc r0 ; update number of blocks so far push r2,sector ; DKREAD args: disk entry ptr, block no. push dlblk0,#sector ; DKREAD args: word count, address jsr r5,dkread ; read in next block rptl > cmp r0,14(r3) ; see if the lengths are the same exitl eq ; yes this seems to be a file br 1$ ; report error > clr 14(sp) ; say no error print ^" being salvaged. " br 2$ 1$: mov #-1,14(sp) ; say error and print out message print ^" is not a file. " 2$: pop r4,r3,r2,r1,r0 ; restore regs rts r5 ; the Y command allows DOS format files to be transfered between ; two disk drives. The user specifies the two disks and the disrectories ; on both disks from which the files will be put/gotten from. The ; user is queried before each file is transfered and has the option ; of quiting. When a user decides to quit all succesful transfer ; operations will have been done already. ytrcom: jsr pc,crcheck ; check for a carriage-return print ^" From Disk: " jsr r5,rdsknm ; read a disk name jsr r5,dskchk ; get disk entry pointer pop disk0 ; get it bmi 1$ ; punt if negative print ^" Directory; " jsr r5,rdsknm ; read in a directory name pop dirnm0 ; get it beq 10$ ; punt if no dir name supplied push disk0,dirnm0 ; DUICLK args:disk entry ptr,dir name jsr r5,duiclk ; read into UFDBLK pop * ; got it, read into UFDBLK,no need for ptr bmi 2$ ; punt if negative mov disk0,r0 ; get ptr to disk 0 entry mov dlblk(r0),r0 ; get length of UFD on disk 0 asr r0 ; make word count mov r0,dlblk0 ; save word count mov #ufdblk,r1 ; get ptr to UFD mov #ufdbl0,r2 ; get ptr to 2nd UFD loop < mov (r1)+,(r2)+ ; transfer UFDBLK to UFDBL0 sorl r0 ; done??? > ; now get the disk and directory to which the files will be sent. print ^" To disk: " jsr r5,rdsknm ; read in a disk name jsr r5,dskchk ; check it out pop disk1 ; got it bmi 1$ ; punt if negative print ^" Directory; " jsr r5,rdsknm ; read a directory name pop dirnm1 ; got it beq 10$ ; punt if no directory name supplied push disk1,dirnm1 ; DUICLK args: disk entry ptr,dir name jsr r5,duiclk ; go find directory pop * ; got it bmi 2$ ; punt if negative mov disk1,r0 ; get disk entry ptr mov dlblk(r0),r5 ; get number of bytes per sector asr r5 ; make it a word count mov r5,dlblk1 ; save the number of words/block dec r5 ; minus 1 due to link word clr r4 ; for the following division div #11,r4 ; 9. words per entry in a UFD mov r4,dnent1 ; save number of entries per directory mov dlblk0,r5 ; get number of words/block dec r5 ; minus 1 because of link word clr r4 ; for the following division div #11,r4 ; get number of entries/directory block mov r4,dnent0 ; save number of entries/block mov #ufdbl0+2,r5 ; get ptr to UFD block from 1st disk br 3$ 1$: print ^" Unknown disk name given. " br 10$ 2$: print ^" Unknown directory name given. " 10$: jmp prompt ; do another command 3$: loop < mov r5,r3 ; copy ptr to entry tst (r3) ; see if zero (i.e. no file) beq 4$ ; if 1st part 0 then not a file jsr r5,prtfil ; print out message jsr r5,readc ; get response cmp r0,#'Q ; quit doing these transfers beq 10$ ; yes!!! cmp r0,#'Y ; afffirmative??? bne 4$ ; no! go do the next iff any ; now add this file entry to the "TO DISK" UFD and save the UFD ; R3 points to the file entry on disk 0. jsr r5,dadden ; go add this file to the 2nd disk UFD mov 12(r3),sblk0 ; save the block number we are reading push disk0,sblk0 ; DKREAD args: disk entry ptr, block no. push dlblk0,#sectr0 ; DKREAD args: word count, address jsr r5,dkread ; read in first block mov #sectr0+2,dfilp0 ; set ptr to the block read in clr dnumr0 ; set character count ; setup SECTOR to contain the block we will write to disk 1 push disk1 ; DALLOC arg: disk entry ptr jsr r5,dalloc ; get a block number pop sblk ; save it mov dlblk1,r1 ; get number of words in a block mov #sector,r2 ; get ptr to sector loop < clr (r2)+ ; clear this location sorl r1 ; done > clr dnumr1 ; no words initially mov #sector+2,dfilp1 ; set ptr for first word to be written mov fent1,r1 ; get ptr to entry mov sblk,12(r1) ; set starting block number mov sblk,16(r1) ; set ending block number mov #1,14(r1) ; set length to 1 loop < jsr r5,getwrd ; get the next word from the file on disk 0 pop r0 ; got it exitl mi ; if negative then we are done push r0 ; WRTWRD arg: word to write jsr r5,wrtwrd ; write out this word rptl > ; done finally, now clean up the directory entry mov sblk,16(r1) ; set ending block number mov #233,20(r1) ; set protection code mov 6(r3),6(r1) ; copy the date mov 10(r3),10(r1) ; copy the byte count push disk1,ufdbln ; DKWRIT args: disk entry ptr, block number push dlblk1,#ufdblk ; DKWRIT args: word count, address jsr r5,dkwrit ; write out the UFD push disk1,sblk ; DKWRIT args: disk entry ptr, block number push dlblk1,#sector ; DKWRIT args: word count, address jsr r5,dkwrit ; write out the last block of the file ; time to move onto the next entry. 4$: add #22,r5 ; go to next entry dec r4 ; go do next if non-zero rptl ne ; .... tst ufdbl0 ; is there another block exitl eq ; no push disk0,ufdbl0 ; DKREAD args: disk entry ptr,block no. push dlblk0,#ufdbl0 ; DKREAD args: word count,address jsr r5,dkread ; get next block mov #ufdbl0+2,r5 ; set ptr to first entry mov dnent0,r4 ; get number of entries in UFD rptl ; do some more > print ^" Transfer finished. " jmp prompt ; GETWRD gets the next word from the read file (on disk 0) getwrd: push (sp) ; make room for a return arg inc dnumr0 ; we're taking a character cmp dnumr0,dlblk0 ; finished reading this block??? if eq,< ; if equal then we've taken all for this block tst sectr0 ; is there another block if eq,< ; no mov #-1,2(sp) ; return -1 (EOF) rts r5 > push disk0,sectr0 ; DKREAD args: disk entry ptr, block no. push dlblk0,#sectr0 ; DKREAD args: word count, address jsr r5,dkread ; get the next block mov #sectr0+2,dfilp0 ; set the file pointer mov #1,dnumr0 ; set the character count gotten so far > push r0 ; save register mov dfilp0,r0 ; get ptr to the word to return mov (r0)+,4(sp) ; move next character for return mov r0,dfilp0 ; save pointer for next time pop r0 ; restore register rts r5 ; WRTWRD takes a character on the stack and outputs it to the ; file on disk 1 wrtwrd: push r0,r1,r2 ; save registers inc dnumr1 ; inc the number of words outputed cmp dnumr1,dlblk1 ; filed the buffer yet? if eq,< ; yes push disk1 ; DALLOC arg: disk entry ptr jsr r5,dalloc ; get another block pop sector ; save as link block push disk1,sblk ; DKWRIT args: disk entry ptr, block no. push dlblk1,#sector ; DKWRIT args: word count, address jsr r5,dkwrit ; write out this block mov sector,sblk ; set block number to be the one from above mov #sector,r2 ; get ptr to buffer mov dlblk1,r1 ; get number of words in buffers loop < clr (r2)+ ; clear this location sorl r1 ; done?? > mov fent1,r1 ; get ptr to UFD entry inc 14(r1) ; inc the number of blocks in file mov #sector+2,dfilp1 ; set ptr to buffer again mov #1,dnumr1 ; set length to 1 > mov dfilp1,r0 ; get ptr to file buffer mov 10(sp),(r0)+ ; put word in buffer and inc buffer ptr mov r0,dfilp1 ; save ptr pop r2,r1,r0,(sp) ; restore regs, remove arg rts r5 ; prtfil prints out the xfer message. R3 is a ptr to the entry ; being transfered. prtfil: push r0,r1 ; save registers print ^" Do you want to transfer " push disk0 ; PRDISK arg: disk entry ptr jsr r5,prdisk ; print disk name mov dirnm0,r1 ; get dir name jsr pc,rad50 ; print it print ^";" mov (r3),r1 ; print 1st part of filename jsr pc,rad50 ; ... mov 2(r3),r1 ; print 2nd part of filename jsr pc,rad50 ; ... print ^"." mov 4(r3),r1 ; print ext. part of filename jsr pc,rad50 ; ... print ^" to " push disk1 ; PRDISK arg: disk entry ptr jsr r5,prdisk ; print disk name mov dirnm1,r1 ; get dir name jsr pc,rad50 ; print it print ^"; ?" pop r1,r0 ; restore registers rts r5 ; DADDEN ads the entry pointed to by R3 to the directory ; in UFDBLK sector. dadden: jsr r5,save6 ; save the registers 2$: mov #ufdblk+2,r5 ; get ptr to UFD mov dnent1,r4 ; get number of slots in the UFD dec r4 ; do one less entry loop < tst (r5) ; is this entry free? bne 1$ ; no tst 2(r5) ; .... bne 1$ ; no tst 4(r5) ; .... bne 1$ ; no mov r5,fent1 ; save file entry ptr mov (r3),(r5)+ ; copy 1st part of filename mov 2(r3),(r5)+ ; copy 2nd part of filename mov 4(r3),(r5)+ ; copy extension clr (r5)+ ; clear rest of entry clr (r5)+ ; clear rest of entry clr (r5)+ ; clear rest of entry clr (r5)+ ; clear rest of entry clr (r5)+ ; clear rest of entry clr (r5)+ ; clear rest of entry br 3$ ; done 1$: add #22,r5 ; inc to the next entry sorl r4 ; do only the number of entries > tst ufdblk ; see if there is a next block if ne,< ; yes get it mov ufdblk,ufdbln ; set the block number to be the new one push disk1,ufdblk ; DKREAD args: disk entry ptr,block no. push dlblk1,#ufdblk ; DKREAD args: word count, address jsr r5,dkread ; read in the next block > else < push disk1 ; DALLOC arg: disk entry ptr jsr r5,dalloc ; get a disk block for the UFD pop r1 ; got it mov r1,ufdblk ; set the link block push disk1,ufdbln ; DKWRIT args: disk entry ptr,block no. push dlblk1,#ufdblk ; DKWRIT args: word count,address jsr r5,dkwrit ; write out the changed block mov r1,ufdbln ; set the block number to the new block mov #ufdblk,r5 ; get ptr to UFDBLK mov dlblk1,r4 ; get word count loop < clr (r5)+ ; clear this location sorl r4 ; done > > mov #ufdblk+2,r5 ; get ptr to the UFD mov dnent1,r4 ; get number of slots in the UFD dec r4 ; do one less br 2$ ; try again with this block 3$: jsr r5,rest6 ; restore the registers rts r5 ;Trace down a file -- print each block#, then print ;the length of the file. Arg is bk# of 1st bk. trccom: jsr pc,crcheck ;must be followed by CR print ^" File trace: " clr r5 ;length counter mov arg,r0 ;bk# of 1st block mov r0,sector ;set "link" to 1st block loop < mov #5,r4 ;ctr for # bk#s printed on line loop < mov sector,r0 ;link to next block in file beq 1$ ;zero means no more blocks jsr r5,octal ;print this block# print ^" " inc r5 ;inc length-of-file count mov sector,arg push arg+2,arg ; DKRBLK args: disk no., block no. jsr r5,dkrblk ;read next block sorl r4 ;enuf bk#s on this line? > jsr pc,crlf ;yes rptl > 1$: print ^" Length of file = " mov r5,r0 jsr r5,octal jsr pc,crlf jmp prompt ; DUMP CONTENTS OF SECTOR ON DUMP DEVICE. ; CFLAG BITS TELL DUMP MODES. dmpcom: jsr pc,crcheck mov pc,more ; do more processing print ^"Block No. = " push bkn,bkn+2 jsr pc,eql ; print block# and Vbit jsr pc,crlf tst cflag ; null dump? if eq,< jmp prompt > ; Compute number of words per line of output. clr r1 ; r1 will count chars per word bit #1,cflag ; ascii dumped? if ne,< add #2,r1 ; yes, 2 characters/word > bit #2,cflag ; rad50? if ne,< add #3,r1 ; yes, 3 characters/word > bit #4,cflag ; octal? if ne,< add #7,r1 ; yes, 7 characters/word > bit #10,cflag ; byte? if ne,< add #10,r1 ; yes, 8 characters/word > push #0,r2,r3 ; save regs clr r2 mov swidth,r3 sub #13,r3 ; account for address etc div r1,r2 mov r2,4(sp) pop r3,r2 ; restore regs bic adrmod,(sp) ; mod-n set by user, so addrs nice mov bkn+2,r5 ; get disk entry ptr mov dlblk(r5),r5 ; length of block in bytes asr r5 ; make it word count mov #sector,r4 ; running pointer dmplin: mov r4,r0 ;address sub #sector,r0 ;correct jsr r5,octal ;print addr print ^": " bit #4,cflag ;dump octal? if ne,< mov (sp),r3 ;yes, words per this line push r4 ;save pointer loop < jsr r5,nextwd ; get next word to print pop r0 ;next word jsr r5,octal ;print mov #40,r0 ;space jsr r5,typec sorl r3 > mov #40,r0 ;type another space jsr r5,typec pop r4 ;yes, restore ptr > bit #10,cflag ;dump byte? if ne,< mov (sp),r3 ;yes, # words push r4 ;save ptr loop < clr r2 ; flag for 2 bytes/word jsr r5,nextwd ; get next word to print 1$: movb (sp),r1 ;next byte jsr pc,tbyte ;print mov #40,r0 ;space jsr r5,typec com r2 ;was that 2nd byte in wd? if ne,< ;no swab (sp) ; swap bytes for printing br 1$ > pop * ; remove word sorl r3 > pop r4 ;restore ptr > bit #1,cflag ;dump ascii? if ne,< mov (sp),r3 ;yes, # wds push r4 ;save ptr loop < clr r2 ;flag for 2 chars jsr r5,nextwd ; get next word to print 2$: movb (sp),r0 ;next char jsr pc,ascchk ;make printable jsr r5,typec ;print char com r2 ;1st or 2nd char in wd? if ne,< ;no swab (sp) ; swap bytes for printing br 2$ > pop * ; remove word sorl r3 > pop r4 ;yes, restore ptr mov #40,r0 ;space jsr r5,typec > bit #2,cflag ;dump rad50? if ne,< mov (sp),r3 ; yes, # wds push r4 ; ptr loop < jsr r5,nextwd ; get next word to print pop r1 ; next rad50 word jsr pc,rad50 ; type 3 chars sorl r3 > pop r4 ; yes > jsr pc,crlf add (sp),r4 ;move pointer up for add (sp),r4 ;next line. (wds*2 for addr) sub (sp),r5 ;done dumping sector? bgt dmplin ;no. dump this line tst (sp)+ ;pop no. words/line clr more jmp prompt ; NEXTWD gets the next word for DUMP and returns a zero if ; the next word is not in the block being dumped. ; R4 points to the next word. VAl is returned on the stack. nextwd: push (sp),r0 ; make room for return arg and save reg mov bkn+2,r0 ; get disk entry pointer cmp dlblk(r0),r4 ; are we still in range? if gt,< ; no! clr 4(sp) ; make it a zero return word > else < mov (r4)+,4(sp) ; inc ptr and return word > pop r0 ; restore reg rts r5 ; Make R0 printable character. ascchk: incb r0 ; see if printable cmpb r0,#40 if le,< clrb r0 ; must not smash upper byte bisb #57,r0 ; no, print period instead > decb r0 rts pc ; Set base block no. of core-image (used by / command). bstcom: jsr pc,crcheck mov arg,corbkn mov arg+2,corbkn+2 jmp prompt exmcom: jsr pc,crcheck ;examine location within core-image loop < mov arg,r0 ;location within core-image mov r0,r1 ;type location jsr r5,octal mov r1,r2 mov r1,r0 bic #177000,r0 ;offset within sector clc ;divide by 1000 for block offset ror r2 ;(Making sure that is unsigned divide) clrb r2 swab r2 mov corbkn,r1 ;bk# of core-image's 1st sector add r2,r1 ;get bk# of sector with location arg push corbkn+2,r1 jsr r5,dkrblk ;read in block print ^" / " mov sector(r0),r0 jsr r5,octal jsr r5,readc ;read a character cmpb r0,#12 ;next location? exitl ne ;no add #2,arg ;yes, set for next location rptl > jmp prompt modcom: jsr pc,crcheck ;wait for cr. modler: mov #'>,r0 jsr r5,typec jsr r5,rnumbr mov r0,r2 bic #1,r2 ;force even addr modcc: jsr r5,readc cmpb r0,#'X ;exit from mod-mode? if eq,< print ^"EXIT FROM MOD-MODE " jmp prompt > cmpb r0,#15 beq modler cmpb r0,#12 beq modlf cmpb r0,#'_ beq moddep cmpb r0,#'^ ;go to previous location beq modup modex: mov r2,r3 ;r2 has user-provided offset add #sector,r3 ;get loc within sector mov cflag,r4 bit #1,r4 if ne,< jsr pc,modtyu movb (r3),r0 jsr pc,ascchk ;check if nice char jsr r5,typec ;period instead mov (r3),r0 swab r0 jsr pc,ascchk jsr r5,typec > bit #2,r4 if ne,< jsr pc,modtyu mov (r3),r1 jsr pc,rad50 > bit #4,r4 if ne,< jsr pc,modtyu mov (r3),r0 jsr r5,octal > bit #10,r4 beq modcc jsr pc,modtyu clr r1 movb (r3),r1 jsr pc,tbyte mov (r3),r1 clrb r1 swab r1 mov #40,r0 jsr r5,typec jsr pc,tbyte br modcc modtyu: print ^" . " rts pc modlf: tst (r2)+ mov r2,r0 jsr r5,octal br modex moddep: jsr r5,rnumbr mov r2,r3 ;again get loc within sector. add #sector,r3 mov r0,(r3) br modcc modup: sub #4,r2 ;move back twice, let LF then br modlf ;move forward and do the CRLF etc. .sbttl Disk Subroutines ; DTYPE takes one argument on the stack and returns the type of drive ; for the passed disk number. ; ; ARGS: VALUES: ; (SP)-> Disk Entry Ptr (SP)-> type of disk drive dtype: push r4 ; save reg mov 4(sp),r4 ; get disk entry ptr mov dsktyp(r4),4(sp) ; return value type of disk drive pop r4 ; restore reg rts r5 ; the DSKCHK subroutine takes an arg on the stack and verifies ; that it is a recognized disk name. It returns the disk number ; if the name is valid, otherwise it returns a -1. dskchk: push r0,r1,r2 ; save registers mov 10(sp),r2 ; get rad50 name of disk mov #-1,10(sp) ; set initial answer to be an illegal disk mov #ndisk, r0 ; number of disk to look at mov pc,r1 ; get PIC address of disk table add #dsktab-.,r1 ; ... loop < cmp dsknam(r1),r2 ; is this the disk we want if eq,< ; yes clr 10(sp) ; clear return value mov r1,10(sp) ; return the disk entry ptr exitl ; finished > add #dsknbm+2,r1 ; move to next disk structure entry sorl r0 ; do ndisk times > pop r2,r1,r0 ; restore registers rts r5 ; the RDSKNM subroutine parses a disk name and terminates on a ; CR, LF, :, or any non-rad50 character. rdsknm: push (sp) ; create return value slot push r0,r1 ; save registers clr r1 ; R1 contains the rad50 disk name loop < jsr r5,readc ; get next charcter cmp #12,r0 ; CR ??? exitl eq ; finished cmp #14,r0 ; LF ??? exitl eq ; finished cmp #':,r0 ; : ??? exitl eq ; finished jsr r5,cvr50 ; convert to rad50 tst r0 ; see if illegal rad50 character exitl mi ; finished mul #50,r1 ; shove over characters already there add r0,r1 ; add in next rad50 character rptl ; get another character > mov r1,6(sp) ; return rad50 disk name pop r1,r0 ; restore registers rts r5 ; LISDSK prints the names of all the defined disks lisdsk: push r0,r1,r2,r3 ; save regs mov #ndisk,r3 ; number of disk names to print mov pc,r0 ; for PICness add #dsktab-.,r0 ; get address of DISK TABLE clr r2 ; clear number of disks done 1$: mov dsknam(r0),r1 ; RAD50 arg: rad50 word jsr pc,rad50 ; print out disk name print ^": " inc r2 ; get next disk number cmp r2,r3 ; are we finished beq 2$ ; yes add #22,r0 ; bump ptr to next entry br 1$ ; go print it 2$: jsr pc,crlf ; finish with a CRLF pop r3,r2,r1,r0 ; restore regs rts r5 ; PRDISK prints the name of the disk for the disk number on the stack. prdisk: push r0,r1 ; save registers mov 6(sp),r0 ; get disk entry ptr mov dsknam(r0),r1 ; get disk name jsr pc,rad50 ; print it print ^": " ; followed by a : pop r1,r0,(sp) ; restore regs and remove arg rts r5 ; SAVBLK sets the corresponding bit in the appropriate bit map ; for the block number passed as an argument on the disk specified. savblk: jsr r5,save6 ; save regs mov 20(sp),r4 ; get disk no. mov 16(sp),r1 ; get block number clr r0 ; for DIV div #1700,r0 ; get bitmap no. and offset push r4,r0 ; DGBM args: disk no., bitmap no. jsr r5,dgbm ; get bitmap pop r5 ; val: ptr mov r1,r0 ; copy offset ash #-3,r1 ; get byte offset add r1,r5 ; add to block ptr bic #177770,r0 ; get no. of bit position bisb bits(r0),10(r5) ; take block for ourselves push r4 ; DRBM arg: disk entry pointer jsr r5,drbm ; write out this bit map jsr r5,rest6 ; restore regs pop (sp),(sp) ; remove args from stack rts r5 .sbttl MFD lookup ; DUICLK ; ARGS: VALS: ; SP -> dir name SP -> block ptr or -1 ; disk entry ptr duiclk: jsr r5,save6 ; save regs mov 16(sp),r5 ; get directory name mov 20(sp),r4 ; get disk entry ptr mov dlblk(r4),r3 ; get number of bytes/block asr r3 ; make it a word count push r4,dskmfd(r4) ; DKREAD args: disk entry ptr, block no. push r3,#ufdblk ; DKREAD args: word count, address jsr r5,dkread ; read in MFD 2$: mov #ufdblk+2,r1 ; get pointer to first entry in MFD mov dlblk(r4),r0 ; get length of block sub #2,r0 ; minus 2 because of link word ash #-3,r0 ; get no. of slots in MFD (10 bytes per entry) loop < cmp (r1),r5 ; this the desired directory name? if eq,< mov 2(r1),ufdbln ; save the block number of this UFD push r4,2(r1) ; DKREAD args: disk entry ptr, block no. push r3,#ufdblk ; DKREAD args: word count,address jsr r5,dkread ; read in UFD mov #ufdblk,20(sp) ; return ptr to UFD br 1$ > add #10,r1 ; move to next entry in MFD sorl r0 > tst ufdblk ; another block to the MFD?? if eq,< ; no! mov #-1,20(sp) ; return error > else < push r4,ufdblk ; DKREAD args: disk entry ptr, block no. push r3,#ufdblk ; DKREAD args: word count, address jsr r5,dkread ; get the next block of the MFD br 2$ ; look through this one > 1$: jsr r5,rest6 ; restore regs pop (sp) ; remove an arg rts r5 .sbttl DDF ; DDF ; ARGS: VALS: ; SP -> starting block no. SP -> error code ; disk entry pointer ddf: jsr r5,save6 ; save regs mov 20(sp),r4 ; get disk no. mov 16(sp),r3 ; get starting block no. if ne,< loop < mov r3,r1 ; copy block no. push r4,r3 ; DKRBLK args: disk no., block no. jsr r5,dkrblk ; read first block mov sector,r3 ; get next block number clr r0 ; for DIV div #1700,r0 ; get bitmap no. and offset push r4,r0 ; DGBM args: disk no., bitmap no. jsr r5,dgbm ; get bitmap pop r5 ; val: ptr mov r1,r0 ; copy offset ash #-3,r1 ; get byte offset add r1,r5 ; add to block ptr bic #177770,r0 ; get no. of bit position bitb bits(r0),10(r5) ; bit already clear? if eq,< ; yes, don't clear anymore!! clr r3 ; by clearing next block no. sub r1,r5 ; restore ptr to block > else < bicb bits(r0),10(r5) ; clear bit for this block in bitmap push r4 ; DRBM arg: disk entry pointer jsr r5,drbm ; write out this bit map > tst r3 ; another block? rptl ne > > 1$: jsr r5,rest6 ; restore regs pop (sp) ; remove one arg from stack rts r5 .sbttl Block allocation ; DALLOC allocates and returns a disk block. ; ; ARGS: VALS: ; SP -> disk no. SP -> block number ; dalloc: jsr r5,save6 ; save regs mov 16(sp),r5 ; get disk no. mov dsknbm(r5),r3 ; get number of bitmaps for this disk loop < push r5,dbmno ; DGBM args: disk entry pointer, bitmap no. jsr r5,dgbm ; get bitmap pop r4 ; val: block ptr mov r4,r1 add #10,r1 ; bump up ptr to 1st bitmap word mov r1,r2 ; save ptr mov #74,r0 ; no. of words in bitmap loop < cmp (r1)+,#177777 ; find a bitmap word with a free block bne 2$ sorl r0 > push r5 ; DRBM arg: disk entry pointer jsr r5,drbm ; release bitmap inc dbmno cmp dbmno,dsknbm(r5) ; at last disk bit-map block no. if eq,< ; yes clr dbmno ; wrap back to first bit-map > sorl r3 ; have we looked at all the bit-maps > print ^"No free blocks on disk. " ; no free space on this disk jmp prompt ; time to go to command level 2$: tst -(r1) ; move ptr back to word with free block cmpb (r1),#377 ; low byte have any free blocks? if eq,< inc r1 ; no, use high byte > sub r1,r2 neg r2 ash #3,r2 clr r3 sec loop < rol r3 ; next bit in byte inc r2 ; increment block no. bitb r3,(r1) ; this block free? rptl ne > dec r2 ; correct for over incrementing bisb r3,(r1) ; set bit to allocate block push r5 ; DRBM arg: disk entry pointer jsr r5,drbm ; release bitmap block mov dbmno,r0 ; get the bit-map number inc r0 ; make map number one-based asl r0 ; times two for offset into table add pc,r0 ; get block no. of 1st block in bitmap add dbmtab-.(r0),r2 ; ... ; R2 now has the block number that has been allocated mov r2,16(sp) ; set block no. for return jsr r5,rest6 ; restore regs rts r5 .sbttl Bitmap i/o ; DGBM gets a bitmap given a bitmap no. A block ptr is returned. ; ; ARGS: VALS: ; SP -> bitmap no. SP -> block ptr ; disk entry ptr dgbm: push r0,r1 ; save registers mov 10(sp),r0 ; get disk entry pointer mov 6(sp),r1 ; get bitmap number add dskbmb(r0),r1 ; make it a disk block number (bit-map) cmp r1,dbmnum ; is this bit-map already in core if ne,< ; no different number given push r0,r1 ; DKREAD args: disk entry ptr, block no. push dlblk(r0) ; DKREAD arg: word count asr (sp) ; make it a word count push #bmpbuf ; DKREAD arg: address jsr r5,dkread ; read in bit-map mov r1,dbmnum ; save bit-map block number > pop r1,r0 ; restore register mov #bmpbuf,4(sp) ; return pointer to bit-map buffer pop (sp) ; remove arg from stack rts r5 ; DRBM writes out the bit-map in BMPBUF. ; ; ARGS: VALS: ; SP -> disk entry ptr (none) drbm: push r0 ; save register mov 4(sp),r0 ; get disk entry ptr push r0,dbmnum ; DKWRIT args: disk entry ptr,block no. push dlblk(r0),#bmpbuf ; DKWRIT args: word count,address asr 2(sp) ; make it a word count jsr r5,dkwrit ; write out the bit-map pop r0,(sp) ; restore reg, remove arg from stack rts r5 .sbttl I/O subroutines crlf: print ^" " rts pc ; the CVR50 subroutine takes a character in r0 and returns in ; r0 the rad50 value of that character, unless it is not rad50 ; character in which case it returns -1. cvr50: push r1,r2 ; save registers mov pc,r1 ; get PIC address of conversion table add #r50tab-.,r1 ; .... mov #50,r2 ; number of rad50 characters loop < cmpb (r1)+,r0 ; is this the character??? if eq,< ; yes sub pc,r1 ; subtract address of table to get offset sub #r50tab+1-.,r1 ; (which is rad50 character) mov r1,r0 ; put rad50 into r0 exitl > sorl r2 ; do next one mov #-1,r0 ; not a rad50 character exitl > pop r2,r1 ; restore registers rts r5 ; RNUMX calls RNUM to read a number and throw away the terminator rnumx: jsr r5,rnum ; read number push r0 ; save no. jsr r5,readc ; read terminator and ignore pop r0 ; restore no. rts r5 ; RNUM throws away leading spaces and then calls RNUMBR to read a no. rnum: jsr r5,readc ; get char cmp r0,#40 ; space? beq rnum mov r0,reread jmp rnumbr tbyte: push r0,r1,r3 mov #3,r3 swab r1 mov #100,r0 loop < rol r1 rolb r0 rptl cc bis #60,r0 jsr r5,typec mov #40,r0 sorl r3 > pop r3,r1,r0 rts pc prad50: push r1 ; save register mov 4(sp),r1 ; get arg jsr pc,rad50 ; print it out pop r1,(sp) ; restore register, remove the arg rts pc rad50: push r0 ; save reg clr r0 ; for DIV div #50*50,r0 ; get 1st char in r0, last two in r1 movb r50tab(r0),r0 ; convert 1st to ascii jsr r5,typec ; type it clr r0 ; for DIV div #50,r0 ; get 2nd char in r0, 3rd in r1 movb r50tab(r0),r0 ; convert 2nd to ascii jsr r5,typec ; type it movb r50tab(r1),r0 ; convert 3rd to ascii jsr r5,typec ; type it pop r0 ; restore reg rts pc ; DKRBLK reads a block from disk into the sector buffer. ; ARGS: VALS: ; SP -> block no. (none) ; disk no. dkrblk: mov 2(sp),bkn ; save block last read/written mov 4(sp),bkn+2 ; save disk number last read/written push (sp),(sp) ; make room for two extra args to DKREAD push r0 ; save reg mov 12(sp),r0 ; get disk entry pointer mov dlblk(r0),6(sp) ; get number of bytes/block pop r0 ; restore reg asr 4(sp) ; DKREAD arg3: word count mov #sector,2(sp) ; DKREAD arg4: address jmp dkread ; DKWBLK writes the sector buffer back to a block on disk. ; ARGS: VALS: ; SP -> block no. (none) ; disk no. dkwblk: mov 2(sp),bkn ; save block last read/written mov 4(sp),bkn+2 ; ... push (sp),(sp) ; make room for two extra args to DKWRIT push r0 ;save reg mov 12(sp),r0 ; get disk entry ptr mov dlblk(r0),6(sp) ; get number of bytes/block pop r0 ; restore reg asr 4(sp) ; DKWRIT arg3: word count mov #sector,2(sp) ; DKWRIT arg4: address jmp dkwrit ; DKREAD reads from the disk. ; ARGS: VALS: ; SP -> address (none) ; word count ; block no. ; disk no. dkread: push 10(sp) ; DTYPE arg: disk number jsr r5,dtype ; get disk type .if ne nrk cmp #rk,(sp) ; is the disk an RK type disk???? if eq,< pop * ; remove val from stack push (sp) ; make room for arg to RKRW mov #5,2(sp) ; put in op code for read jmp rkrw > .endc .if ne nrp cmp #rp,(sp) ; is the disk an RP type disk??? if eq,< pop * ; yes, remove vall from stack push (sp) ; make room for arg to RPRW mov #5,2(sp) ; put in op code for read jmp rprw ; and do it > .endc .if ne nrx cmp #rx,(sp) ; is the disk an RX type disk???? if eq,< pop * ; remove val 1$: push 10(sp),6+2(sp),2+4(sp) ; RXREAD args: disk no., block no., ; address jsr r5,rxread ; read one block from floppy inc 6(sp) ; increment block no. push r0 ; save register mov 12(sp),r0 ; get disk entry ptr mov dlblk(r0),r0 ; get number of bytes/block add r0,4(sp) ; next address asr r0 ; make word count sub r0,6(sp) ; decrement word count if hi,< pop r0 ; restore register br 1$ ; read next block if word count not counted out > pop r0 ; restore register pop 6(sp) ; remove args from stack add #6,sp ; ... rts r5 > .endc .if ne nrl cmp #rl,(sp) ; is this an rl type disk???? if eq,< pop * ; remove val from stack push (sp) ; make room for arg to RLRW mov #14,2(sp) ; put in op code for read jmp rlrw ; process command > .endc print ^" Disk Read: Illegal disk type. " mov #1000,sp ; clear off gunk jmp prompt ; go to another command ; DKWRIT writes to the disk. ; ARGS: VALS: ; SP -> address (none) ; word count ; block no. ; disk no. dkwrit: push 10(sp) ; DTYPE arg: disk number jsr r5,dtype .if ne nrk cmp #rk,(sp) ; is the disk an RK type disk???? if eq,< pop * push (sp) ; make room for arg to RKRW mov #3,2(sp) ; put in op code for write jmp rkrw > .endc .if ne nrp cmp #rp,(sp) ; is this an RP type disk??? if eq,< pop * ; yes, remove val from stack push (sp) ; make room for arg to RPRW mov #3,2(sp) ; put in op code for write jmp rprw ; and do it > .endc .if ne nrx cmp #rx,(sp) ; is the disk an RX type disk???? if eq,< pop * push r0,r1 ; save registers mov 10+4(sp),r0 ; get disk number pointer push r0,6+2+4(sp),2+4+4(sp) ; RXWRIT args: disk no., block no., ; address jsr r5,rxwrit ; write one block to floppy inc 6+4(sp) ; increment block no. mov dlblk(r0),r1 ; get byte count add r1,2+4(sp) ; next address asr r1 ; make word count sub r1,4+4(sp) ; decrement/test word count bhi dkwrit ; write next block until ; word count counted out pop r1,r0 ; restore registers pop 6(sp) ; remove args from stack add #6,sp ; ... rts r5 > .endc .if ne nrl cmp #rl,(sp) ; is this an rl type disk???? if eq,< pop * ; remove val from stack push (sp) ; make room for arg to RLRW mov #12,2(sp) ; put in op code to write data jmp rlrw ; go do command > .endc print ^" Disk Write: Illegal disk type. " mov #1000,sp ; clear off gunk jmp prompt .if ne nrl .sbttl RL11 read/write ; RLRW ; ; ARGS: VALS: ; SP ->op code (none) ; address ; word count ; block number ; disk number rlrw: jsr r5,save6 ; save registers mov 24(sp),r1 ; get block number clr r0 ; clear track counter mov #40.,r2 ; there are 40. blocks per track div r2,r0 ; get number of tracks in r0 ash #6,r0 ; mov into place for Cylinder address bis r1,r0 ; merge sector (in r1) with track mov r0,24(sp) ; save converted disk address neg 22(sp) ; make the word count negative for ; the stupid controller mov 26(sp),r0 ; get disk entry ptr movb dskdrv(r0),r0 ; get drive number bic #177400,r0 ; clear any gunk ash #8.,r0 ; put disk number in bits 9-8 mov r0,26(sp) ; save disk number mov #7,r4 ; number of times to try recoverable errors ; ; reset the drive ; loop < mov #rlcsr,r5 ; get address of CSR mov #13,4(r5) ; do a get status/reset drive mov 26(sp),r0 ; get disk number bis #4,r0 ; put in function code mov r0,(r5) ; perform function loop < tstb (r5) ; has drive finished yet?? rptl pl ; no yet > tst (r5) ; check for errors bmi rlerr ; go handle them jsr pc,rlseek ; seek to the right track ; Now we can finally do the read/write operation!!!!!!!!! mov 22(sp),6(r5) ; set word count mov 20(sp),2(r5) ; set bus address mov 24(sp),4(r5) ; set disk address mov 26(sp),r0 ; get disk number bis 16(sp),r0 ; set function code into R0 mov r0,(r5) ; go do it loop < tstb (r5) ; is the controller finished??? rptl pl ; not yet if plus > tst (r5) ; test for errors exitl pl ; no error, we're through bit #140000,(r5) ; see if a disk error bne rlerr ; check out disk errors sorl r4 ; try a few more times br rlerr > jsr r5,rest6 ; restore registers pop 10(sp) ; remove args from stack add #10,sp ; .... rts r5 ; perform a seek on the disk to the right track rlseek: push r0,r1,r2 ; save registers mov 26+10(sp),r0 ; get disk number bis #10,r0 ; add in function mov r0,(r5) ; execute read headers function loop < tstb (r5) ; has drive finished yet???? rptl pl ; not yet > mov 6(r5),r0 ; get current disk address mov 24+10(sp),r1 ; get desired disk address bic #77,r1 ; clear sector bits bic #177,r0 ; clear sector and surface bits mov r1,r2 ; copy desired disk address bic #177677,r2 ; isolate surface bit ash #-2,r2 ; position it for difference word in seek bic #100,r1 ; remove surface bit sub r1,r0 ; find difference word for seek operation bcc 1$ ; if CC actual >= desired position neg r0 ; make positive difference bis #4,r0 ; set bit to indicate move towards disk center 1$: inc r0 ; set marker bit bis r2,r0 ; merge in surface bit mov r0,4(r5) ; put difference word into RLDAR mov 26+10(sp),r0 ; get disk number bis #6,r0 ; add in function mov r0,(r5) ; perform a seek function loop < tstb (r5) ; has controller finished rptl pl ; not yet > pop r2,r1,r0 ; restore registers rts pc ; perform error checking on the disk drive rlerr: push r5 ; save register print ^" RL01 disk error -- regs: " mov #rlcsr,r2 ; get pointer to CSR mov #4,r3 ; number of registers loop < mov (r2)+,r0 ; get disk register jsr r5,octal ; print it print ^" " ; leave some space sorl r3 ; do rest > ; analyze errors print ^" Errors: " mov #rlcsr,r5 ; get pointer to CSR bit #20000,(r5) ; is the a NXM error if ne,< print ^"Non-Existent Memory error. " > bit #2000,(r5) ; is Operation Incomplete set?? bne 1$ ; yes print type of error bit #4000,(r5) ; check for CRC error if ne,< print ^"Data CRC error. " > bit #10000,(r5) ; check for data late error if ne,< print ^"Data Late error. " > br rlderr ; go handle drive errors 1$: bit #4000,(r5) ; check for CRC error if ne,< print ^"Header CRC error. " > bit #10000,(r5) ; check for header not found error if ne,< print ^"Header Not Found error. " > ; fall through to drive error checking routine rlderr: bit #40000,(r5) ; was there really a drive error beq 2$ ; no, time to exit mov #3,4(r5) ; do a get status on the drive mov 30(sp),r0 ; get disk number bis #4,r0 ; put in function code mov r0,(r5) ; execute function loop < tstb (r5) ; is controller finished??? rptl pl ; not yet if plus > mov 6(r5),r0 ; get drive errors print ^" RL01 Drive Errors -- drive error register " jsr r5,octal ; print error register (in r0) ; all through, but probably should parse ; through r0 and print what errors are there. 2$: pop r5 ; restore register clr silent ; turn printing back on print ^"Continue?" ; continue after disk error jsr r5,readc ; get next character cmp #'Y,r0 ; continue ???? beq 1$ ; yes mov #1000,sp ; no, clear off gunk and return jmp prompt 1$: jsr pc,crlf ; do a CRLF jsr r5,rest6 ; restore regs pop 10(sp) ; remove args from stack add #10,sp ; .... rts r5 .endc ;nrl .sbttl RP11 read/write .if ne nrp ; RPRW ; ARGS: VALS: ; SP -> op code (none) ; address ; word count ; block no. ; disk no. rprw: jsr r5,save6 ; save regs clr r0 ; get ready to divide mov 24(sp),r1 ; get block number requested div #10.,r0 ; divide by number of sectors/track (10.) mov r1,r3 ; save sector number in R3 (will be ; RPDAR eventually) mov r0,r1 ; prepare for another divide clr r0 ; ... div #20.,r0 ; divide by number of tracks per ; cylinder to get track number swab r1 ; move track address to bits 8-12 clrb r1 ; clear lower in case...... bis r1,r3 ; set track address with sector ; address mov r0,r2 ; save cylinder number in R2 (for RPCAR) mov 26(sp),r1 ; get disk entry ptr movb dskdrv(r1),r1 ; get drive number swab r1 ; shift into bits 13-15 clrb r1 ; clear lower byte of any gunk mov 16(sp),r0 ; get op code bis r1,r0 ; set disk no. in CSR neg 22(sp) ; negate word count for stupid controller mov #7,r5 ; no. of times to retry recoverable errors loop < mov #rpcsr,r4 ; ptr to RPCSR mov #1,(r4) ; controller reset loop < tstb (r4) ; wait for done rptl pl > mov #rpdar+2,r4 ; get ptr that will autodec to RPDAR mov r3,-(r4) ; set RPDAR mov r2,-(r4) ; set RPCAR mov 20(sp),-(r4) ; set RPBAR mov 22(sp),-(r4) ; set RPWCR mov r0,-(r4) ; set RPCSR, i.e. perform operation loop < tstb (r4) ; wait for done rptl pl > tst (r4) ; errors? bmi 1$ ; Now compare stuff just read/written with disk copy mov #rpdar+2,r4 ; get ptr that will autodec to RPDAR mov r3,-(r4) ; set RPDAR mov r2,-(r4) ; set RPCAR mov 20(sp),-(r4) ; set RPBAR mov 22(sp),-(r4) ; set RPWCR mov r0,r1 ; get function and drive number bic #174377,r1 ; remove all but drive number bis #7,r1 ; set write check op code and go bit mov r1,-(r4) ; set RPCSR, do write check loop < tstb (r4) ; wait for done rptl pl > tst (r4) ; Error? exitl pl 1$: bit #040000,(r4) ; recoverable error? bne rper sorl r5 ; yes, try a few times br rper > jsr r5,rest6 ; restore regs pop 10(sp) ; remove args from stack add #10,sp ; ... rts r5 rper: push r5 ; save register print ^" RP11 Disk error -- regs: " mov #rpdsr-10,r2 mov #8.,r3 ;# of regs. loop < mov (r2)+,r0 ;next disk reg. jsr r5,octal ;type contents. print ^" " sorl r3 > jsr pc,crlf mov #8.,r3 ; # of regs. loop < mov (r2)+,r0 ;next disk reg. jsr r5,octal ;type contents. print ^" " sorl r3 > jsr pc,crlf ; Analyze errors (last so can ^S). print ^" Errors: " mov pc,r5 ;make ptr to ermsg ptrs add #rpertb-.,r5 mov @#rperr,r4 ;the error bits loop < mov r5,r1 ;next error msg add (r5)+,r1 clc ;want logical shift ror r4 ;next error bit if cs,< jsr r5,types rptl > rptl ne > pop r5 ; restore register clr silent ; turn printing back on print ^"Continue?" ; continue after disk error jsr r5,readc ; get next character cmp #'Y,r0 ; continue ???? beq 1$ ; yes mov #1000,sp ; no, clear off gunk and return jmp prompt 1$: jsr pc,crlf ; do a CRLF jsr r5,rest6 ; restore regs pop 10(sp) ; remove args from stack add #10,sp ; .... rts r5 .endc ; ne nrp .sbttl RK11 read/write .if ne nrk ; RKRW ; ARGS: VALS: ; SP -> op code (none) ; address ; word count ; block no. ; disk no. rkrw: jsr r5,save6 ; save regs clr r0 ; divide block no. by 12 mov 24(sp),r1 ; ... div #12.,r0 ; ... ash #4,r0 ; multiply quotient by 16 add r1,r0 ; add remainder to get DAR mov 26(sp),r1 ; get disk entry ptr movb dskdrv(r1),r1 ; get drive number swab r1 ; shift into bits 13-15 clrb r1 ; clear lower byte of any gunk ash #5,r1 ; ... bis r1,r0 ; set disk no. in DAR neg 22(sp) ; negate word count for stupid controller mov #7,r5 ; no. of times to retry recoverable errors loop < mov #rkcsr,r4 ; ptr to RKCSR mov #1,(r4) ; controller reset loop < tstb (r4) ; wait for done rptl pl > mov #rkdar+2,r4 ; get ptr that will autodec to RKDAR mov r0,-(r4) ; set RKDAR mov 20(sp),-(r4) ; set RKBAR mov 22(sp),-(r4) ; set RKWCR mov 16(sp),-(r4) ; set RKCSR, i.e. perform operation loop < tstb (r4) ; wait for done rptl pl > tst (r4) ; errors? bmi 1$ ; Now compare stuff just read/written with disk copy mov #rkdar+2,r4 ; get ptr that will autodec to RKDAR mov r0,-(r4) ; set RKDAR mov 20(sp),-(r4) ; set RKBAR mov 22(sp),-(r4) ; set RKWCR mov #7,-(r4) ; set RKCSR, do write check loop < tstb (r4) ; wait for done rptl pl > tst (r4) ; Error? exitl pl 1$: bit #166340,-(r4) ; recoverable error? bne rker sorl r5 ; yes, try a few times br rker > jsr r5,rest6 ; restore regs pop 10(sp) ; remove args from stack add #10,sp ; ... rts r5 rker: push r5 ; save register print ^" RK05 Disk error -- regs: " mov #rkdsr,r2 mov #6,r3 ;# of regs. loop < mov (r2)+,r0 ;next disk reg. jsr r5,octal ;type contents. print ^" " sorl r3 > ; Analyze errors (last so can ^S). print ^" Errors: " mov pc,r5 ;make ptr to ermsg ptrs add #dertab-.,r5 mov @#rkerr,r4 ;the error bits loop < mov r5,r1 ;next error msg add (r5)+,r1 clc ;want logical shift ror r4 ;next error bit if cs,< jsr r5,types rptl > rptl ne > pop r5 ; restore register clr silent ; turn printing back on print ^"Continue?" ; continue after disk error jsr r5,readc ; get next character cmp #'Y,r0 ; continue ???? beq 1$ ; yes mov #1000,sp ; no, clear off gunk and return jmp prompt 1$: jsr pc,crlf ; do a CRLF jsr r5,rest6 ; restore regs pop 10(sp) ; remove args from stack add #10,sp ; .... rts r5 mov #1000,sp ;clear off gunk jmp prompt .endc ; ne nrk .sbttl RX11 read/write .if ne nrx ; RXREAD ; ARGS: VALS: ; SP -> address (none) ; block no. ; disk no. rxread: push r0,r1,r2 ; save regs mov #rxcs,r0 ; get bus address of RX11 controller push 12(sp),#7 ; RXRW args: block no., op code mov 14+4(sp),r2 ; get disk entry ptr movb dskdrv(r2),r2 ; get disk drive number bic #177400,r2 ; clear any gunk if ne,< ; see if drive 1 bis #20,(sp) ; yes, set unit select in op code > jsr r5,rxrw ; initiate read loop < bit #40,(r0) ; wait for Done rptl eq > tst (r0) ; Error? bmi rxer mov #10,r2 ; no. of times to retry parity errors in Empty loop < mov #3,(r0) ; send Empty command mov 10(sp),r1 ; get ptr to buffer loop < bitb #240,(r0) ; test Transfer Request and Done bits rptl eq ; wait for one to set exitl pl ; Done? movb 2(r0),(r1)+ ; no, Transfer Request, copy data byte rptl > tst (r0) ; Error (parity error in transfer from buffer)? exitl pl sorl r2 ; retry Empty operation br rxer > pop r2,r1,r0,4(sp) ; restore regs, remove args from stack cmp (sp)+,(sp)+ ; ... rts r5 ; RXWRIT writes a block on the floppy. ; ARGS: VALS: ; SP -> address (none) ; block no. ; disk no. rxwrit: push r0,r1,r2 ; save regs mov #rxcs,r0 ; get bus address of RX11 controller mov #10,r2 ; no. of times to retry parity errors in Fill loop < mov #1,(r0) ; send Fill command mov 10(sp),r1 ; get ptr to buffer loop < bitb #240,(r0) ; test Transfer Request and Done bits rptl eq exitl pl ; Done? movb (r1)+,2(r0) ; no, Transfer Request, load data byte rptl > tst (r0) ; Error (parity error in transfer to buffer)? exitl pl sorl r2 ; retry Fill br rxer > push 12(sp),#5 ; RXRW args: block no., op code mov 14+4(sp),r2 ; get disk entry ptr movb dskdrv(r2),r2 ; get disk drive number bic #177400,r2 ; clear any gunk if ne,< bis #20,(sp) ; yes, set unit select in op code > jsr r5,rxrw ; initiate write loop < bit #40,(r0) ; wait for Done rptl eq > tst (r0) ; Error? bmi rxer pop r2,r1,r0,4(sp) ; restore regs, remove args from stack cmp (sp)+,(sp)+ ; ... rts r5 ; RXRW issues a read or write command to the RX11. If writing, the RX11 ; buffer should already be filled with the stuff to be written. If reading ; the RX11 buffer should be emptied afterward. RXRW does not wait for the ; read or write operation to complete. ; ARGS: VALS: ; SP -> op code (none) ; block no. rxrw: push r2,r3 ; save regs clr r2 ; divide block no. by 26 to get track mov 10(sp),r3 ; and sector addresses mov r3,rxbloc ; save block no. for error printer div #26.,r2 ; perform the division asl r3 cmp r3,#26. if his,< sub #26.-1,r3 > inc r3 ; make sector address one based mov r3,rxsect ; save sector address for the error printer mov r2,rxtrac ; save track address for the error printer loop < bit #40,(r0) ; wait for Done rptl eq > mov 6(sp),(r0) ; send read or write command loop < tstb (r0) ; wait for Transfer Request rptl pl > mov r3,2(r0) ; send Sector address loop < tstb (r0) ; wait for Transfer Request rptl pl > mov r2,2(r0) ; send Track address pop r3,r2,(sp),(sp) ; restore regs, remove args from stack rts r5 rxer: mov @#rxdb,r0 bit #1,r0 if ne,< print ^" CRC error detected reading diskette." > bit #2,r0 if ne,< print ^" Parity error detected on command or address data being transfered to RX01." > print ^" RXCS Block Sector Track Error " push r0 ; save error register mov @#rxcs,r0 ; OCTAL arg jsr r5,octal ; print Command and Status register in octal print ^" " mov rxbloc,r0 ; OCTAL arg jsr r5,octal ; print last Block address in octal print ^" " mov rxsect,r0 ; OCTAL arg jsr r5,octal ; print last Sector address in octal print ^" " mov rxtrac,r0 ; OCTAL arg jsr r5,octal ; print last Track address in octal print ^" " pop r0 ; OCTAL arg jsr r5,octal ; print Error Register in octal jsr pc,crlf mov #1000,sp jmp prompt .endc ; ne nrx d.to.b: mov r0,-(sp) ;convert r1 from dar to bk#. mov r5,-(sp) mov r1,r0 ;r0 will have sector addr. bic #177760,r0 bic #160017,r1 ;r1 will have cyl addr. asr r1 ;mult r1 by 12.(is already *16) mov r1,r5 ;save it temporarily. asr r1 ;(* 4) add r5,r1 ;(* 12) add r0,r1 ;now have block #. mov (sp)+,r5 mov (sp)+,r0 rts pc .sbttl Data bases ; The following table matches the command characters with the ; routine to process them. The table starts with -1 and ends ; with -1,0. Each entry in-between is two words: a command ; character followed by the address of the routine. comtab: -1 .word ',dircom-c-2 ; list sector as directory .word ',nxtcom-c-2 ; ignore ^E (End output) .word ',trccom-c-2 ; trace down a file .word ',lstmfd-c-2 ; list sector as MFD .word ',tstrp1-c-2 ; test of RP11 controller .word 14,clrcom-c-2 ; clear screen .word 15,prompt-c-2 ; .word ' ,nxtcom-c-2 ; next command .word '!,divcom-c-2 ; divide command .word '&,andcom-c-2 ; and command .word '*,mulcom-c-2 ; multiply command .word '+,addcom-c-2 ; add command .word '-,subcom-c-2 ; subtract command .word ':,termcm-c-2 ; change terminal type command .word '/,exmcom-c-2 ; print contents of arg in core-image. ; LF for next .word '<,bstcom-c-2 ; set core-image block # to arg .word '=,eqlcom-c-2 ; type arg .word '?,hlpcom-c-2 ; help command .word 'A,adkcom-c-2 ; read all of a disk .word 'B,btmcom-c-2 ; convert arg to bit-map info .word 'C,cstcom-c-2 ; set type-out modes for dump command .word 'D,dmpcom-c-2 ; dump command .word 'E,doscom-c-2 ; Write DOS format command .word 'F,fixcom-c-2 ; print available disk and current one .word 'G,ladcom-c-2 ; list all directories .word 'H,rufdcm-c-2 ; read in the requested UFD .word 'I,imtran-c-2 ; image transfer ; (copy one disk to another) .word 'J,lufdcm-c-2 ; list a UFD requested .word 'K,cufdcm-c-2 ; create a UFD. .word 'L,lnkcom-c-2 ; set arg to link block of current block .word 'M,mapcom-c-2 ; convert bit-map info block number .word 'N,inccom-c-2 ; increment arg .word 'O,ddfcom-c-2 ; delete file command .word 'P,deccom-c-2 ; decrement arg .word 'Q,salcom-c-2 ; salvage command .word 'R,rdcom-c-2 ; read block # arg .word 'S,scom-c-2 ; search for next occurence of word pattern .word 'T,xfrcom-c-2 ; transfer blocks from one disk to another .word 'U,mfdcom-c-2 ; sets arg to the MFD block for disk # arg+2 .word 'V,rmvcom-c-2 ; set current disk .word 'W,wrtcom-c-2 ; write block # arg .word 'X,xitcom-c-2 ; exit command .word 'Y,ytrcom-c-2 ; transfer DOS files from one disk to another ; does a directory specified by the user and ; queries before transfering the file. .word 'Z,zrocom-c-2 ; zero core-image .word '\,remcom-c-2 ; modulo command .word '_,modcom-c-2 ; modify core-image command .word '|,iorcom-c-2 ; OR command .word '],savcom-c-2 ; Save blocks command .word 177,delcom-c-2 ; delete command .word -1,0 ; terminator rpertb: .word dermsg-.,ovrmsg-.,nxmmsg-.,wcemsg-.,rtemsg-. .word csemsg-.,wpemsg-.,lpemsg-.,mermsg-.,fermsg-. .word premsg-.,nxsmsg-.,nxtmsg-.,nxcmsg-.,fuvmsg-. .word wlomsg-. dertab: .word wcemsg-.,csemsg-.,nxemsg-.,nxemsg-.,nxemsg-. .word nxsmsg-.,nxcmsg-.,nxdmsg-.,rtemsg-.,dltmsg-. .word nxmmsg-.,pgemsg-.,skemsg-.,wlomsg-.,ovrmsg-. .word dremsg-. dermsg: .asciz " Disk error. " wpemsg: .asciz " Word parity error. " lpemsg: .asciz " Longitudinal parity error. " mermsg: .asciz " Mode error. " fermsg: .asciz " Format error. " premsg: .asciz " Program error. " nxtmsg: .asciz " Non-existant track. " fuvmsg: .asciz " File unsafe violation. " wcemsg: .asciz " Write check. " csemsg: .asciz " Checksum. " nxemsg: .asciz " not a valid error. " nxsmsg: .asciz " Non-existant sector. " nxcmsg: .asciz " Non-existant cylinder. " nxdmsg: .asciz " Non-existant disk. " rtemsg: .asciz " Read timing error. " dltmsg: .asciz " Data late. " nxmmsg: .asciz " Non-existant memory. " pgemsg: .asciz " Programming error. (E.g. Format enable off) " skemsg: .asciz " Seek error. " wlomsg: .asciz " Write-protect. " ovrmsg: .asciz " Overflow out of disk. " dremsg: .asciz " Drive error. " .even cmsgp: cmsg1,cmsg2,cmsg3,cmsg4,0 cmsg1: .asciz "DUMP MODES: Octal byte? " cmsg2: .asciz " Octal word? " cmsg3: .asciz " RAD50? " cmsg4: .asciz " ASCII? " r50tab: .ascii " ABCDEFGHIJKLMNOPQRSTUVWXYZ$.%0123456789" .even dbmtab: .word 0,0,1700,3600,5500,7400 .word 11300,13200,15100,17000 .word 20700,22600,24500,26400 .word 30300,32200,34100,36000 .word 37700,41600,43500,45400 .word 47300 ; version no. in decimal: vn2== vn1==>/10. vn0==-<10.*vn1>> hlomsg: .ascii " DSKDMP " .byte vn2+60,vn1+60,vn0+60 ; the version #. .asciz ". " arg: .blkw 2 ; contains argument (block number, disk number). bkn: .blkw 2 ; block no., disk number of last read or write corbkn: .blkw 2 ; core-image bk#, disk number cflag: .word 4 ; FLAGS TO SHOW WHAT TYPE OF CHAR-DUMP IS ; TO BE INCLUDED IN DUMP: (1 = ON) ; BIT 0: ASCII ; BIT 1: RAD50 ; BIT 2: OCTAL WORD ; BIT 3: OCTAL BYTE adrmod: .word 1 ; MASK FOR DUMP ADDRESS MOD-N swidth: .word 80. mask: .word -1 ; search mask bmpbuf: .blkb maxblk ; buffer for a bit-map dbmnum: .word -1 ; block number of bit-map in BMPBUF dbmno: .blkw 1 ; bitmap no. ; these are used for storing variableas describing the disks ; when using the Y command. (i.e. Transfering DOS files.) ; and for the (Q) salvage command. disk0: .blkw 1 ; disk name for disk 0 disk1: .blkw 1 ; disk name for disk 1 dirnm0: .blkw 1 ; directory name for disk 0 dirnm1: .blkw 1 ; directory name for disk 1 dnent0: .blkw 1 ; number of entries in a UFD on disk 0 dnent1: .blkw 1 ; number of entries in a UFD on disk 1 dlblk0: .blkw 1 ; length of a block on disk 0 dlblk1: .blkw 1 ; length of a block on disk 1 dnumr0: .blkw 1 ; current word of block read in from 0 dnumr1: .blkw 1 ; current word of block to be written ; on disk 1 dfilp0: .blkw 1 ; pointer to current word of block read in dfilp1: .blkw 1 ; pointer to current word of block to be ; written fent1: .blkw 1 ; ptr to entry added to disk1 UFD ufdbln: .blkw 1 ; block number of UFD in UFDBLK sblk0: .blkw 1 ; block number of the block in sectr0 sblk: .blkw 1 ; block number of the block in sector .if ne nrx rxbloc: .word 0 ; last block read or written from floppy rxsect: .word 0 ; last sector read or written from floppy rxtrac: .word 0 ; last track read or written from floppy .endc sector: .blkb maxblk ; sector image sectr0: .blkb maxblk ; sector image ufdblk: .blkb maxblk ; for the UFD from the disk ufdbl0: .blkb maxblk ; for the other UFD from the other disk mfdblk: .blkb maxblk ; for storing a MFD from disk 0 mfdbl1: .blkb maxblk ; for storing a MFD from disk 1 imbuf: .blkb secbuf ; buffer for 1 track for image copying constants .end go EDSK: PDP11; DSKDMP > 03749,PALX secbuf=319 maxblk=335 versio=351 nrl=743 nrk=751 nrx=759 nrp=767 nrl=798 nrk=806 nrx=814 nrp=822 rkdsr=854 rkerr=892 rkcsr=907 rkwcr=922 rkbar=937 rkdar=952 rpdsr=989 rperr=004 rpcsr=019 rpwcr=034 rpbar=049 rpcar=064 rpdar=079 rpm1r=094 rpm2r=109 rpm3r=124 rpsucr=140 rpsilo=156 rlcsr=192 rlbar=230 rldar=245 rlmpr=260 ndisk=466 dsknam=492 dsktyp=529 dsknum=566 dskdrv=605 dlblk=649 dnsect=699 dntrak=751 dskmfd=801 dskbmb=846 dsknbm=895 ndisk=943 dsktab:991 rp=009 rp0=020 rp1=032 rk=187 rk0=198 rk1=210 rx=355 rx0=366 rx1=378 rl=505 rl0=516 rl1=528 start:695 dskdmp:704 prompt:744 nxtcom:045 c:283 comerr:339 hlpcom:452 termcm:946 argcom:030 mfdcom:263 delcom:449 inccom:487 deccom:519 clrcom:551 lnkcom:601 addcom:768 subcom:869 mulcom:982 divcom:084 remcom:216 dvbig:345 andcom:532 iorcom:667 rmvcom:864 Disk:908 fixcom:0302 eqlcom:0572 eql:0842 scom:1183 Pattern 1203 sread:1697 dircom:2401 dircm1:3518 lstmfd:4663 lsmfd1:5615 crcheck:6984 savcom:7215 SAVE:7363 tstrp1:8289 rp11win:8891 ladcom:9097 rufdcm:9661 lufdcm:0428 cufdcm:1316 cufdbad:4635 cufdex:4694 ddfcom:4816 cstcom:5405 xitcom:5944 btmcom:6071 mapcom:7081 xfrcom:8023 xfrask:8818 xfrno:9286 doscom:9414 dosno:0179 dosgo:0267 adkcom:3952 adkno:4647 adkmsk:4753 rdcom:5282 wrtcom:5419 zrocom:5735 zblock:6012 imtran:6431 imno:8219 numsct:8321 lsttrk:8338 salcom:8711 salgo:9585 saldir:2990 filtst:5767 ytrcom:7811 getwrd:2859 wrtwrd:3753 prtfil:4884 dadden:5627 trccom:7606 dmpcom:8426 dmplin:9471 nextwd:1757 ascchk:2102 bstcom:2345 exmcom:2422 modcom:3156 modler:3197 modcc:3292 modex:3552 modtyu:4190 modlf:4222 moddep:4279 modup:4389 dtype:4707 dskchk:5051 rdsknm:5757 lisdsk:6476 prdisk:7082 savblk:7449 duiclk:8183 ddf:9641 dalloc:0926 dgbm:2837 drbm:3610 crlf:3968 cvr50:4170 rnumx:4763 rnum:4985 tbyte:5092 prad50:5285 rad50:5437 dkrblk:6020 dkwblk:6551 dkread:7046 dkwrit:8832 rlrw:0616 rlseek:2567 rlerr:3751 Errors:4091 rlderr:4947 rprw:6087 rper:8231 Errors:8662 rkrw:9579 rker:1106 Errors:1410 rxread:2361 rxwrit:3522 rxrw:4842 rxer:5660 d.to.b:6494 comtab:7212 rpertb:9649 dertab:9836 dermsg:00021 wpemsg:00057 lpemsg:00100 mermsg:00151 fermsg:00187 premsg:00225 nxtmsg:00264 fuvmsg:00308 wcemsg:00355 csemsg:00391 nxemsg:00424 nxsmsg:00466 nxcmsg:00510 nxdmsg:00556 rtemsg:00598 dltmsg:00640 nxmmsg:00674 pgemsg:00718 skemsg:00785 wlomsg:00820 ovrmsg:00858 dremsg:00903 cmsgp:00948 cmsg1:00982 cmsg2:01025 cmsg3:01057 cmsg4:01084 r50tab:01116 dbmtab:01185 vn2=01392 vn1=01412 vn0=01442 hlomsg:01483 arg:01571 bkn:01636 corbkn:01702 cflag:01750 adrmod:01943 swidth:01992 mask:02009 bmpbuf:02044 dbmnum:02090 dbmno:02144 disk0:02336 disk1:02377 dirnm0:02419 dirnm1:02466 dnent0:02513 dnent1:02571 dlblk0:02629 dlblk1:02678 dnumr0:02727 dnumr1:02785 dfilp0:02859 dfilp1:02921 fent1:02995 ufdbln:03048 sblk0:03098 sblk:03153 rxbloc:03226 rxsect:03286 rxtrac:03347 sector:03416 sectr0:03456 ufdblk:03496 ufdbl0:03549 mfdblk:03614 mfdbl1:03671 imbuf:03727  DSK: PDP11; DEFS > 00821,PALX yes=42 no=50 mit=91 sao=21 lll=51 mit44=62 drl=98 drk=34 drp=70 r0=666 r1=673 r2=680 r3=687 r4=694 r5=701 sp=708 pc=715 swr=098 ps=156 pr0=361 pr1=405 pr2=415 pr3=425 pr4=435 pr5=445 pr6=455 pr7=465 lks=496 tks=525 tkb=563 tps=576 tpb=589 rkdsr=619 rkerr=657 rkcsr=672 rkwcr=687 rkbar=702 rkdar=717 rlcsr=753 rlbar=791 rldar=806 rlmpr=821 rpcou1=858 rpcou2=874 rpcou3=890 rpcou4=906 rpdsr=921 rperr=936 rpcsr=951 rpwcr=966 rpbar=981 rpcar=996 rpdar=011 rpm1r=026 rpm2r=041 rpm3r=056 rpsucr=072 rpsilo=088 rxcs=124 rxdb=177 lps=248 lpb=261 lvs=274 lvb=287 %.m=921 ifcnt=1142 gncnt=1332  DSK: PDP11; STUFF > 00198,PALX stvn=3 save6:72 rest6:93 mul1:073 mul2:980 div2:089 dmul:871 ddiv:955 ddiv10:508 ddiv24:788 ddiv60:064 bits:260 dzlpar:867  DSK: PDP11; SASTUF > 00681,PALX savn=4 %tntt=16 %tnsb=32 %tnvt=55 go:59 initsb:386 initvt:899 inittt:372 initvt:580 ignore:939 powerf:095 poweru:183 nxmt:256 catchn:459 nxmcat=580 octal:659 octals:107 rnumbr:564 readc:319 ireadc:917 tk1int:374 dzrint:503 tkint:857 typesc:412 types:743 typec:996 tyt:494 tyr:525 tycr:569 tylf:640 tytab:0426 tyclr:0692 itypes:0979 itypec:1364 memtop:1709 silent:1749 xonxof:1790 more:1836 ttytyp:1885 isr:1917 linel:1962 pagel:1994 hpos:2025 vpos:2064 reread:2103 typein:2147 inchar:2180 patch:2233  ; New PDP11 Console program -*-PALX-*- versio==%fnam2 .iif ndf asmsac, asmsac===1 ; stand alone version unless told otherwise .if ne asmsac ; if stand alone then include startup code .title Stand alone Console .sbttl Startup .insrt pdp11;defs setf ^"Address of Console?",consad ; When booted the system starts here at CONSAD. The top of memory ; is determined and Console is started. Console does all its work ; at interrupt level so the system simply enters a wait loop. stack==1000 .=consad ; code starts just above stack go: spl 7 ; set high priority so no interrupts mov #stack,sp ; set stack ptr .if eq sys-sao mov #60,r0 mov pc,r1 add #vecsav-.,r1 mov (r0)+,(r1)+ mov (r0)+,(r1)+ mov (r0)+,(r1)+ mov (r0)+,(r1)+ .endc .if ne pfail mov #powerf,@#24 ; set power fail vector mov #pr7,@#26 ; ... .endc jsr r5,consol ; console initialization spl 0 ; run at pr0 loop < wait ; interrupt driven now rptl > ; CATCHN is called to setup for an expected nxm trap. ; When the nxm trap occurs control will be passed to address ; specified by a relative ptr after the call. .if ne sys-sao nxmcat==42 ; this is address BOOT uses for NXM catch catchn: mov r5,@#nxmcat ; set catch for address specified add (r5)+,@#nxmcat ; by relative ptr after call rts r5 .iff ; if eq sys-sao catchn: mov r5,nxmcat add (r5)+,nxmcat mov @#4,svloc4 mov @#6,svloc6 push pc add #nxmt-.,(sp) pop @#4 mov #pr7,@#6 rts r5 ; NXMT is the NXM catch handler for SAO's machine. This is provided ; automatically by BOOT on the MIT machine. nxmt: tst nxmcat ; catch set? if eq,< halt ; no, crap out rti ; ignore it if continued (?) > mov nxmcat,(sp) ; clobber PC on stack with catch address clr nxmcat ; catch is now used up mov svloc4,@#4 ; restore trap vector mov svloc6,@#6 ; ... rti svloc4: .blkw 1 svloc6: .blkw 1 nxmcat: .blkw 1 vecsav: .blkw 4 .endc ; end conditional on SAO's machine .if ne pfail ; POWERF is Console's power fail handler. powerf: add #poweru-powerf,@#24 halt ; POWERU is Console's power up handler. poweru: add #powerf-poweru,@#24 jmp go .endc ; Include random useful stuff. .insrt pdp11;stuff .endc ; ne asmsac .sbttl Configuration .iif ndf asmcmd, asmcmd===1 ; command processor always. .iif ndf asmlod, asmlod===asmsac ; loading iff stand alone .iif ndf asmcpy, asmcpy===asmsac ; copy stuff iff stand alone .if eq * ; MIT .iif ndf asmclp, asmclp===asmsac ; hack lpt iff stand alone .iif ndf asmctk, asmctk===asmsac ; hack tektronix iff stand alone .iff ; elsewhere .iif ndf asmclp, asmclp===0 ; no LPT .iif ndf asmctk, asmctk===0 ; no plotter .endc llb==10+<6144.*asmclp> ; buffer size for LPT ltb==10+<6144.*asmctk> ; buffer size for Tektronix ack==4 nack==6 nos==1 .sbttl Data structures ; Define queue structure dsect < qsize:: .word 0 ; size of queue buffer qbp:: .word 0 ; ptr to buffer used as queue qfp:: .word 0 ; ptr to front of queue qrp:: .word 0 ; ptr to rear of queue >,lq ; Define TTBL entry dsect < tcpp:: .word 0 ; command processor co-routine PC (zero if not in cp) trcv:: .word 0 ; addr of routine to call for char rcv'd on this line txmt:: .word 0 ; addr of routine to get char to send on this line tsend:: .word 0 ; addr to routine to call to send character tlink:: .word 0 ; output destinations mask tline:: .word 0 ; line no. of this line tbit:: .word 0 ; bit which identifies this line in DZ11 tdladd:: .word 0 ; DL11 address targ1:: .word 0 ; 1st arg to command targ2:: .word 0 ; 2nd or only arg to command toq:: .blkb lq ; output queue .even >,lttbl .sbttl Initialization ; Call CONSOL to start Console; operation proceeds at interrupt level. ; CONSOL initializes the DZ11 and DL11s and sets up the TTBL entries ; for each line. consol: jsr r5,save6 ; save regs mov #1,r0 ; bit id of line mov pc,r1 ; ptr to TTBL add #ttbl-.,r1 ; ... mov pc,r2 ; ptr to TTBLP add #ttblp-.,r2 ; ... mov pc,r3 ; ptr to TTBL initialization data add #inidat-.,r3 ; ... mov pc,r4 ; ptr to buffer space add #bspace-.,r4 ; ... clr r5 ; line no. loop < mov r1,(r2)+ ; save ptr to this entry in our table of ptrs mov r5,tline(r1) ; set line no. mov r0,tbit(r1) ; set bit id of this line clr tcpp(r1) ; not in command processor so zero PC mov r3,-(sp) ; initialize TRCV to INIDAT entry for line add (r3)+,(sp) ; ... jsr pc,@(sp)+ ; prime the pump pop trcv(r1) ; ... mov pc,-(sp) ; initialize TXMT to TTYO add #ttyo-.,(sp) ; ... mov (sp)+,txmt(r1) ; ... push r4,(r3),r1 ; QINIT args: ptr to output buffer, size, add #toq,(sp) ; ptr to queue structure to init jsr r5,qinit ; setup output queue for this line add (r3)+,r4 ; update buffer space ptr mov (r3)+,tlink(r1) ; set link word mov pc,-(sp) ; init send subr to NOSEND add #nosend-.,(sp) ; ... mov (sp)+,tsend(r1) ; ... add #lttbl,r1 ; move ptr to next TTBL entry inc r5 asl r0 ; next bit rptl ne ; zero iff have done all 16 lines > .if ne ndz jsr r5,catchn ; in case no DZ11 on bus nodz-. mov #dzaddr,r4 ; addr of DZ11 mov #20,(r4) ; initialize clr nxmcat ; we have a DZ11, clear NXM catch loop < bit #20,(r4) ; wait for init to finish rptl ne > mov #dzv,r5 ; ptr to int vector for DZ11 mov pc,(r5) ; DZ11 rcvr int PC add #dzrint-.,(r5)+ ; ... mov #pr5,(r5)+ ; and PS mov pc,(r5) ; DZ11 xmtr int PC add #dzxint-.,(r5)+ ; ... mov #pr5,(r5)+ ; and PS mov #8.,r0 ; no. of lines to setup mov pc,r2 ; ptr to TTBL ptr array add #ttblp-.,r2 ; ... mov pc,r3 ; ptr to list of line parameters add #dzlpar-.,r3 ; ... loop < mov (r2)+,r1 mov (r3)+,2(r4) ; setup line parameter register mov pc,-(sp) ; set sending routine to DZSEND add #dzsend-.,(sp) ; ... mov (sp)+,tsend(r1) ; ... sorl r0 > mov #177400,4(r4) ; set all data term rdys, clear ; all xmit line enables mov #040140,(r4) ; turn on ints, start DZ11 nodz: .endc ; ne ndz .if ne ndl mov #ndl,r0 ; no. of DL11s mov pc,r2 ; ptr to TTBL entry for 1st DL11 add #ttblp+<8.*2>-.,r2 ; ... mov #pr4,r3 ; priority 4 for setting vector PS mov #175610,r4 ; 1st DL11 address mov #dlv,r5 ; 1st DL11 vector jsr r5,catchn ; set trap vector in case no DL11 nodl-. loop < mov (r2)+,r1 ; ptr to this DL11's TTBL entry mov #106,(r4) ; enable ints, set req to send + data term rdy clr 4(r4) ; disable xmtr ints until ready to send mov pc,(r5) ; set rcvr vector PC add #dlrint-.,(r5)+ ; ... mov r3,(r5)+ ; set rcvr vector PS mov pc,(r5) ; set xmtr vector PC add #dlxint-.,(r5)+ ; ... mov r3,(r5)+ ; set xmtr vector PS mov r4,tdladd(r1) ; save address of this DL11 mov pc,-(sp) ; sending accomplished by DLSEND add #dlsend-.,(sp) ; ... mov (sp)+,tsend(r1) ; ... inc r3 ; keep DL11 # in vector PS add #10,r4 ; next DL11 address sorl r0 > nodl: .endc mov #pr4+ndl,r3 mov pc,r2 add #ttblp+<8.+ndl*2>-.,r2 mov #177560,r4 mov #60,r5 mov (r2)+,r1 ; ptr to this DL11's TTBL entry mov #106,(r4) ; enable ints, set req to send + data term rdy clr 4(r4) ; disable xmtr ints until ready to send mov pc,(r5) ; set rcvr vector PC add #dlrint-.,(r5)+ ; ... mov r3,(r5)+ ; set rcvr vector PS mov pc,(r5) ; set xmtr vector PC add #dlxint-.,(r5)+ ; ... mov r3,(r5)+ ; set xmtr vector PS mov r4,tdladd(r1) ; save address of this DL11 mov pc,-(sp) ; sending accomplished by DLSEND add #dlsend-.,(sp) ; ... mov (sp)+,tsend(r1) ; ... .if ne asmclp jsr r5,catchn ; in case no lpt on bus nolpt-. tst @#lps ; just to generate nxm mov ttblp+<15.*2>,r1 ; get address of TTBL mov pc,r0 ; set TSEND to DLSEND add #dlsend-.,r0 ; this should work fine for the LPT mov r0,tsend(r1) mov #lps-4,tdladd(r1) ; DLSEND will want to know its CSR address mov #%lpv,r0 ; lpt vector address mov pc,(r0) ; set output vector to LPXINT add #lpxint-.,(r0)+ mov #pr4,(r0) ; priority of LPT output is 4 nolpt: .endc clr nxmcat jsr r5,rest6 ; restore regs rts r5 ; TTBL initialization data ; inital tflags ; output queue size ; initial link word .if eq * inidat: .word ttyi-., 10,000000 ; line 0: VT132 #1 .word ttyi-., 10,000000 ; line 1: VT132 #2 .word ttyi-., 10,000000 ; line 2: VT132 #3 .word ttyi-., 10,000000 ; line 3: SAO's VT52 .word tmci-., 10,000000 ; line 4: 1200 dialup .word ttyi-., 10,000000 ; line 5: Spinwriter .word ttyi-., 10,000000 ; line 6: HP3000 .word tmci-., 40,000000 ; line 7: MC .word ttyi-.,ltb,000000 ; line 8: 4662 .word tmci-., 10,000000 ; line 9: VADIC 300 Baud .word ttyi-., 10,000000 ; line 10: Plotter .word ttyi-., 10,000000 ; line 11: unused .word ttyi-., 10,000000 ; line 12: unused .word ttyi-., 10,000000 ; line 13: unused .word ttyi-., 10,000000 ; line 14: unused .word ttyi-.,llb,000000 ; line 15: LPT .endc .if eq sys-sao inidat: .word ttyi-., 10,000000 ; line 0: unused .word ttyi-., 10,000000 ; line 1: unused .word ttyi-., 10,000000 ; line 2: unused .word ttyi-., 10,000000 ; line 3: unused .word ttyi-., 10,000000 ; line 4: unused .word ttyi-., 10,000000 ; line 5: unused .word ttyi-., 10,000000 ; line 6: unused .word ttyi-., 10,000000 ; line 7: unused .word tmci-., 10,001000 ; line 8: Vadic DLV-11 .word ttyi-., 140,000400 ; line 9: System console DLV-11 .word ttyi-., 10,000000 ; line 10: unused .word ttyi-., 10,000000 ; line 11: unused .word ttyi-., 10,000000 ; line 12: unused .word ttyi-., 10,000000 ; line 13: unused .word ttyi-., 10,000000 ; line 14: unused .word ttyi-.,llb,000000 ; line 15: LPT .endc .sbttl Interrupt handlers ; The terminal interrupt handlers receive and transmit characters. ; When a character is received the interrupt handler calls the input ; co-routine for that terminal (the input co-routine's PC is stored ; in the TRCV word of the TTBL entry for the line). The input co-routine ; returns with JSR PC,@(SP)+ and the interrupt handler stores PC back ; into TRCV. The character received is passed in R0 and has the ; following format: ; Bit 14: Overrun, the previous character(s) has been lost ; Bit 13: Framing error, character stop bit was wrong (probably BREAK) ; Bit 12: Parity error, character parity is incorrect ; Bits 0-7: Character ; When a transmitter interrupt occurs the handler calls a line specific ; subroutine to get a character to output (the address is stored in the ; TSEND word of the TTBL entry for the line). The subroutine either takes ; a skip return (return2) in which case the character to output is in R0 ; or does not skip if there are no more characters to output. .if ne ndz ; DZ11 rcvr interrupt handler. Read from silo and call ; line specific rcv routine for each char. dzrint: jsr r5,save6 ; save regs mov #dzaddr,r4 ; get addr of DZ11 loop < mov 2(r4),r0 ; read RBUF exitl pl ; character not valid, stop reading silo mov r0,r1 ; get line no. swab r1 ; ... bic #177770,r1 ; ... bic #103400,r0 ; clear data valid bit and line no. jsr pc,tichr ; call input routine rptl > jsr r5,rest6 ; restore regs rti ; DZ11 xmtr interrupt handler. Send to all lines which are ready. dzxint: jsr r5,save6 ; save regs mov #dzaddr,r4 ; addr of DZ11 loop < mov (r4),r1 ; read CSR exitl pl ; no more lines ready swab r1 ; get line no. bic #177770,r1 ; ... asl r1 ; word address add pc,r1 ; PC relative offset to TTBL pointer tables mov ttblp-.(r1),r1 ; pointer to TTBL jsr r5,@txmt(r1) ; get character to send br 1$ movb r0,6(r4) ; send character rptl 1$: bicb tbit(r1),4(r4) ; no char to send, stop transmission rptl > jsr r5,rest6 ; restore regs rti .endc ; ne ndz .if ne ndl ; DL11 rcvr interrupt handler dlrint: mfps -(sp) ; save ps to extract unit no. jsr r5,save6 ; save regs mov 14(sp),r1 ; get ps (unit no. in cc bits) bic #177760,r1 ; ... mov r1,r2 ; copy for register address asl r2 ; make word address add pc,r2 ; ptr to TTBL entry for this line mov ttblp+20-.(r2),r2 ; ... mov tdladd(r2),r2 ; get address of device registers for this DL11 mov 2(r2),r0 ; get the character + the error bits cmp r1,#ndl ; is this console TTY unit no.? if eq,< cmpb r0,#234 beq 1$ cmpb r0,#34 ; is it ^\? if eq,< 1$: mov #20000,r0 ; then fake a break > > add #8.,r1 ; convert DL unit no. to Console line no. jsr pc,tichr ; call input procedure jsr r5,rest6 ; restore regs tst (sp)+ ; remove ps from stack rti ; DL11 xmtr interrupt handler dlxint: mfps -(sp) ; save ps to extract unit no. jsr r5,save6 ; save regs mov 14(sp),r1 ; get ps (unit no. in cc bits) bic #177760,r1 ; ... asl r1 ; times two for word ops add pc,r1 ; ptr to TTBL entry for this line mov ttblp+20-.(r1),r1 ; ... mov tdladd(r1),r2 ; get address of DL11 jsr r5,@txmt(r1) ; get character to send br 1$ movb r0,6(r2) ; send character br 2$ 1$: bic #100,4(r2) ; nothing to send, turn off interrupts 2$: jsr r5,rest6 ; restore regs tst (sp)+ ; remove ps from stack rti .endc ; ne ndl .if ne asmclp ; LPT xmtr interrupt handler lpxint: jsr r5,save6 ; save r0 and r1 mov ttblp+<15.*2>,r1 ; get address of TTBL loop < jsr r5,@txmt(r1) ; get character to send br 1$ movb r0,@#lpb ; output character tstb @#lps ; lpt fills buffer at memory speed, so we rptl mi ; check to see if we can do another right away > br 2$ 1$: bic #100,@#lps ; nothing to send, turn off interrupts 2$: jsr r5,rest6 ; restore regs rti .endc ; TICHR is the input character procedure. The character is passed to the ; line's input co-routine. Break escapes to a command processor. tichr: asl r1 ; get line no. times 2 for word op add pc,r1 ; get ptr to TTBL entry for this line mov ttblp-.(r1),r1 ; ... .if eq asmcmd jsr pc,@trcv(r1) ; call line's input co-routine pop trcv(r1) ; save co-routine PC rts pc .iff tst tcpp(r1) ; command processor co-routine active? if ne,< bic #150200,r0 ; ignore overrun, parity error and parity bits bit #020000,r0 ; ignore chars with framing errors if eq,< jsr pc,@tcpp(r1) ; call command processor co-routine pop tcpp(r1) ; save co-routine PC > rts pc > mov r0,r2 ; copy character bic #150200,r2 ; ignore overrun, parity error and parity bits cmp r2,#020000 ; BREAK? if ne,< ; no jsr pc,@trcv(r1) ; call line's input co-routine pop trcv(r1) ; save co-routine PC rts pc > jsr pc,nccp ; call command processor pop tcpp(r1) ; save command processor PC rts pc ; NCONSO command processor. nccp: push tline(r1),#'! ; SEND args: line no., character jsr r5,send ; prompt user pop * ; val: error code ; read a command mov tline(r1),targ1(r1) ; if only 1 arg, first defaults to this line 1$: clr targ2(r1) ; start command argument at zero loop < jsr pc,@(sp)+ ; get next character push tline(r1),r0 ; SEND args: line no., character jsr r5,send ; echo character pop * ; val: error code cmp r0,#'0 ; character a digit? exitl lo cmp r0,#'9 exitl hi sub #'0,r0 ; convert digit to no. mov targ2(r1),r2 ; multiply arg so far by 10 asl r2 mov r2,-(sp) ash #2,r2 add (sp)+,r2 add r0,r2 ; add digit to arg mov r2,targ2(r1) ; save rptl > cmp r0,#', ; terminator a comma? if eq,< mov targ2(r1),targ1(r1) ; copy arg just accumulated br 1$ > cmp r0,#'a ; lower case letter? if his,< cmp r0,#'z if los,< sub #'a-'A,r0 ; convert to upper case > > cmp r0,#'L ; Link command? beq link cmp r0,#'A ; Attach beq atta cmp r0,#'U ; Unlink beq unlink cmp r0,#'D ; Detach beq deta .if ne ndz cmp r0,#'S ; Speed beq speed .endc cmp r0,#'? ; ? beq quest cmp r0,#'F ; File beq file cmp r0,#'X ; Exit bne bad jmp exitc bad: push tline(r1),#7 ; SEND args: line no., character jsr r5,send ; feep at luser pop * ; val: error code jmp ncce ; UNLINK command - unlink two lines unlink: clr r3 ; clear link br l1 ; LINK command - link two lines link: mov pc,r3 ; make link l1: jsr pc,link1 ; make link from targ1 to targ2 mov targ2(r1),-(sp) mov targ1(r1),targ2(r1) ; and then from targ2 to targ1 mov (sp)+,targ1(r1) jsr pc,link1 ; symetric. jmp ncce ; DETACH - unmake a one way link deta: clr r3 ; clear link br a1 ; ATTACH - make a one way link atta: mov pc,r3 ; make link a1: jsr pc,link1 ; just make 1 link jmp ncce link1: mov targ1(r1),r2 ; get 2nd arg, terminal # to link to.. cmp r2,#15. ; ensure line no. is 0-15 bhi bad asl r2 ; make word address mov ttblp(r2),r2 ; get TTBL for terminal to link to. mov targ2(r1),r0 ; line # we are linking from cmp r0,#15. ; ensure line no. is 0-15 bhi bad mov #1,-(sp) ; start with a 1 bit loop < dec r0 exitl lt ; remember line #'s are zero based asl (sp) ; shift it until we have a mask rptl > tst r3 if ne,< bis (sp)+,tlink(r2) ; or in link. > else < bic (sp)+,tlink(r2) ; unlink > rts pc .if ne ndz ; SPEED - set speed of line speed: mov pc,r3 ; ptr to SPDTAB (speed table) add #spdtab-.,r3 ; ... mov r3,r2 ; copy ptr mov targ2(r1),17.*2(r3) ; 16 speeds in table, 17th should end it loop < cmp (r3)+,targ2(r1) ; right speed? rptl ne > tst -(r3) ; bump ptr back to match sub r2,r3 ; get offset into table cmp r3,#16.*2 ; last entry (i.e. the object searched for)? bhi bad swab r3 ; shift 7 places into bits 7400 (speed) asr r3 ; ... mov targ1(r1),r2 cmp r2,#7 ; ensure only try to set speed on a DZ line bhi bad asl r2 ; times two for word ops add pc,r2 ; get ptr to line's entry in DZLPAR add #dzlpar-.,r2 ; ... bic #7400,(r2) ; clear old speed in DZLPAR entry bis r3,(r2) ; set new spped in entry mov #dzaddr,r3 ; get address of DZ mov (r2),2(r3) ; set parameter register br ncce spdtab: 50.,75.,110.,134.,150.,300.,600.,1200.,1800.,2000.,2400. 3600.,4800.,7200.,9600.,19200.,0 .endc .if ne asmcpy ; F command - set block no. for FTP11 transfers file: mov targ2(r1),cblk ; set block no. to transfer to. br ncce .endc ; ? command - type our line no. quest: mov tline(r1),r0 ; get our line no. add #'0,r0 ; make printable cmp targ1(r1),#15. ; ensure line no. is 0-15 bhi bad push targ1(r1),r0 ; SEND args: line no., character jsr r5,send ; type our line no. on specified line pop * ; val: error code br ncce .if eq sys-sao exitc: jsr pc,@(sp)+ ; get next character cmp r0,#'. ; must be . bne badj mov pc,r0 add #vecsav-.,r0 mov #60,r1 mov (r0)+,(r1)+ mov (r0)+,(r1)+ mov (r0)+,(r1)+ mov (r0)+,(r1)+ clr r0 emt 35 .iff ; EXIT command exitc: jsr pc,@(sp)+ ; get next character cmp r0,#'. ; must be . bne badj .exit .endc badj: jmp bad ; Come here when NCONSO command terminated ncce: clr r0 ; hack instruction sequence that jumps to jsr r0,@(sp)+ ; co-routine, setting PC on stack to zero .endc ; ne asmcmd .sbttl Input Co-routines ; Terminal Input Co-routine ttyi: jsr pc,@(sp)+ ; get character jsr r5,distri ; distribute to linked lines br ttyi ; SB Input Co-routine tsbi: jsr pc,@(sp)+ ; get character bic #177600,r0 ; clear error and parity bits cmp r0,#33 ; ESC? if ne,< 1$: jsr r5,distri ; no, simply distribute br tsbi > jsr pc,@(sp)+ ; get char after escape bic #177600,r0 ; clear error and parity bits cmp r0,#'C if eq,< mov #40,r0 ; translate C to space for stupid StupidBee br 1$ > cmp r0,#'p if eq,< mov #33,r0 ; F1 key: send escape br 1$ > cmp r0,#'q if eq,< mov #3,r0 ; F2 key: send ^C br 1$ > mov r0,-(sp) ; save current character mov #33,r0 ; send an escpae followed by jsr r5,distri mov (sp)+,r0 ; the character br 1$ ; MC input co-routine. ; scan input for sequence 1,x as commands to start loading, copying, etc. tmci: jsr pc,@(sp)+ ; get character jsr r5,distri 1$: cmp r0,#1 ; 1? bne tmci jsr pc,@(sp)+ ; get character after 1 jsr r5,distri .if ne asmlod cmp r0,#2 ; 1,2? if eq,< jmp load > .endc .if ne asmcpy cmp r0,#3 ; 1,3? if eq,< jmp copy > .endc .if ne asmclp cmp r0,#30 ; 1,^X? if eq,< bis #100000,tlink(r1) ; link this line to lpt.. br tmci > cmp r0,#31 ; 1,^Y if eq,< bic #100000,tlink(r1) ; unlink this line from lpt br tmci > .endc br 1$ ; DISTRI is used by the input co-routines to send their input to ; multiple output lines. The TLINK word of the line's TTBL entry ; is a bit mask specifying which lines to send to. distri: mov tlink(r1),r2 ; get link word mov #17,r3 ; count lines down loop < tst r2 ; this line linked to? if mi,< push r3,r0 ; SEND args: line no., char jsr r5,send ; send char pop * ; pop off error code > dec r3 asl r2 rptl ne > rts r5 .sbttl Output subroutines ; TTYO handles output to normal terminals. The next character is ; removed from the output buffer and returned to the interrupt routine ; to output. ttyo: push r1 ; REMQ arg: queue ptr add #toq,(sp) ; ... jsr r5,remq ; get character from output queue pop r0,* ; vals: character, error code if eq,< tst (r5)+ ; return2 for normal return > rts r5 .sbttl Loading .if ne asmlod ; LOAD is part of the MC input co-routine. Once in load mode characters ; received from MC come here. load: mov #'1,lgood ; init digit to type for good block clr jmpblk ; clear jump block flag jsr pc,loader ; setup loader by getting it pop loadsw ; to request 1st character loop < jsr pc,@(sp)+ ; get next char from MC bit #070000,r0 if ne,< jsr pc,loderr ; call loader error routine pop loadsw ; save return address rptl > add r0,cksm ; keep checksum jsr pc,@loadsw ; call loader co-routine pop loadsw ; save return address rptl > loader: jsr pc,@(sp)+ ; look for 1,0 1$: cmp r0,#1 bne loader jsr pc,@(sp)+ ; found the 1, now check for 0 tst r0 bne 1$ ; if next isn't a 0, see if its a 1 mov #1,cksm ; initialize checksum (includes the 1,0) jsr pc,@(sp)+ ; next two bytes are byte count of block movb r0,bcount jsr pc,@(sp)+ movb r0,bcount+1 jsr pc,@(sp)+ ; next two bytes are address to load movb r0,addr jsr pc,@(sp)+ movb r0,addr+1 sub #6,bcount ; correct for header, count, address if eq,< ; if no data then jump block mov pc,jmpblk > else < loop < jsr pc,@(sp)+ ; read data byte movb r0,@addr ; store it inc addr ; update current address dec bcount ; keep count rptl ne > > jsr pc,@(sp)+ ; read checksum byte tstb cksm ; which should send checksum to zero if ne,< loderr: push tline(r1),#nack ; SEND args: line no., char jsr r5,send ; send error pop * ; result: error code mov #'B,r0 ; char to type to indicate bad block jsr r5,distri ; type B br loader > push tline(r1),#ack ; SEND args: line no., char jsr r5,send ; send acknowledge pop * ; result: error code mov lgood,r0 ; character to type to indicate good block jsr r5,distri ; type sequential digits for each good block inc lgood ; next digit cmp lgood,#'9 ; past 9? if hi,< mov #'0,lgood ; wrap back to 0 > tst jmpblk ; was last block a jump block? beq loader push tline(r1),#nos ; SEND args: line no., char jsr r5,send ; tell MC not to send symbols tst (sp)+ ; pop off SEND result tst (sp)+ ; pop co-routine PC jmp tmci ; go back to scan .endc .sbttl Copying .if ne asmcpy ; COPY is part of the MC input co-routine. Once in copy mode characters ; received from MC come here. copy: push cblk ; DOPENW arg: block no. jsr r5,dopenw ; set output block no. mov #'1,lgood ; start good block digit at 1 clr cmsgno ; start msg no. at 0 ; CRESYN resyncs the transfer by waiting for a start of block escape ; sequence. Data sent before the next start of block is ignored. cresyn: clr crcvfl ; clear receive flag clr cescfl ; clear escpae flag loop < jsr pc,@(sp)+ ; get next character from MC bit #070000,r0 ; overrun, framing, or parity error? bne cresyn ; yes, ignore this block. MC will resend. add r0,ccksm ; keep checksum cmp r0,#200 ; escape character? if eq,< mov pc,cescfl ; set flag to indicate 200 received rptl > tst cescfl ; was last character a 200? if ne,< clr cescfl ; next char is normal so clear flag cmp r0,#3 ; 200,3 stops transfer if eq,< jsr r5,dclsw jmp tmci > cmp r0,#2 ; 200,2 starts a new block if eq,< mov #cbufl,cbufc push pc ; set CBUFP to CBUF add #cbuf-.,(sp) ; ... pop cbufp ; ... clr ccksm ; start checksum at 0 mov pc,crcvfl ; indicate we're receiving rptl > cmp r0,#1 ; 200,1 sends a 200 if eq,< mov #200,r0 > else < tst r0 ; 200,0 sends a 0 (for checksums) bne cresyn ; anything else is an error > > tst crcvfl ; receiving a msg? rptl eq ; no, ignore this character dec cbufc ; finished msg yet? exitl mi movb r0,@cbufp ; no, store in buffer inc cbufp ; move ptr to next slot rptl > tstb ccksm ; msg done, this byte is checksum bne cresyn ; error if checksum not 0 cmp cbuf,cmsgno ; is msg no. correct? bne cresyn ; no, ignore this msg mov lgood,r0 ; character to type to indicate good block jsr r5,distri ; type sequential digits for each good block inc lgood ; next digit cmp lgood,#'9 ; past 9? if hi,< mov #'0,lgood ; wrap back to 0 > ; msg received correctly, now output mov #cbufl-2,r2 ; no. of chars to output mov pc,r0 ; ptr to buffer add #cbuf+2-.,r0 ; ... loop < movb (r0)+,-(sp) ; DPUTB arg: character jsr r5,dputb sorl r2 > push tline(r1),cmsgno ; SEND args: line no., character add #40,(sp) jsr r5,send ; send low byte of ack msg (msg no) pop * inc cmsgno ; now get next msg cmp cmsgno,#100. if eq,< clr cmsgno > br cresyn .macro print text jsr r5,typmsg .string ^~text~ .endm ; TYPMSG takes a relative ptr to an asciz string after the JSR R5,TYPMSG ; and types the string typmsg: push r0,r3 ; save regs mov r5,r3 ; relative ptr to asciz string add (r5)+,r3 ; make absolute loop < movb (r3)+,r0 ; next char exitl eq ; null terminates jsr r5,distri ; output char rptl > pop r3,r0 ; restore regs rts r5 dskerr: print ^"Proceed (P)?" jsr pc,@(sp)+ cmp r0,#'P if eq,< jmp cresyn > jmp tmci asmpr===1 .insrt pdp11;sadisk .endc .sbttl Get character .if ne 0 ; GCHAR removes a character from an output buffer queue, given ; a line number. ; Primarily used by Roundhouse to read its terminal input, since ; most real terminals call REMQ directly during output interrupt ; processing. ; ARGS: VALS: ; SP -> line no. SP -> character ; error code gchar: push (sp),r1 ; make slot for vals, save reg mov 6(sp),r1 ; get line no. argument asl r1 ; times two for word op add pc,r1 ; get ptr to TTBL entry of line mov ttblp-.(r1),r1 ; ... push r1 ; REMQ arg: queue ptr add #toq,(sp) ; ... jsr r5,remq ; get char from line's output queue pop 4+2(sp),6(sp) ; val: character, error code pop r1 ; restore reg rts r5 .endc .sbttl Output ; SEND outputs a character to the specified line. If the character cannot ; be output (e.g. due to a full output queue) then a nonzero error code is ; is returned. ; ARGS: VALS: ; SP -> character SP -> error code ; line no. send: push r0,r1 ; save regs mov 10(sp),r1 ; line no. asl r1 ; word address add pc,r1 ; offset into TTBL pointer table mov ttblp-.(r1),r1 ; pointer to TTBL push 6(sp) ; arg: char jsr r5,@tsend(r1) ; send the char pop 10(sp) ; error code pop r1,r0,(sp) ; restore regs, remove one arg from stack rts r5 .if ne ndz ; DZSEND outputs a character to a DZ line. The character is inserted ; into the line's output queue and transmitter interrupts are enabled. ; ARGS: VALS: ; SP -> char SP -> error code ; R1 -> TTBL entry for line dzsend: push r2 ; save reg push 4(sp),r1 ; INSQ args: character, queue ptr add #toq,(sp) ; ... jsr r5,insq ; insert into output queue pop 4(sp) ; return error code mov #dzaddr,r2 ; addr of DZ11 bisb tbit(r1),4(r2) ; turn on output pop r2 ; restore reg rts r5 .endc .if ne ndl ; DLSEND outputs a character to a DL line. The character is inserted ; into the line's output queue and transmitter interrupts are enabled. ; ARGS: VALS: ; SP -> char SP -> error code ; R1 -> TTBL entry for line dlsend: push r2 ; save reg push 4(sp),r1 ; INSQ args: character, queue ptr add #toq,(sp) ; ... jsr r5,insq ; insert character into output queue pop 4(sp) ; result: error code mov tdladd(r1),r2 ; address of this DL11 bis #100,4(r2) ; turn on xmtr interrupt pop r2 ; restore reg rts r5 .endc ; NOSEND sends a character to a nonexistant line. The character is thrown ; away. ; ARGS: VALS: ; SP -> char SP -> error code ; R1 -> TTBL entry for line nosend: clr 2(sp) rts r5 .sbttl Queue management ; QINIT initializes a queue structure. ; ARGS: VALS: ; SP -> ptr to queue (none) ; buffer size ; buffer ptr qinit: push r1 ; save reg mov 4(sp),r1 ; get ptr to queue structure mov 6(sp),qsize(r1) ; save queue buffer size mov 10(sp),qbp(r1) ; set buffer ptr mov 10(sp),qfp(r1) ; set front ptr mov 10(sp),qrp(r1) ; set rear ptr pop r1,4(sp) ; restore reg, move up return r5 cmp (sp)+,(sp)+ ; pop off args rts r5 ; INSQ inserts a character into the rear of a queue. ; ARGS: VALS: ; SP -> queue ptr SP -> error code ; character insq: push r1,r2 ; save regs mov 6(sp),r1 ; ptr to queue structure mov qrp(r1),r2 ; ptr to rear of queue dec r2 ; move to next char slot cmp r2,qbp(r1) ; wrap around to end? if lo,< add qsize(r1),r2 ; yes, make ptr to end of buffer > cmp r2,qfp(r1) ; room for this character? if ne,< movb 10(sp),(r2) ; queue not full, put in this char mov r2,qrp(r1) ; update ptr to rear of queue clr 10(sp) ; indicate character inserted > pop r2,r1,(sp) ; restore regs, pop off arg rts r5 ; REMQ removes a character from the front of a queue. ; ARGS: VALS: ; SP -> queue pointer SP -> character ; error code remq: push (sp),r1 ; make room for results, save regs mov 6(sp),r1 ; ptr to queue structure cmp qrp(r1),qfp(r1) ; queue empty? if ne,< dec qfp(r1) ; move rear ptr to next char cmp qfp(r1),qbp(r1) ; wrap around? if lo,< add qsize(r1),qfp(r1) ; yes, put ptr at end of buffer > movb @qfp(r1),4(sp) ; put character in its result slot clr 6(sp) ; indicate success > pop r1 ; restore reg rts r5 .sbttl Console data base .lif ne asmsac constants ttblp: .blkw 16. ; ptrs to TTBL entries ttbl: .blkb lttbl*16. ; reserve space for TTBL bspace: .blkb 400+llb+ltb ; buffer space .lif ne asmcpy .if eq sysdsk-drk cblk: 5212 .endc .if eq sysdsk-drl cblk: 6560 .endc .if eq sys-sao cblk: 0 .endc .if ne asmlod ; loading data loadsw: .word 0 ; co-routine addr of loader addr: .word 0 ; address for loading bcount: .word 0 ; byte count for loading cksm: .word 0 ; checksum of load data jmpblk: .word 0 ; nonzero to indicate this is a jump block .endc .if ne asmcpy cmsgno: .word 0 crcvfl: .word 0 cescfl: .word 0 ccksm: .word 0 cbufp: .word 0 cbufc: .word 0 cbufl==512.+2 cbuf: .blkb cbufl .endc .lif ne asmlod+asmcpy lgood: .word 0 ; digit to type for good block .if p2 .if ne asmsac .print " Highest location = " typval \. .endc .endc .lif ne asmsac .end go Dy; RUG - PDP11 SYMBOLIC DEBUGGER -*-PALX-*- versio==%fnam2 .TITLE RUG .insrt pdp11;defs > setf ^"Start of RUG?",rugsa .if ne sys-lll setf ^"SA Disk (no)?",asmdsk .iif b asmdsk, asmdsk==0 .endc .iif ndf asmdsk, asmdsk==0 .if eq asmdsk setf ^"RT11?",asmrt1 .iif b asmrt1, asmrt1==0 setf ^"Serial line?",asmsrl .iif b asmsrl, asmsrl==0 .endc .iif ndf asmRT1, asmRT1==0 .iif ndf asmsrl, asmsrl==0 .if ne asmrt1+asmsrl setf ^"Program Dumping?",asmdmp .iif b asmdmp, asmdmp==0 .endc .iif ndf asmdmp, asmdmp==0 setf ^"Simulator?",asmsim .iif b asmsim, asmsim==0 trs==dzaddr .if ne asmsim ndz==0 trs==177560 .endc .lif eq ndz setf ^"Terminal address (0=177560)?",trs .iif b trs, trs==177560 .iif eq trs, trs==177560 .if eq ndz .if ne asmrt1 setf ^"Console interrupt vector (0=60)?",icvec .iif b icvec, icvec==60 .iif eq icvec, icvec==60 .endc .endc ; terminal type codes %tngl==-1 ; Glass Note, comparisons depend on Glass being %tntt==0 ; TTY less than 0 and TTY being 0. %tnsb==1 ; StupidBee %tnvt==2 ; VT52 .macro print text jsr r5,types .string ^~text~ .endm asmpr===1 .macro sout text jsr r5,itypes .string ^~text~ .endm nbpt==10 ;number of breakpoints ; flag word bits %regv==1 ; regsiter value flag bit %half==2 ; half killed %ndef==4 ; undefined expression %nilv==10 ; null expression .sbttl RUG Initialization .=rugsa restrt: mfps ups ; save processor status word spl 7 ; set high priority mov sp,usp ; save stack ptr clr upc ; clear PC since its unknown mov #stack,sp ; setup RUG's stack .if eq ndz .if ne asmrt1 jsr pc,sistat ;save inital state for RT-11 jsr pc,sstat ; save rest of machine state .endc .endc mov #rtrap4,@#4 ; set bus error vector mov #pr7,@#6 ; ... .lif ne ndz jsr pc,dzini ; init DZ tst bptset ; breakpoints set? if ne,< jsr r5,rembrk ; remove breakpoints > mov #-1,bptno ; indicate not stopped at breakpoint jmp rugcmd rug: spl 7 ; RUG runs at high priority clr ups ; set user PS clr upc ; set user PC clr usp ; set user SP mov #stack,sp ; set RUG's stack ptr .if eq ndz .if ne asmrt1 jsr pc,sistat ;save inital state for RT-11 jsr pc,sstat ; save rest of machine state .endc .endc mov #rtrap4,@#4 ; set bus error vector mov #pr7,@#6 ; ... .lif ne ndz jsr pc,dzini ; init DZ clr bptset ; indicate no breakpoints set mov #-1,bptno ; set bpt no. to -1, not stopped at breakpoint jsr r5,clrscn ; clear screen ; get version no. in decimal: vn2==versio/100. vn1==>/10. vn0==>-<10.*vn1> .irp ra,\restrt .litrl ^| .ascii " RUG " .byte vn2+60,vn1+60,vn0+60 .asciz ". Restart is ra'. "|,%.ptmp .endm jsr r5,types .word %.ptmp-. jmp rugcmd .if ne ndz dzini: mov #dzaddr,r4 ; DZ address mov #20,(r4) ; initialize DZ loop < bit #20,(r4) ; wait for done rptl ne > mov #dzlpar,r1 ; ptr DZ line parameter table mov #8.,r0 ; no. of entries loop < mov (r1)+,2(r4) ; set DZ line parameters sorl r0 > mov #177401,4(r4) ; set data term rdys, enable line 0 mov #40,(r4) ; turn on receiver rts pc .endc catchn: mov r5,nxmcat add (r5)+,nxmcat rts r5 rtrap4: tst nxmcat if ne,< mov nxmcat,(sp) rtt > halt rtt nxmcat: .word 0 ; Insert Save6, Rest6, Mul and Div for non-EIS machines, and the dz param table .if ne * ; SAVE6 routine saves R0 through R5 on stack, R0 at top: ; SP -> R0 ; R1 ; R2 ; R3 ; R4 ; R5 ; Call by JSR R5,SAVE6. Restore regs by REST6 routine. save6: push r4,r3,r2,r1,r0 ; R5 already on stack by JSR. jmp (r5) ; return. ; REST6 routine restores R0 through R5 from stack, where ; R0 is considered to be the top word of the stack (which is ; how SAVE6 pushes the registers). Call by JSR R5,REST6. ; REST6 returns with the 6 words popped off the stack. rest6: tst (sp)+ ; forget old R5 contents. pop r0,r1,r2,r3,r4 ; restore other regs. rts r5 ; return and restore R5. .iff .insrt pdp11;stuff .endc .lif ne asmdsk .insrt pdp11;sadisk .sbttl RUG command decoder rugcmd: dskerr:: ; disk errors come here too print ^" *" ; prompt for reset mov o.bw,oo.bw ; save byte/word open flag and clr o.bw ; close all mov pwmode,twmode ; reset temporary modes mov pbmode,tbmode ; ... mov pabsmd,tabsmd ; ... mov pradix,tradix ; ... br rcd2 rcd1: print ^" " rcd2: mov #stack,sp ;reset stack so errors can jump here jsr pc,bufclr ;clear char buffer clr altcnt ;no alts yet clr argcnt jsr r5,ininst ; try parsing input as an instruction first br rcd3 mov #buf,bufptr ; reread typein so far jsr r5,exp ; interpret as an expression this time pop cvflgs,r4 bit #%ndef,cvflgs ; undefined value? bne err bit #%nilv,cvflgs ; was expression null? if eq,< mov r4,cvalue rcd3: inc argcnt ; no, one more arg > rcd4: jsr pc,bufrdu ; get command character mov #comls1,r1 ; ptr to list of command characters movb r0,ncom(r1) ; put char at end of list loop < cmpb r0,(r1)+ rptl ne > sub #comls1+1,r1 ; get offset into list asl r1 ; multiply by two jmp @comls2(r1) ; go to proper routine alt: inc altcnt ;keep track of no of alts br rcd4 nxmerr: print ^"--NXM" err: print ^"?" ;error. br rcd1 .sbttl Command routines ; Process CR - close location. cr: jsr pc,close ; close current location jmp rugcmd ; return to decoder ; Process LF - open next word. lf: jsr pc,close ; close present cell if any tst o.bw ; anything open? if eq,< mov oo.bw,o.bw ; no, reset to prev open mode > bit #%regv,clflgs ; location a register? if eq,< add length,clocat ; no, move down length of cvalue > else < inc clocat ; else only increment by one > lf1: print ^" " push clocat,clflgs ; SYM args: value, flags jsr r5,sym ; typeout clocat cmp o.bw,#1 ; word or byte mode? if ne,< print ^"/" > else < print ^"\" > jsr r5,open ; open clocat jmp rcd1 ; Process ^ - open previous word. up: jsr pc,close ;close open location tst o.bw ;anything open? if eq,< mov oo.bw,o.bw ;no, reset to prev open modes of > bit #%regv,clflgs ; register location? if eq,< sub o.bw,clocat ; no, subtract 1 or 2 for byte or word mode > else < dec clocat ; register, subtract 1 > br lf1 ;go do the rest ; Process [ - open as no. onum: mov #tycons,twmode br oword ; Process ] - open as symbol. osym: mov #tysymb,twmode br oword ; Process \ - open byte. obyte: mov #1,o.bw ; set byte mode br obw tab: mov cvalue,clocat mov cvflgs,clflgs br lf1 ; Process / - open word. oword: mov #2,o.bw ; set word mode obw: mov cvalue,clocat ; set address to open mov cvflgs,clflgs ; set address flags jsr r5,open jmp rcd1 ; Process @ - Open location addressed by user PC as instr openpc: mov upc,clocat ; make PC current location clr clflgs ; clear current flags mov #tyinst,twmode ; force instruction mode br lf1 ; Process = - type out value as constant. equal: push cvalue,cvflgs ; CONST args: value, flags jsr r5,const ; type current value as constant jmp rcd1 ; Process _ - retype q in symbolic mode. undscr: jsr r5,tysymb jmp rcd1 ; Process : - define label ; Note: this command not interpreted through the regular command symbol ; and jump tables, but by a special check at ininst label: jsr pc,bufrd ; read the : mov clocat,cvalue mov clflgs,cvflgs br def1 ; Process > - define symbol define: jsr r5,gsym ; read symbol name def1: jsr r5,def jmp rcd1 ; DEF defines a symbol. def: jsr r5,svalue ; find where symbol is in table pop r0,* ; just get flags mov sptr,r1 ; ptr to symbol if defined bit #%ndef,r0 ; defined? if ne,< mov stend,r1 ; ptr to bottom of symbol table asl sbit ; move to next bit in flag words if eq,< ; end of group, create new group inc sbit ; put 1 in sbit mov r1,sflgp ; save ptr to register flag word sub #4,r1 ; create two flag words clr 4(r1) ; clear all register flag bits mov #-1,2(r1) ; set all half killed bits > mov r1,stend ; save ptr to end sub #6,stend ; move down one symbol slot mov s1,-4(r1) ; set symbol name mov s2,-2(r1) ; ... > mov cvalue,(r1) ; set value of symbol mov sflgp,r4 ; ptr to register flag word bit #%regv,cvflgs ; check register flag, value a register? if ne,< bis sbit,(r4) ; yes, set symbol's bit in register flags > else < bic sbit,(r4) ; no, clear register-flag bit > bit #%half,cvflgs ; check half killed flag if ne,< bis sbit,-(r4) ; half killed, set symbol's bit in flag word > else < bic sbit,-(r4) ; clear half killed bit > rts r5 ; Process FOOK and FOOK - Kill defined symbol. kill: cmp altcnt,#2 ; half or full kill? blo 1$ tst argcnt ; full kill, no arg? if eq,< ; no arg, kill all symbols mov #symtop,stend ; move up end of symbol table ptr > else < mov sptr,r4 clr (r4) clr -(r4) clr -(r4) 1$: mov sflgp,r4 ;ptr to symbol's reg-flag word. bis sbit,-(r4) ;set half-kill bit in hkill word. > jmp rcd1 errj: jmp err ;process z, zero all of user core. zero: cmp altcnt,#2 ;see if we are $$z or not bne errj .if eq asmrt1 clr r1 ;zero from loc 0 .iff mov #1000,r1 ;leave rt-11 alone! .endc loop < clr (r1)+ cmp r1,stend ;to bottom of symtab rptl los > jmp rcd1 ; Process the ":XXXXXX" commands -- NOT the label definition "LABEL:" which ; is not handled thru the command table. Name of command is 6 letters, two ; rad50 words. COLTAB is table of colon com routines. COLTAB is terminated ; by -1 word, which is not a legal rad50 word. colon: jsr r5,gsym ; get command name as 2 rad50 words in s1, s2 mov #coltab-6,r5 ; ptr to com table loop < add #6,r5 ; next command in table cmp (r5),#-1 ; end of table? (-1 not legal rad50 word) exitl eq ; yes, command not found cmp (r5),s1 ; match the command name? rptl ne ; no cmp 2(r5),s2 rptl ne ; no jmp @4(r5) ; yes, to that routine > jmp err ; command not found ; :HELP lists the available : commands. colhlp: mov #coltab,r5 ;ptr into : command table. loop < print ^" " cmp (r5),#-1 ;end of table? exitl eq ;yes. mov (r5)+,ainst ;no, 1st 3 letters. mov (r5)+,ainst+2 ;last 3 letters. jsr r5,type50 ;print rad50 : com name. tst (r5)+ ;past ptr to routine. rptl > jmp rugcmd ;:EXIT returns to DSKLOD. In RT-11 it returns there. exit: print ^" " .if eq asmrt1 .exit .endc .if ne asmrt1 jsr pc,ristat ;restore the state .exit .endc .sbttl Breakpointing commands ; B - Set breakpoint setbpt: bit #%nilv,cvflgs bne err2 ;for now that command is meaningless bit #1,cvalue bne err2 ;badness if odd address jsr r5,delb ;delete any old breakpoint at this address mov #bptadr,r4 mov #nbpt,r0 loop < cmp (r4)+,#-1 ;is this cell free? exitl eq ;jump if yes sorl r0 br err2 > mov cvalue,-(r4) ;set breakpoint mov #1,bptcnt-bptadr(r4) jmp rcd1 ;return ; U - Delete breakpoint delbpt: jsr r5,delb jmp rcd1 delb: push r4 ; save reg clr r4 loop < bit #%nilv,cvflgs if eq,< cmp cvalue,bptadr(r4) bne 1$ > mov #-1,bptadr(r4) mov bpti,bptins(r4) ; reset contents of table clr bptcnt(r4) ; clear count 1$: tst (r4)+ cmp r4,#nbpt*2 rptl lo ; done > pop r4 ; restore reg rts r5 err2: jmp err ; The :LISTB command prints a list of the breakpoints set, in ; the same format used when breakpoint is hit. In addition ; the proceed count is printed if it is not 1. ;E.g., "$3B; FOO+4>>MOV #4 , @#6" ; or, "$3B; FOO+4>>MOV #4 , @#6 ( 3 )" listb: push clocat ; save current location mov #bptadr,r5 ; ptr to breakpoint address array mov #'0,r0 ; ascii of bpt no. loop < cmp (r5),#-1 ; this slot free? if ne,< print ^" $" jsr r5,typec ; print bpt no. push r0 ; save reg print ^"B; " mov (r5),clocat ; address of this breakpoint push (r5),#0 ; SYMBOL args: value, flags jsr r5,symbol ; print as symbolic address << print ^">>" jsr r5,openi ; print in instruction mode (CLOCAT) mov bptcnt-bptadr(r5),r0 ; proceed count cmp r0,#1 ; print count? if ne,< print ^" ( " jsr r5,tnumbr ; print proceed count print ^" )" > pop r0 ; restore reg > inc r0 ; next breakpoint tst (r5)+ cmp r0,#'7 ; done? (8 breaks, 0 - 7) rptl le > print ^" " pop clocat ; restore current location jmp rugcmd .sbttl Mode decoding ; Location typeout modes (word) ; I - Instruction typeout mode imode: mov #tyinst,r1 br setwm ; C - Constant typeout mode cmode: mov #tycons,r1 br setwm ; S - Symbol typeout mode smode: mov #tysymb,r1 br setwm ; " - Ascii typeout mode amode: mov #tyasci,r1 br setwm ; & - Rad50 typeout mode rmode: mov #tyrad5,r1 ; br setwm setwm: mov r1,semimd ; set semicolon mode mov r1,twmode ; set temporary mode cmp altcnt,#1 if hi,< mov r1,pwmode ; set permanent mode > jmp rcd1 ; Location typeout modes (byte) ; ` - Constant typeout mode cmodeb: mov #tybcon,r1 br setbm ; ' - Ascii typeout mode amodeb: mov #tybasc,r1 ; br setbm setbm: mov r1,tbmode ; set temporary mode cmp altcnt,#1 if hi,< mov r1,pbmode ; set permanent mode > jmp rcd1 ; Address typeout modes ; A - absolute addr mode absmd: mov pc,tabsmd ; set temporary mode cmp altcnt,#1 if hi,< mov pc,pabsmd ; set permanent mode > jmp rcd1 ; $R - Relative addr mode relmd: clr tabsmd ; set temporary mode cmp altcnt,#1 if hi,< clr pabsmd ; set permanent mode > jmp rcd1 ; O - Octal typeout mode soct: mov #8.,tradix ; set temporary output radix to 8 cmp altcnt,#1 if hi,< mov #8.,pradix ; set permanent output radix to 8 > jmp rcd2 ; D - Decimal typeout mode sdec: mov #10.,tradix ; set temporary output radix to 10 cmp altcnt,#1 if hi,< mov #10.,pradix ; set permanent output radix to 10 > jmp rcd2 ;semi-colon: retype $q in the most recently specified ;temporary or permanent mode. semicn: cmp altcnt,#1 ; see if $; or $$; blo 2$ beq 1$ mov semimd,pwmode ; set permanent mode 1$: mov semimd,twmode ; set temporary mode 2$: jsr r5,@semimd ; type out cvalue jmp rcd1 .sbttl Location opening open: push r4 ; save reg mov clocat,r4 ; current location bit #%regv,clflgs ; current location a register? if ne,< cmp r4,#nuregs-1 ; check that its a valid register no. if hi,< jmp err > asl r4 ; convert to address of saved value add #uregs,r4 ; ... mov #2,o.bw ; force word mode cmp twmode,#tyinst ; instruction mode? if eq,< mov #tysymb,twmode ; don't open registers in instruction mode > > mov r4,r0 ; copy address bic #1,(sp) ; make word address mov #savls1,r1 ; ptr to list of locations saved loop < cmp r0,(r1)+ ; this location on the list? if eq,< ror r4 ; save low bit of r4 mov (r1),r4 ; yes, put its actual address in r4 adc r4 ; restore low bit exitl > tst (r1)+ ; skip over save address tst (r1) ; end of list? rptl ne > bit #1,r4 ; odd address? if ne,< mov #1,o.bw ; yes, force byte mode > mov r4,caddr ; save address for close print ^" " clr cvflgs ; init current value flags cmp o.bw,#1 ; byte or word mode? if ne,< push r4 ; GETW arg: location jsr r5,getw ; get the word pop cvalue ; current value jsr r5,@twmode ; type out loc in current word mode > else < push r4 ; GETB arg: location jsr r5,getb ; get the byte pop cvalue ; current value mov #1,length ; all bytes are length 1 jsr r5,@tbmode ; type out loc in current byte mode > pop r4 ; restore reg rts r5 ; OPENI open location as an instruction openi: push o.bw,twmode ; save modes mov #2,o.bw ; force to word and instr mode mov #tyinst,twmode jsr r5,open pop twmode,o.bw rts r5 ; Close word or byte and exit, address in clocat. ; Upon entering, r2 has numeric flag, r4 has contents. ; If a byte or word is to be deposited into the open loc ; then PUTWRD or PUTBYT is called. (They will check ; to see if the byte/word is to be put in core or on the ; core-image.) close: tst argcnt beq 1$ cmp o.bw,#1 ;closing byte, word, or none? blo 1$ ;0, nothing to close if eq,< push caddr,r4 ;change, this is addr, contents jsr r5,putb ;put byte away > else < mov .lenth,length ; .lenth is length of input value push caddr,cvalue ;close instruction jsr r5,putw ;put val into @clocat cmp length,#2 blos 1$ ;return (no more to instr) push caddr add #2,(sp) ;next addr in instr push cvalue+2 ;next part to deposit jsr r5,putw ;deposit next part of value cmp length,#4 ;done this instr yet? blos 1$ ;yes, return. push caddr ;no, one more time. add #4,(sp) push cvalue+4 jsr r5,putw ;deposit last (3rd) part of > 1$: rts pc .sbttl Typeout modes ; Location typeout (word) ; constant typeout tycons: print ^" " mov #2,length ; length is 2 bytes push cvalue,cvflgs ; CONST args: value, flags jsr r5,const ; type current value as constant rts r5 ; symbol typeout tysymb: mov #2,length ; length is 2 bytes push cvalue,cvflgs ; SYMBOL args: value, flags jsr r5,symbol ; type current value as symbol rts r5 ; ascii typeout tyasci: mov #2,length ; two bytes print ^|"| movb cvalue,r0 ; current value low byte jsr r5,typec ; type ascii char movb cvalue+1,r0 ; current value high byte jsr r5,typec ; type ascii char rts r5 ; rad50 typeout tyrad5: mov #2,length print ^"&" mov cvalue,ainst clr ainst+2 jsr r5,type50 rts r5 ; instruction typeout tyinst: mov #2,length ; start length at 2, may get larger mov cvalue,r0 jsr r5,inst rts r5 ;ok return br tycons ;did not find one, print as number ; Location typeout (byte) ; constant mode tybcon: mov cvalue,r0 ; current value jsr r5,tnumbr ; type as octal no. rts r5 ; ascii mode tybasc: print ^"'" ; type ' mov cvalue,r0 ; current value jsr r5,typec ; type as ascii character rts r5 .sbttl Search commands ; SEARCHES - $MSK HAS THE MASK ; $MSK+2 HAS THE LOWER LIMIT ; $MSK+4 HAS THE UPPER LIMIT wsearc: tst argcnt ; check for object found beq err3 ; error if no object mov #2,o.bw ; set word mode mov smask+2,r2 ; set origin mov smask,r4 ; set mask com r4 ; complement so can bic loop < push r2 ; GETW arg: location jsr r5,getw ; get word bic r4,(sp) ; apply mask cmp (sp)+,cvalue ; see if this is it if eq,< jsr r5,schtyp ; type location and value > .if eq ndz tstb @ttycsr ; stop search if user types anything .iff tstb @#dzaddr ; stop search if user types anything .endc exitl mi add #2,r2 ; move to next address cmp r2,smask+4 ; check for end of search range rptl los > jmp rcd1 nsearc: tst argcnt ; check for object found beq err3 ; error if no object mov #2,o.bw ; set word mode mov smask+2,r2 ; set origin mov smask,r4 ; set mask com r4 ; complement so can bic loop < push r2 ; GETW arg: location jsr r5,getw ; get word bic r4,(sp) ; apply mask cmp (sp)+,cvalue ; see if this is it if ne,< jsr r5,schtyp ; type location and value > .if eq ndz tstb @ttycsr ; stop search if user types anything .iff tstb @#dzaddr ; stop search if user types anything .endc exitl mi add #2,r2 ; move to next address cmp r2,smask+4 ; check for end of search range rptl los > jmp rcd1 esearc: tst argcnt ; check for arg beq err3 mov #2,o.bw ; set word mode mov smask+2,r2 ; starting point for search loop < push r2 ; GETW arg: location jsr r5,getw ; get word pop r0 cmp r0,cvalue ; is (x) = k? beq 1$ mov r0,r3 ; calc (x)+x+2 add r2,r3 ; ... add #2,r3 ; ... cmp r3,cvalue ; is (x)+x+2 = k? beq 1$ movb r0,r0 ; get low byte sign extended inc r0 ; make offset from x+2 asl r0 ; ... add r2,r0 cmp r0,cvalue ; is the result a proper relative branch? bne 2$ 1$: jsr r5,schtyp .if eq ndz 2$: tstb @ttycsr ; stop search if user types anything .iff 2$: tstb @#dzaddr ; stop search if user types anything .endc exitl mi add #2,r2 cmp r2,smask+4 rptl los > jmp rcd1 err3: jmp err schtyp: mov r2,clocat print ^" " push r2,#0 ; SYM args: value, flags jsr r5,sym ; type address print ^"/ " push r2 ; GETW arg: location jsr r5,getw ; get word pop cvalue jsr r5,@twmode ; type contents rts r5 .sbttl Program loading .if ne asmrt1+asmsrl ; either RT11 or serial line loading dgetwa: .word dgetba: .word ; procedure variables to use for reading .if ne asmrt1 ;get the rt11 macros .insrt chsncp;rt11m defext: .rad50 "BIN" .rad50 "BIN" .word 0,0 .even emtare: .blkw 5 ;for EMT traps to RT-11 rdpnt: .word bufend ;init so we read a block blkcnt: .word 0 ;block count is initially zero bufbeg: .blkw 256. bufend=. .endc load: mov sp,lodasp ; save stack for abortion .if ne asmrt1*asmsrl print ^" L for serial line; R for RT11 " ; type a space after $L jsr pc,bufrdu ; get menu selection print ^" " cmpb r0,#'L ; serial line ? beq 1$ cmpb r0,#'R ; RT11 file? beq 2$ jmp rugcmd ;punt .endc .if ne asmrt1 2$: .settop #-2 ;set top of core to address > than RMON ;which will give us as much core as possible mov #go,46 ;set up value for usr swapping print ^" Input RT-11 File Specifier: " jsr pc,ristat ;restore the state of the world .csige #bufbeg,#defext,#0 ;take input from terminal jsr pc,sstat ;save the state of the world mov lodasp,sp ;restore the stack mov #dgetlb,dgetba ; set up for reading from RT-11 file mov #dgetlw,dgetwa mov #bufend,rdpnt ;initialize for first transfer clr blkcnt ;clear the block count br 10$ ;start loading program .endc 1$: .if ne asmsrl ; Handle serial line? print ^" Input CSR addr of serial line (" mov srlcsr,r0 ; choose defaul CSR addr. Previous choice if eq,< mov ttycsr,r0 ; if we already had one, else console TTY > mov r0,srlcsr ; prepare the default jsr r5,tnumbr ; show default CSR address. print ^"): " jsr pc,bufclr ; backup to here on rubout jsr r5,rnumbr ; read no., return no.,flags on stack pop r0 ; get possible CSR address bit #%nilv,(sp)+ ; did we read a number? if eq,< mov r0,srlcsr > print ^" ^G aborts" mov #getlb,dgetba ; set up for reading from DLV typ device mov #getlw,dgetwa cmp srlcsr,#160000 ; see if it is a reasonable addr bhis 10$ print ^" Bad CSR addr " ; complain jmp rugcmd ; punt .endc 10$: cmp altcnt,#1 ; $$L? if los,< bis #%nilv,cvflgs ; simulate an $U with no arg jsr r5,delb ; ie. clear all breakpoints mov #symtop,stend ; $L, clear core, flush symbols clr r1 ; ptr to 1st memory location to clear clr (r1) ; zap location zero so uninited traps halt .if eq asmrt1 mov #10,r1 ; leave 4,6 alone (also 2 incidentally) .iff mov #1000,r1 ;do not disturb rt-11 .endc loop < clr (r1)+ ; clear memory cmp r1,stend ; until bottom of symbol table rptl los > > clr errcnt l1: jsr r5,@dgetba ; look for header cmp r0,#1 ; is it 1? bne l1 mov r0,r2 ; initialize checksum jsr r5,@dgetba ; next should be zero tst r0 if ne,< inc errcnt br l1 > l2: jsr r5,@dgetwa ; get byte count mov r0,r5 ; r5 will have the byte count jsr r5,@dgetwa ; get address mov r0,r1 sub #6,r5 ; correct byte count for stuff already read if ne,< ; and handle start block specially loop < jsr r5,@dgetba ; get data byte mov #savls2,r3 ; check address against saved addresses loop < cmp (r3)+,r1 ; match a saved address? if eq,< mov (r3),r4 ; address of place where saved movb r0,(r4)+ ; store into saved copy tst (r1)+ ; advance r1 dec r5 ; grab another byte beq l1 ; but be prepared to punt this block if it jsr r5,@dgetba ; end on an odd byte movb r0,(r4) ; store high byte of saved copy br 3$ > tst (r3)+ tst (r3) rptl ne > cmp r1,stend ; are we going to overwrite ourselves? if lo,< movb r0,(r1)+ ; store > cmp r1,#lastlc ; see if we are above rug? if hi,< movb r0,(r1)+ ; store > 3$: sorl r5 jsr r5,@dgetba ; get checksum tstb r2 ; checksum zero? if ne,< inc errcnt ; increment error count if there was one > br l1 ; next block > > mov r1,starta jsr r5,@dgetba ; get checksum tstb r2 ; checksum zero? if ne,< inc errcnt > ; now load symbols ; find last symbol in symbol table and current flag words and mask mov stbeg,r1 ; ptr to one before start of symbol table clr r3 ; bit flag loop < sub #6,r1 ; move ptr to next symbol cmp r1,stend ; check for end of symbol table exitl los asl r3 ; next bit if eq,< ; if 16 symbols then get new flag word inc r3 ; set bit 1 for first symbol mov r1,r4 ; save ptr to register flag words sub #4,r1 ; move symbol ptr past flag words > rptl > ; upon exiting this loop, ; R4 -> flag words, -2(r4) is half killed flags, (r4) reg flags ; R1 -> first unused symbol word ; R3 -> mask for flag bits of current symbol jsr r5,@dgetba ; check for symbols cmpb r0,#2 ; any symbols? if ne,< br lend > loop < jsr r5,@dgetwa ; get 1st three chars of name push r0 ; save them exitl eq ; zero word terminates jsr r5,@dgetwa ; get 2nd three chars of name push r0 ; save them jsr r5,@dgetwa ; get flags mov r0,r5 ; stick flags in R5 for easy access jsr r5,@dgetwa ; get value bit #10000,r5 ; is this an undefined symbol? if ne,< ; yes, cmp (sp)+,(sp)+ ; clear cruft off stack rptl ; and try for next symbol > asl r3 ; next bit if eq,< ; if 16 symbols then get new flag word inc r3 ; set bit 1 for first symbol mov r1,r4 ; save ptr to register flag word sub #4,r1 ; move symbol ptr past flag words clr (r4) ; clear register bits mov #-1,-2(r4) ; but initially set half kill bits > mov r0,(r1) ; save value mov (sp)+,-2(r1) ; save first word of RAD50 name mov (sp)+,-4(r1) ; 2nd word bit #20000,r5 ; half killed? if ne,< bis r3,-2(r4) > else < bic r3,-2(r4) > bit #4000,r5 ; register? if ne,< bis r3,(r4) > else < bic r3,(r4) > sub #6,r1 ; move to next symbol mov r1,stend rptl > br lend labort: mov lodasp,sp ; unwind stack print ^" LOADING ABORTED" lend: print ^" Error count= " mov errcnt,r0 jsr r5,tnumbr jmp rugcmd ; GETLB reads a byte from the serial line. Adds it into checksum ; stored in R2. Returns byte read in R0 getlb: push r1,r3 mov srlcsr,r1 mov ttycsr,r3 2$: cmp r1,r3 beq 1$ tstb (r3) if mi,< cmpb 2(r3),#7 ; ^G aborts if eq,< pop r3,r1 br labort > > 1$: tstb (r1) bpl 2$ movb 2(r1),r0 bic #177400,r0 ; mask down to just 8 bits add r0,r2 ; add it into checksum pop r3,r1 rts r5 ; GETLW reads two bytes and assembles them into a word in R0 getlw: jsr r5,getlb ; get first byte, low order push r0 ; save it jsr r5,getlb ; get high order byte, note that the high swab r0 ; byte is always guaranteed to be zero add (sp)+,r0 ; combine the two bytes into a word, note rts r5 ; no overlapping bits, no chance of carry .endc .if ne asmrt1 ; DGETLB reads a byte, adds to the checksum in R2 and returns the byte ; in R0 dgetlb: cmp rdpnt,#bufend ;at end of buffer yet? if his,< ;get byte .readw #emtare,#3,#bufbeg,#256.,blkcnt ;get data if cs,< ;no error tstb @#52 ;did we read past the end of the file? if eq,< ;no. clr #bufbeg ;end of symbol table is a zero word clr #bufbeg+2 ;ditto > else < print ^"I/O Error" jmp labort ;abort the loading > > inc blkcnt ;up the block count mov #bufbeg,rdpnt ;reset the read pointer > movb @rdpnt,r0 ;get the byte inc rdpnt ;inc the pointer bic #177400,r0 ;clear out the high byte add r0,r2 ;add to checksum rts r5 ;done ; DGETLW reads two bytes and assembles them into a word in R0 dgetlw: jsr r5,dgetlb ; get first byte, low order push r0 ; save it jsr r5,dgetlb ; get high order byte, note that the high swab r0 ; byte is always guaranteed to be zero add (sp)+,r0 ; combine the two bytes into a word, note rts r5 ; no overlapping bits, no chance of carry .endc .sbttl Program loading .if ne asmdsk load: print ^" " ; type a space after $L jsr pc,bufclr ; backup to here on rubout jsr r5,rnumbr ; read no. pop r0,* ; vals: no., flags cmp altcnt,#1 ; $$L? if los,< mov #symtop,stend ; $L, clear core, flush symbols clr r1 ; ptr to 1st memory location to clear loop < clr (r1)+ ; clear memory cmp r1,stend ; until bottom of symbol table rptl los > > push r0 ; DOPENR arg: block no. jsr r5,dopenr ; open for reading l1: jsr r5,dgetw ; get byte count pop r0 ; ... if ne,< jsr r5,dgetw ; get address pop r1 ; ... loop < jsr r5,dgetb ; get data byte cmp r1,stend ; are we getting too high? if lo,< movb (sp)+,(r1)+ ; store > sorl r0 > br l1 ; next block > jsr r5,dgetw ; get start address pop starta ; ... mov #4,r4 ; ptr to bus error trap vector mov (r4)+,sv4 ; save bus error trap vector mov (r4)+,sv6 ; ... mov #pr7,-(r4) ; setup RUG's bus error trap vector mov #rtrap4,-(r4) ; ... ; now load symbols loop < jsr r5,dgetw ; get 1st three chars of name pop s1 exitl eq ; zero word terminates jsr r5,dgetw ; get 2nd three chars of name pop s2 jsr r5,dgetw ; get value pop cvalue jsr r5,dgetw ; get flags pop cvflgs jsr r5,def ; define the symbol just read in rptl > jmp rugcmd .endc .sbttl Program Dumping .if ne *asmdmp dmplow: .word ;low address to dump dmphi: .word ;high address to dump dputwa: .word ; address of routine to put out a word dputba: .word ; ditto for a byte dclose: .word ;close file routine dump: .if ne asmrt1*asmsrl print ^" L for serila line R for RT-11 " ;which to dump onto? jsr pc,bufrdu ;get a menu selection print ^" " cmpb r0,#'L ;serial line? beq 1$ ;do serial line cmpb r0,#'R ;do RT-11 file beq 2$ jmp rugcmd ;huh? .endc .if ne asmrt1 2$: print ^" Input RT-11 File Specification: (foo.bin=) " jsr pc,ristat ;restore the state of the world .csige #bufbeg,#defext,#0 ;take input from terminal jsr pc,sstat ;save the state of the world mov #dputlb,dputba ;setup for writing to RT-11 file mov #dputlw,dputwa mov #rt11cl,dclose mov #bufbeg,rdpnt ;initialize to fill first buffer clr blkcnt ;clear the block count br actdmp ;continue dumping .endc .if ne asmsrl 1$: print ^" Input CSR addr of serial line (" mov srlcsr,r0 ;choose default CSR if eq,< mov ttycsr,r0 ;he has made no previous choice- use console > mov r0,srlcsr ;setup default jsr r5,tnumbr ;type out the number print ^"): " jsr pc,bufclr ;we backup to here on rubout jsr r5,rnumbr ;read a number from the user pop r0 ;get the number read bit #%nilv,(sp)+ ;was it a number we got? if eq,< mov r0,srlcsr > print ^" ^G aborts" mov #putlb,dputba ;set up for reading from DLV type device mov #putlw,dputwa mov #srlcls,dclose ;close routine for a serial line cmp srlcsr,#160000 ;is this a reasonable number? bhis actdmp print ^" Bad CSR addr " ;complain to user jmp rugcmd .endc actdmp: mov dmplow,r3 ;low address for dumping mov dmphi,r4 ;high address for dumping mov sp,lodasp ;save the stack pointer for error returns loop < mov r4,r1 ;save high addr sub r3,r1 ;size in r1 if gt,< loop< tstb (r3)+ ;see if the byte is zero bne 2$ ;get one not zero? sorl r1 >> br 4$ 2$: dec r3 ;back up 4$: clr r2 ;clear out the checksum cmp r3,r4 ;anything to dump? if lo,< mov r3,r1 ;save pointer 1$: .rept 5 ;look for five of more zero bytes in a row cmp r1,r4 ;at the end yet? if lo,< tstb (r1)+ bne 1$ > .endr sub r3,r1 ;get size of block jsr pc,strtbl ;output block header mov r1,r0 ;put out size of block add #6,r0 ;account for the block header jsr r5,@dputwa mov r3,r0 ;put out address of block jsr r5,@dputwa loop < movb (r3)+,r0 ;get byte to output jsr r5,@dputba sorl r1 > neg r2 ;convert to proper checksum mov r2,r0 ;output checksum jsr r5,@dputba > cmp r3,r4 rptl lo > clr r2 ;init checksum jsr pc,strtbl ;output the block header mov #6,r0 ;block length of six jsr r5,@dputwa mov starta,r0 ;put out start address jsr r5,@dputwa neg r2 ;correct checksum mov r2,r0 jsr r5,@dputba ; Now dump symbols mov #2,r0 ; output a flag for symbols jsr r5,@dputba mov #symtop+6,r1 ; ptr to before 1st symbol's value word clr r3 loop < sub #6,r1 ; move ptr to next symbol cmp r1,stend ; beyond end of symbol table? exitl los asl r3 ; get its bit in flag words if eq,< ; move to next group of 16 symbols inc r3 ; set bit 1 for first symbol mov r1,r4 ; save ptr to register flag word sub #4,r1 ; move ptr over flag words to value cell ; of first symbol > tst -4(r1) ; anything there? rptl eq mov -4(r1),r0 jsr r5,@dputwa ; write out 1st three chars of name mov -2(r1),r0 jsr r5,@dputwa ; write out 2nd three chars of name clr r0 ; flag word bit r3,(r4) ; register value? if ne,< bis #4000,r0 ; yes, set register flag in flag word > bit r3,-2(r4) ; half killed? if ne,< bis #20000,r0 > jsr r5,@dputwa mov (r1),r0 jsr r5,@dputwa ; write out symbol value rptl > clr r0 ; DPUTW arg: word jsr r5,@dputwa ; write zero word to terminate symbols jsr r5,@dclose ;close the file jmp rugcmd strtbl: mov #1,r0 ;write out start block jsr r5,@dputba clr r0 jsr r5,@dputba rts pc dabort: mov lodasp,sp ;restore the sp print ^" DUMPING ABORTED" jmp rugcmd .if ne asmsrl ; PUTLB writes a byte to a DLV type serial line putlb: push r1,r3 mov srlcsr,r1 ;get the csr in r1 mov ttycsr,r3 ;get the console CSR in r3 1$: tstb (r3) ;is there a char? if mi,< cmpb 2(r3),#7 ;^G aborts if eq,< pop r3,r1 ;pop off registers jsr r5,dclose ;close the file? br dabort ;dumping aborted > > tstb 4(r1) ;can we send a char yet? bpl 1$ ;wait for char to arrive movb r0,6(r1) ;get char push r0 ;save onto the stack; bic #177400,(sp) ;mask to 8 bits add (sp)+,r2 ;accumulate checksum pop r3,r1 rts r5 ; PUTLW writes out a word to the DLV type serial line putlw: jsr r5,putlb ;output the low byte swab r0 ;swap the bytes jsr r5,putlb ;send the high byte rts r5 ;done ; SRLCLS closes the serial line by writing a zero byte srlcls: clr r0 ;output a zero byte to end the file jsr r5,putlw rts r5 ;done .endc .if ne asmrt1 ; DPUTLB write a byte to an RT-11 file open on channel 0. dputlb: cmp rdpnt,#bufend ;at end of buffer yet? if his,< ;put byte .writw #emtare,#0,#bufbeg,#256.,blkcnt ;put out data bcs wlos ;handle error inc blkcnt ;up the block count mov #bufbeg,rdpnt ;reset the pointer > movb r0,@rdpnt ;get the byte inc rdpnt ;bump the pointer push r0 ;save onto stack bic #177400,(sp) ;clear out high byte add (sp)+,r2 ;add to checksum rts r5 ;done ;DOUTLW writes a word as two bytes to the file open on channel 0 dputlw: jsr r5,dputlb ;put out the low byte swab r0 ;swap the bytes jsr r5,dputlb ;put out the high byte rts r5 ;done ;RT11CL closes the RT-11 file open on channel 0. rt11cl: cmp rdpnt,#bufbeg ;if the buffer is not empty then write it. if ne,< .writw #emtare,#0,#bufbeg,#256.,blkcnt ;put out data if cs,< ;Tell user about I/O error wlos: print ^"I/O Error" .close #0 ;close the file for good measure br dabort ;abort the dumping > > .close #0 rts r5 ;done .endc .endc .sbttl Program Dumping .if ne asmdsk ; DUMP dumps core to the disk. The format used is the same used by LOAD. dump: print ^" " ; type a space after $L jsr pc,bufclr ; backup to here on rubout jsr r5,rnumbr ; read no. pop r0,* ; vals: no., flags push r0 ; DOPENW arg: block no. jsr r5,dopenw ; open dump area for writing mov sv4,@#4 mov sv6,@#6 mov stend,r2 ; lowest address used by RUG clr -(r2) ; 6 bytes of zero to terminate dumping clr -(r2) ; ... clr -(r2) ; ... clr r0 ; ptr to 1st memory location br 2$ ; start scanning for nonzero location loop < mov r0,r1 ; save ptr to current address clrb (r2) ; this insures scan doesn't go beyond end 1$: .rept 5 tstb (r1)+ ; look for 5 or more zero bytes bne 1$ .endr sub r0,r1 ; calculate no. of bytes sub #5,r1 ; correct for 5 zero bytes push r1 ; DPUTW arg: word jsr r5,dputw ; write out byte count push r0 ; DPUTW arg: word jsr r5,dputw ; write out address loop < movb (r0)+,-(sp) ; DPUTB arg: byte jsr r5,dputb ; write out data byte sorl r1 > 2$: movb #-1,(r2) ; this insures scan for nonzero ends loop < tstb (r0)+ ; find nonzero byte rptl eq > dec r0 cmp r0,r2 ; this byte beyond dump range? rptl lo > push #0 ; DPUTW arg: word jsr r5,dputw ; write jump block byte count push starta ; DPUTW arg: word jsr r5,dputw ; write start address mov #rtrap4,@#4 mov #pr7,@#6 ; Now dump symbols mov #symtop+6,r1 ; ptr to before 1st symbol's value word clr r2 loop < sub #6,r1 ; move ptr to next symbol cmp r1,stend ; beyond end of symbol table? exitl los asl r2 ; get its bit in flag words if eq,< ; move to next group of 16 symbols inc r2 ; set bit 1 for first symbol mov r1,r4 ; save ptr to register flag word sub #4,r1 ; move ptr over flag words to value cell ; of first symbol > tst -4(r1) ; anything there? rptl eq push -4(r1) jsr r5,dputw ; write out 1st three chars of name push -2(r1) jsr r5,dputw ; write out 2nd three chars of name push (r1) jsr r5,dputw ; write out symbol value clr -(sp) ; flag word bit r2,(r4) ; register value? if ne,< bis #%regv,(sp) ; yes, set register flag in flag word > bit r2,-2(r4) ; half killed? if ne,< bis #%half,(sp) > jsr r5,dputw rptl > push #0 ; DPUTW arg: word jsr r5,dputw ; write zero word to terminate symbols jsr r5,dclsw ; close write file jmp rugcmd .endc .sbttl Go and Proceed commands ; $G - Go go: mov cvalue,r5 ;get starting address tst argcnt ;arg specified? if eq,< mov starta,r5 ;no, set start address from default > bit #1,r5 ;check low order bit bne goerr ;error if odd number cmp altcnt,#2 ;set the default? if eq,< mov r5,starta ;yes, set it to arg > mov r5,upc ;set up new pc cmp usp,stend ; make sure stack ptr is within bounds bhi 1$ cmp usp,#402 if los,< 1$: mov #1000,usp ; not in bounds, reset it > jsr r5,setbrk ;set breakpoints clr ssflag ;not single stepping bic #20,ups ;make sure trap bit off br contin ;start program goerr: jmp err ; $P - Proceed from a breakpoint proced: mov cvalue,r5 tst argcnt ; was count specified? if eq,< mov #1,r5 ; no count, use 1 > mov bptno,r0 if pl,< asl r0 ; times two for word operations mov r5,bptcnt(r0) ; set proceed count > ; come here from BPTH if count nonzero proc1: clr ssflag bis #20,ups ; set trace trap bit mov pc,proflg ; now step over next instruction br contin ; and then restore BPTs and continue ; ^N - Single step sstep: mov cvalue,count tst argcnt ; arg specified? if eq,< mov #1,count ; no arg, assume a single step > mov pc,ssflag ; set single step flag bis #20,ups ; set trace trap bit in PS ; fall through to CONTIN contin: mov #14,r0 ; ptr to trap vector mov #bpth,(r0)+ ; set breakpoint trap vector mov #pr7,(r0)+ ; high priority jsr pc,rstat ; restore regs etc. mov usp,sp ; restore user stack ptr push ups,upc ; setup ps,pc for rti rtt .sbttl Breakpoint bpth: tst ssflag ; tracing? if ne,< dec count ; count reached? if ne,< ; no bis #20,2(sp) ; make sure trace bit still on rtt ; keep going > > pop upc,ups ; save pc and ps mov sp,usp ; save stack ptr mov #stack,sp ; setup RUG's stack jsr pc,sstat ; save rest of machine state tst proflg ; trace trap from proceed? if ne,< bic #20,ups ; clear trace bit clr proflg ; clear flag jsr r5,setbrk ; set breakpoints jmp contin ; continue program > mov upc,clocat ; set current location to after instruction clr clflgs ; ... tst ssflag ; single stepping? if ne,< bic #20,ups ; clear T bit in user ps print ^" " br bph2 > jsr r5,rembrk ; remove breakpoints sub #2,upc ; correct for incrementation of pc sub #2,clocat ; ... mov #nbpt*2-2,r4 ; get a counter loop < cmp clocat,bptadr(r4) ; compare with list exitl eq ; jump if found sub #2,r4 rptl ge ; re-loop until found print ^" BE; " mov #-1,bptno ; not stopped by breakpoint, set bpt no to -1 br bph2 > dec bptcnt(r4) ; finished count? bne proc1 ; no, continue mov #1,bptcnt(r4) ; set proceed count to 1 print ^" $" ; type "$nB;" where n is bpt no. mov r4,r0 ; get n*2 asr r0 ; divide by two mov r0,bptno ; save bpt no. add #'0,r0 ; convert breakpoint number jsr r5,typec ; to ascii and type it print ^"B; " bph2: push clocat,#0 ; SYMBOL args: value, flags jsr r5,symbol ; print symbolic address << print ^">>" ; indicate RUG opened it jsr r5,openi ; open as an instruction jmp rcd1 trap4: tst @#42 ; user program nxm catch set? if ne,< mov @#42,(sp) ; set PC to throw to clr @#42 ; clear catch rtt ; throw > pop upc,ups ; save user PC and PS mov sp,usp ; save user SP mov #stack,sp ; setup RUG's stack jsr pc,sstat ; save processor status jsr r5,rembrk ; remove breakpoints if they're set mov upc,clocat ; set current location to be that of trap print ^" Trap through 4: " br bph2 ; set breakpoints 0-7 setbrk: push r1 ; save reg com bptset ; test if breakpoints already set if eq,< halt ; yes, RUG error > mov #nbpt*2-2,r1 ; restore all breakpoints loop < cmp bptadr(r1),#-1 if ne,< mov @bptadr(r1),bptins(r1) ;save contents mov bpti,@bptadr(r1) ;replace with trap > sub #2,r1 rptl pl ;re-loop until done > pop r1 ; restore reg rts r5 ; then quit ; remove breakpoints 0-7 ; in the opposite order of setting rembrk: push r1 ; save reg com bptset ; test if breakpoints set if ne,< ; no, RUG error halt > clr r1 loop < cmp bptadr(r1),#-1 if ne,< mov bptins(r1),@bptadr(r1) ;clear breakpoint > tst (r1)+ cmp r1,#nbpt*2 rptl lo > pop r1 ; restore reg rts r5 .sbttl save/restore processor state ; save processor state sstat: mov r0,uregs ; save r0 mov #uregs+2,r0 ; address of register save area mov r1,(r0)+ ; save r1-r5 mov r2,(r0)+ mov r3,(r0)+ mov r4,(r0)+ mov r5,(r0)+ mov #savls2,r1 ; get list of locations to save loop < mov @(r1)+,@(r1)+ ; save location in its save place tst (r1) ; end of list? rptl ne > .if eq ndz mov ttycsr,r1 mov (r1),svrcsr mov 4(r1),svtcsr bic #100,(r1) ; shut off interrupts bic #100,4(r1) .endc mov #rtrap4,@#4 ; setup bus error trap mov #pr7,@#6 .lif ne ndz movb #1,dzaddr+4 ; enable only line 0 rts pc ; restore processor state rstat: .if ne ndz loop < tst @#dzaddr ; wait for char to type rptl pl > .endc mov #savls2,r1 ; ptr to list of locations saved loop < mov @2(r1),@(r1)+ ; restore location's value tst (r1)+ ; skip over save location address tst (r1) ; end of list? rptl ne > .if eq ndz loop < mov ttycsr,r1 tstb 4(r1) ; wait for char to type rptl pl > mov svrcsr,(r1) ; then restore device status registers mov svtcsr,4(r1) .endc mov #4,r0 tst (r0) ; any bus error vector specified? if eq,< mov #trap4,(r0)+ ; no, setup one mov #pr7,(r0)+ > mov #uregs+2,r0 ; ptr to register save area mov (r0)+,r1 ; restore r1-r5 mov (r0)+,r2 mov (r0)+,r3 mov (r0)+,r4 mov (r0)+,r5 mov uregs,r0 ; restore r0 rts pc .if eq ndz .if ne asmrt1 sistat: tst havsav ;have we saved before? if eq,< mov @#trs,sircsr ;save the initial tty csr mov @#trs+4,sitcsr ;for both receiver and transmitter mov @#icvec,sicvec ;save the trasnmist and receive vectors mov @#icvec+2,sicvec+2 mov @#icvec+4,sicvec+4 mov @#icvec+6,sicvec+6 mov @#100,sclock ;save the clock mov @#102,sclock+2 mov #1,havsav ;we have saved values, never do it again > rts pc ristat: mov sircsr,@#trs ;restore the CSR mov sitcsr,@#trs+4 mov sicvec,@#icvec ;and the initial interupr vectors mov sicvec+2,@#icvec+2 mov sicvec+4,@#icvec+4 mov sicvec+6,@#icvec+6 mov sclock,@#100 ;restore the clock mov sclock+2,@#102 rts pc .endc .endc .sbttl Instruction typeout - lookup inst: mov #insts,r1 ; start of instruction symbol table loop < mov r0,r2 ; to save value tstb 1(r1) ; is it a flag if eq,< mov #6,wds2 ; set in case its two words of RAD50 tst (r1)+ ; 2 word rad50 or change flag? beq 1$ ; if eq then 2 word rad50 mov (r1)+,r3 mov (r1)+,r4 rptl > mov #4,wds2 1$: bic r3,r2 ; apply mask cmp 2(r1),r2 if eq,< sub #4,wds2 ; zero if not 2 word rad50 jmp (r4) > add wds2,r1 cmp r1,#inste ; done? rptl los > tst (r5)+ ; return2 rts r5 .sbttl Instruction typein - lookup ininst: jsr r5,gsym ; read instruction name tst s1 ; anything there? beq 2$ jsr pc,bufpek ; special check to see if this is "label:" cmp r0,#': if eq,< jmp label > mov #2,.lenth mov #insts,r1 ; start of instruction symbol table clr r4 loop < mov r0,r2 ; to save value tstb 1(r1) ; is it a flag if eq,< mov #6,wds2 ; set in case its two words of RAD50 tst (r1)+ ; 2 word rad50 or change flag? beq 1$ ; if eq then 2 word rad50 tst (r1)+ ; skip mask word mov (r1)+,r3 ; get address of typeout routine add -6(r1),r3 ; add offset to get typein routine rptl > mov #4,wds2 1$: cmp (r1),s1 if eq,< cmp wds2,#6 ; two words of rad50 in instruction name? if eq,< cmp 4(r1),s2 ; yes, compare second part exitl eq > else < cmp s2,#6200 ; 6200 = .rad50 "b " if eq,< mov #100000,r4 exitl > tst s2 exitl eq > > add wds2,r1 cmp r1,#inste ; done? rptl los 2$: tst (r5)+ rts r5 > add 2(r1),r4 ; get value of instruction jmp (r3) ; goto proper typein routine .sbttl Instruction typein/typeout routines ; ADD/SUB typeout addsub: jsr r5,typin br arith1 ; double operand typeout (except ADD/SUB) arith: jsr r5,bposs arith1: push r0 asl r0 asl r0 swab r0 ;get source bits in right place bic #177700,r0 jsr r5,ssordd pop r0 dest1: print ^"," dest: bic #177700,r0 jsr r5,ssordd jmp back ; double operand typein inop2: jsr r5,spchk mov r4,val jsr r5,inssdd pop r4 jsr1: swab r4 asr r4 asr r4 bis r4,val jsr r5,comchk endin: jsr r5,inssdd bis (sp)+,val back2: mov val,cvalue mov val+2,cvalue+2 mov val+4,cvalue+4 mov .lenth,length rts r5 ; single operand typeout singop: jsr r5,bposs br dest ; signle operand typeout, no byte instructions singo1: jsr r5,typin br dest ; single operand typein inop1: jsr r5,spchk mov r4,val br endin ; RTS typeout .rts: jsr r5,typin bic #177770,r0 push r0,#%regv jsr r5,sym jmp back ; RTS typein inrts: jsr r5,spchk mov r4,val jsr r5,getreg add r4,val back3: br back2 errr: jmp err ; JSR/XOR typeout .jsr: jsr r5,typin push r0 rol r0 rol r0 swab r0 bic #177770,r0 jsr r5,ssordd pop r0 jmp dest1 ; JSR/XOR typein injsr: jsr r5,spchk mov r4,val jsr r5,getreg br jsr1 .if ne eis ; EIS instruction typeout .eis: jsr r5,typin push r0 bic #177700,r0 jsr r5,ssordd print ^"," pop r0 ash #-6,r0 bic #177770,r0 jsr r5,ssordd br back ; EIS typein ineis: jsr r5,spchk mov r4,val jsr r5,inssdd bis (sp)+,val jsr r5,comchk jsr r5,getreg ash #6,r4 bis r4,val br back2 .endc ; ne eis ; Branch typeout .brchs: jsr r5,typin movb r0,r0 inc r0 asl r0 add clocat,r0 push r0,#0 ; SYMBOL args: value, flags jsr r5,symbol jmp back ; Branch typein inbrch: jsr r5,spchk mov r4,val jsr r5,exp pop r2,r4 bit #%ndef,r2 bne errr sub clocat,r4 asr r4 dec r4 blt .neg cmp r4,#177 bgt errr .neg: cmp r4,#-177 ble errb ;absolute value of displ < 400 bic #177400,r4 bis r4,val bck4: br back3 .sob: jsr r5,typin push r0 bic #177077,r0 ash #-6,r0 push r0,#%regv jsr r5,sym print ^"," bic #177700,(sp) dec (sp) neg (sp) asl (sp) add clocat,(sp) push #0 jsr r5,symbol br back ; SOB instruction insob: jsr r5,spchk mov r4,val jsr r5,getreg ash #6,r4 bis r4,val jsr r5,comchk jsr r5,exp pop r2,r4 bit #%ndef,r2 bne errb sub clocat,r4 ; subtract instr address from branch dest asr r4 ; halve for word offset bcs errb ; reject odd addresses dec r4 ; correct for usual branch offset neg r4 ; and branchs are always backwards blt errb cmp r4,#77 bgt errb bic #177400,r4 bis r4,val br bck4 errb: jmp errr .trap: .cntrl: jsr r5,typin rts r5 incntr: mov r4,val bck3: br bck4 back: print ^" " rts r5 comchk: jsr pc,bufrd cmp r0,#', bne errb rts r5 spchk: jsr pc,bufrd cmp r0,#40 bne errb rts r5 getreg: jsr r5,exp pop r2,r4 cmp r4,#7 bhi errb bit #%ndef+%nilv,r2 bne errb rts r5 bposs: tst r0 ; byte command? bpl typin ; no mov #6200,ainst+2 ; .rad50 /b / br typ1 typin: clr ainst+2 typ1: mov (r1),ainst tst wds2 if ne,< clr wds2 mov 4(r1),ainst+2 > jsr r5,type50 print ^" " rts r5 cndcod: clr ainst+2 mov (r1),ainst jsr r5,type50 ; type out instruction portion print ^" " ; then a space clr ainst ; flush instr once we've typed it out mov r0,r2 ror r2 bcc noccc add #3,ainst ;.rad50 / c/ noccc: ror r2 bcc noccv add #104600,ainst+2 ;.rad50 /v / noccv: ror r2 bcc noccz add #2020,ainst+2 ;.rad50 / z / noccz: ror r2 bcc noccn add #16,ainst+2 ;.rad50 / n/ noccn: jsr r5,type50 br back ainst: 0 0 inccdd: mov r4,val jsr r5,spchk 1$: jsr pc,bufrdu ; read an upper case char mov #1,r2 mov #tbl,r3 loop < cmpb r0,(r3)+ if eq,< bis r2,val asl r2 br 1$ > asl r2 tstb (r3) ;signals end of table rptl ne > jsr pc,bufrrd ; if it wasn't a condition code, put it back br bck3 TBL: .BYTE 'C .BYTE 'V .BYTE 'Z .BYTE 'N wds2: 0 ;left byte never zero .sbttl Instruction typeout - addresses ; SSORDD - types out a source or destination field of an instruction. ; ARGS: VALS: ; R0 -> address syllable in R0 -> effective address of source or dest ; low 6 bits R1 -> flag word for R0 (ie. %regv or not) ; CLOCAT -> 1st word of instr R2 -> non-zero if deferred ssordd: mov r0,r1 ; copy arg bic #177770,r1 ; get register no. ash #-3,r0 ; get address mode clr r2 ; use as flag to say whether deferred bit #1,r0 ; deferred mode? if ne,< mov pc,r2 ; flag bic #1,r0 ; clear bit, check if register deferred mode beq 5$ ; register deferred mode, type (R) print ^"@" ; not register deferred, preceed with @ > add r0,pc ; decode mode br 1$ ; register br 2$ ; autoincrement br 3$ ; autodecrement br 4$ ; index 1$: jsr r5,regtyp ; type R rts r5 2$: cmp r1,#7 ; PC? if eq,< print ^"#" ; type #N jsr r5,tinget ; get next word of instruction push #0 ; SYM arg2: flags jsr r5,sym ; arg1 on stack from TINGET rts r5 > print ^"(" ; type (R)+ jsr r5,regtyp print ^")+" rts r5 3$: print ^"-(" ; type -(R) jsr r5,regtyp print ^")" rts r5 4$: jsr r5,tinget ; get next word of instruction cmp r1,#7 ; PC? if eq,< add clocat,(sp) ; make offset into absolute address add length,(sp) ; ... push #0 ; SYM arg2: flags jsr r5,sym ; type A rts r5 > push #0 ; SYM arg2: flags jsr r5,sym ; arg1 on stack from TINGET 5$: print ^"(" ; type x(R) jsr r5,regtyp print ^")" rts r5 regtyp: push r1,#%regv ; SYM args: value, flags jsr r5,sym rts r5 tinget: push (sp) ; slot for result push clocat ; current location add length,(sp) ; skip over first part of instruction jsr r5,getw ; get next word pop 2(sp) ; store in result slot add #2,length ; instruction now another word long rts r5 .sbttl Instruction typein - addresses inssdd: push (sp) ; make slot for return val clr 2(sp) ; initially zero jsr pc,bufrd ; get next character cmp r0,#'@ if eq,< bis #10,2(sp) ; @, turn on indirect bit in address jsr pc,bufrd ; get another character > cmp r0,#'# if eq,< jsr r5,exp pop r2,r4 bit #%ndef+%regv+%nilv,r2 bne erri bis #27,2(sp) jsr r5,appval rts r5 > cmp r0,#'- if eq,< jsr pc,bufrd cmp r0,#'( beq 1$ jsr pc,bufrrd > cmp r0,#'( beq 2$ jsr pc,bufrrd jsr r5,exp pop r2,r4 bit #%nilv,r2 bne erri bit #%regv,r2 if ne,< cmp r4,#7 bhi erri bis r4,2(sp) rts r5 > jsr pc,bufrd cmp r0,#'( if ne,< jsr pc,bufrrd sub clocat,r4 sub .lenth,r4 sub #2,r4 bis #67,2(sp) jsr r5,appval rts r5 > jsr r5,appval bis #60,2(sp) 1$: bis #40,2(sp) 2$: jsr r5,getreg bis r4,2(sp) jsr pc,bufrd cmp r0,#') bne erri bit #60,2(sp) if eq,< jsr pc,bufrd cmp r0,#'+ if eq,< bis #20,2(sp) > else < bis #10,2(sp) jsr pc,bufrrd > > rts r5 erri: jmp err appval: mov .lenth,r0 mov r4,val(r0) add #2,.lenth rts r5 val: .word 0,0,0 .lenth: .word 0 .sbttl Expression reader ; EXP exp: push (sp),(sp) jsr r5,term pop 2+2(sp),4(sp) loop < jsr pc,bufrd cmp r0,#40 ; space, binary plus beq 1$ cmp r0,#'+ if eq,< ; +, binary plus 1$: jsr r5,term bis (sp)+,2+2(sp) add (sp)+,4(sp) rptl > cmp r0,#'- if eq,< ; -, binary minus jsr r5,term bis (sp)+,2+2(sp) sub (sp)+,4(sp) rptl > > jsr pc,bufrrd ; reread unknown character rts r5 ; TERM term: push (sp),(sp) ; make slots for return vals push r0,r2,r3 ; save regs jsr r5,fact pop 10+2(sp),r3 loop < jsr pc,bufrd cmp r0,#'* if eq,< ; *, binary multiply jsr r5,fact bis (sp)+,10+2(sp) mul (sp)+,r3 rptl > cmp r0,#'! if eq,< ; !, binary divide jsr r5,fact bis (sp)+,10+2(sp) clr r2 div (sp)+,r2 mov r2,r3 rptl > > jsr pc,bufrrd ; reread unknown character mov r3,12(sp) pop r3,r2,r0 ; restore regs rts r5 ; FACT fact: push (sp),(sp) ; make two result slots clr 2(sp) ; clear flags word jsr r5,rnumbr ; see if numeric pop 4+2(sp),* if eq,< rts r5 ; numeric, reutrn value > jsr pc,bufrd ; get input character cmp r0,#'+ if eq,< ; +, unary plus jsr r5,fact pop 2+2(sp),4(sp) rts r5 > cmp r0,#'- if eq,< ; -, unary minus jsr r5,fact pop 2+2(sp),4(sp) neg 4(sp) rts r5 > cmp r0,#'' if eq,< ; ', read ascii byte jsr pc,bufrd mov r0,4(sp) rts r5 > cmp r0,#'" if eq,< ; ", read ascii word jsr pc,bufrd movb r0,4(sp) jsr pc,bufrd movb r0,5(sp) rts r5 > cmp r0,#'& if eq,< ; &, read rad50 word jsr r5,get50 pop 4(sp) rts r5 > cmp r0,#33 ; check for Escape just so we can implment $Q if eq,< jsr pc,bufrdu ; read one more ahead cmp r0,#'Q ; is it $Q if eq,< ; yes, evalutes to last value typed out mov cvalue,4(sp) clr 2(sp) ; is this better? ; mov cvflgs,2(sp) rts r5 > jsr pc,bufrrd ; wasn't $Q put, the char back > jsr pc,bufrrd ; reread the character for RR50 jsr r5,rr50 ; start of symbol? br 1$ jsr pc,bufrrd ; reread the character for GSYM jsr r5,gsym ; read symbol jsr r5,svalue ; get symbol value pop 2+2(sp),4(sp) ; store results rts r5 ; character not the start of a factor so return null value 1$: mov #%nilv,2(sp) ; null flag rts r5 ; and return ; RNUMBR, reads a number ; On return, SP -> numberP flag, ; value rnumbr: push (sp),(sp) ; create two result slots push r0,r1,r2 ; save regs mov #%nilv,12(sp) ; initially no number clr r1 clr r2 loop < jsr pc,bufrd ; get input character cmp r0,#'0 ; digit? exitl lo cmp r0,#'9 exitl hi sub #'0,r0 ash #3,r2 add r0,r2 mul #10.,r1 add r0,r1 clr 12(sp) rptl > cmp r0,#'. if eq,< tst 12(sp) bne 1$ mov r1,10(sp) > else < 1$: mov r2,10(sp) jsr pc,bufrrd > pop r2,r1,r0 ; restore regs rts r5 ; GSYM reads a symbol, converting it to rad50. ; smashes R1 ; VALS: ARGS: ; reads own input S1 -> first word of rad50 symbol ; S2 -> second word of rad50 symbol gsym: jsr r5,get50 ; read 1st word of rad50 pop s1 ; copy result to return slot jsr r5,get50 ; read 2nd word of rad50 pop s2 ; copy result to return slot loop < jsr r5,rr50 ; read rad50 characters till no more exitl ; return for character not rad50 rptl > rts r5 ; GET50 reads up to 3 rad50 characters and packs them into a word. get50: push (sp),r1 ; make result slot, save reg clr 4(sp) ; init rad50 word jsr r5,rr50 ; read rad50 character br 1$ mul #50*50,r1 ; store in 1st position in word add r1,4(sp) ; ... jsr r5,rr50 ; read rad50 character br 1$ mul #50,r1 ; store in 2nd position in word add r1,4(sp) ; ... jsr r5,rr50 ; read rad50 character br 1$ add r1,4(sp) ; store in 3rd position in word 1$: pop r1 ; restore reg rts r5 ; RR50 reads a ascii character and converts it to rad50. If the ; character is not rad50 RR50 doesn't skip and character is left ; to be reread. Character is left in R1. rr50: jsr pc,bufrdu ; read upper case ascii character clr r1 ; starting rad50 character (added to below) cmp r0,#'$ beq 1$ cmp r0,#'% beq 2$ cmp r0,#'. beq 3$ mov r0,r1 ; numbers in below comments are octal sub #'0,r1 ; R1 = char-60 ('0) blo 7$ ; char < 60, not rad50 by now cmp r1,#9. ; ('0-'9)? 60<=char<=72? 0<=R1<=12? blos 4$ ; yes, R1+36 (char-60+36) is a rad50 number sub #'A-'0,r1 ; R1 = R1-21 (char-101) blo 7$ ; 72 flags, ; value svalue: push (sp),(sp) ; make room for return vals push r1 ; save reg mov stbeg,r1 ; ptr to before 1st symbol's value word clr sbit loop < sub #6,r1 ; move ptr to next symbol cmp r1,stend ; beyond end of symbol table? if los,< ; not found clr 6(sp) ; return zero mov #%ndef,4(sp) ; with undefined bit set exitl > asl sbit ; get its bit in flag words if eq,< ; move to next group of 16 symbols inc sbit ; set bit 1 for first symbol mov r1,sflgp ; save ptr to register flag word sub #4,r1 ; move ptr over flag words to value cell ; of first symbol > cmp -4(r1),s1 ; 1st word of rad50 same? rptl ne cmp -2(r1),s2 ; 2nd word of rad50 same? rptl ne mov (r1),6(sp) ; found symbol, store value clr 4(sp) ; flag word bit sbit,@sflgp ; register value? if ne,< bis #%regv,4(sp) ; yes, set register flag in flag word > > mov r1,sptr ; save ptr to symbol entry pop r1 ; restore reg rts r5 sptr: .word 0 sbit: .word 0 sflgp: .word 0 s1: .word 0 s2: .word 0 .sbttl Symbol typeout ; SYM is like SYMBOL but checks absolute/relative typeout mode first sym: tst tabsmd ; absolute mode? bne const ; fall through to symbol ; SYMBOL searches the symbol table for a value greater than or equal ; to the lookup value such that the difference is smaller than 200. ; Types out SYMBOL+OFFSET from looked up value. ; ARGS: VALS: ; SP -> flag AINST -> symbol name in AINST & AINST+2 ; value symbol: jsr r5,save6 ; save regs clr ainst ; will still be zero if nothing found mov stbeg,r1 ; ptr to start of symbol table clr r2 ; value of last symbol found clr r3 ; bit in flag word for current symbol loop < sub #6,r1 ; move ptr to next symbol cmp r1,stend ; check for end of symbol table exitl los asl r3 ; next bit if eq,< ; if 16 symbols then get new flag words inc r3 ; set bit 1 for first symbol mov r1,r4 ; save ptr to register flag word sub #4,r1 ; move ptr to before first symbol in this group > mov 20(sp),r0 ; get value bit r3,-2(r4) ; if half killed then ignore it rptl ne sub (r1),r0 ; compare symbol's value to lookup value rptl lo ; no good if smaller cmp r0,mxoff ; no good if difference is large rptl hi cmp (r1),r2 ; no good if smaller than largest found rptl lo bit #%regv,16(sp) ; symbol's reg flag must = value's if eq,< bit r3,(r4) ; lookup value is not register rptl ne > else < bit r3,(r4) ; lookup value is register rptl eq tst r0 ; no offsets used for register typeout rptl ne > mov -4(r1),ainst ; save symbol name mov -2(r1),ainst+2 ; ... mov (r1),r2 ; and value rptl > tst ainst ; if zero, no symbol found if ne,< jsr r5,type50 ; type symbol name mov 20(sp),r0 ; lookup value sub r2,r0 ; calculate offset from symbol value beq 1$ ; don't type offset if 0 print ^"+" jsr r5,tnumbr ; type octal of r0 > else < push 20(sp),16+2(sp) ; CONST args: value, flags jsr r5,const ; type value as a constant > 1$: jsr r5,rest6 ; restore regs pop 2(sp),* ; remove args from stack rts r5 ; CONST types its arg as a constant. First arg is value, second is ; flag word. const: bit #%regv,2(sp) ; register value? if ne,< print ^"%" ; % to indicate register value > mov 4(sp),r0 ; value arg jsr r5,tnumbr ; type as octal no. pop (sp),(sp) ; remove args from stack rts r5 .sbttl Typeout routines ; TNUMBR: type out number in R0, do not smash it tnumbr: push r0 ; save reg jsr r5,1$ cmp tradix,#10. if eq,< print ^"." ; decimal, follow typeout with point > pop r0 ; restore reg rts r5 1$: push r1 ; save reg mov r0,r1 ; setup for DIV instruction, ugh clr r0 ; ... div tradix,r0 ; stuff left to type in r0, this digit in r1 if ne,< jsr r5,1$ ; output higher digits > mov r1,r0 ; make ascii add #'0,r0 ; ... jsr r5,typec ; type it pop r1 ; restore reg rts r5 ; TYPE50 converts AINST and AINST+2 from RAD50 to ASCII typeout type50: push r0,r1 ; save regs clrb r50asc ; spaces become nulls mov ainst,r1 ; first word of RAD50 jsr r5,unpack mov ainst+2,r1 ; second word of RAD50 jsr r5,unpack movb #40,r50asc ; restore spaces pop r1,r0 ; restore regs rts r5 unpack: jsr r5,subl ; get first char in r0 50*50 movb r50asc(r0),r0 ; convert first to ascii if ne,< jsr r5,typec ; type if not null > jsr r5,subl ; get second char in r0, third in r1 50 movb r50asc(r0),r0 ; convert second to ascii if ne,< jsr r5,typec ; type if not null > movb r50asc(r1),r0 ; convert third to ascii if ne,< jsr r5,typec ; type if not null > rts r5 subl: mov #-1,r0 ; start count loop < inc r0 ; count no. of subtractions sub (r5),r1 rptl cc > add (r5)+,r1 ; subtracted once too often, so correct rts r5 r50asc: .ascii " ABCDEFGHIJKLMNOPQRSTUVWXYZ$.%0123456789" .sbttl Input buffering and rubout processing buf: .blkb 78. ;buffer to store characters in .byte -1 ;marks end of buf .even bufptr: buf ;pts to next char to read in buf. buflst: buf ;pts to next open slot in buf (bufptr may ;be less than buflst if currently ;rereading chars). bufpc: -1 ;place to goto if rubout found. (backup) bufsp: -1 ;stack ptr if rubout found. ;BUFRD reads a char (input or from buf). If bufptr=buflst ;then a char is inputted, echoed, and put into buf. If ;bufptr > rts pc bufrd: cmp bufptr,buflst ; input or reread? if lo,< movb @bufptr,r0 ; reread char inc bufptr ; advance to next character rts pc > 1$: jsr r5,readc ; read next character cmpb r0,#177 ; rubout? if eq,< loop < cmp buflst,#buf ; rubout at beginning of buf? if los,< print ^"" ; beg of buf, so beep (Nothing to rub out) br 2$ > dec buflst ; forget about last character in buffer movb @buflst,r0 ; get character just rubbed out jsr r5,rubout ; erase it from display 2$: jsr r5,readc ; get next input character cmp r0,#177 ; another rubout? rptl eq > mov r0,reread ; reread character mov #buf,bufptr ; reset ptr so reread chars mov bufsp,sp ; now backup stack... mov bufpc,(sp) ; ... and PC rts pc > cmp r0,#014 ; ^L? if eq,< jsr r5,clrscn ; clear screeen push r1 ; save reg mov #buf,r1 ; ptr to input buffer loop < cmp r1,buflst ; typed everything in buffer yet? exitl eq movb (r1)+,r0 ; get next char in input buffer jsr r5,typec ; type it rptl > pop r1 ; restore reg br 1$ ; get next input character > movb r0,@buflst ; put char into bufffer inc buflst ; move to new char slot br bufrd ; go return char ; BUFRRD causes the last character read to be reread. bufrrd: dec bufptr movb @bufptr,r0 rts pc ; RUBOUT does rubout echoing/erasing for char in R0. rubout: tst ttytyp ; printing terminal? if eq,< jsr r5,typec ; yes, echo character rts r5 > cmpb r0,#40 ; control char? if lo,< cmpb r0,#33 ; escape is only one char if ne,< jsr r5,types ; control char, rub out both ^ and char bsspbs-. > > jsr r5,types ; rub out char bsspbs-. rts r5 bsspbs: .byte 10,40,10,0 ; BS, SP, BS .even .sbttl Input-output routines. ; READC gets a character from the terminal. The char is returned in r0. readc: mov reread,r0 ; any character to be reread? bpl 2$ ; yes, return right away jsr r5,ireadc ; get a character tst ttytyp ; TTY? if eq,< cmp r0,#'} ; yes, translate } to escape if eq,< mov #33,r0 > > .if eq * cmp ttytyp,#%tnsb ; SB? if eq,< cmp #33,r0 ; SB escape sequence? bne 1$ ; no, no translation jsr r5,ireadc cmp r0,#'p ; F1 key: ESC if eq,< mov #33,r0 > cmpb r0,#'q ; F2 key: ^C if eq,< mov #3,r0 > > .endc 1$: tst r0 ; throw away nulls since proably beq readc ; garbage command anyway cmpb #15,r0 ; don't echo cr, lf, or rubout beq 2$ cmpb #12,r0 beq 2$ cmpb #177,r0 beq 2$ jsr r5,typec ; echo character cmpb r0,#4 ; ^D beq wipe cmpb r0,#7 ; ^G beq quit 2$: mov #-1,reread ; clear reread rts r5 wipe: print ^" XXX? " br qbr quit: print ^"QUIT? " qbr: jmp rcd1 ; IREADC reads a char from the terminal. .if eq ndz ireadc: tstb @ttycsr bpl ireadc mov @#trs+2,r0 ; get character bic #177600,r0 ; strip off parity etc. rts r5 .iff ireadc: mov #dzaddr,r0 ; get address of DZ11 loop < tstb (r0) ; wait for a character rptl pl > mov 2(r0),r0 ; get character bit #3400,r0 ; character from line 0? bne ireadc ; no, ignore bic #177600,r0 ; strip off parity etc. rts r5 .endc .sbttl Output subroutines ; Clears screen for display, for TTY or Glass TTY clrscn: tst ttytyp if le,< print ^" " > else < jsr r5,types .litrl ^".byte 233,'H,233,'J,0" > rts r5 ; TYPES takes a relative ptr to an asciz string following the call and ; types the string. types: push r0,r1 ; save regs mov r5,r1 ; relative ptr to asciz msg add (r5)+,r1 ; make absolute loop < movb (r1)+,r0 ; next character exitl eq ; null terminates jsr r5,typec ; type char rptl > pop r1,r0 ; restore regs rts r5 ; ITYPES takes a relative ptr to an asciz string following the call and ; image types the string. itypes: push r0,r1 ; save regs mov r5,r1 ; relative ptr to string add (r5)+,r1 ; make absolute loop < movb (r1)+,r0 ; get character exitl eq ; null terminates jsr r5,itypec ; type char rptl > pop r1,r0 ; restore regs rts r5 ; Type character contained in r0 typec: push r0 ; save char cmpb r0,#7 ; BELL? beq tyco2 cmpb r0,#10 ; BS? if eq,< dec hpos br tyco2 > cmpb r0,#11 ; TAB? if eq,< mov #40,r0 ; type spaces to simulate loop < jsr r5,itypec inc hpos bit #7,hpos ; until reach multiple of 8 rptl ne > pop r0 ; restore char rts r5 > cmpb r0,#12 ; LF? if eq,< jsr r5,itypec tst ttytyp ; printing terminal or glass TTY? ble tyco3 ; yes, just type sout ^"K" ; erase to end of line br tyco3 ; now type LF > cmpb r0,#15 ; CR? if eq,< clr hpos br tyco2 > cmpb r0,#33 ; ESC? if eq,< mov #'$,r0 br tyco1 > cmpb r0,#40 if lo,< mov #'^,r0 jsr r5,itypec inc hpos mov (sp),r0 bis #100,r0 > tyco1: inc hpos tyco2: jsr r5,itypec tyco3: pop r0 ; restore reg rts r5 .if eq ndz itypec: push r1 ; save reg loop < mov ttycsr,r1 tstb 4(r1) ; wait for ready rptl pl ; ... > movb r0,6(r1) ; send character pop r1 ; restore reg rts r5 .iff itypec: push r1 ; save reg mov #dzaddr,r1 ; get DZ11 address loop < tst (r1) ; wait for transmitter ready rptl pl ; ... > movb r0,6(r1) pop r1 ; restore reg rts r5 .endc .sbttl Core/Core-image Routines getw: jsr r5,catchn nxmer1-. mov @2(sp),2(sp) ; get desired word rts r5 getb: jsr r5,catchn nxmer1-. movb @2(sp),2(sp) ; get byte clrb 3(sp) rts r5 putw: jsr r5,catchn nxmer1-. mov 2(sp),@4(sp) ; try deposit pop (sp),(sp) rts r5 putb: jsr r5,catchn nxmer1-. movb 2(sp),@4(sp) ; try deposit pop (sp),(sp) ; remove args rts r5 nxmer1: jmp nxmerr .sbttl Instruction Symbol Table ; SYMBOL TABLE -- RAD50, THEN VALUE ; TO CHANGE MASK AND JUMP HAVE 0 HIGH BYTE IN 1ST RAD50 WORD ; FOLLOWED BY NEW MASK AND JUMP LOC ; IF FOLLOWED BY ZERO RIGHT BYTE, NEXT SYMBOL IS 2 WORDS LONG INSTS: INOP2-ARITH ; ???? 107777 ; Mask ARITH ; Subroutine .RAD50 /MOV/ 010000 .RAD50 /CMP/ 020000 .RAD50 /BIT/ 030000 .RAD50 /BIC/ 040000 .RAD50 /BIS/ 050000 ;ADD&SUB DO NOT HAVE BYTE OPTION SO ARE SEPERATE INOP2-ADDSUB ; ???? 007777 ; Mask ADDSUB ; Subroutine .RAD50 /ADD/ 060000 .RAD50 /SUB/ 160000 ;SINGLE OPERAND INSTRUCTIONS INOP1-SINGOP ; ???? 100077 ; Mask SINGOP ; Subroutine .RAD50 /CLR/ 005000 .RAD50 /COM/ 005100 .RAD50 /INC/ 005200 .RAD50 /DEC/ 005300 .RAD50 /NEG/ 005400 .RAD50 /ADC/ 005500 .RAD50 /SBC/ 005600 .RAD50 /TST/ 005700 .RAD50 /ROR/ 006000 .RAD50 /ROL/ 006100 .RAD50 /ASR/ 006200 .RAD50 /ASL/ 006300 ; single operand, non-byte, instructions INOP1-SINGO1 ; ???? 000077 ; Mask SINGO1 ; Subroutine .RAD50 /JMP/ 000100 0 ; signals instruction with >3 chars .RAD50 /SWA/ 000300 .RAD50 /B / .if ne pdp11-10 .if ne pdp11-20 .RAD50 /SXT/ 006700 .if eq * 0 .RAD50 /MTP/ 106400 .RAD50 /S/ 0 .RAD50 /MFP/ 106700 .RAD50 /S/ .endc ; eq * .if ne memman 0 .rad50 /MFP/ 006500 .rad50 /I/ 0 .rad50 /MTP/ 006600 .rad50 /I/ 0 .rad50 /MFP/ 106500 .rad50 /D/ 0 .rad50 /MTP/ 106600 .rad50 /D/ .endc ; ne memman .endc ; ne pdp11-20 .endc ; ne pdp11-10 ;CONDITION CODES INCCDD-CNDCOD ; ???? 000017 ; Mask CNDCOD ; Subroutine .RAD50 /SE / 000260 .RAD50 /CL / 000240 ;RTS INRTS-.RTS 000007 .RTS .RAD50 /RTS/ 000200 ;JSR/XOR INJSR-.JSR ; ???? 000777 ; Mask .JSR ; Subroutine .RAD50 /JSR/ 004000 .if ne pdp11-10 .if ne pdp11-20 .rad50 /XOR/ 074000 .endc ; ne pdp11-20 .endc ; ne pdp11-10 .if ne eis ;EIS ineis-.eis ; (typein subroutine)-(typeout subroutine) 000777 ; mask .eis ; typeout subroutine .rad50 /MUL/ 070000 .rad50 /DIV/ 071000 .rad50 /ASH/ 072000 0 .rad50 /ASH/ 073000 .rad50 /C/ .endc ; ne eis ;CONTROL GROUP INCNTR-.CNTRL 0 .CNTRL 0 .RAD50 /HAL/ 0 .RAD50 /T / 0 .RAD50 /WAI/ 1 .RAD50 /T / .RAD50 /RTI/ 2 .RAD50 /BPT/ 3 .RAD50 /IOT/ 4 0 .RAD50 /RES/ 5 .RAD50 /ET / .if ne pdp11-10 .if ne pdp11-20 .RAD50 /RTT/ 6 .endc .endc .RAD50 /NOP/ 240 ;TRAP AND EMT INCNTR-.TRAP 377 .TRAP .RAD50 /EMT/ 104000 0 .RAD50 /TRA/ 104400 .RAD50 /P / ;BRANCHES INBRCH-.BRCHS 377 .BRCHS .RAD50 /BR / 000400 .RAD50 /BNE/ 001000 .RAD50 /BEQ/ 001400 .RAD50 /BGE/ 002000 .RAD50 /BLT/ 002400 .RAD50 /BGT/ 003000 .RAD50 /BLE/ 003400 .RAD50 /BPL/ 100000 .RAD50 /BMI/ 100400 .RAD50 /BHI/ 101000 0 .RAD50 /BLO/ 101400 .RAD50 /S / .RAD50 /BVC/ 102000 .RAD50 /BVS/ 102400 .RAD50 /BCC/ 103000 0 .rad50 /BHI/ 103000 .rad50 /S / .RAD50 /BCS/ 103400 .rad50 /BLO/ 103400 ; SOB INSOB-.SOB 777 .SOB .rad50 /SOB/ inste: 077000 constants ;Constants area goes here ;(Strings and other literals) .sbttl Command dispatch tables comls1: .byte 033 ; $ alt .byte ': ; : colon starts command name. .byte '= ; = equal .byte '; ; ; semicn .byte '@ ; @ openpc opens location addressed by PC .byte '> ; > define .byte '/ ; / oword .byte '\ ; \ obyte .byte '[ ; [ onum .byte '] ; ] osym .byte 015 ; CR cr .byte 012 ; LF lf .byte 011 ; TAB tab .byte '^ ; ^ up .byte ' ; ^N single step .byte '_ ; _ type $q in symbolic mode .lif ne asmdsk+asmRT1+asmsrl .byte 'L ; $L load Load .lif ne asmdsk+asmdmp .byte 'Y ; $Y dump Dump .byte 'G ; $G go Go .byte 'W ; $W wsearc Word search .byte 'N ; $N nsearc Not Equal word search .byte 'E ; $E esearc Effective addr search .byte 'B ; $B setbpt Breakpoint .byte 'P ; $P proced Proceed .byte 'U ; $U delbpt Remove breakpoint .byte 'K ; $K kill Half kill .byte 'Z ; $Z zero Zero core .byte 'O ; $O soct Set octal output radix .byte 'D ; $D sdec Set decimal output radix .byte 'C ; $C cmode Constant typeout mode .byte 'S ; $S smode Symbol typeout mode .byte 'I ; $I imode Instruction typeout mode .byte '" ; $" amode Ascii typeout mode .byte '& ; $& rmode Rad50 typeout mode .byte '` ; $` cmodeb Constant typeout mode (byte) .byte '' ; $' amodeb Ascii typeout mode (byte) .byte 'A ; $A absmd Absolute typeout mode .byte 'R ; $R relmd Relative typeout mode ncom==.-comls1 ; no. of commands .byte 0 ; place to stick search terminator .even ; Address of command routines comls2: alt ; $ signals command colon ; : followed by command name equal ; = prints current value semicn ; ; retype $q in last specified mode openpc ; @ opens location addressed by PC define ; > defines sym oword ; / open word in current core obyte ; \ open byte onum ; [ open as number osym ; ] open as symbol cr ; CR close lf ; LF close, open next tab ; TAB open location addressed by . up ; ^ close, open previous sstep ; ^N single step undscr ; _ Type $q in symbolic mode .lif ne asmdsk+asmRT1+asmsrl load ; L Load .lif ne asmdsk+asmdmp dump ; D Dump go ; G Go wsearc ; W Word search nsearc ; N Not Equal word search esearc ; E Effective addr search setbpt ; B Set Breakpoint proced ; P Proceed delbpt ; U Delete breakpoint kill ; K Kill symbol zero ; Z Zero core soct ; O Set octal typeout radix sdec ; D Set decimal typeout radix cmode ; C Constant typeout mode smode ; S Symbolic typeout mode imode ; I Instruction typeout mode amode ; " Ascii typeout mode rmode ; & Rad50 typeout mode cmodeb ; ` Constant typeout mode (byte) amodeb ; ' Ascii typeout mode (byte) absmd ; A Absolute typeout mode relmd ; R Relative typeout mode .iif ne <.-comls2>/2-ncom, .error Command tables not same length err ; illegal command ;Table of routine-pointers for colon commands: ;Terminated by -1, an illegal rad50 word. COLTAB: .rad50 "help " ; list : commands .word colhlp .rad50 "exit " ; return to DSKLOD .word exit .rad50 "listb " ; list breakpoints .word listb .word -1 ; terminator .sbttl Data ; mode data tabsmd: .word 0 ; temporary absolute/relative typeout mode pabsmd: .word 0 ; permanent absolute/relative typeout mode semimd: .word tycons ; semi-colon mode twmode: .word tyinst ; temporary location typeout mode (word) pwmode: .word tyinst ; permanent location typeout mode (word) tbmode: .word tybcon ; temporary location typeout mode (byte) pbmode: .word tybcon ; permanent location typeout mode (byte) tradix: .word 8. ; temporary output radix pradix: .word 8. ; permanent output radix altcnt: .word 0 ;no of alts in command ; current location clflgs: .word 0 ; current location flags (register flag) caddr: .word 0 ; used only by OPEN and CLOSE o.bw: .word 0 ; 0 - closed, 1 - byte open, 2 - word open oo.bw: .word 0 ; old o.bw for next ^ or LF command nextad: .word 0 ; command argument arg: .word 0 argflg: .word 0 argcnt: .word 0 ; current value length: .word 0 ; length of current value cvalue: .word 0,0,0 ; current value cvflgs: .word 0 ; current value flags (register flag) ; breakpoint data bptset: .word 0 ;-1 if breakpoints set bptno: .word 0 ;no. of last breakpoint bptadr: .rept nbpt -1 .endr bptcnt: .blkw nbpt bptins: .blkw nbpt bpti: bpt ;breakpoint instruction proflg: .word 0 ; set to single step once, then proceed ssflag: .word 0 ; nonzero if single stepping count: .word 0 ; single step count lodoff: .word 0 ; load offset (added to load addresses) starta: .word 0 ; program start address ; terminal data .iif eq *, %tntyp===%tnvt .iif eq sys-sao, %tntyp===%tnvt .iif eq sys-lll, %tntyp===%tngl .iif ndf %tntyp, %tntyp===%tntt ttytyp: .word %tntyp ttycsr: .word trs hpos: .word 0 ; output column pointer reread: .word -1 ; character to be reread .if eq ndz .if ne asmrt1 havsav: .word 0 ;static flag to indicate if we have saved ;the initial console information sircsr: .word 0 ;initial receive csr sitcsr: .word 0 ;initial transmit csr sicvec: .word 0,0,0,0 ;initial interrupt vector for the console sclock: .word 0,0 ;save area for the clock interupt .endc .endc .if ne asmsrl+asmRT1 srlcsr: .word 0 errcnt: .word 0 ; number of checksum errors per load lodasp: .word 0 ; the SP to unwind to when aborting loading .endc smask: .word -1 ; search mask .word 0 ; low limit .word symtop ; high limit ; symbol table stbeg: .word rugsa-2+6 ; ptr to one symbol beyond first register flag word stend: .word symtop ; ptr to symbol slot beyond last in table ; This word defines how far from a symbol a number has to be before it will ; not use the form: +offset for printing. mxoff: .word 200 .sbttl User-Register Storage ; The order of the following entries is critical uregs: 0 ; user r0 0 ; r1 0 ; r2 0 ; r3 0 ; r4 0 ; r5 usp: 0 ; user sp upc: 0 ; user pc nuregs==<.-uregs>/2 ; List of locations saved while in RUG. RUG saves the locations in the ; program being debugged which it clobbers so that they may be restored ; when the program is continued. savls1: .word 177776,ups ; This is handled separately savls2: .word 4,sv4 .word 6,sv6 .iif ne ndz, .word dzaddr+4,tcr .word 0 ; this terminates the list ups: 0 ; user ps sv4: 0 sv6: 0 svrcsr: 0 svtcsr: 0 .lif ne ndz tcr: 0 ; saved DZ11 transmit control register .blkw 60. ; stack area stack==. lastlc==.-2 ; highest RUG location .sbttl Symbol Table ; The following macro produces symbol-table entries. The symbol table grows ; downward from BSYMT (below RUG) in groups of 16 symbols (the last, lowest ; group is padded with null entries). Every 16-sym group is followed by 2 ; flag words whose bits specify which of the 16 symbols are half-killed ; (lower word), and which are registers. The low-order bit in each flag ; corresponds to the symbol entry with the highest address (for that 16 ; symbol group). The flags are stored in two temporaries, %.rflg and %.hflg, ; until the 16 symbol group is done. They are then put into their core ; locations. ; The macro S takes four arguments: NAME is the symbol name (it may be any ; length but is entered in the symbol table as 6 letters), VALUE is the ; symbol value, FLAG1 and FLAG2 may be "HK" and/or "REG" (or neither) to ; signify that the symbol is to be half-killed or is a register. Some ; examples: "S FOO,1,HK" or "S FOO,1,REG,HK" or "S FOO,1,HK,REG". After all ; symbols, terminate with the macro ENDS. ; A symbol entry is 3 words: two words of rad50 name (up to ; 6 letters) followed by a value word. %.rflg===0 ; temp reg flags word %.hflg===0 ; temp half-kill flags word %.sbit===0 ; flag bit for current symbol in group .macro s name,value,flag1,flag2 .if eq %.sbit .=.-4-<16.*6> ; starting a new block, move down %.sbit===100000 .endc %.stmp===. .rad50 /name/ %.slng===.length name .iif le %.slng-3, .word 0 .iif gt %.slng-6, .=%.stmp+4 .word value .irp flag, .iif idn flag,hk, %.hflg===%.hflg!%.sbit .iif idn flag,HK, %.hflg===%.hflg!%.sbit .iif idn flag,reg, %.rflg===%.rflg!%.sbit .iif idn flag,REG, %.rflg===%.rflg!%.sbit .endm %.sbit===<%.sbit/2>&077777 .if eq %.sbit .word %.hflg,%.rflg .=.-4-<16.*6> %.hflg===0 %.rflg===0 .endc .endm s .macro ends .if ne %.sbit .rept 16. .if ne %.sbit .word 0,0,0 %.sbit===<%.sbit/2>&077777 %.hflg===%.hflg!%.sbit ; half-kill empty slots .endc .endr .word %.hflg,%.rflg .=.-4-<16.*6> .endc .endm ends .=rugsa ; start symbol table just below start of RUG s %0,0,reg s %1,1,reg s %2,2,reg s %3,3,reg s %4,4,reg s %5,5,reg s %6,6,reg s %7,7,reg clocat=.+4 ;where dot's value is stored s .,0,hk ; current location s .m,smask,hk ; search mask s .ttyty,ttytyp,hk ; tty type code .if ne asmdsk .lif eq sysdsk-drk s .rknum,rknum,hk ; disk no. (0 or 20000) .lif ne nrx s .rxnum,rxnum,hk ; disk no. (0 or 20) .endc s .stbeg,stbeg,hk ; ptr to top of symbol table s .stend,stend,hk ; ptr to bottom of symbol table s .start,starta,hk ; start address of program s .bptno,bptno,hk ; last breakpoint no. s .mxoff,mxoff,hk ; Maximum offset from a symbol .if ne *asmdmp s .dmplo,dmplow,hk ; low address to dump s .dmphi,dmphi,hk ; high address to dump .endc ends symtop==.-2 ; top of user symbol table .if2 .print " Highest RUG location = " typval \lastlc .print " Top of user symbol table = " typval \symtop .print " " .endc .end rug  s; BOOT - Bootstrap program -*-PALX-*- versio==%fnam2 .title Bootstrap Program .insrt pdp11;defs > .macro print text jsr r5,typesc .string ^text .endm .sbttl Startup .if eq sysdsk-drk .=220 .word go,pr7 ; for trap startup (RK05 disk) .endc .if eq sysdsk-drl .=160 .word go,pr7 ; for trap startup (RL01 disk) .endc .=1000 go: mov #stack,sp ; set stack ptr mov #1$,@#4 ; set NXM trap vector for finding memtop mov #pr7,@#6 ; ... mov pc,r1 ; here is a good place to start loop < tst (r1) ; check if memory there add #2,r1 ; move to next location rptl > 1$: cmp (sp)+,(sp)+ ; remove pc,ps of trap from stack mov r1,memtop ; save 1st NXM address .if eq sysdsk-drk push #11272 ; RKRW arg: block number 10$: push #5 ; RKRW arg: operation code jsr r5,rkrw ; read in MFD .endc .if eq sysdsk-drl push #47750 ; RLRW arg: block number 10$: push #14 ; RLRW arg: operation code jsr r5,rlrw ; read in MFD .endc mov #dbuf+2,r2 ; ptr to first entry in MFD .if eq sysdsk-drk mov #510./10,r3 ; no. of entries in MFD .endc .if eq sysdsk-drl mov #254./10,r3 ; no. of entries in MFD .endc loop < cmp (r2),#402 ; look for [1,2] exitl eq add #10,r2 ; move to next MFD slot sorl r3 tst @#dbuf ; is there another MFD??? if ne,< push @#dbuf ; get next MFD block number br 10$ ; read it in > print ^"[1,2] not found " br moveup > mov #names,r1 ; ptr array to setup with program names mov #pblock,r3 ; ptr to array to setup with program block no.s push 2(r2) ; RKRW or RLRW arg: block number .if eq sysdsk-drk 12$: push #5 ; RKRW arg: operation code jsr r5,rkrw ; read in [1,2] .endc .if eq sysdsk-drl 12$: push #14 ; RLRW arg: operation code jsr r5,rlrw ; read in [1,2] .endc mov #dbuf+2,r2 ; ptr to UFD just read in .if eq sysdsk-drk mov #510./22,r0 ; no. of entries in UFD .endc .if eq sysdsk-drl mov #254./22,r0 ; no. of entries in UFD .endc loop < mov (r2),r4 if ne,< jsr r5,radasc ; convert 1st three chars of filename mov 2(r2),r4 jsr r5,radasc ; convert 2nd three chars of filename mov 4(r2),r4 jsr r5,radasc ; convert extension mov 12(r2),(r3)+ ; store block no. clrb (r1)+ > add #22,r2 ; move to next UFD entry sorl r0 tst @#dbuf ; is there another UFD block??? if ne,< push @#dbuf ; RLRK (or RLRW) arg: block number br 12$ ; read in next block > > br moveup radasc: push r5 ; save reg mov r4,r5 ; divide by 50*50 to get 1st rad50 char in r4 clr r4 ; ... div #50*50,r4 ; ... movb r50asc(r4),(r1)+ ; convert to ascii and store in buffer clr r4 ; divide remainder by 50 to get 2nd div #50,r4 ; and 3rd rad50 chars movb r50asc(r4),(r1)+ ; convert 2nd to ascii and store movb r50asc(r5),(r1)+ ; convert 3rd to ascii and store pop r5 ; restore reg rts r5 r50asc: .byte 0 .ascii "ABCDEFGHIJKLMNOPQRSTUVWXYZ$%.0123456789" ; move self up to high core moveup: mov #/2,r0 ; no. of words to relocate mov memtop,r3 ; calculate relocation offset sub #last,r3 ; ... mov #first,r1 ; ptr to first address to relocate mov r1,r2 ; calculate relocated first add r3,r2 ; ... mov r2,firstp ; save ptr to relocated FIRST loop < mov (r1)+,(r2)+ ; move program to high core sorl r0 > add r3,sp ; correct stack ptr add r3,pc ; jump to relocated program first==. .sbttl Command processor boot: dskerr:: ; disk errors come here too jsr r5,typesc ; type greeting msg .litrl < .byte 33,'H,33,'J .ascii " MIT Math RL01 Disk Boot Version " .byte versio/10.+'0,versio-+'0 .ascii " Please enter program name: " .byte 0 > ; Read a program name from the TTY boo1: mov pc,r1 ; ptr to line buffer add #linbuf-.,r1 ; ... loop < jsr r5,readc cmp r0,#15 ; CR? exitl eq cmp r0,#177 ; RUBOUT? if eq,< print ^"XXX " br boot > movb r0,(r1)+ ; store character in line buffer rptl > print ^" " clrb (r1)+ ; put in null byte to terminate ; Lookup name in NAMES table mov pc,r1 ; ptr to line buffer add #linbuf-.,r1 ; ... mov pc,r2 ; ptr to program name list add #names-.,r2 ; ... mov pc,r3 ; ptr to program block list add #pblock-.,r3 ; ... loop < push r1,r2 ; save ptrs loop < cmpb (r1)+,(r2)+ ; compare strings exitl ne tstb -1(r1) ; last byte null? rptl ne push (r3) ; DOPENR arg: block no. jsr r5,dopenr ; init for LOAD jmp load ; load program > pop r2,r1 ; restore ptrs add #10.,r2 ; move to next program name tst (r3)+ ; and block no. tstb (r2) ; list ended rptl ne > print ^"Program not found " br boo1 .insrt pdp11;stuff .insrt pdp11;sadisk .sbttl Program loading ; LOAD loads the open file into memory. The file is in a modified abs ; loader format. First two bytes specify the no. of data bytes. The ; next two bytes specify the address of the data. The last n bytes are ; data. load: tstb @#tps ; wait for printing to finish bpl load reset ; bus reset so loaded program starts ok clr r1 ; ptr to 1st memory address ; Put BPT in 0 to catch random jumps mov #3,(r1)+ ; BPT clr (r1)+ ; HALT ; Set trap vectors mov #<34-4>/4+1,r0 ; no. of vectors to setup mov #pr7+1,r2 ; first trap vector PS loop < mov pc,(r1) ; ptr to TRP add #trp-.,(r1)+ ; ... mov r2,(r1)+ ; priority 7, trap no. inc r2 ; increment trap no. sorl r0 > add #trap4-trp,@#4 ; correct bus error vector dec @#6 ; ... add #powerf-trp,@#24 ; correct power fail vector clr (r1)+ ; set DLINK vector (40) to zero clr (r1)+ ; set NXMCAT to zero ; Set all interrupt vectors loop < mov pc,(r1) ; ptr to TRP add #trp-.,(r1)+ ; ... mov r2,(r1)+ ; priority 7, trap no. cmp r1,#400 ; do up to vector 376 rptl lo > ; Zero memory below FIRST loop < clr (r1)+ ; zero memory cmp r1,firstp ; done? rptl lo > ; Load the program loop < jsr r5,dgetw ; get no. of data bytes in block pop r1 exitl eq ; jump block if no data jsr r5,dgetw ; get address pop r2 loop < jsr r5,dgetb ; read data byte movb (sp)+,(r2)+ ; store sorl r1 > rptl ; do next block > jsr r5,dgetw ; get start address from jump block bit #1,(sp) ; start address odd? if eq,< jmp @(sp)+ ; no, jump to program > print ^"No start address " jmp boot .sbttl Program Dumping ; DUMP dumps the loaded program to the standard dump area. The format is ; the same used by LOAD. No symbols are dumped. dump: push r0,r1,r2 ; save regs mov firstp,r2 ; lowest address used by (relocated) BOOT clr -(r2) ; 6 bytes of zero to terminate dumping clr -(r2) ; ... clr -(r2) ; ... clr r0 ; ptr to 1st memory location br 2$ ; start scanning for nonzero location loop < mov r0,r1 ; save ptr to current address clrb (r2) ; this insures scan doesn't go beyond end 1$: .rept 5 tstb (r1)+ ; look for 5 or more zero bytes bne 1$ .endr sub r0,r1 ; calculate no. of bytes sub #5,r1 ; correct for 5 zero bytes push r1 ; DPUTW arg: word jsr r5,dputw ; write out byte count push r0 ; DPUTW arg: word jsr r5,dputw ; write out address loop < movb (r0)+,-(sp) ; DPUTB arg: byte jsr r5,dputb ; write out data byte sorl r1 > 2$: movb #-1,(r2) ; this insures scan for nonzero ends loop < tstb (r0)+ ; find nonzero byte rptl eq > dec r0 cmp r0,r2 ; this byte beyond dump range? rptl lo > mov #3,r0 ; no. of words to write loop < push #0 ; DPUTW arg: word jsr r5,dputw ; write 4 zero words (jump block + end of syms) sorl r0 > jsr r5,dclsw ; close write pop r2,r1,r0 ; restore regs rts r5 .sbttl Trap handling ; TRAP4 handles traps through vector 4, i.e. stack overflow and bus ; error traps. If caused by a bus error and a catch is set then it ; is thrown and the catch reset. trap4: mfps trapno ; save PS from trap vector (trap no in cc bits) cmp sp,#400 ; stack overflow? blo t1 inc trapno ; not stack overflow, set no. for bus error tst @#nxmcat ; NXM catch set? beq t1 mov @#nxmcat,(sp) ; yes, set PC to return to catch address clr @#nxmcat ; clear catch rti nxmcat==42 ; constant location so program can set ; Power fail trap handler. Simply restarts BOOT. powerf: add #boot-powerf,@#24 halt ; TRP determines which trap called it by examining the PS set from the ; trap vector and types an appropriate message on the TTY. trp: mfps trapno ; save PS from trap vector (trap no in cc bits) t1: mov (sp),trappc ; save PC of executing program mov 2(sp),trapps ; save PS of executing program mov sp,trapsp ; save SP of executing program mov pc,sp ; set stack ptr add #stack-.,sp ; ... print ^" Error; " push trapsp,r5,r4,r3,r2,r1,r0 ; push regs for typeout mov trapno,r1 ; find trap no. from cc bits of vector PS bic #177760,r1 ; ... asl r1 ; times 2 for wording add pc,r1 ; make ptr to trap description mov ttable-.(r1),r1 ; ... add pc,r1 ; ... t2: jsr r5,types ; type trap description print ^" trap. PC = " mov trappc,r1 ; TYPEO arg: word to type jsr r5,typeo ; type PC print ^", PS = " mov trapps,r1 ; TYPEO arg: word to type jsr r5,typeo ; type PS .if eq pdp11-10 cmp trapno,#pr7+7 ; Unexpected interrupt trap? if eq,< print ^", VECTOR = " mov @#177712,r1 ; R12 contains address of last vector used jsr r5,typeo ; type interrupt vector trapped through > .endc print ^" Registers:" mov #7.,r0 ; no. of words to type, R0-SP: 7 registers loop < print ^" " ; two spaces between values pop r1 ; get next register value jsr r5,typeo ; type reg sorl r0 > print ^" Dump? " jsr r5,readc ; ask user if he wants to dump corpse cmp r0,#'Y if eq,< .if eq sysdsk-drk push #5212 ; DOPENW arg: block no. .endc .if eq sysdsk-drl push #6560 ; DOPENW arg: block no. .endc jsr r5,dopenw ; open dump area for writing jsr r5,dump ; write out program > print ^" " jmp boot .macro t text .string ^"text",%.ttmp .word %.ttmp-t2 .endm ttable: t ^"Stack overflow" t ^"Bus error" t ^"Illegal instruction" t ^"BPT" t ^"IOT" t ^"EMT" t ^"TRAP" t ^"Interrupt" .sbttl TTY i/o ; READC reads and echos a character from the TTY. Lower case is ; converted to upper case. readc: jsr r5,ireadc ; read character jsr r5,itypec ; echo it cmp r0,#15 ; CR? if eq,< print ^" " ; echo as CRLF ( for padding) > cmp r0,#'a ; lower case letter? if his,< cmp r0,#'z if los,< sub #'a-'A,r0 ; convert to upper case > > rts r5 ; IREADC simply reads a character from the TTY. ireadc: tstb @#tks ; wait for char bpl ireadc ; ... movb @#tkb,r0 ; get char bic #177600,r0 rts r5 ; TYPEO types its argument as an octal no. on the TTY. No. in R1. typeo: push r0 ; save reg clr r0 sec ; so won't exit loop till after 6 digits br 1$ ; begin by shifting only 1 bit loop < rol r1 ; shift high three bits from R1 into R0 rol r0 rol r1 rol r0 1$: rol r1 exitl eq rol r0 add #'0,r0 ; convert to ascii digit jsr r5,itypec ; type digit clr r0 rptl > pop r0 ; restore reg rts r5 ; TYPESC types an asciz string on the TTY. A relative ptr to the ; string is passed following the call. typesc: push r1 ; save reg mov (r5)+,r1 ; relative ptr to asciz string add r5,r1 ; make absolute sub #2,r1 ; move back pointer?????? jsr r5,types ; type string pop r1 ; restore reg rts r5 ; TYPES types an asciz string on the TTY. Ptr to string in R1. types: push r0 ; save reg loop < movb (r1)+,r0 ; get character exitl eq ; null terminates jsr r5,itypec ; type char rptl > pop r0 ; restore reg rts r5 ; ITYPEC types a character on the TTY. Character in R0. itypec: tstb @#tps bpl itypec movb r0,@#tpb rts r5 constants memtop: .word 0 ; 1st NXM location firstp: .word 0 ; ptr to first location of (relocated) BOOT linbuf: .blkb 32. ; line buffer for reading program name nprog==30. pblock: .blkw nprog ; program block no.s names: .blkb 10.*nprog ; program names .word 0 ; terminator trapno: .word 0 ; PS set from vector (trap no. in cc bits) trapps: .word 0 ; PS of user program trappc: .word 0 ; PC of user program trapsp: .word 0 ; SP of user program .blkw 30. ; stack area stack==. .sbttl Disk boot ; Boot first disk block, start at xx7730 ; modified 24 Feb 1979 by CBF not to use 177706 as the SP address since ; that is 11/10 dependant. In order to avoid having the interrupt smash ; location 1000 (now used to set SP), we now loop for the done condition, ; then explicitely load up the PS, then the PC. ; Starts at DBOOT dboot1: .if eq sysdsk-drk loop < tstb @#177404 rptl pl > mtps @#222 mov @#220,pc .endc .if eq sysdsk-drl loop < tstb @#174400 rptl pl > mtps @#162 mov @#160,pc .endc dboot: reset mov #1000,sp .if eq sysdsk-drk mov #5,@#177404 .endc .if eq sysdsk-drl mov #174400,r0 ; get address of RLCSR 1$: tstb (r0) ; wait for controller to be ready bpl 1$ ; not ready yet mov #13,4(r0) ; set drive reset and clear error mov #4,(r0) ; get status command 2$: tstb (r0) ; wait for controller to be ready bpl 2$ ; not ready yet mov #25,4(r0) ; time to do a seek to the bottom track mov #6,(r0) ; perform the seek 3$: tstb (r0) ; wait for controller to be ready bpl 3$ ; not ready yet mov #177400,6(r0) ; word count for read (1 track,40 sector) mov #0,4(r0) ; read track 0,bottom of disk mov #14,(r0) ; execute a read function .endc br dboot1 ddump: spl 7 .if eq sysdsk-drk push #5212 jsr r5,dopenw jsr r5,dump loop < tstb @#177404 rptl pl > .endc .if eq sysdsk-drl push #6560 jsr r5,dopenw jsr r5,dump loop < tstb @#174400 rptl pl > halt .endc .blkb 140000-<137730+.-dboot> last==. .if p2 .print "DBOOT address = " typval \<140000-last+dboot> .print " " .print "DDUMP address = " typval \<140000-last+ddump> .print " " .endc .end go  ; SASTUF - Useful stuff for stand alone PDP11 programs -*-PALX-*- savn==%fnam2 ; Terminal type codes %tntt==1 ; TTY %tnsb==2 ; Stupid-Bee %tnvt==3 ; VT52 ; String output macros .macro print text jsr r5,typesc .string ^~text~ .endm .macro sout text jsr r5,itypes .string ^~text~ .endm .sbttl Initialization .=1000 go: mov #1000,sp ; set stack ptr reset ; send INIT on bus spl 0 ; priority 0 for normal operation mov #nxmt,@#4 mov #pr7,@#6 mov #24,r0 ; ptr to power fail vector mov pc,(r0) ; set to power fail handler add #powerf-.,(r0)+ ; ... mov #pr7,(r0)+ ; PS for good measure jsr r5,catchn ; setup catch for NXM 1$-. mov #20000,r5 ; Start from 4K loop < tst (r5) ; any core there? add #4000,r5 ; yes, go up 1K rptl > 1$: mov r5,memtop ; top location+2 (1st nxm) mov #60,r0 ; ptr to TTY interrupt vector mov pc,(r0) ; set rcvr interrupt PC add #tk1int-.,(r0)+ ; ... mov #pr4,(r0)+ ; set rcvr interrupt PS .if ne ndz mov #dzv,r0 ; ptr to DZ interrupt vector mov pc,(r0) ; set rcvr interrupt PC add #dzrint-.,(r0)+ ; ... mov #pr5,(r0)+ ; set rcvr interrupt PS .endc mov #-1,reread clr typein mov #100,@#tks ; turn on TTY input interrupts .if eq * .if ne ndz jsr r5,catchn ; setup NXM catch in case no DZ inittt-. mov #dzaddr,r4 ; DZ address mov #20,(r4) ; initialize DZ loop < bit #20,(r4) ; wait for done rptl ne > mov #dzlpar,r1 ; ptr DZ line parameter table mov #8.,r0 ; no. of entries loop < mov (r1)+,2(r4) ; set DZ line parameters sorl r0 > mov #177401,4(r4) ; set data term rdys, enable xmit on line 0 mov #40,(r4) ; enable receiver ; Check to see if either a VT52 or SB is connected to the DZ line 0. mov r4,isr ; set so DZ used for output sout ^"a" ; SB command to send back cursor address mov #77777,r0 ; no. of times to loop, about 1/3 sec loop < tstb (r4) ; loop, waiting for input bmi initsb sorl r0 > sout ^"Z" ; VT52 command to send back id mov #77777,r0 ; no. of times to loop, about 1/3 sec loop < tstb (r4) ; loop, waiting for input bmi initvt sorl r0 > mov #140,(r4) ; turn on rcvr interrupts br inittt ; neither VT52 or SB respond on DZ line 0 ; so use TTY ; Initialize for StupidBee initsb: mov #8.,r1 ; no. of chars to ignore jsr r5,ignore ; slurp up SB's cursor address (8 chars) mov r4,isr ; set to use SB mov #%tnsb,ttytyp ; set terminal type mov #80.,linel ; set line length mov #25.-1,pagel ; set page length sout ^"H 1 1 1 1 1 1 1 1 1H" ; set tabs and leave cursor home clr vpos ; set position to home clr hpos ; ... mov #140,(r4) ; turn on ints jmp start ; Initialize for using VT52 initvt: mov #3.,r1 ; no. of chars to ignore jsr r5,ignore ; slurp up VT52's identification (3 chars) mov r4,isr ; set to use VT52 mov #%tnvt,ttytyp ; set terminal type mov #80.,linel ; set line length mov #24.-1,pagel ; set page length sout ^"H" ; home up clr vpos ; set position to home clr hpos ; ... mov #140,(r4) ; turn on ints jmp start .endc ; ne ndz .endc ; eq sys-mit .if eq * ; Initialize for using TTY inittt: mov #tks,isr ; set to use TTY mov #%tntt,ttytyp ; set terminal type mov #132.,linel ; set line length print ^" " ; CRLF jmp start .endc .if eq sys-sao ; Initialize for using VT52 initvt: mov #tks,isr ; set to use VT52 mov #%tnvt,ttytyp ; set terminal type mov #80.,linel ; set line length mov #24.-1,pagel ; set page length sout ^"H" ; home up clr vpos ; set position to home clr hpos ; ... jmp start .endc ; IGNORE throws away the next few characters of input from DZ11. ; R1 contains no. of chars to ignore. ignore: tstb (r4) ; wait for next character to come in bpl ignore movb 2(r4),r0 ; read next char sob r1,ignore rts r5 ; Power fail handler. powerf: add #poweru-powerf,@#24 ; Setup for powerup trap halt ; Power up handler. poweru: add #powerf-poweru,@#24 ; setup for another power fail jmp go nxmt: mov @#nxmcat,(sp) rti ; CATCHN is called to setup for an expected nxm trap. ; When the nxm trap occurs control will be passed to address ; specified by a relative ptr after the call. catchn: mov r5,@#nxmcat ; set catch for address specified add (r5)+,@#nxmcat ; by relative ptr after call rts r5 nxmcat==42 .sbttl Numeric input/output ; OCTAL types R0 as an octal no. octal: push r1 ; save reg mov r0,r1 ; put no. in r1 clr r0 sec ; so won't exit loop till after 6 digits br 1$ loop < rol r1 ; shift three binary bits from R1 into R0 rol r0 rol r1 rol r0 1$: rol r1 exitl eq rol r0 add #'0,r0 ; make digit ascii jsr r5,typec ; type it clr r0 rptl > pop r1 ; restore reg rts r5 ; OCTALS types R0 as an octal no. with leading zeros suppressed octals: push r0 ; save no. clc ; shift out lowest digit ror r0 ; ... asr r0 ; ... asr r0 ; ... if ne,< jsr r5,octals ; type leading digits first > pop r0 ; restore no. bic #177770,r0 ; get lowest octal digit add #'0,r0 ; convert to ascii jsr r5,typec ; type digit rts r5 ; RNUMBR takes numberic input from the terminal. The no. is returned in R0. ; If followed by "." the no. is decimal, otherwise octal. rnumbr: push r1,r2 ; save reg clr r1 ; octal accumulator clr r2 ; decimal accumulator loop < jsr r5,readc cmp r0,#'0 ; check if numeric exitl lo cmp r0,#'9 exitl hi sub #'0,r0 ; convert to ascii ash #3,r1 ; multiply by 8. asl r2 ; multiply by 10. mov r2,-(sp) ; ... ash #2,r2 ; ... add (sp)+,r2 ; ... add r0,r1 ; add to octal no. add r0,r2 ; add to decimal no. rptl > cmp r0,#'. ; terminator "."? if eq,< mov r2,r0 ; yes, decimal > else < mov r0,reread ; otherwise reread terminator mov r1,r0 ; and use octal no. > pop r2,r1 ; restore regs rts r5 .sbttl Terminal input ; READC gets next character and does input processing and echoing. readc: mov reread,r0 ; character to be reread? if mi,< jsr r5,ireadc ; get character cmp r0,#21 ; ^Q? beq 2$ cmp r0,#23 ; ^S beq 2$ cmp r0,#12 ; LF? beq 1$ cmp r0,#15 ; CR? if eq,< 1$: print ^" " ; type CRLF for CR > else < jsr r5,typec ; echo the character > cmp r0,#'a ; lower case? if his,< cmp r0,#'z if los,< sub #'a-'A,r0 ; convert to upper case > > > 2$: mov #-1,reread ; no character to reread rts r5 ; IREADC gets next character typed on terminal into R0. ireadc: loop < spl 4 ; set priority 4 to test flag tst typein ; character in yet? exitl ne push #0 ; PS for RTI jsr pc,1$ ; put PC on stack for RTI wait ; wait for an interrupt to occur rptl 1$: rtt ; set PR0 and execute WAIT without interrupt > mov inchar,r0 ; get character typed clr typein ; clear typein flag spl 0 ; lower priority rts r5 ; Terminal input interrupts ; TTY rcvr interrupts tk1int: movb @#tkb,inchar ; get character mov #tks,isr ; output to TTY now br tkint .if ne ndz ; DZ11 rcvr interrupts dzrint: push r1,r4 ; save regs mov #dzaddr,r4 ; DZ11 address loop < mov 2(r4),r1 ; get character exitl pl movb r1,inchar ; save swab r1 ; get line no. bic #177770,r1 ; ... movb bits(r1),4(r4) ; enable corresponding output line rptl > mov r4,isr ; output to DZ now pop r4,r1 ; restore regs br tkint .endc tkint: bic #177600,inchar ; clear random bits cmp inchar,#7 ; ^G? if eq,< jmp go ; restart program on ^G > cmp inchar,#5 ; ^E? if eq,< mov pc,silent ; silence output > cmp inchar,#23 ; ^S? if eq,< mov pc,xonxof ; no output until ^Q br 1$ > cmp inchar,#21 ; ^Q? if eq,< clr xonxof ; no output until ^S br 1$ > mov #-1,typein ; indicate there is typein 1$: rti .sbttl Terminal output ; TYPESC takes a relative ptr to an asciz string after the JSR R5,TYPES ; and types the string typesc: push r0,r1 ; save regs mov r5,r1 ; relative ptr to asciz string add (r5)+,r1 ; make absolute loop < movb (r1)+,r0 ; next char exitl eq ; null terminates jsr r5,typec ; output char rptl > pop r1,r0 ; restore regs rts r5 ; TYPES takes a ptr to an asciz string in R1 and types the string. types: push r0 ; save reg loop < movb (r1)+,r0 ; next char exitl eq ; null terminates jsr r5,typec ; output char rptl > pop r0 ; restore reg rts r5 ; TYPEC types character in R0. Extensive output processing is done. typec: push r0,r1 ; save regs tst silent ; output suppressed? bne tyr 1$: tst xonxof ; waiting for a ^Q bne 1$ ; keep waiting cmpb r0,#11 ; TAB? beq tytab cmpb r0,#12 ; LF? beq tylf cmpb r0,#15 ; CR? beq tycr cmpb r0,#7 ; BELL? beq tyt cmpb r0,#177 ; RUBOUT? beq tyt cmpb r0,#' ; clear screen? beq tyclr cmpb r0,#' ; ignore ^S beq tyr cmp r0,#40 if lo,< sout ^"^" inc hpos bis #100,r0 > inc hpos ; keep track of horizontal pos tyt: jsr r5,itypec ; type it tyr: pop r1,r0 ; restore regs rts r5 tycr: jsr r5,itypec ; type CR clr hpos ; update position br tyr tylf: cmp ttytyp,#%tntt ; TTY or display? if eq,< jsr r5,itypec ; TTY, just send LF br tyr > inc vpos ; move to next line cmp vpos,pagel ; beyond end of page? if hi,< sout ^"H" ; yes, wrap to top line clr vpos ; keep track of position > else < jsr r5,itypec > sout ^"K" ; erase line cmp vpos,pagel ; on last line? blo tyr tst more ; do --More-- processing? beq tyr print ^"--More--" ; prompt jsr r5,readc ; read char, space = yes, rubout = no sout ^"HK" clr hpos clr vpos cmpb r0,#40 if ne,< mov pc,silent ; stop output cmpb r0,#15 ; carriage-return? if eq,< mov #-1,reread ; don't reread character > else < mov r0,reread ; else reread character > > br tyr tytab: cmp ttytyp,#%tntt ; TTY? if ne,< jsr r5,itypec ; not tty, just output a tab add #8.,hpos bic #7,hpos br tyr > movb #40,r0 ; on TTY simulate with spaces loop < jsr r5,itypec inc hpos bit #7,hpos rptl ne > br tyr tyclr: cmp ttytyp,#%tntt ; TTY? if ne,< sout ^"HJ" ; not tty, HOME and then EOS clr hpos clr vpos > else < print ^" " ; TTY, CRLF > br tyr ; ITYPES takes a relative ptr to an asciz string after the JSR R5,ITYPES ; and image types the string. itypes: push r0,r1 ; save regs mov r5,r1 ; relative ptr to asciz string add (r5)+,r1 ; make absolute loop < movb (r1)+,r0 ; next char exitl eq ; null terminates jsr r5,itypec ; output rptl > pop r1,r0 ; restore regs rts r5 ; ITYPEC takes a character in R0 and image types it (i.e. does not ; do any output conversions or update cursor position). itypec: push r1 ; save reg mov isr,r1 ; get terminal address cmp isr,#dzaddr ; DZ11? if eq,< loop < tst (r1) ; wait for xmtr ready rptl pl > > else < loop < tstb 4(r1) ; wait for printer ready rptl pl > > movb r0,6(r1) ; send char pop r1 ; restore reg rts r5 .sbttl Data memtop: .word 0 ; first nxm location silent: .word 0 ; silence output flag xonxof: .word 0 ; non-zero if waiting for ^Q more: .word 0 ; do --More-- processing flag ttytyp: .word 0 ; terminal type isr: .word 0 ; address of output device linel: .word 0 ; line length pagel: .word 0 ; page length hpos: .word 0 ; horizontal position vpos: .word 0 ; vertical position reread: .word 0 ; character to be reread typein: .word 0 ; typein flag inchar: .word 0 ; interrupt char ; patch area patch: pat: .blkw 100 }; -*-PALX-*- .sbttl Disk i/o .iif ndf asmpr, asmpr==0 ; assume we can't print if we don't know how .if eq sysdsk-drk lblk==512. ; no. of bytes per sector nsecto==12. ; no. of sectors per track ntrack==406. ; no. of tracks per disk .endc .if eq sysdsk-drl lblk==256. ; no. of bytes per sector nsecto==40. ; no. of sectors per track ntrack==256. ; no. of tracks per disk .endc .if ne nrx lblk==128. ; no. of bytes per sector nsecto==26. ; no. of sectors per track ntrack==77. ; no. of tracks per disk .endc ; DOPENR sets up for reading from disk. dopenr: mov 2(sp),dblock ; set block no. to first block to read clr dbufc ; no characters in buffer yet pop (sp) ; remove arg from stack rts r5 ; DOPENW sets up for writing to disk. dopenw: mov 2(sp),dblock ; set block no. to first block to write mov #lblk,dbufc ; room for 512 (or 256) characters in block mov pc,-(sp) ; set DBUFP to DBUF add #dbuf-.,(sp) ; ... mov (sp)+,dbufp ; ... pop (sp) ; remove arg from stack rts r5 ; DCLSW finishes up writing to the disk. dclsw: cmp dbufc,#lblk ; something in buffer? if ne,< loop < clrb @dbufp ; clear remainder of buffer inc dbufp dec dbufc rptl ne > push dblock ; DKWRIT arg: block no. jsr r5,dkwrit ; write out block > rts r5 ; DGETW reads a word from the disk. dgetw: push (sp) ; make room for return val jsr r5,dgetb ; read low byte movb (sp)+,2(sp) jsr r5,dgetb ; read high byte movb (sp)+,3(sp) rts r5 ; DGETB reads a byte from the disk. dgetb: push (sp) ; make room for return val dec dbufc ; characters left to read in this block? if mi,< ; none left, read next block push dblock ; DKREAD args: block no. jsr r5,dkread ; read block inc dblock ; increment block no. mov #lblk-1,dbufc ; 511 (or 255) bytes left to read mov pc,-(sp) ; set DBUFP to DBUF add #dbuf-.,(sp) ; ... mov (sp)+,dbufp ; ... > clr 2(sp) ; so high byte will be zero movb @dbufp,2(sp) ; get character inc dbufp ; move ptr to next rts r5 ; DPUTW writes a word to the disk. dputw: push 2(sp) ; DPUTB arg: byte jsr r5,dputb ; write low byte swab 2(sp) ; switch bytes and fall through ; to write high byte ; DPUTB writes one byte to the disk. dputb: movb 2(sp),@dbufp ; store character in buffer inc dbufp ; move ptr to next character slot dec dbufc ; buffer filled? if eq,< ; yes, write it out push dblock ; DKWRIT args: block no. jsr r5,dkwrit ; write out this block inc dblock ; increment block no. mov #lblk,dbufc ; room for 512 (or 256) more characters sub #lblk,dbufp ; set DBUFP to DBUF > pop (sp) ; remove arg from stack rts r5 .if eq sysdsk-drk dkread: push (sp) mov #5,2(sp) br rkrw dkwrit: push (sp) mov #3,2(sp) br rkrw .endc .if eq sysdsk-drl dkread: push (sp) mov #14,2(sp) br rlrw dkwrit: push (sp) mov #12,2(sp) br rlrw .endc .if ne nrx dkread: br rxread dkwrit: br rxwrit .endc .sbttl RL11 read/write ; RLRW ; ; ARGS: VALS: ; SP ->op code (none) ; block number .if eq sysdsk-drl rlrw: jsr r5,save6 ; save registers mov 20(sp),r1 ; get block number clr r0 ; clear track counter mov #40.,r2 ; there are 40. blocks per track div r2,r0 ; get number of tracks in r0 ash #6,r0 ; mov into place for Cylinder address bis r1,r0 ; merge sector (in r1) with track mov r0,20(sp) ; save converted disk address mov pc,r1 ; pointer to DBUF add #dbuf-.,r1 ; ... mov #7,r4 ; number of times to try recoverable errors ; ; reset the drive ; loop < mov #rlcsr,r5 ; get address of CSR mov #13,4(r5) ; do a get status/reset drive mov #4,(r5) ; perform function loop < tstb (r5) ; has drive finished yet?? rptl pl ; no yet > tst (r5) ; check for errors bmi rlerr ; go handle them jsr pc,rlseek ; seek to the right track ; Now we can finally do the read/write operation!!!!!!!!! mov #-,6(r5) ; set word count mov r1,2(r5) ; set bus address mov 20(sp),4(r5) ; set disk address mov 16(sp),(r5) ; perform function loop < tstb (r5) ; is the controller finished??? rptl pl ; not yet if plus > tst (r5) ; test for errors exitl pl ; no error, we're through bit #140000,(r5) ; see if a disk error bne rlerr ; check out disk errors sorl r4 ; try a few more times br rlerr > jsr r5,rest6 ; restore registers pop (sp),(sp) ; remove args from stack rts r5 ; perform a seek on the disk to the right track rlseek: push r0,r1,r2 ; save registers mov #10,(r5) ; execute read headers function loop < tstb (r5) ; has drive finished yet???? rptl pl ; not yet > mov 6(r5),r0 ; get current disk address mov 20+10(sp),r1 ; get desired disk address bic #77,r1 ; clear sector bits bic #177,r0 ; clear sector and surface bits mov r1,r2 ; copy desired disk address bic #177677,r2 ; isolate surface bit ash #-2,r2 ; position it for difference word in seek bic #100,r1 ; remove surface bit sub r1,r0 ; find difference word for seek operation bcc 1$ ; if CC actual >= desired position neg r0 ; make positive difference bis #4,r0 ; set bit to indicate move towards disk center 1$: inc r0 ; set marker bit bis r2,r0 ; merge in surface bit mov r0,4(r5) ; put difference word into RLDAR mov #6,(r5) ; perform a seek function loop < tstb (r5) ; has controller finished rptl pl ; not yet > pop r2,r1,r0 ; restore registers rts pc ; perform error checking on the disk drive rlerr: .if ne asmpr print ^" RL01 disk error -- operation aborted " .endc jmp dskerr .endc ;eq sysdsk-drl ; RKRW performs disk transfers of one sector. It takes two args: ; the block no. and operation code (3 for write, 5 for read). ; ARGS: VALS: ; SP -> op code (none) ; block no. .if eq sysdsk-drk rkrw: jsr r5,save6 ; save regs clr r0 ; divide block no. by 12 mov 20(sp),r1 ; ... div #12.,r0 ; ... ash #4,r0 ; multiply quotient by 16 add r1,r0 ; add remainder to get DAR bis rknum,r0 ; put in disk no. mov pc,r1 ; ptr to DBUF add #dbuf-.,r1 ; ... mov #7,r5 ; no. of times to retry recoverable errors loop < mov #rkcsr,r4 ; ptr to RKCSR mov #1,(r4) ; controller reset loop < tstb (r4) ; wait for done rptl pl > mov #rkdar+2,r4 ; ptr to RKDAR + 2 mov r0,-(r4) ; set RKDAR mov r1,-(r4) ; set RKBAR mov #-,-(r4) ; set RKWCR mov 16(sp),-(r4) ; set RKCSR, i.e. perform operation loop < tstb (r4) ; wait for done rptl pl > tst (r4) ; errors? exitl pl bit #166340,-(r4) ; recoverable error? if eq,< sorl r5 ; yes, try a few times > .if ne asmpr print ^" Disk Error -- operation aborted " .endc jmp dskerr > jsr r5,rest6 ; restore regs pop (sp),(sp) ; remove args from stack rts r5 rknum: .word 0 ; Using disk number zero because ; disk no. 1 (fixed) is not formatted .endc .sbttl RX11 read/write .if ne nrx ; RXREAD ; ARGS: VALS: ; SP -> block no. (none) rxread: push r0,r1,r2 ; save regs mov #rxcs,r0 ; get bus address of RX11 controller push 10(sp),#7 ; RXRW args: block no., op code bis rxnum,(sp) ; yes, set unit select in op code jsr r5,rxrw ; initiate read loop < bit #40,(r0) ; wait for Done rptl eq > tst (r0) ; Error? bmi rxer mov #10,r2 ; no. of times to retry parity errors in Empty loop < mov #3,(r0) ; send Empty command mov pc,r1 ; ptr to buffer add #dbuf-.,r1 ; ... loop < bitb #240,(r0) ; test Transfer Request and Done bits rptl eq ; wait for one to set exitl pl ; Done? movb 2(r0),(r1)+ ; no, Transfer Request, copy data byte rptl > tst (r0) ; Error (parity error in transfer from buffer)? exitl pl sorl r2 ; retry Empty operation br rxer > pop r2,r1,r0,(sp) ; restore regs, remove arg from stack rts r5 ; RXWRIT writes a block on the floppy. ; ARGS: VALS: ; SP -> block no. (none) rxwrit: push r0,r1,r2 ; save regs mov #rxcs,r0 ; get bus address of RX11 controller mov #10,r2 ; no. of times to retry parity errors in Fill loop < mov #1,(r0) ; send Fill command mov pc,r1 ; get ptr to buffer add #dbuf-.,r1 ; ... loop < bitb #240,(r0) ; test Transfer Request and Done bits rptl eq exitl pl ; Done? movb (r1)+,2(r0) ; no, Transfer Request, load data byte rptl > tst (r0) ; Error (parity error in transfer to buffer)? exitl pl sorl r3 ; retry Fill br rxer > push 10(sp),#5 ; RXRW args: block no., op code bis rxnum,(sp) ; yes, set unit select in op code jsr r5,rxrw ; initiate write loop < bit #40,(r0) ; wait for Done rptl eq > tst (r0) ; Error? bmi rxer pop r2,r1,r0,(sp) ; restore regs, remove arg from stack rts r5 ; RXRW issues a read or write command to the RX11. If writing, the RX11 ; buffer should already be filled with the stuff to be written. If reading ; the RX11 buffer should be emptied afterward. RXRW does not wait for the ; read or write operation to complete. ; ARGS: VALS: ; SP -> op code (none) ; block no. rxrw: push r2,r3 ; save regs clr r2 ; divide block no. by 26 to get track mov 10(sp),r3 ; and sector addresses div #nsecto,r2 ; perform the division asl r3 cmp r3,#nsecto if his,< sub #nsecto-1,r3 > inc r3 ; make sector address one based loop < bit #40,(r0) ; wait for Done rptl eq > mov 6(sp),(r0) ; send read or write command loop < tstb (r0) ; wait for Transfer Request rptl pl > mov r3,2(r0) ; send Sector address loop < tstb (r0) ; wait for Transfer Request rptl pl > mov r2,2(r0) ; send Track address pop r3,r2,(sp),(sp) ; restore regs, remove args from stack rts r5 rxer: mov @#rxdb,r0 bit #1,r0 if ne,< .if ne asmpr print ^" CRC error detected reading diskette." .endc > bit #2,r0 if ne,< .if ne asmpr print ^" Parity error detected on command or address data being transfered to RX01." .endc > .if ne asmpr jmp dskerr .iff pop r2,r1,r0,(sp) rts r5 .endc rxnum: .word 0 ; disk no. .endc ; ne nrx dbuf: .blkb lblk ; disk sector buffer dblock: .word 0 ; block no. for next disk i/o dbufp: .word 0 ; ptr to next byte in disk buffer to read/write dbufc: .word 0 ; read: no. of characters remaining in buffer ; write: room left in buffer