.title edresl misc cluster lib support routines for C TED ; Last edit: 27-Jan-86 13:08:12 Brian Nelson ; ; Removed root code for some terminal init/restore stuff .psect rescod ,ro,i,lcl,rel,con .enabl gbl .mcall qiow$s .macro save list .if b , .ift save .iff .irp x, mov x,-(sp) .endr .endc .endm save .macro unsave list .if b , .ift unsave .iff .irp x, mov (sp)+,x .endr .endc .endm unsave .sbttl terminal read/write binary mode ; putbin(buffer,len) ; ; Passed: ; 2(sp) buffer address ; 4(sp) buffer length .WRITE = EMT + 4 XRB = 442 putbin::save ; save temp registers mov 6(sp) ,r0 ; get the passed length please bne 20$ ; something real to print mov 4(sp) ,r1 ; null length, asssume .asciz 10$: tstb (r1)+ ; find the end of the string beq 20$ ; found it inc r0 ; not ye, len++ br 10$ ; go back for next one 20$: mov r0 ,-(sp) call gsys cmpb r0 ,#4 ; RSTS/E ? bne 30$ ; no, rsx or p/os mov #XRB ,r1 ; yes, do straight .writes mov @sp ,(r1)+ ; size of the write mov (sp)+ ,(r1)+ ; size of the write, again mov 4(sp) ,(r1)+ ; buffer address clr (r1)+ ; channel zero clr (r1)+ ; unused clr (r1)+ ; unused also mov #4096. ,(r1)+ ; io.wal .WRITE br 40$ ; exit 30$: mov (sp)+ ,r0 ; mov 4(sp) ,r1 qiow$s #io.wal,#5,,,,, ; rsx and p/os 40$: clr r0 ; assume no errors and exit unsave ; pop register return ; ;putbin::mov 2(sp) ,r1 ; mov r1 ,r0 ;10$: tstb (r0)+ ; bne 10$ ; sub r1 ,r0 ; dec r0 ; qiow$s #io.wal,#5,,,,, ; return ; .save ; .globl $vexta ; .psect $$vex1 ,rw,d,gbl,rel,ovr ;.vex1: .word termtype ; .word systype ; .word ttinit ; .restore gterm:: mov @#$vext ,r0 mov @(r0) ,r0 return gsys:: mov @#$vext ,r0 mov @2(r0) ,r0 return gvext:: mov @#$vext ,r0 return .sbttl get date and time .enabl lc .mcall gtim$s rgetti::save mov @r5 ,r0 ; can't use sp for arg in clusters sub #16. ,sp ; make room for result mov sp ,r1 ; result addr for gtim$ gtim$s r1 ; get time and date mov g.tida(r1),r2 ; r2 := day jsr pc ,cnvert ; convert and store day movb #'- ,(r0)+ ; insert dash mov g.timo(r1),r2 ; r2 := month asl r2 add g.timo(r1),r2 ; r2 := 3*month add #mnthtab-3,r2 ; r2 := mnthtab[3*month]@ movb (r2)+ ,(r0)+ movb (r2)+ ,(r0)+ ; store month name movb (r2)+ ,(r0)+ movb #'- ,(r0)+ ; insert dash mov @r1 ,r2 ; r2 := year jsr pc ,cnvert ; convert and store year movb #40 ,(r0)+ ; final space movb #40 ,(r0)+ ; final space mov #3,r3 ; loop count := 3 add #g.tihr,r1 ; start with hours 1$: mov (r1)+,r2 ; begin loop jsr pc,cnvert ; convert to ascii and store dec r3 ; if done beq 2$ ; then exit loop movb #':,(r0)+ ; else insert colon br 1$ ; end loop 2$: add #16.,sp clrb @r0 ; .asciz and exit unsave return ; ; cnvert: internal procedure to convert ; integer in r2 to ascii. cnvert: add #366,r2 ;begin loop tstb r2 bpl cnvert ;end loop add #"00-366,r2 ;convert to ascii swab r2 ;reorder bytes movb r2,(r0)+ ;store digit swab r2 movb r2,(r0)+ ;store digit rts pc ; .save .psect rwdata ,rw,d,lcl,rel,con mnthtab:.ascii /JanFebMarAprMayJunJulAugSepOctNovDec/ .even .restore .sbttl local copy of csv.mac for the reslib .iif ndf C$PMTR C$PMTR = 4 ;formal[n] @ c$pmtr+(r5) .iif ndf C$AUTO C$AUTO = -6 ;local[n] @ c$auto-(r5) .iif ne C$PMTR-4 .error Bad definition of C$PMTR .iif ne C$AUTO+6 .error Bad definition of C$AUTO ; ; By defining C$PMTR and C$AUTO as local symbols, the task ; builder need not do so much work ;05- .psect c$code ; ; save R4-R2 and make a one-word temp slot on the stack. ; C$SAV:: ;06 CSV$:: MOV R5, R0 MOV SP, R5 MOV R4, -(SP) MOV R3, -(SP) MOV R2, -(SP) JSR PC,(R0) ;TST -(SP) JMP (R0) ;04 ; ; pop R2-R4 and restore stack linkage registers. ; C$RET:: ;06 CRET$:: MOV R5, R2 ;03 + MOV -(R2), R4 MOV -(R2), R3 MOV -(R2), R2 ;03 - C$RETS:: ;Funny Whitesmith's entry ;06 MOV R5, SP MOV (SP)+, R5 RTS PC .sbttl one shot terminal init code ; 27-Jan-86 13:04:44 Removed from PDPIO for placement in EDRESL ; ; Brian Nelson .iif ndf, .SPEC , .SPEC = EMT + 14 .iif ndf, TTYHND, TTYHND = 2 .iif ndf, XRB , XRB = 442 .iif ndf, FIRQB , FIRQB = 402 .iif ndf, FQFUN , FQFUN = 3 .iif ndf, FQFIL , FQFIL = 4 .iif ndf, FQDEV , FQDEV = 30 .iif ndf, CALFIP, CALFIP = EMT + 0 .iif ndf, OPNFQ, OPNFQ = 2 .iif ndf, CLSFQ, CLSFQ = 0 .iif ndf, .WRITE, .WRITE = EMT + 4 .iif ndf, .READ, .READ = EMT + 2 .iif ndf, .TTECH, .TTECH = EMT + 20 .iif ndf, .TTNCH, .TTNCH = EMT + 22 .iif ndf, .TTRST, .TTRST = EMT + 26 .iif ndf, .UUO , .UUO = EMT + 66 .iif ndf, UU.TRM, UU.TRM = 20 .save .psect dlmmsk ,ro,d,lcl,rel,con dlmmsk: .byte ^B11110111 ; .byte ^B01111111 ; For RSTS/E make everything a delimiter .rept 36 ; other than control C for screen editor .byte 377 ; single character reads. Much cleaner .endr ; this way rather than trying to use RSX .restore ; emulation for it under RSTS. forcevtedit:: clr r0 ; assume line mode mov @#$vext ,r1 cmpb @2(r1) ,#11 ; but is this p/os ? bne 100$ ; no inc r0 ; yes, return(1) 100$: return inqtermtype:: mov @#$vext ,r1 cmpb @2(r1) ,#11 ; but is this p/os ? beq 80$ ; yes (vt100 please) cmpb @2(r1) ,#4 ; but is this RSTS ? bne 80$ ; no, return( VT100 ) mov #FIRQB ,r0 ; RSTS/E, find out the terminal type mov #40 ,r1 ; clear firqb 10$: clrb (r0)+ ; a byte at a time sob r1 ,10$ ; ... movb #UU.TRM ,FIRQB+FQFUN ; .UUO subfunction mov #1+<400*377>,FIRQB+4 ; function 1, 377 for current term .UUO ; call the exec tstb FIRQB ; it should always work bne 100$ ; no, so assumme vt100 mov #rsts100,r1 ; check for vt100 series terminal clr r0 ; bisb FIRQB+6 ,r0 ; terminal code into R0 70$: tstb @r1 ; common code for checking VT100 type beq 90$ ; end of list, assume VT220 then cmpb (r1)+ ,r0 ; check for terminal being a 100 series bne 70$ ; no 80$: mov #2 ,r0 ; return( vt100 ) br 100$ ; exit 90$: mov #3 ,r0 ; yes, return( vt220 ) 100$: return ; and exit ; Terminal type codes ; RSTS v9.x ; ; unknown = 1 ; vt100 = 6 ; vt101 = 13 (10) ; vt125 = 15 (10) ; vt131 = 16 (10) ; vt132 = 17 (10) ; vt105 = 21 (10) .save .psect rwdata rsts100:.byte 1,6,13.,15.,16.,17.,21.,0 rsx100: .byte 0 .even .restore .sbttl setup terminal for full screen editing rstter::mov @#$vext ,r0 clr @4(r0) ; ttinit = 0 ; call clrdlm 100$: mov #1 ,r0 ; success return setter::mov @#$vext ,r0 mov sp ,@4(r0) ; ttinit = 1 cmpb @2(r0) ,#4 ; is this RSTS/E bne 20$ ; no mov #firqb ,r1 ; open the device up please mov #40 ,r0 ; clear firqb out first 10$: clrb (r1)+ ; simple sob r0 ,10$ ; next mov #"KB ,firqb+fqdev ; device name movb #14*2 ,firqb+fqfil ; channel times two movb #OPNFQ ,firqb+fqfun ; CALFIP subfunction CALFIP ; open it call setdlm ; a RSTSism (set delimiter mask) br 100$ ; end of RSTSism's 20$: 100$: mov #1 ,r0 ; nop for setterminal() return ; for now .enabl lsb setdlm::mov r0 ,-(sp) ; save r0 please mov @#$vext ,r0 cmpb @2(r0) ,#4 ; is this RSTS/E bne 100$ mov #XRB ,r0 ; setup mult private delims for RSTS/E mov #11 ,(r0)+ ; setup mov #40 ,(r0)+ ; size of the bitmask mov #dlmmsk ,(r0)+ ; address of the bitmask movb #14*2 ,(r0)+ ; channel movb #TTYHND ,(r0)+ ; driver index clr (r0)+ ; unused clr (r0)+ ; unused mov #1 ,(r0)+ ; subfunction .SPEC ; Do it br 100$ ; exit clrdlm::mov r0 ,-(sp) ; save r0 mov @#$vext ,r0 cmpb @2(r0) ,#4 ; is this RSTS/E bne 100$ ; no mov #XRB ,r0 ; yes, clear the delimiter mask mov #11 ,(r0)+ ; function for .SPEC clr (r0)+ ; zero clr (r0)+ ; zero movb #14*2 ,(r0)+ ; channel movb #TTYHND ,(r0)+ ; driver index clr (r0)+ ; unused clr (r0)+ ; unused clr (r0)+ ; clear the mask .SPEC ; do it and exit mov #FIRQB ,r0 ; Close it next 10$: cmp r0 ,#FIRQB+36 ; End of it ? bhi 20$ ; Yes clr (r0)+ ; No br 10$ ; Next please 20$: movb #CLSFQ ,FIRQB+FQFUN ; Function movb #14*2 ,FIRQB+FQFIL ; Channel number CALFIP ; Close the channel 100$: mov (sp)+ ,r0 return .dsabl lsb .sbttl check for typeahead .mcall qiow$s sf.gmc = 2560 tc.tbf = 71 typeahead:: save ; save r1 please clr r0 ; assume no typeahead clr -(sp) ; get the typehead buffer size mov @#$vext ,r1 cmpb @2(r1) ,#4 ; is this RSTS/E beq 100$ ; exit with failure if RSTS mov sp ,r1 ; point to the parameter area movb #tc.tbf ,@r1 ; we want amount in the buffer qiow$s #sf.gmc,#5,,,,, ; post the qio now tstb 1(r1) ; anything there ? beq 100$ ; we have nothing to get there inc r0 ; we have something 100$: tst (sp)+ ; pop buffer unsave ; pop reg and exit return ; exit .end