.title minprm .sbttl start ;+ ; initialization routine for the software tools runtime system ;- ap=%5 blank=40 ; ascii for BLANK .mcall exst$s,alun$s,srda$s,fdof$l,wtse$s,gtsk$s fdof$l .psect $r.rod,con,ro,rel,lcl,d .enabl lc fmttsk: .asciz "%2r" errmsg: .asciz "Cannot open ERROUT." felmsg: .asciz "felled." .even .dsabl lc .psect $r.roi,con,ro,rel,lcl,i .enabl lsb initst:: initr4:: sub #32.,sp ; make room for gtsk buffer on stack mov sp,r0 ; save address gtsk$s r0 ; get task parameters mov g.tsts(r0),r$enda ; save last virtual address mov r0,-(sp) ; set up call to sprint mov #fmttsk,-(sp) ; ... mov #r$tknm,-(sp) ; ... clr -(sp) ; ... mov sp,ap ; ... call sprint ; format task name into r$tknm add #40.,sp ; restore stack mov #r$dbst,r5 ; start of pointer array clr r2 ; lun 0 10$: cmp r5,#r$dbnd ; done? beq 20$ ; YES inc r2 ; next lun value call $fchnl ; get FFDB address in r0 bcs 20$ ; c set => invalid lun add #d.fdb,r0 ; now have FDB address mov (r5)+,r1 ; RFDB address mov r0,r.fdb(r1) ; store away FDB address movb r2,r.lun(r1) ; and lun br 10$ 20$: mov r2,r$endl ; save lun for later call r$gefn ; get a free event flag mov r0,r$ioef ; store it for use in qio's call r$gefn ; get a free event flag mov r0,r$spef ; store it for use in spwn calls srda$s #rcdast ; establish receive data AST call makarg ; get arguments call ttyatt ; attach terminal for ^O mov r$erdb,r1 ; ERROUT RFDB address mov #r$erac,-(sp) ; address of ERROUT access mov r$erfl,-(sp) ; address of ERROUT file spec clr -(sp) ; dummy # of arguments mov sp,ap ; place address in arg pointer call r$cref ; open the file bcs baderr ; cannot open ERROUT mov r$indb,r1 ; STDIN RFDB address mov r$infl,2(ap) ; address of STDIN filespec mov #r$inac,4(ap) ; address of STDIN access call r$opnf ; open the file bcs nbderr ; cannot open STDIN mov r$oudb,r1 ; STDOUT RFDB address mov r$oufl,2(ap) ; address of STDOUT filespec mov #r$ouac,4(ap) ; address of STDOUT access call r$cref ; create the file bcs nbderr ; cannot open STDOUT add #6,sp ; restore stack return ; ; ; endst:: endr4:: r$exit:: tstb r$fgpc ; foreground process active? beq 25$ ; NO mov #r$fgpc,r0 ; address of pid call r$kill ; kill the bugger wtse$s r$spef ; wait for it to die 25$: mov #r$dbst,r4 ; start of array of pointers 30$: cmp r4,#r$dbnd ; done? beq 40$ ; YES mov (r4)+,r1 ; get RFDB address into r1 call r$clsf ; close the file if open br 30$ ; go again 40$: mov #ex$suc,r0 ; assume successful exit tst (ap) ; called with any arguments? beq 50$ ; NO, exit cmp @2(ap),#ok ; endst(OK)? beq 50$ ; YES cmp @2(ap),#err ; endst(ERR) beq 45$ ; YES mov #felmsg,r0 ; address of felled message call r$ermo ; output to user's terminal 45$: mov #ex$sev,r0 ; severe error 50$: exst$s r0 ; exit to RSX/IAS ; ; receive data AST address ; rcdast: mov #eof,-(sp) ; endst(EOF) mov sp,r0 ; address of EOF mov r0,-(sp) ; in call block mov #1,-(sp) ; one arg mov sp,ap ; ... jmp r$exit ; exit baderr: mov #errmsg,r0 ; address of error message call r$ermo ; output to user's terminal br 45$ ; exit nbderr: call cant ; cannot open file .page .sbttl alun ;+ ; dsw = alun(lun, dev, unit) ;- lun=2 dev=4 unit=6 ap=%5 ; ; .mcall alun$s .psect $r.roi,con,ro,rel,lcl,i .enabl lsb alun:: mov dev(ap),r0 ; address of device string movb (r0)+,-(sp) ; copy to stack movb (r0),1(sp) ; copy to stack mov (sp)+,r1 ; place in register bic #<40+<40*256.>>,r1 ; make upper case alun$s @lun(ap),r1,@unit(ap) ; assign lun mov @#$dsw,r0 ; return DSW return .page .sbttl cant ;+ ; subroutine cant(file) ;- ap=%5 buf=2 .psect $r.rod,con,ro,rel,lcl,d .enabl lc cbuf: .asciz " - cannot open."<12> .dsabl lc .even .psect $r.roi,con,ro,rel,lcl,i .enabl lsb cant:: mov r$erdb,r1 ; ERROUT RFDB address call r$lput ; output the file spec mov #cbuf,-(sp) ; place address in call block clr -(sp) ; dummy arg count mov sp,ap ; place in arg pointer call r$lput ; output the line cmp (sp)+,(sp)+ ; clean stack mov #err,-(sp) ; endst(ERR) mov sp,r0 ; address of ERR mov r0,-(sp) ; in call block mov #1,-(sp) ; one arg mov sp,ap ; set up arg ptr jmp r$exit ; done .page .sbttl close ;+ ; call close(int) ; ; closes the file, flushing the last record if opened for output ;- ap=%5 int=2 ; ; .mcall close$ ; ; .psect $r.roi,con,ro,rel,lcl,i .enabl lsb close:: mov @int(ap),r0 ; rat4 unit number call r$gfbk ; get RFDB address in r1 bcs 100$ ; c set => invalid unit number r$clsf:: bit #rf.clo,(r1) ; is the file opened? bne 100$ ; NO, nothing to do bit #rf.mod,(r1) ; output mode? bne 10$ ; NO tst r.byte(r1) ; any bytes left to flush? beq 10$ ; NO movb #newlin,r3 ; place NEWLINE character in register call r$cput ; flush the buffer 10$: mov r.fdb(r1),r0 ; FDB address in r0 close$ ; close the file mov #rf.clo,(r1) ; mark the file as closed 100$: return .page .sbttl create ;+ ; int = create(ext, access) ; ; creates a file specified by ext at access ; if the file exists, open it. otherwise create it ; ; if error occurs, returns ERR ;- ap=%5 ext=2 access=4 ; ; .psect $r.roi,con,ro,rel,lcl,i .enabl lsb create:: call r$gffb ; get a free RFDB address in r1 bcs 100$ ; c set => error r$cref:: bic #rf.old,(r1) ; wish to create a file call r$opfl ; general open file routine return 100$: mov #err,r0 ; return ERR return .page .sbttl ctoo ;+ ; integer function ctoo(buf) ;- ap=%5 buf=2 .psect $r.roi,con,ro,rel,lcl,i .enabl lsb ctoo:: mov buf(ap),r0 ; buffer address call $cotb ; convert to binary mov r1,r0 ; return binary number return .page .sbttl efnsub ;+ ; this pair of routines implement the following fortran interfaces ; ; integer function getefn() ; subroutine putefn(event_flag) ; ; they permit the programmer to request free event flags and to ; return them when he is done with them. The domain of these ; routines is the set of local event flags 1. -> 24. ; flags 25. -> 32. are listed as reserved for DEC use. ;- ap=%5 efn=2 err=-3 ; error return if no flags available ; ; global data ; bits set in these masks indicate flags which are in use ; .psect $r.rwd,con,rw,rel,lcl,d low: .word 0 ; flags 1. -> 16. high: .word 0 ; flags 17. -> 24. ; ; efn = getefn() ; .psect $r.roi,con,ro,rel,lcl,i .enabl lsb getefn:: r$gefn:: mov #1,r0 ; starting efn number mov #16.,r1 ; limit for first pass mov #low,r2 ; address of efn mask call getbit ; get a free efn bcc 10$ ; c clear => success mov #24.,r1 ; limit for second pass mov #high,r2 ; address of efn mask call getbit ; get a free efn bcc 10$ ; c clear => success mov #err,r0 ; return ERR 10$: return ; ; subroutine getbit ; ; inputs: ; r0 starting EFN number ; r1 limit EFN ; r2 address of relevant EFN mask ; ; outputs: ; r0 EFN to return, if success - next EFN to try if not ; r1 unchanged ; r2 unchanged ; c bit set if error ; c bit clear if successful ; getbit: mov r3,-(sp) ; save r3 mov #1,r3 ; initialize bit mask 90$: cmp r0,r1 ; see if limit exceeded bgt 110$ ; if r0 > r1, YES bit r3,(r2) ; is the bit set? beq 100$ ; if == 0, NO - done clc ; clear c bit rol r3 ; rotate mask bit one left inc r0 ; next event flag number br 90$ ; try next bit 100$: bis r3,(r2) ; set bit to indicate allocation clc ; c clear => success br 120$ 110$: sec ; c set => failure 120$: mov (sp)+,r3 ; restore r3 return ; ; subroutine putefn(efn) ; putefn:: mov @efn(ap),r0 ; get EFN to return r$pefn:: tst r0 ; test value of efn ble 50$ ; if <= 0, invalid EFN cmp r0,#24. ; see if too large bgt 50$ ; if >, invalid EFN mov #low,r1 ; assume EFN <= 16. cmp r0,#16. ; is this true? ble 20$ ; YES sub #16.,r0 ; correct for high mask numbers mov #high,r1 ; address of mask 20$: mov #1,r2 ; initialize bit mask 30$: dec r0 ; subtract 1 from counter beq 40$ ; if == 0, have correct mask bit in r2 clc ; clear c bit rol r2 ; shift one bit left br 30$ ; try again 40$: bic r2,(r1) ; clear bit to indicate that it is free 50$: return .page .sbttl r$gfbk - get ratfor file descriptor block ;+ ; call r$gfbk ; ; inputs: ; r0 rat4 unit number ; ; outputs: ; r0 unchanged ; r1 address of RFDB ; c bit set if error ; clear is success ;- .psect $r.roi,con,ro,rel,lcl,i .enabl lsb r$gfbk:: mov r0,-(sp) ; save r0 mov #r$dbst,r0 ; start of pointer array 10$: cmp r0,#r$dbnd ; done? beq 20$ ; YES mov (r0)+,r1 ; get address of RFDB cmpb (sp),r.lun(r1) ; is this the correct lun? bne 10$ ; NO clc ; c clear => success call valbuf ; assure valid buffer br 30$ ; return 20$: sec ; c set => failure 30$: mov (sp)+,r0 ; restore register return .page .sbttl r$gffb - get a free RFDB for use ;+ ; this routine scans the list of RFDB's for one that is not in use ; if successful, the RFDB address is returned in r1 ; ; outputs: ; r1 RFDB address ; c bit set if none are available ; c bit clear if successful ;- .psect $r.roi,con,ro,rel,lcl,i .enabl lsb r$gffb:: mov #r$dbst,r0 ; address of pointer array 10$: cmp r0,#r$dbnd ; at end of list? beq 20$ ; YES, error mov (r0)+,r1 ; get RFDB address bit #rf.clo,(r1) ; file open? beq 10$ ; YES, try next RFDB clc ; clear c bit for success call valbuf ; assure valid buffer br 30$ 20$: sec 30$: return .page .sbttl valbuf - validate buffer, and obtain one if not there ;+ ; routine to extend task to obtain a buffer if one is not ; already allocated ; ; inputs: ; r1 RFDB address ; ; outputs: ; r0 mangled ; r1 the same ; c bit set if error extending task ; c bit clear if successful ;- .mcall extk$s .psect $r.rod,con,ro,rel,lcl,d .enabl lc extmsg: .asciz "error extending task." .dsabl lc .even .psect $r.roi,con,ro,rel,lcl,i .enabl lsb valbuf: tst r.buf0(r1) ; buffer allocated yet? bne 10$ ; YES extk$s #10 ; extend task by 512. bytes bcc 5$ ; c clear => success mov #extmsg,r0 ; address of error message call r$ermo ; notify user sec ; c set => error br 10$ 5$: mov r$enda,r.buf0(r1) ; store buffer address mov r.buf0(r1),r.bufp(r1) ; initialize buffer pointer add #1000,r$enda ; update task's last address clc ; clear c bit 10$: return .page .sbttl gmcrst ; ; this routine is called by the runtime initialization routine ; to get the calling command line. First, an attempt is made to ; retrieve a record from the device SR0:, where the command lines ; from a software tools spawn directive will reside. Failing this, ; a GMCR call is made to retrieve a command line from MCR. ; If this too fails, the user is prompted at the terminal for ; the remainder of the arguments with a prompt of the form ; ; args? ; ; inputs: ; r0 258. byte buffer for GMCR and read ; r1 lun to use in read to SR0: ; ; outputs: ; c clear successfully retrieved command line into buffer ; c set no command line found anywhere ; all registers remain the same ; ; ; ; macro calls ; .mcall alun$s,qiow$s ; ; ; defined symbols ; cr=15 ; carriage return ; ; ; .psect $r.rod,con,ro,rel,lcl,d .enabl lc psta: .ascii "args? " pstl=.-psta .even .dsabl lc .psect $r.roi,con,ro,rel,lcl,i .enabl lsb gmcrst:: call r$savr ; save registers tst (r0)+ ; bump address to data area call r$garg ; get args in the tools way bcc 30$ ; c clear => successful 10$: mov (pc)+,-(r0) ; place emt code in buffer .byte 127.,41. ; codes for GMCR mov r0,-(sp) ; place DPB address on stack emt 377 ; go do it bcs 20$ ; c set => error mov @#$dsw,r$iosb+2 ; place count in local var tst (r0)+ ; point at first character br 30$ ; go finish up 20$: mov #2,r$iosb+2 ; initialize to dummy count tst (r0)+ ; bump to data area movb #'*,(r0)+ ; copy dummy image name movb #' ,(r0)+ ; ... alun$s r1,#"TI,#0 ; assign lun to TI: bcs 30$ ; c set -> error qiow$s #io.rpr,r1,r$ioef,,#r$iosb,, bcc 30$ ; c clear => OK mov #2,r$iosb+2 ; dummy count 30$: add r$iosb+2,r0 ; point at terminator loc movb #cr,(r0) ; place terminator in buffer clc ; clear c bit for sure 40$: return .page .sbttl gtddir ;+ ; implements the following fortran subroutine call ; ; call gtddir(buf, type) ; ap=%5 buf=2 type=4 .psect $r.roi,con,ro,rel,lcl,i .enabl lsb gtddir:: cmp #path,@type(ap) ; PATH? bne 1$ ; NO mov #r$ddir,r0 ; address of def dir br 2$ 1$: mov #r$duic,r0 ; address of def uic string 2$: tstb (r0) ; anything in string? bne 10$ ; YES mov r0,-(sp) ; save buffer address call .rdfui ; read default UIC mov r1,r3 ; need it in r3 for .ppasc mov (sp),r2 ; destination address clr r4 ; separators and no leading zeroes call .ppasc ; format UIC clrb (r2) ; terminate with EOS mov (sp)+,r0 ; restore source address 10$: mov buf(ap),r1 ; destination address 20$: movb (r0)+,(r1)+ ; copy character bne 20$ ; if not EOS, do next char return .page .sbttl jcopys ;+ ; subroutine jcopys(in, i, c, out) ;- ap=%5 in=2 i=4 c=6 out=10 .psect $r.roi,con,ro,rel,lcl,i .enabl lsb jcopys:: mov in(ap),r0 ; address of in(1) mov i(ap),r2 ; address of i dec (r2) ; decrement i add (r2),r0 ; address of in(i) mov out(ap),r1 ; address of out(1) movb @c(ap),r3 ; terminating character 10$: inc (r2) ; increment i movb (r0),(r1)+ ; copy character beq 20$ ; if == 0, done cmpb (r0)+,r3 ; terminating character? bne 10$ ; NO, do next character clrb (r1) ; terminate with EOS inc (r2) ; bump i past terminating char 20$: return .page .sbttl kill ;+ ; integer function kill(proces) ; ; alternate entry - r$kill ; ; proces address passed in r0 ;- .mcall sdat$s,abrt$s ap=%5 proces=2 .psect $r.rwd,con,rw,rel,lcl,d dots: .ascii "..." pidbuf: .asciz "123456" .even task: .rad50 "123456" .psect $r.roi,con,ro,rel,lcl,i .enabl lsb kill:: mov proces(ap),r0 r$kill:: mov r5,-(sp) ; save r5 mov #pidbuf,r1 ; destination address tstb (r0) ; have a non-null pid? bne 10$ ; YES mov #r$fgpc,r0 ; address of foreground proc tstb (r0) ; is there one active? beq 60$ ; NO, nothing to do 10$: movb (r0)+,(r1)+ ; copy character bne 10$ mov #pidbuf,r0 ; address of pid clr r5 ; initialize counter 20$: mov #task,r1 ; buffer for rad50 call r$rad5 ; convert to rad50 bcs 70$ ; c set => error in conversion tst r5 ; which pass bne 40$ ; use abrt movb pidbuf,r0 ; get first character cmpb r0,#'. ; first character PERIOD? beq 30$ ; YES cmpb r0,#'$ ; DOLLAR? bne 40$ ; NO 30$: cmpb r0,pidbuf+1 ; first 2 chars same? beq 40$ ; YES sdat$s #task,#dots ; send message to tool mov @#$dsw,r1 ; get DSW br 50$ 40$: abrt$s #task ; abort task mov @#$dsw,r1 ; get DSW bgt 50$ ; if >, success inc r5 ; increment try count mov #dots,r0 ; starting address of buffer cmp r5,#2 ; done? blt 20$ ; NO 50$: tst r1 ; test DSW blt 60$ mov #ok,r0 ; return(OK) br 70$ 60$: mov #err,r0 ; return(ERR) 70$: mov (sp)+,r5 ; restore r5 return .page .sbttl makarg ;+ ; this routine fetches and sets up the command line arguments ; for subsequent retrieval by getarg and masking by delarg ;- cr=15 tab=10 ; ; ; .psect $r.roi,con,ro,rel,lcl,i .enabl lsb makarg:: mov #r$gmcr,r0 ; buffer address for args mov #1,r1 ; LUN to use for tools args call gmcrst ; get command line bcs 150$ ; c set => no command line tst (r0)+ ; point at first character mov #r$argv,r1 ; start of argv clr r$argc ; initialize arg count 110$: clr r3 ; clear quote flag 120$: movb (r0)+,r2 ; get next character cmp r2,#' ; is it a BLANK? beq 120$ ; YES, skip leading blanks cmp r2,#cr ; stop on terminator beq 150$ ; done, build stack frame cmp r2,#'' ; check for quoted strings beq 130$ ; cmp r2,#'" ; both kinds are legal bne 131$ ; 130$: mov r2,r3 ; save quote character cmp r1,#r$arge ; does argument fit? bhis 150$ ; NO mov r0,(r1)+ ; add to argv inc r$argc ; increment arg count br 140$ ; 131$: cmp r2,#'< ; STDIN redirection? bne 132$ ; NO mov r0,r$infl ; save address br 140$ ; collect argument 132$: cmp r2,#'> ; STDOUT redirection? bne 134$ ; NO cmpb r2,(r0) ; APPEND access? bne 133$ ; NO inc r0 ; point past ">>" mov #appe$r,r$ouac ; modify STDOUT access 133$: mov r0,r$oufl ; save address br 140$ ; collect argument 134$: cmp r2,#'? ; ERROUT redirection? bne 138$ ; NO cmpb (r0),#' ; BLANK? beq 138$ ; YES, not ERROUT redirection cmpb (r0),#tab ; TAB? beq 138$ ; YES, not ERROUT redirection cmpb (r0),#cr ; end of args? beq 138$ ; YES, not ERROUT redirection cmpb r2,(r0) ; APPEND access? bne 135$ ; NO inc r0 ; point past "??" mov #appe$r,r$erac ; modify ERROUT access 135$: mov r0,r$erfl ; save address br 140$ ; collect argument 138$: cmp r1,#r$arge ; does argument fit? bhis 150$ ; NO mov r0,(r1) ; add to argv dec (r1)+ ; went one character too far inc r$argc ; increment arg count 140$: movb (r0)+,r2 ; collect the argument cmp r2,#cr ; terminator? beq 145$ ; YES tst r3 ; in quoted string? bne 143$ ; YES cmp r2,#' ; is it a BLANK? beq 145$ ; YES, end of argument cmp r2,#tab ; is it a TAB? beq 145$ ; YES, end of argument br 140$ ; try next character 143$: cmp r2,r3 ; closing quote? bne 140$ ; NO 145$: clrb -1(r0) ; terminate with 0-byte cmp r2,#cr ; are we done? bne 110$ ; NO 150$: return .page .sbttl open ;+ ; int = open(ext, access) ; ; opens an existing file specified by ext at access ; ; if error occurs, returns ERR ;- ap=%5 ext=2 access=4 ; ; .psect $r.roi,con,ro,rel,lcl,i .enabl lsb open:: call r$gffb ; get a free RFDB address in r1 bcs 100$ ; c set => error r$opnf:: bis #rf.old,(r1) ; wish to open an existing file call r$opfl ; general open file routine return 100$: mov #err,r0 ; return ERR return .page .sbttl putch ;+ ; call putch(buf, int) ; ; the character in buf is put to the file specified by unit ;- ap=%5 buf=2 int=4 ; ; .mcall qiow$s,put$ ; ; .psect $r.roi,con,ro,rel,lcl,i .enabl lsb putch:: mov @int(ap),r0 ; ratfor unit number call r$gfbk ; get RFDB address in r1 bcs 100$ ; c set => invalid unit bit #rf.clo,(r1) ; is the file open? bne 100$ ; NO, error bit #rf.raw,(r1) ; rawmode terminal? beq 10$ ; NO mov #1,r0 ; number of characters to write mov buf(ap),r2 ; address of buffer r$rput:: tst r0 ; any bytes to write? ble 5$ ; NO qiow$s #io.wal,@int(ap),r$ioef,,,, 5$: return 10$: bit #rf.mod,(r1) ; output mode? beq 20$ ; YES cmpb #rdwr$r,r.acc(r1) ; opened at READWRITE? bne 100$ ; NO, error clr r.byte(r1) ; no bytes buffered yet mov r.buf0(r1),r.bufp(r1) ; reset buffer pointer bic #rf.mod,(r1) ; set to output mode 20$: movb @buf(ap),r3 ; place character in register r$cput:: cmp r.byte(r1),#512. ; buffer full? bge 30$ ; YES, flush it cmpb #newlin,r3 ; NEWLINE character? bne 40$ ; NO 30$: mov r.buf0(r1),r2 ; buffer address mov r.fdb(r1),r0 ; real FDB address in r0 put$ ,r2,r.byte(r1) ; put the record mov r2,r.bufp(r1) ; reset buffer pointer clr r.byte(r1) ; zero character count 40$: cmpb #newlin,r3 ; NEWLINE character? beq 100$ ; YES, do not copy movb r3,@r.bufp(r1) ; store the character inc r.byte(r1) ; update byte count inc r.bufp(r1) ; bump buffer pointer 100$: return .page .sbttl putlin ;+ ; call putlin(buf, int) ;- ap=%5 buf=2 int=4 ; ; .psect $r.roi,con,ro,rel,lcl,i .enabl lsb putlin:: mov @int(ap),r0 ; rat4 unit number call r$gfbk ; get RFDB address in r1 bcs 100$ ; c set => invalid unit r$lput:: bit #rf.clo,(r1) ; is the file open? bne 100$ ; NO, error mov buf(ap),r4 ; buffer address in non-volatile reg bit #rf.raw,(r1) ; rawmode terminal? beq 30$ ; NO clr r0 ; initialize count of characters 10$: tstb (r4)+ ; null byte yet? beq 20$ ; YES inc r0 ; increment count br 10$ ; try again 20$: mov buf(ap),r2 ; address of buffer call r$rput ; do a raw put of the line return 30$: bit #rf.mod,(r1) ; output mode? beq 40$ ; YES cmpb #rdwr$r,r.acc(r1) ; READWRITE access? bne 100$ ; NO, error clr r.byte(r1) ; no bytes buffered yet mov r.buf0(r1),r.bufp(r1) ; reset buffer pointer bic #rf.mod,(r1) ; set to output mode 40$: movb (r4)+,r3 ; place character in r3 beq 100$ ; if == 0, done call r$cput ; put the character (cooked) br 40$ ; do next character 100$: return .page .sbttl r$btoo ;+ ; this routine formats the byte found in r1 into octal with ; no leading zeroes into the buffer pointed at by r0 ; r0 is left pointing at the next free location in the buffer ; all other registers are constant across the call ; ;- .psect $r.roi,con,ro,rel,lcl,i .enabl lsb r$btoo:: call r$savr ; save r0-r5 movb r1,r2 ; place value in even register bne 10$ ; something to do movb #'0,(r0)+ ; just unit 0 br 40$ ; finish up 10$: ashc #-6,r2 ; rotate low 6 bits into r3 mov #3,r1 ; counter 20$: bic #177770,r2 ; mask to 3 bits beq 30$ ; no leading zeroes add #'0,r2 ; make it a character movb r2,(r0)+ ; copy to buffer 30$: ashc #3,r2 ; shift next 3 bits into r2 sob r1,20$ ; do again 40$: clrb (r0) ; terminate with EOS mov r0,2(sp) ; place next address in saved r0 return .page .sbttl r$dspt ;+ ; this routine builds a data set descriptor ; ; inputs: ; r0 address of file string ; r1 address of data set descriptor ; ; outputs: ; data set descriptor for file string is built ; all registers remain unchanged ;- .psect $r.roi,con,ro,rel,lcl,i .enabl lsb r$dspt:: call r$savr ; save r0-r5 clr (r1) ; zero length fields in dspt clr 4(r1) ; ... clr 10(r1) ; ... mov r0,r3 ; initialize roving pointer mov r3,r2 ; start of string 10$: cmpb (r3),#': ; end of device string? bne 20$ ; NO mov r2,2(r1) ; store starting address mov r3,r0 ; calculate length sub r2,r0 ; ... inc r0 ; ... mov r0,(r1) ; place length in dspt mov r3,r2 ; new start of string inc r2 ; ... br 30$ ; do next field 20$: cmpb (r3),#'] ; end of UIC string? bne 25$ ; NO mov r2,6(r1) ; store starting address mov r3,r0 ; calculate length sub r2,r0 ; ... inc r0 ; ... mov r0,4(r1) ; store length mov r3,r2 ; new start of string inc r2 ; ... br 30$ ; do next field 25$: tstb 1(r3) ; end of file spec? bne 30$ ; NO mov r2,12(r1) ; store address mov r3,r0 ; calculate length sub r2,r0 ; ... inc r0 ; ... mov r0,10(r1) ; store length 30$: .enabl lc movb (r3),r0 ; get character cmp r0,#'a ; lower case? blt 40$ ; NO cmp r0,#'z ; lower case? bgt 40$ ; NO bic #40,r0 ; make upper case .dsabl lc 40$: movb r0,(r3)+ ; copy character back into string tstb (r3) ; end of file spec? bne 10$ ; NO return .page .sbttl r$ermo ;+ ; routine to provide error message output ; ; inputs: ; r0 address of ASCIZ message string ; ; all registers remain the same across the call ;- .psect $$iob1,rw,d,lcl,rel,ovr errorb: .blkb 132. .psect $r.roi,con,ro,rel,lcl,i .enabl lsb .mcall qiow$s,gtsk$s sep: .asciz " *** " .even r$ermo:: call r$savr ; save r0-r5 mov #errorb,r0 ; address of output buffer mov #<15+<256.*12>>,(r0)+ ; copy CRLF into buffer mov #r$tknm,r1 ; address of task name string call copy mov #sep,r1 ; separator string call copy ; copy into error buffer mov 2(sp),r1 ; user's buffer call copy ; copy it movb #15,(r0)+ ; CR at end sub #errorb,r0 ; length of buffer in r0 qiow$s #io.wlb,.molun,r$ioef,,,,<#errorb,r0,#0> 100$: return ; ; ; copy: movb (r1)+,(r0)+ ; copy character bne copy ; if not 0, do again tstb -(r0) ; point at null byte return .page .sbttl r$garg .if df SRDRV .mcall alun$s,qiow$s .iff .mcall get$ .psect $r.rod,con,ro,rel,lcl,d seed: .asciz "arg" ; seed for fgenr8 call .even .psect $$iob1,ovr,rw,rel,lcl,d file: .blkb 40. ; space for arg file name .even .endc .psect $r.roi,con,ro,rel,lcl,i .enabl lsb r$garg:: call r$savr ; save registers .if df SRDRV alun$s r1,#"SR,#0 ; assign lun to SR0: bcs 10$ ; c set => error - return qiow$s #io.rlb,r1,r$ioef,,#r$iosb,, ; read from driver bcs 10$ ; c set => error - try MCR tstb r$iosb ; see if error in driver ble 10$ ; if <=, YES .iff mov #file,-(sp) ; address of file mov #seed,-(sp) ; address of seed mov #r$tknm,-(sp) ; address of pid mov #3,-(sp) ; three args mov sp,ap ; arg pointer for fgenr8 call fgenr8 ; call fgenr8(pid, seed, file) add #8.,sp ; clean up stack mov #r$inac,-(sp) ; READ access mov #file,-(sp) ; file to open clr -(sp) ; dummy count mov sp,ap ; arg pointer mov r$erdb,r1 ; ERROUT RFDB address call r$opnf ; open the file rol r2 ; save c bit add #6.,sp ; clean up stack ror r2 ; restore c bit bcs 10$ ; c set => open error mov 2(sp),r2 ; fetch buffer address clr r$iosb+2 ; assume error get$ r.fdb(r1),r2,#255. ; read the record bcs 5$ ; read error mov f.nrbd(r0),r$iosb+2 ; copy the count of chars read 5$: call .dlfnb ; close and delete the file .endc clc ; c clear => success return 10$: sec ; c set => error return .page .sbttl r$opfl ;+ ; this routine performs general file opens for the software tools ; runtime system ; ; inputs: ; r1 RFDB address ; ; outputs: ; c set error in opening file ; c clear successful open ;- ap=%5 ext=2 access=4 .mcall nmblk$,ofnb$,fdop$r,fdat$r .psect $r.roi,con,ro,rel,lcl,i .enabl lsb r$opfl:: mov r1,-(sp) ; save RFDB address mov ap,-(sp) ; save argument pointer mov #path,-(sp) ; type for fxlate mov sp,r0 ; save address add #r.name,r1 ; address of out mov r1,-(sp) ; place in call block mov r0,-(sp) ; address of type mov ext(ap),-(sp) ; address of in mov #3,-(sp) ; arg count mov sp,ap ; establish argument pointer call fxlate ; convert to local file spec mov 6(sp),r0 ; address of file spec in r0 add #10.,sp ; pop arg block from stack mov (sp)+,ap ; restore argument pointer mov (sp)+,r2 ; save RFDB in non-volatile reg sub #12.,sp ; build data set desc on stack mov sp,r1 ; dspt address in r1 call r$dspt ; build a data set descriptor mov r2,r1 ; RFDB address in correct place mov r.fdb(r1),r0 ; get FDB address mov sp,f.dspt(r0) ; store away dspt address mov pc,r2 ; get address of branch statement br 50$ ; branch around pure code nmblk$ ,,0,SY,0 ; default name block 50$: tst (r2)+ ; address of dfnb in r2 mov r2,f.dfnb(r0) ; store into FDB call r$pars ; parse the file spec rol r3 ; save c bit in r3 add #12.,sp ; restore stack ror r3 ; restore c bit bcs 100$ ; c set => parse error movb @access(ap),r.acc(r1) ; store access mode in RFDB fdop$r ,,,,,#fa.enb!fa.dlk ; no lock upon aborted closure mov #fd.cr,r2 ; assume LIST cctrl cmpb #prin$r,r.acc(r1) ; PRINT access? bne 60$ ; NO mov #fd.ftn,r2 ; FORTRAN cctrl 60$: fdat$r ,#r.var,r2 ; variable length records cmpb #read$r,r.acc(r1) ; READ access? beq 90$ ; YES cmpb #appe$r,r.acc(r1) ; APPEND access? bne 80$ ; NO ofnb$ ,#fo.apd ; open existing file at append access bcc 85$ ; c clear => success br 81$ ; open a new file 80$: cmpb #prin$r,r.acc(r1) ; PRINT access? beq 81$ ; YES, open new file ofnb$ ,#fo.upd ; open existing file for write bcs 81$ ; c set => error, try new file cmpb #rdwr$r,r.acc(r1) ; READWRITE access? beq 85$ ; YES, don't delete call .dlfnb ; delete existing file bitb #fd.ftn!fd.cr,f.ratt(r0); any implied carriage control? bne 81$ ; yes movb #fd.cr,f.ratt(r0) ; new file is LIST carriage control 81$: ofnb$ ,#fo.wrt ; open new file at write access bcc 85$ ; c clear => success ofnb$ ,#fo.upd ; try to reopen existing file ; this is needed if the user has ; write access to the file, but ; not delete access (YEP!) bcs 100$ ; c set => open error br 85$ ; fill in RFDB 90$: ofnb$ ,#fo.rd!fa.shr ; open at read access with sharing bcs 100$ ; c set => open error 85$: clr (r1) ; file is open and flags cleared bitb #fd.tty,f.rctl(r0) ; is it a TTY? beq 86$ ; NO bis #rf.tty,(r1) ; note this in RFDB 86$: bitb #fd.ftn!fd.cr,f.ratt(r0); any implied carriage control? beq 87$ ; NO bis #rf.ctl,(r1) ; note this in RFDB 87$: cmpb #read$r,r.acc(r1) ; READ access? bne 88$ ; NO bis #rf.mod,(r1) ; indicate inputmode 88$: cmpb f.rtyp(r0),#r.var ; variable length records? bne 89$ ; NO bit #rf.ctl,(r1) ; implied carriage control? beq 89$ ; NO bis #rf.chr,(r1) ; indicate character file 89$: mov r.buf0(r1),r.bufp(r1) ; initialize buffer pointer clr r.byte(r1) ; clear number of bytes movb r.lun(r1),r0 ; return lun for success clc ; clear c bit for success return 100$: mov #err,r0 ; return ERR return .page .sbttl r$pars ; ; this routine parses the file spec into the fdb and name block ; it takes care of named directories ; ; inputs: ; r0 address of FDB ; ; outputs: ; c bit set => error in parse ; c bit clear => success ; ; all registers are saved across the call ; ; upon return, the FDB in r0 is ready for an OFNB$[X] macro call to ; open the file ; .mcall nmblk$ ; ; .psect $r.rod,con,ro,rel,lcl,d dfnb: nmblk$ ,DIR,0 ; default name block for "name.dir" duic: .ascii "[0,377]" ; uic in which "name.dir" is found duicl=.-duic .even .psect $r.roi,con,ro,rel,lcl,i .enabl lsb r$pars:: call r$savr ; save r0-r5 mov r0,r1 ; generate FNB address add #f.fnb,r1 ; ... mov f.dspt(r0),r2 ; data-set descriptor address mov f.dfnb(r0),r3 ; default file name block call .prsdv ; parse device info bcs 30$ ; device error call .prsdi ; parse directory info bcc 20$ ; of form [g,m] sub #12.,sp ; space for dspt on stack mov sp,r3 ; address of dspt clr (r3) ; no device info for named directory clr 2(r3) ; ... mov 4(r2),10(r3) ; copy directory info into file info mov 6(r2),12(r3) ; ... sub #2,10(r3) ; length - brackets inc 12(r3) ; start after [ mov r3,r2 ; dspt mov #duicl,4(r2) ; length of [0,377] string mov #duic,6(r2) ; address in data-set descriptor mov #dfnb,r3 ; default FNB address call .prsdi ; parse directory info bcs 4$ call .prsfn ; parse file info bcs 4$ call .find ; find the file in [0,377] bcs 4$ mov n.fid(r1),n.did(r1) ; copy the file id into the dir id mov n.fid+2(r1),n.did+2(r1) ; ... mov n.fid+4(r1),n.did+4(r1) ; ... mov r1,r2 ; now clear out fields mov #16.,r3 ; filled in by parse of 10$: ; directory file spec clrb (r2)+ sob r3,10$ bic #7,n.stat(r1) 4$: rol r3 ; save c bit in r3 add #12.,sp ; pop dspt from stack ror r3 ; restore c bit bcs 30$ ; c set => named dir not found mov f.dspt(r0),r2 ; restore file's DSD mov f.dfnb(r0),r3 ; restore file's DFNB 20$: call .prsfn ; parse file info 30$: return .page .sbttl r$rad5 ;+ ; this routine converts the pid passed in r0 into rad50 in the buffer ; passed in r1 ;- .psect $r.rwd,con,rw,rel,lcl,d pidb: .blkb 10 ; buffer for upper-cased pid .psect $r.roi,con,ro,rel,lcl,i .enabl lsb r$rad5:: call r$savr ; save all registers clr (r1) ; zero taskname buffer clr 2(r1) ; ... mov r0,r2 ; source address mov #pidb,r3 ; destination address 10$: movb (r2)+,r4 ; get next character .enabl lc cmpb r4,#'a ; lower case? blt 20$ ; NO cmpb r4,#'z bgt 20$ .dsabl lc bic #40,r4 ; make upper case 20$: movb r4,(r3)+ ; copy character bne 10$ mov r1,r3 ; move buffer address mov #pidb,r0 ; address of ascii buffer mov #1,r1 ; do not stop on periods call $cat5b ; convert to rad50 bcs 30$ ; c set => error mov r1,(r3)+ ; copy into buffer mov #1,r1 call $cat5b bcs 30$ mov r1,(r3) 30$: return .page .sbttl r$savr - save and restore register routines ;+ ; this routine saves and restores registers r0-r5 - it is the ; equivalent of $saval in syslib ; ; upon return from r$savr, the following is the structure of the ; stack ; ; +-------------------+ ; | return address | ; | saved r5 | 14(sp) ; | saved r4 | 12(sp) ; | saved r3 | 10(sp) ; | saved r2 | 6(sp) ; | saved r1 | 4(sp) ; | saved r0 | 2(sp) ; | address of r$retn | (sp) ; +-------------------+ ; ; upon execution of " rts pc", r$retn is entered, which ; restores the registers and returns to the caller's caller ;- .psect $r.roi,con,ro,rel,lcl,i .enabl lsb r$savr:: sub #16,sp ; make room on stack mov 16(sp),(sp) ; move our return address down mov r5,16(sp) ; save r0-r5 mov r4,14(sp) ; ... mov r3,12(sp) ; ... mov r2,10(sp) ; ... mov r1,6(sp) ; ... mov r0,4(sp) ; ... mov #r$retn,2(sp) ; address of routine to restore registers rts pc ; return to caller ; ; ; r$retn: mov (sp)+,r0 ; restore registers r0-r5 mov (sp)+,r1 ; ... mov (sp)+,r2 ; ... mov (sp)+,r3 ; ... mov (sp)+,r4 ; ... mov (sp)+,r5 ; ... rts pc ; return to caller's caller .page .sbttl sprint ;+ ; subroutine sprint(out, fmt, in1, in2, ...) ; ; character out(ARB), fmt(ARB) ; ; fortran callable sprintf from C library ; ; format string consists of three types of characters ; ; 1. non-special characters which are copied directly to 'out' ; ; 2. escape characters of the form '@c'. If 'c' is special, its ; equivalent is placed in 'out', else 'c' is placed in 'out'. ; ; 3. format directives of the form '%c', where is an ; optional field width and 'c' is one of the following: ; c: character input ; d: integer input, formatted in signed decimal ; o: integer input, formatted in octal ; r: integer input in rad50, convert to ascii ; here, the width indicates how many contiguous integers ; to convert ; s: string input ; x: integer input, formatted in hexadecimal ;- ap=%5 out=2 fmt=4 in1=6 ; ; pure data ; .psect $r.rod,con,ro,rel,lcl,d .enabl lc escchr: .ascii "b"<10> ; @b => backspace ^H .ascii "f"<14> ; @f => formfeed ^L .ascii "l"<12> ; @l => linefeed ^J .ascii "n"<12> ; @n => newline ^J .ascii "r"<15> ; @r => return ^M .ascii "t"<11> ; @t => tab ^I .byte 0 ; end of list fmtchr: .asciz "cdorsx" ; valid format characters .even .dsabl lc fmtrtn: .word cfmt,dfmt,ofmt,rfmt,sfmt,xfmt ; formatting routines .psect $r.rwd,con,rw,rel,lcl,d width: .word 0 ; width of format field sign: .word 0 ; holds sign for decimal format fmtbuf: .blkb 10. ; buffer for formatting filchr: .blkb 1 ; fill character for putstr .even ; ; code for sprint ; .psect $r.roi,con,ro,rel,lcl,i .enabl lsb sprint:: call r$savr ; save r0-r5, in case called from macro mov out(ap),r0 ; output string address mov fmt(ap),r1 ; format string address add #in1,ap ; point to address of first argument 10$: movb (r1)+,r2 ; next character from format string beq 30$ ; if == 0, done cmpb #'@,r2 ; escaped character? bne 20$ ; NO movb (r1)+,r2 ; get character after '@' beq 30$ ; if == 0, done mov #escchr,r4 ; address of correspondence array 11$: cmpb r2,(r4)+ ; character match? bne 12$ ; NO movb (r4),r2 ; get equivalence character br 30$ ; copy it to out 12$: inc r4 ; bump past equivalence character tstb (r4) ; done? bne 11$ ; NO br 30$ ; just copy character 20$: cmpb #'%,r2 ; format specifier? bne 30$ ; NO jsr pc,getwid ; get optional width value movb #' ,filchr ; initialize fill character to BLANK movb (r1),r2 ; get format character bisb #40,r2 ; make it lower case clr r4 ; base address 21$: cmpb r2,fmtchr(r4) ; format character match? beq 22$ ; YES inc r4 ; update base address tstb fmtchr(r4) ; done? bne 21$ ; NO br 30$ ; just copy '%' 22$: asl r4 ; multiply base address by 2 jsr pc,@fmtrtn(r4) ; call appropriate subroutine inc r1 ; bump past format character br 10$ ; continue 30$: movb r2,(r0)+ ; copy character into out bne 10$ ; if != 0, do again rts pc ; return to caller .page ; ; formatting routines ; ; register inputs: ; ; r0 next available output address ; r1 address of format character (width has been processed) ; r2-r4 free for use ; ap pointer to address of input argument ; ; ; cfmt - place character in buffer ; .enabl lsb cfmt: mov (ap)+,r2 ; address of character movb (r2),fmtbuf ; place character in temp buf clrb fmtbuf+1 ; one character string mov #fmtbuf,r2 ; string to copy jsr pc,putstr ; copy to user buffer rts pc ; done ; ; sfmt - format string ; sfmt: mov (ap)+,r2 ; address of string jsr pc,putstr ; copy to user's buffer rts pc ; done .page ; ; ofmt - format integer*2 in octal with/without leading zeroes ; if format character is capital o(O), leading zeros ; else leading blanks ; .enabl lsb ofmt: mov r0,-(sp) ; save user buffer address mov r1,-(sp) ; need r1 for scratch mov #fmtbuf,r0 ; format into temporary buffer mov (ap)+,r2 ; address of integer to format mov (r2),r3 ; value of integer bne 4$ ; if non-zero, continue movb #'0,(r0)+ ; just put a zero br 5$ ; go put in user's buffer 4$: clr r2 ; make r2-r3 into 32-bit integer mov #6,r4 ; initialize counter clr r1 ; non-zero character not seen ashc #1,r2 ; shift r2-r3 one bit left 1$: bic #177770,r2 ; mask off to low three bits bne 2$ ; if non-zero, format it tst r1 ; have we seen non-zero yet? beq 3$ ; NO, try next character 2$: inc r1 ; seen non-zero add #'0,r2 ; make it a character movb r2,(r0)+ ; copy into out 3$: ashc #3,r2 ; shift next three bits into r2 sob r4,1$ ; do next character 5$: clrb (r0) ; terminate with EOS mov (sp)+,r1 ; restore r1 mov #fmtbuf,r2 ; address of buffer to copy mov (sp)+,r0 ; restore user's buffer address cmpb (r1),#'O ; upper case o? bne 6$ ; NO movb #'0,filchr ; fill with leading zeroes 6$: jsr pc,putstr ; copy to user's buffer rts pc ; done .page ; ; xfmt - format in hexadecimal ; .psect $r.rod,con,ro,rel,lcl,d .enabl lc xarray: .ascii "0123456789abcdef" .even .dsabl lc .psect $r.roi,con,ro,rel,lcl,i .enabl lsb xfmt: mov r0,-(sp) ; save registers mov r1,-(sp) ; ... mov #fmtbuf,r0 ; format into temporary buffer mov (ap)+,r2 ; address of integer to format mov (r2),r3 ; value of integer bne 31$ ; if non-zero, go ahead movb #'0,(r0)+ ; just put a 0 br 32$ ; copy to user 31$: clr r2 ; make r2-r3 into 32-bit integer mov #4,r4 ; initialize counter clr r1 ; non-zero not seen yet 3$: ashc #4,r2 ; shift next four bits into r2 bic #177760,r2 ; mask to four bits bne 33$ ; non-zero character tst r1 ; seen a non-zero yet? beq 34$ ; NO 33$: inc r1 ; seen a non-zero movb xarray(r2),(r0)+; copy character 34$: sob r4,3$ ; do next character 32$: clrb (r0) ; terminate with EOS mov (sp)+,r1 ; restore registers mov #fmtbuf,r2 ; buffer to copy mov (sp)+,r0 ; user buffer cmpb (r1),#'X ; uppercase x? bne 6$ ; NO movb #'0,filchr ; fill with leading zeroes 6$: jsr pc,putstr ; copy to user buffer rts pc ; done .page ; ; dfmt - format in signed decimal ; .enabl lsb dfmt: mov #fmtbuf+9.,r4 ; end of buffer clrb (r4) ; EOS mov (ap)+,r2 ; address of value clr sign ; assume >= 0 mov (r2),r3 ; value to format bne 5$ ; if non-zero, continue movb #'0,-(r4) ; just output a 0 br 9$ ; copy to user buffer 5$: bgt 6$ ; if > 0, no minus sign inc sign ; indicate negative number neg r3 ; format positive number 6$: clr r2 ; 32-bit number for div 7$: div #10.,r2 ; divide by 10 add #'0,r3 ; make remainder into a character movb r3,-(r4) ; ferret away in buffer mov r2,r3 ; must now divide quotient beq 8$ ; if 0, done clr r2 ; 32-bit number br 7$ ; go again 8$: tst sign ; negative number beq 9$ ; NO movb #'-,-(r4) ; place minus sign in buffer 9$: mov r4,r2 ; buffer to copy jsr pc,putstr ; copy to user buffer rts pc .page ; ; rfmt - format rad50 to ascii ; .psect $r.rod,con,ro,rel,lcl,d .enabl lc t: .ascii " abcdefghijklmnopqrstuvwxyz$.?0123456789" .dsabl lc .even .psect $r.roi,con,ro,rel,lcl,i .enabl lsb rfmt: mov r1,-(sp) ; save register mov (ap)+,r1 ; address of integer array mov width,r4 ; number of integers to format bne 10$ ; if != 0, user specified it mov #1,r4 ; count of 1 10$: mov (r1)+,r3 ; value to convert clr r2 ; make it 32-bit for divide div #3100,r2 ; get first character movb t(r2),(r0)+ ; copy first character clr r2 ; remainder is new divisor div #50,r2 ; get second character movb t(r2),(r0)+ ; copy second character movb t(r3),(r0)+ ; and third character sob r4,10$ ; do more, if necessary mov (sp)+,r1 ; restore register rts pc ; done .page ;+ ; support routines for formatting routines ; ; getwid - get user-supplied field width ; ; inputs: ; r0 address of user buffer ; r1 address of first character after '%' ; r2 '%' ; r3,r4 mangled ; .enabl lsb getwid: clr r3 ; default width value 5$: jsr pc,isdig ; is this character a digit? bcs 6$ ; c set => NO movb (r1)+,r2 ; fetch the digit sub #'0,r2 ; make it an integer mul #10.,r3 ; w = 10 * w + d add r2,r3 ; ... br 5$ ; again 6$: mov r3,width ; save width value rts pc ; done ; ; isdig - determine if character pointed to by r1 is a digit ; ; c set => NO ; c clr => YES ; all registers remain unchanged ; isdig: cmpb (r1),#'0 ; < 0 blt 7$ ; YES cmpb (r1),#'9 ; > 9 bgt 7$ ; YES clc ; c clear => is a digit rts pc 7$: sec ; c set => not a digit rts pc ; ; putstr - put formatted string into user buffer ; ; inputs ; r0 next available address in user buffer ; r1 points at character after '%' ; r2 address of buffer to copy to user buffer ; r3-r4 mangled ; putstr: mov width,r4 ; width of field mov r2,r3 ; address of input buffer 8$: dec r4 ; decrement number of blanks to output tstb (r3)+ ; end of string? bne 8$ ; NO inc r4 ; went one too far ble 10$ ; if <= 0, no blanks to output 9$: movb filchr,(r0)+ ; output leading character sob r4,9$ ; do again, if necessary 10$: movb (r2)+,(r0)+ ; copy character to user buffer bne 10$ ; do again, if necessary tstb -(r0) ; went one too far rts pc ; done .page .sbttl trndev ;+ ; subroutine trndev(dev, unit, buf) ; ; this routine translates the pseudo-device specified by dev and unit ; into its equivalent character string in buf ;- ap=%5 dev=2 unit=4 buf=6 .psect $r.roi,con,ro,rel,lcl,i .enabl lsb .mcall alun$s,glun$s trndev:: clrb @buf(ap) ; assume error mov dev(ap),r0 ; address of device string movb (r0)+,-(sp) ; place first character on stack movb (r0),1(sp) ; second character mov (sp)+,r1 ; have device string in r1 bic #<40+<40*256.>>,r1 ; make upper case alun$s r$endl,r1,@unit(ap) ; assign lun to DDn: bcs 100$ ; c set => bad error sub #12.,sp ; buffer for GLUN mov sp,r1 ; address of buffer glun$s r$endl,r1 ; GLUN bcs 90$ ; c set => almost as bad error mov buf(ap),r0 ; address of output buffer movb g.luna(r1),(r0)+ ; copy first byte of device name movb g.luna+1(r1),(r0)+ ; second byte of device name movb g.lunu(r1),r1 ; unit number call r$btoo ; format byte to octal movb #':,(r0)+ ; copy COLON clrb (r0) ; terminate with EOS 90$: add #12.,sp ; restore stack 100$: return .page .sbttl ttysub - tty subroutines ;+ ; subroutine ttyatt ; ; subroutine ttydet ;- .mcall qiow$s .psect $r.roi,con,ro,rel,lcl,i .enabl lsb ttyatt:: mov #io.att,r0 ; function code for terminal attach br 10$ ttydet:: mov #io.det,r0 ; function code for terminal detach 10$: qiow$s r0,.molun,r$ioef ; perform correct function return .page .sbttl r$data - RFDB database .asect .=0 r.flag:: .blkw 1 ; flags word in RFDB r.buf0:: .blkw 1 ; address of record buffer r.bufp:: .blkw 1 ; current buffer pointer r.byte:: .blkw 1 ; bytes in buffer currently r.fdb:: .blkw 1 ; associated FDB address r.lun:: .blkb 1 ; associated lun r.acc:: .blkb 1 ; access file is opened at r.name:: .blkb 40. ; space for file name r.lgth==. .psect ; ; definitions for bits in r.flag ; rf.clo==1 ; set if file is closed rf.tty==2 ; set if file is associated with terminal rf.old==4 ; set if opening existing file is desired rf.ctl==10 ; set if LIST or Fortran carriage control rf.dir==20 ; set if allocated to a directory rf.raw==40 ; set if unit is raw terminal rf.mod==100 ; set if unit is in inputmode rf.chr==200 ; set if character file ; ; ; general global symbol definitions ; ; eof==-1 err==-3 newlin==12 read$r==1 writ$r==2 rdwr$r==3 appe$r==4 prin$r==5 stdin==1 stdout==2 errout==3 yes==1 no==0 ok==0 path==5 d.fdb==12. ; this offset represents the offset into the FFDB ; for the FDB. it may have to be changed if the RMS ; OTS library is in use for F4P v.3.0 ; ; ; ; .psect $r.rwd,con,rw,rel,lcl,d r$dbst:: r$indb:: .word rfdb1 r$oudb:: .word rfdb2 r$erdb:: .word rfdb3 .word rfdb4,rfdb5,rfdb6,rfdb7 r$dbnd:: r$infl:: .word ti r$inac:: .word read$r r$oufl:: .word ti r$ouac:: .word writ$r r$erfl:: .word ti r$erac:: .word writ$r ti: .asciz "ti:" .even ; ; space for command line argument globals ; r$gmcr:: .blkb 258. ; buffer for command line r$argc:: .word 0 ; holds number of arguments r$argv:: ; start of array of pointers to args .rept 25. ; 25 pointers max .word null ; initially, each points to null arg .endr r$arge:: ; end of list r$ioef:: .word 0 ; event flag number for use in I/O r$spef:: .word 0 ; event flag number for spwn use r$iosb:: .word 0,0 ; io status block r$ddir:: .word 0,0,0,0,0,0 ; buffer for default directory r$duic:: .word 0,0,0,0,0 ; buffer for default uic string r$fgpc:: .byte 0,0,0,0,0,0,0 ; name of active foreground proc r$tknm:: .byte 0,0,0,0,0,0,0 ; our task name null: .asciz "" ; null string .even ; ; pointer to last address in task ; filled in during startup ; r$enda:: .word 0 r$endl:: .word 0 ; next available lun ; ; RFDB's ; rfdb1: .word rf.clo .word 0 ; no buffer initially .blkb rfdb2: .word rf.clo .word 0 ; no buffer initially .blkb rfdb3: .word rf.clo .word errbuf ; only unit with initial buffer .blkb rfdb4: .word rf.clo .word 0 ; no buffer initially .blkb rfdb5: .word rf.clo .word 0 ; no buffer initially .blkb rfdb6: .word rf.clo .word 0 ; no buffer initially .blkb rfdb7: .word rf.clo .word 0 ; no buffer initially .blkb errbuf: .blkb 512. ; record buffer for ERROUT .end