.title output .sbttl output_format_subroutine .psect output_format_subroutine .ident /28JAN82/ ; ; This file should handle the i/o for the Snobol system. ; There are several kludges involved in this subroutine. The fortran ; format statements are handled by brute force, put into quqbuf, and ; printed on unito. ; If stprint macro is used then format 1x1a132 is used, i.e., no formatting ; is assumed or performed. ; If the output macro is used then if unito is directed to a terminal then ; format characters are removed because I didn't like stuff scrolling way off ; of the screen, if unito is directed to somewhere else formatting is left ; on and it is printed with 1a132 with the length stuffed into the format ; statement. ; ; Modification 28 jan 82: ; change formats so that unit numbers > 10 get list format and not ; fortran format for carriage return stuff in files. ; i.e. for unit numbers > 10 no blank will appear at the beginning ; of the line. ; ; regs used: ; r1->format stmt ; r2= format character ; r3->print buffer ; r4->parameter list ; ; necessary data: ; quqbuf: .blkb 134 ; print buffer for output macro quqdesc:: .word .-. .byte 14 .byte 1 .long .-. tab = 09 ; ; subroutine quqout ; called by output macro ; ; in: 4(ap) = address of format descriptor ; 8(ap) = first argument ; 12(ap) = second argument ; . ; . ; .entry quqout,^m moval quqbuf,r3 ; print buffer movl 4(ap),r1 ; format descriptor pointer movl 4(r1),r1 ; format pointer moval 8(ap),r4 cmpb (r1)+,#^a'(' ; does format start with a ( bneq 98$ ; brifnot 1$: jsb qgetnum ; get a number movzbl (r1)+,r2 ; get field type cmpb r2,#^a/H/ ; h literal? beqlu 10$ cmpb r2,#^a/I/ ; i format? beqlu 20$ cmpb r2,#^a/,/ ; comma? beqlu 30$ cmpb r2,#^a/F/ ; f format? beqlu 40$ cmpb r2,#^a'/' ; newline? beqlu 50$ cmpb r2,#^a/)/ ; end of format? beqlu 60$ cmpb r2,#^a/A/ ; a literal? beqlu 70$ brb 1$ 98$: ret ; h literal 10$: pushr #^m movc3 r0,(r1),(r3) popr #^m addl2 r0,r1 addl2 r0,r3 brw 1$ ; i format 20$: jsb qgetnum movl r3,quqdesc+4 ; create vms descr movw r0,quqdesc pushr #^m ; save these over cvt call pushal quqdesc pushal (r4)+ calls #2,g^ots$cvt_l_ti popr #^m addl2 r0,r3 brw 1$ ; , 30$: brw 1$ ; / 50$: jsb quqp brw 1$ ; ) 60$: jsb quqp ret ; a 70$: brw 1$ ; f 40$: jsb qgetnum movl r3,quqdesc+4 ; create vms descr movw r0,quqdesc pushr #^m ; save these over cvt call pushl #2 ; digits in fract pushal quqdesc ; outstr cvtfd (r4)+,44$ pushal 44$ ; value calls #3,g^for$cvt_d_tf popr #^m addl2 r0,r3 brw 1$ 44$: .quad 0 ; ; subroutine qgetnum ; called by jsb ; get a number pointed to by r1 in the format stmt ; qgetnum: clrl r0 2$: movzbl (r1),r2 cmpb r2,#^a/0/ blssu 5$ cmpb r2,#^a/9/ bgtru 5$ bicl2 #^x0fffffff0,r2 mull2 #10,r0 addl2 r2,r0 incl r1 brb 2$ 5$: rsb ; ; subroutine quqp ; called by jsb ; ; helper subroutine to above stuff to print the line ; quqp: pushr #^m pushl #unito ; find out if terminal or file i/o calls #1,qtran tstl r0 ; is it terminal? beql 5$ ; brifnot movb #^a/ /,quqbuf ; unformat if so 5$: subl2 #quqbuf,r3 ; build descriptor for fortran movw r3,quqdesc ; i/o call movw r3,f1a132+2 ; make 'a' format just big enough moval quqbuf,quqdesc+4 pushab f1a132 ; format=use carriage control pushl #unito calls #2,qstprnt popr #^m moval quqbuf,r3 rsb .page .sbttl qstprnt subroutine ; ; subroutine qstprint ; called directly by stprint macro ; called from above from output macro ; ; in: 4(ap) = unit number ; 8(ap) = format address with length set in it ; quqdesc = descriptor (vax format) to string to print ; ; out: string printed fortran style on unit number ; .entry qstprnt,^m<> ;---------------------------- ; 27-jan-82 cmpl 4(ap),#10 ; if unit > 10 then no formatting bleq 10$ moval 4(ap),qstprms+8 callg qstprms,for$open ;---------------------------- 10$: pushl 8(ap) ; format address pushl 4(ap) ; unit number calls #2,for$write_sf pushab quqdesc calls #1,for$io_t_ds calls #0,for$io_end ret qstprms: .long 5 .long ^x000501 .long 0 .long ^x020107 .long ^x04010f .long ^x020118 ; ; subroutine qstread ; called directly by stread macro ; ; in: 4(ap) = unit number ; 8(ap) = address of buffer ; 12(ap)= length of buffer ; ; out: r0 = r1 = 0 successful read ; r0 = 1 end of file encountered ; r1 = 1 error occurred ; ; a string is read from unit number with format(1a80) ; .entry qstread,^m<> ; pushl 4(ap) ; find out if reading ; calls #1,qtran ; from a terminal ; beql 5$ ; brifnot ; pushal qprmpt ; prompt for input if so ; pushl #unito ; calls #2,for$write_sf ; calls #0,for$io_end ;5$: moval quqbuf,quqdesc+4 ; read into quqbuf movw 12(ap),quqdesc ; length of string to read pushab qeof ; end=addr pushab qerr ; err=addr pushal f1a80 ; format pushl 4(ap) ; unit no. calls #4,for$read_sf pushab quqdesc calls #1,for$io_t_ds calls #0,for$io_end ; ; convert tabs to spaces ; ; ; register useage ; r0: no. of bytes left in source string ; r1: address in source string ; r3: address in destination string movzwl 12(ap),r0 ; size of input string moval quqbuf,r1 ; r1->source string movl 8(ap),r3 ; r3->destination string 4$: movl r1,r6 ; save start position locc #tab,r0,(r1) ; find a tab beql 8$ ; brifnone ; r0=bytes remaining in src str ; r1->tab pushr #^m ; save these across char instr subl3 r6,r1,r7 ; get no of chars skipped movc3 r7,(r6),(r3) ; copy to dst area ; r0=0 ; r1->tab ; r3->next position in dst string subl3 8(ap),r3,r8 ; no of chars in dst string bicl2 #^xfffffff8,r8 ; save 3 bits subl3 r8,#8,r8 ; number of spaces to next tab mark movc5 #0,0,#^a/ /,r8,(r3) ; put some spaces in popr #^m ; restore regs incl r1 ; skip over tab subl2 r8,r0 ; count as 'n' characters ; decl r0 ;;;;; 10nov81 change brb 4$ 8$: subl3 r6,r1,r7 ; get no of chars skipped movc3 r7,(r6),(r3) ; copy to dst area 80$: clrl r0 clrl r1 ret qeof: clrl r0 ; end of file encountered movl #1,r1 ret qerr: movl #1,r0 ; error occurred clrl r0 ret ; length is modified: ; in f1a132 format by stprnt macro, ; in f1x1a132 by quqp subroutine ; f1a80: .byte ^x15,^x50,^x04 ; format(80a1) f1a132:: .byte ^x95,^x04,^x84,^x00,^x04 ; format(1a132) f1x1a132:: .byte ^x13,^x01,^x95,^x04,^x84,^x00,^x04 ; format(1x1a132) ;qprmpt: .byte ^x0f,^x05,^x24,^x53,^x4e,^x4f,^x3e,^x04 ; 'SNO>' .page .sbttl determine terminal or file i/o ; ; subroutine qtran ; ; in: 4(ap) = fortran unit number ; ; out: r0 = 0 if unit number is to a file ; 1 if unit number is a terminal ; ; logic: ; put 'FOR' into string at 30$ ; convert unit number into '006' at 30$+3 ; translate the logical name at 30$ to string at 60$ ; if no translation for the string at 30$ then exit ; if translation not successful then exit ; if string translated to 'xxxx_TTxxx' then exit - it is terminal ; copy result at 60$ to 30$ ; loop again ; ; .entry qtran,^m movw #6,20$ ; set length of 'FORnnn' movl 31$,30$ ; put 'FOR' into string pushl #3 ; number of characters pushal 40$ ; output buffer pushal 4(ap) ; unit number calls #3,g^ots$cvt_l_ti ; convert to make 'FOR006' 5$: pushal 50$ ; length of result pushal 50$ ; descriptor of result pushal 20$ ; descriptor of origional calls #3,g^lib$sys_trnlog ; translate from 20$ to 50$ cmpl r0,#ss$_notran ; if no translation then exit beql 7$ cmpl r0,#ss$_normal bneq 9$ ; if not normal assume terminal cmpc3 #3,60$+4,80$ ; is it '_TT' ? beql 9$ movzwl 50$,r6 ; copy to input descriptor movc3 r6,60$,30$ movw 50$,20$ movw #20,50$ brb 5$ ; gofer more 7$: clrl r0 ; it is a file ret 9$: movl #1,r0 ; it is a terminal ret 20$: .word 6 ; input descriptor to translate .byte 14 .byte 1 .long 30$ 30$: .ascii /FORxxxxxxx/ 31$: .ascii /FOR0/ 40$: .word 3 ; descriptor to integer convert .byte 14 .byte 1 .long 30$+3 50$: .word 20 ; output descriptor from translate .byte 14 .byte 1 .long 60$ 60$: .ascii /01234567890123456789/ 80$: .ascii /_TT/ .end