.TITLE RDLINE .IDENT /V1.00/ ;+ ; ; This fortran callable subroutine will perform line editing ; based on the unsolicited character AST routine for fortran. ; This routine will perform character validation based on three ; types of character input; ; 1) alphanumeric strings, with terminator, or optional ; 2) numeric strings, with or optional terminators ; 3) floating point, with or optional terminators ; ; FORTRAN calling sequence; ; ; CALL RDLINE (buffer,len,options[,deflt,defltlen][,term]) ; ; where ; buffer - is the address of the input buffer (limited to 80. bytes) ; len - is returned as the number of bytes read in (word boundary) ; options - are defined as follows (word boundary) ; - bit 15 (set) don't echo characters as they are received ; - bit 15 (clear) echo characters as they are received ; - bit 14 - 2 (undefined, not referenced) ; - bit 1 - 0 ; = 0 receive characters in alpha mode ; = 1 receive characters in numeric mode ; = 2 receive characters in floating mode ; term - optional buffer to receive terminator character ; (byte boundary) ; ; Author : Dave Carroll [DTC] ; ;- CH.DEL =177 CH.CR =15 CH.CTLU =25 CH.ESC =33 .PSECT DATA,RW,D P.LST: .WORD 1,INCHAR INCHAR: .WORD 0 .MCALL QIOW$,CLEF$S,WTSE$S,DIR$ ECHO: QIOW$ IO.WVB,1,1,,,, IONL: QIOW$ IO.WVB,1,1,,,, IODEL: QIOW$ IO.WVB,1,1,,,, IOBEL: QIOW$ IO.WLB,1,1,,,, BELL: .ASCII <7><7> NL: .BYTE CH.CR,0 DELBUF: .ASCIZ <10>/ /<10> ; delete string - backspace,space,backspace .PSECT ROCODE,I,RO RDLINE:: CMP (R5),#3 ; are there enough arguments BEQ 10$ ; don't want the terminator BLO ERROR ; too small, fuss about it CMP (R5),#4 ; want four,no default string... BEQ 20$ ; handle it CMP (R5),#5 ; want a default block spec ? BLO ERROR ; wrong ... BEQ 30$ ; handle the default block CMP (R5),#6 ; are we in sync ... BNE ERROR ; wrong again CALL 30$ ; do the beginning MOV R0,@14(R5) ; stash the terminator RETURN ; to caller 10$: CALL INPUT ; dispatch it BCS 10$ ; all not OK RETURN ; all done 20$: CALL 10$ ; do the process MOVB R0,@10(R5) ; store the terminator RETURN ; to caller 30$: CALL 10$ ; handle the input TST R1 ; check the count BNE 60$ ; had a character ; ; Need to restore the default block ; 40$: MOV 10(R5),R2 ; point to the default MOV 2(R5),R3 ; get bufer address MOV @12(R5),R4 ; set a counter MOV R4,@4(R5) ; zap in the length 50$: MOVB (R2)+,(R3)+ ; copy a byte SOB R4,50$ ; copy it all RETURN ; back to caller 60$: BIT #2,@6(R5) ; is this floating ??? BEQ 70$ ; nope, return CMP #1,R1 ; is there only one character BEQ 40$ ; yup, only a dot in the buffer, default it 70$: RETURN ERROR: SEC RETURN INPUT: MOV @6(R5),R0 ; get the dispatch value BIC #^C<3>,R0 ; clear the high garbage ASL R0 ; double it CLR R1 ; clear counter MOV 2(R5),R2 ; set initial buffer address CALL @DISPAT(R0) ; goto our input routine ;+ ; If carry set, report the error ; ; Outputs from the routines are; ; ; R0 - terminator character ; R1 - length of the string read in ;- BCS INERR ; input error fuss about it MOV R1,@4(R5) ; set the length of the read DIR$ #IONL RETURN INERR: TST @6(R5) ; were they echoing BMI 20$ ; nope skip erase 10$: CALL DEL ; delete a character if possible TST R1 ; anything left BNE 10$ ; try again 20$: DIR$ #IOBEL ; output a bell SEC ; reset carry for the caller RETURN .PSECT RODATA,RO,D DISPAT: ASCII NUMER FLOAT ERROR .PSECT ROCODE,RO,I ;+ ; ASCII -- This routine is used to accept ASCII input into a line ; buffer, and return the length of it to the calling routine ; ; Inputs : ; R1 - zero for character counter ; R2 - buffer address to store characters ; ;- ASCII: CMP @4(R5),R1 ; too many characters yet BCS 10$ ; too many characters CALL CHR ; get a character, process funnies BCC ASCII ; not a terminator CLC ; say all is OK 10$: RETURN ; to caller ;+ ; NUMER - FLOAT These routines also use R3 and R4 for flags ; They are not meant to be passed back as values ;- NUMER: CLR R3 ; say no float JMP NUMB ; process it for em FLOAT: MOV #100000,R3 ; set floating flag CALL NUMB ; check for it BCC 10$ ; all went OK RETURN 10$: TSTB R3 ; any '.' seen BNE 20$ ; yup, don't append one MOVB #'.,(R2)+ ; set in a period INC R1 ; bump character count 20$: RETURN ; to caller NUMB: CALL ASCII ; get the line input BCS RET ; too many characters TST R1 ; anything at all ?? BEQ RET ; nope, ignore it MOV R0,-(SP) ; save the terminator MOV R1,-(SP) ; save the counter MOV 2(R5),R0 ; restore the begining of the buffer 10$: CMPB (R0),#'0 ; is it a valid number BLO 40$ ; nope error CMPB (R0),#'9 ; is it too high BHI 40$ ; yup, too high 20$: INC R0 ; bump the pointer SOB R1,10$ ; check the next one CLC ; clear carry 30$: MOV (SP)+,R1 ; restore the count MOV (SP)+,R0 ; and the terminator RETURN 40$: CMPB (R0),#'- ; negative number ??? BEQ 60$ ; allow it CMPB (R0),#', ; is it a seperating comma BEQ 20$ ; yes, continue TST R3 ; integer or number mode BPL 50$ ; integer mode, error CMPB (R0),#'. ; was it a period BNE 50$ ; wasn't a period, error TSTB R3 ; is it more than the first BNE 50$ ; yup, error INC R3 ; bump period count BR 20$ ; and continue 50$: SEC ; set carry BR 30$ ; return 60$: CMP 2(R5),R0 ; first character only for '-' BEQ 20$ ; we can allow this BR 50$ ; set an error ;+ ; CHR -- This routine is used to receive a character process the ; special characters and and return with carry clear if ; the character was not a terminator. ; ; Entry : ; R2 - next buffer address to place character ; R1 - character count of the current character ; R5 - set with fortran parameter list pointer ; ; Exit : ; R2 - updated buffer position ; R1 - updated character count ; R0 - character processed ; ;- CHR: MOV R5,-(SP) ; save the parameter list MOV #P.LST,R5 ; set the new parameter list to R5 10$: CALL INCHR ; try to get a character MOV INCHAR,R0 ; check if we got anything BNE 20$ ; got something CLEF$S #15 ; clear e.f. 16, saying we're waiting CALL INCHR ; check again, just in case something ; came in MOV INCHAR,R0 ; put into R0 BNE 20$ ; got something WTSE$S #15 ; wait for a to come in BR 10$ ; then go get the string ; ; Got something !!! ; 20$: MOV (SP)+,R5 ; restore parameter list CMP #CH.DEL,R0 ; is it delete BEQ DEL ; yup, process CMP #CH.CTLU,R0 ; control-U BEQ CTLU ; yup process that CMP #CH.CR,R0 ; seen ? BEQ CR ; yup terminate CMP #CH.ESC,R0 ; or was it an escape BEQ CR ; han'l it CMP R0,#40 ; less than a space BLO CHR ; control char, try again ; ; Normal character, handle as usual ; MOVB R0,(R2)+ INC R1 ; bump the count TST @6(R5) ; want it to echo BMI RET ; nope don't echo it DIR$ #ECHO ; echo the character RET: RETURN ; try again CTLU: CALL DEL ; delete a character from the buffer TST R1 ; any more BNE CTLU ; try again BR CHR ; get another CR: SEC ; set carry, got a terminator RETURN ; to caller ;+ ; DEL -- Delete a character from the buffer if possible, and echo if ; needed. ;- DEL: TST R1 ; check our counter BEQ RET ; OK to delete DEC R2 ; drop the character pointer DEC R1 ; and the count TST @6(R5) ; are we echoing BMI RET ; if so return DIR$ #IODEL ; issue the delete RETURN ; to caller .END