.TITLE LGETST Aleda Get String .PSECT Aleda,Gbl,Con .Dsabl GBL .Mcall $List, $Span ;;********************************************************************** ;; Fortran callable subroutine to access the console input device ;; (Alvin unit 0) for transfer of characters to a user specified buffer. ;; The default is for prefix blanks to be removed from the input. With ;; Control word bit 0 set, the prefix blanks will be removed. ;; ;; The user specified prompt is listed first followed by an optional ;; prompt postfix string. ;; ;; The provision for returning a BREAK indication is Ierror = 1 with the ;; Return Code = 1. ;; ;; Supports calls of the form: ;; Ierror = LGetST ( Prompt, Line, Line Size, [ Return Count/Code ], ;; [ Control ], [ prompt postfix string ] ) ;;********************************************************************** ;; Control Word definitions: ;; If Bit 0 Set, leave prefix blanks on the input string. ;; NoPrefix = 1 ;; ;;********************************************************************** ;; Last Modified: 25-Jul-84 DVJensen ;; 25-Jul-84 included optional prompt postfix string - using the ;; default buffer provided in unit 1 descriptor. ;; 2-Aug-84 DVJ - Control word added for removing prefix blanks on ;; input string. ;;********************************************************************** ;; .Mcall $Alv51 .Globl GetList,GetParm,GetDDA,PutByte,PutList,ResetBuf ;External .Globl Span $Alv51 $Span ;;********************************************************************** LGetString:: MOV R5,-(SP) ;SAVE REGISTERS USED MOV R4,-(SP) MOV R3,-(SP) MOV R2,-(SP) MOV R1,-(SP) Clr Count ;Initialize Variables Clr RtnAdr ;Fortran Calling Convention: Clr R0 ;Set for counting the parameters MOV (R5)+,R1 ;Get number of parameters passed. BIC #177400,R1 ;Clear possible high order junk Jsr PC,GetParm ;Get Parm # 1: User Prompt string. Bcs GetlError ;Required Parm - Abort if not provided. Mov R4,Prompt ;Get the starting address of the prompt string. Jsr PC,GetParm ;Get Parm # 2: Line Buffer. Bcs GetlError ;Required Parm - Abort if not provided. Mov R4,LnBuf ;Save pointer to the buffer region. Jsr PC,GetParm ;Get Parm # 3: Line Buffer Size. Bcs GetlError ;Required Parm - Abort if not provided. Mov (R4),LnSize ;Save the SIZE. Ble GetLError ;Return an error if Negative or Zero. Jsr PC,GetParm ;Get Parm # 4: Return Code Location. Bcs Getp5 ;Continue if not available (defaulted above) Mov R4,RtnAdr ;Save the address to return the code to. Getp5: Clr Control ;Default control word to zero. Jsr Pc,GetParm ;Get the Control word parm. Bcs GetPP Mov (R4),Control ;Save the user's control word value. GetPP: Clr ProPost ;Default parm # 6 to none. Jsr PC,GetParm ;Get Parm # 6 - Optional Postfix Prompt string. Bcs GetP7 ;Continue if none. Mov R4,ProPost ;Save the address. Getp7: Jsr R5,GetDDA ;Get the Device Descriptor Address. .Word 0 ;Requested unit is default console input device. Tst R0 ;Check if this was a valid unit number Beq GetL1Error ;Branch to error if no desc. Bit #Disabled,(R0) ;Is this device currently enabled? Bne GetEnaErr ;No, invalid device. Bit #Output,Lctl(R0) ;Is this an Output device? Bne GetOutDev ;Yes, branch - Cannot input from it. Bit #Seized,(R0) ;Is the Device Seized? (Available?) Bne GetSz ;; Jsr R5,GetDDA ;Check the Console list device. .Word 1 ;Requested unit is default console output device. Tst R0 ;Check if this was a valid unit number Beq Getl1Error ;Branch if no device defined. Bit #Disabled,(R0) ;Is the console list device enabled? Bne GetEnaErr ;No, error - branch. Bit #Output,Lctl(R0) ;Is this a valid output device? Beq GetInDev ;No, branch. Br GetSGO ;;**************************** GetL1Err: Mov #20.,R0 ;Error - No device Descriptor. GetLError: ;Error occurred - Code is in R0 Neg R0 ;Force return value negative to indicate error. Mov R0,Count ;Error returns error code and no count. Jmp GetLRtn ;and Return GetEnaErr: Mov #21.,R0 ;Error code #21 - Device not enabled. Br GetLError ;Return error code. GetOutDev: Mov #25.,R0 ;Error code #25 - Device not an input device. Br GetLError ;Return error code. GetInDEV: Mov #26.,R0 ;Error code #26 - Device is not an output device. Br GetLError ;Return error code. GetSZ: Mov #36.,R0 ;Error code #36 - Device is seized. Br GetLError ;Return error code. ;;**************************** ;; GetSGO: Mov R0,R2 ;Save Device Desc of List device. Mov BDefault(R2),R4 ;Get the default buffer desc. Jsr R5,PutList ;List a blank as a string - guarantee that .Word ABlank ; the defualt buffer is not in use. Jsr PC,ResetBuf ;Reset the default buffer for linear string. Mov Prompt,R3 ;Get the starting address of the user prompt. Jsr Pc,BufStr ;Put the user prompt into the default buffer. Mov ProPost,R3 ;Get the optional prompt postfix address. Beq Getset ;If zero, it was not provided. Jsr Pc,Bufstr ;Put it also in the default buffer. GetSet: Mov Bstart(R4),GetSPrompt ;Build desc for concatenated prompt. Mov Bin(R4),R3 ;Get the next input location of buffer. Dec R3 ;This is always one past last char. Mov R3,GetsPrompt+2 ;Set Static String end address. Jsr Pc,ResetBuf ;Reset pointers again so next default ; buffered output will not add to this. Mov #LnBuf,R4 ;Get address of the variable string desc. Mov (R4)+,R3 ;Get the starting address of the user line buf. Mov R3,(R4)+ ;Set the dynamic end pointer to the start. Add LnSize,R3 ;Calculate the end address of the line buffer. Dec R3 ;Backup by one for inclusive descriptor. Mov R3,(R4) ;Set the end address. ;; Jsr R5,GetList ;Call Getlist to do the actual I/O. .Word GetSPrompt ;The prompt static string descriptor. .Word LnBuf ;The input line descriptor. Br Break ;Break exit - branch. ; (GetList will set R0 = 0 if break) Mov R0,Count ;Set the Character count. Beq GetLRtn ;If zero, just exit. Bit #Noprefix,Control ;A request to remove prefix blanks? Beq GetLOK ;No, return. Jsr R5,Span ;Yes, let span do it. .Word LnBuf .Word SStr!Blank ;Span all occurances of blanks in static string. Br AllBlank ;Nothing but blanks - branch. Mov #LnBuf,R4 Cmp R0,(R4) ;Were any blanks spanned? Beq GetLOK ;No, nothing to do Mov (R4)+,R3 ;Get the Start of buffer address Mov R0,R1 ;Get pointer to first non-blank character. Sub R3,R1 ;Calculate number of characters removed. Sub R1,Count ;Subtract this from the count. Squeze: Movb (R0)+,(R3)+ ;Move the string down removing prefix blanks. Cmp R0,(R4) ;Is this the end of input? Blos Squeze Clrb (R3) ;Add null to end of string. GetLOK: Clr R0 ;Return code = Zero. Br GetLRtn AllBlank: Clr R0 ;Set return code = 0, Count = 0. Br SetCount Break: Inc R0 ;Set Functional Value = 1 = Break. SetCount: Mov R0,Count ;Set Count (return code) the same as error code. Clrb @Lnbuf ;Force a null string returned to the user. GetLRtn: Tst RtnAdr ;Did the user specify to return the char count? Beq GetLExit ;No, exit. Mov Count,@RtnAdr ;Return char count to user GetLexit: MOV (SP)+,R1 MOV (SP)+,R2 MOV (SP)+,R3 MOV (SP)+,R4 MOV (SP)+,R5 RTS PC ;AND RETURN ;;**************************************************************************** ;; Subroutine to move a user string whose base address is in Register 3 ;; to a Buffer whose descriptor is in Register 4. ;; Null and Backslash are used for terminators. A Maximum of 64 characters ;; will be moved. If the buffer becomes full, Bufstr simply returns. ;; Expects calls of the form: Jsr PC,BufStr ;; BufStr: Mov R1,-(SP) ;Save work register Mov #64.,R1 ;Allow maximum prompt length of 64 characters. BufsLP: Movb (R3)+,R0 ;Look for the end of the string. Bic #177600,R0 ;Clear parity Beq BufSEnd ;If zero, then this is the end. Cmp #'\,R0 ;Is this a backslash? Beq BufSend ;Yes, then have found end of string. Jsr R5,PutByte ;Put the character into the buffer. .Word 0 ;Assume buffer descriptor in in Register 4. Br BufSend ;If full then that's all folks. Dec R1 ;Has maximum length of the prompt been exceeded? Bne BufsLP ;No, loop Bufsend: ;Yes, well then this is it, no error though. Mov (Sp)+,R1 ;Restore R1 Rts PC ;;**************************** Prompt: .Word 0 ;User Prompt start address. ProPost: .Word 0 ;Optional user prompt postscript address. GetsPrompt: .Word 0 ;Prompt String Descriptor built by LGetSt - start .Word 0 ; end address (2 word descriptor) ;; LnBuf: .Word 0 ;Variable string desc (3 words) User's Line begin .Word 0 ;Address of last input char (set by GetList) .Word 0 ;Last address in the user line. ;; LnSize: .Word 0 ;Size of the User's Line Buffer. Count: .Word 0 ;Count of characters transmitted to user. RtnAdr: .Word 0 ;Address of User's Location for Return Code. Control: .Word 0 ;Control word value. ;; ABlank: .Word OneBlank ;String descriptor of a blank. .Word OneBlank OneBlank: .Ascii ' ' ;;**************************************************************************** .END