.TITLE LPUTLN Aleda Put Line .PSECT Aleda,Gbl,Con .Ident /LVL51 / .Dsabl GBL ;;********************************************************************** ;; Fortran callable subroutine to output to the specified Alvin unit # ;; for transfer of characters from the user specified line. ;; ;; Supports calls of the form: ;; Ierror = LPutLN ( Unit #, Line, Line Size, [ Return Count ], ;; c [ Control Word ], [ Terminator Array ] ) ;;********************************************************************** ;; Last Modified: 8-May-84 DVJensen - Abort if Line Size < = 0 . ;; 1-Aug-84 DVJ - Terminator is not transmitted by default. ;; 19-Jul-85 DVJ - If terminator array processed even though no control word. ;; 25-Nov-85 DJ - AlvIdle invoked if buffer fills up. This will do a timed ;; wait before resuming, relinquishing some time to other jobs. ;;********************************************************************** ;; .Mcall $Alv51 .Globl PutByte,GetParm,GetDDA,Send,AlvIdle ;External Globals $Alv51 ;; Control Word Bits - If set they indicate: DoTerms=1 ; 0 : Process terminator array for end of line. Parity =2 ; 1 : Include parity bit in characters moved to buffer. DoTime =4 ; 2 : Return to user if next character is not transmitted ; within "TimOut" length of time (in tenths of secs). BufTerms=8. ; 4 : Buffer the terminator when found. ;;********************************************************************** LPutLn:: MOV R5,-(SP) ;SAVE REGISTERS USED MOV R4,-(SP) MOV R3,-(SP) MOV R2,-(SP) MOV R1,-(SP) Clr Count ;Initialize Variables Clr Return ;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: Alvin Unit number. Bcs PutlError ;Required Parm - Abort if not provided. Mov (R4),R3 ;Get the actual unit number Mov R3,Unit ;Save it Jsr PC,GetParm ;Get Parm # 2: Line Buffer. Bcs PutlError ;Required Parm - Abort if not provided. Mov R4,LnBuf ;Save pointer to the user line. Jsr PC,GetParm ;Get Parm # 3: Line Size. Bcs PutlError ;Required Parm - Abort if not provided. Mov (R4),LnSize ;Save the SIZE. Ble PutLError ;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,Return ;Save the address to return the code to. Getp5: Clr Control ;Default Control Word to zero (optional). Jsr PC,GetParm ;Get Parm # 5: Control Word. Bcs Getp6 ;Continue if not available Mov (R4),Control ;Save the Control Word value. Getp6: Clr Terms ;Default Terminator Array (optional) to zero. Jsr PC,GetParm ;Get Parm # 6: String of Terminator Chars. Bcc Getp6T ;Branch if specified to save it Bit #Doterms,Control ;Did the user say to look for terminators? Bne PutNoTerm ;Yes, and none was provided - error branch. Br Getp7 Getp6T: Mov R4,Terms ;Save the base adr of the terminator array. Getp7: Clr Timout ;Default Time-out value (optional) to zero. Jsr PC,GetParm ;Get Parm # 7: Maximum time to complete transfer. Bcs Getp8 ;Continue if not available. Mov (R4),Timout ;Save the Time-out Value. Getp8: Br PutLGO ;;**************************** PutLError: ;Error occurred - Code is in R0 Neg R0 ;Force return value negative to indicate error. Mov R0,Count ;Error returns Error code not count. Jmp PutLRtn ;and Return ;;**************************** ;; PutLGO: Jsr R5,GetDDA ;Get the Device Descriptor Address .Word -1 ;Requested unit is already in Register 3. Tst R0 ;Check if this was a valid unit number Bne PutLBD ;Proceed if non-zero. PutL1Err: Mov #20.,R0 ;Error - No descriptor. Br PutLError ;Return error code. PutEnaErr: Mov #21.,R0 ;Device not enabled, error #21 Br PutLError ;Return error code. PutInDev: Mov #26.,R0 ;Device is not an output device Br PutLError ;Return error code. PutNoTerm: Mov #33.,R0 ;Array of terminators not provided Br PutLError ;Return error code. PutNoBuf: Mov #37.,R0 ;Error code #37 - No buffer descriptor. Br PutLError ;Return error code. PutLBD: Mov R0,R2 ;Save the Device Desc Address. Bit #Disabled,(R2) ;Is this device currently enabled? Bne PutEnaError ;No, invalid device. Bit #Output,Lctl(R2) ;Is this an Output device? Beq PutInDev ;No, branch - Cannot output to it. Mov BDefault(R2),R4 ;Get the default buffer Descriptor Address Beq PutNoBuf ;If zero, it does not exist. Mov LnBuf,R1 ; Get the User Line Buffer address PutLbyte: MovB (R1),R0 ; Get the first byte from the user line. Bit #Parity,Control ;Should the parity bit be included? Beq PutLPC ;No, branch to clear it Bic #177400,R0 ;Clear only the high byte. Br PutLUB PutLPC: Bic #177600,R0 ;Clear high-order & parity bits. PutLUB: Clr R3 ; Reg 3 = zero = no terminator found. Mov Terms,R5 ; Yes, get the array base address Beq Putit ; If zero, it does not exist. MovB (R5)+,R3 ; Get the number of bytes to look for Beq Putit ; If zero, then no terminators provided Bic #177400,R3 ; Clear high byte TermLP: Cmpb R0,(R5)+ ; Is this a terminator? Bne Nexterm ; No, look at next terminator. Bit #BufTerms,Control ; Should the terminator be buffered? Bne Putit ; Yes, go put it. Br PutLDone ; No, branch to wrapup processing. Nexterm: Dec R3 ; Count down number of term chars. Bne TermLP ; Loop until all terminators checked. Putit: Jsr R5,PutByte ; Put this byte into .Word 0 ; the buffer in Reg 4. Br PutLwait ; No byte transmitted - full - wait... Inc Count ; Count it. Tst R3 ; Was a terminator found? Bne PutLDone ; Yes, branch. TstB (R1)+ ; Advance line character pointer PutLCont: Cmp Count,LnSize ; Has the maximum number of chars been xfer'd? Blo PutLbyte ; No, go look for another Tst Terms ; Were terminators being looked for? Beq PutLdone ; No, then complete normally. Mov #-34.,Count ; Yes, return error code #34. PutLdone: ;Go ahead and try to send the buffer. If the device is already ;active on the default buffer, Send will now return normally. ;This technique will always call AlvUpdate before exiting. PutLSend: Mov Unit,R3 ; Get the unit number into Reg 3. Jsr R5,Send ; Line is buffered - start transmitting it. .Word -1 ; Parm is in register 3 .Word 0 ; Buffer Desc is in Reg 4. Br PutReTry ; Loop until the output is initiated. Br PutLRtn ; Done, now can exit. PutRetry: Jsr Pc,AlvIdle ; Cannot Send. Wait a bit and try again. Br PutLSend ; ;;****************************** PutLwait: ; The buffer is full, try to start it listing. Mov Unit,R3 ;Get the Unit number to send to. Jsr R5,Send ;Try to initiate transmit to device .Word -1 ;Unit number is in reg 3. .Word 0 ;Buffer to send from is in Reg 4. Nop ; Ignore if cannot send right now. Jsr Pc,AlvIdle ; Wait a bit for buffer to transmit/free-up. Br PutLbyte ; Go try to buffer the next byte. ;;**************************** PutLRtn: Sec Mov Count,R0 ; If there was an error, this is the code. Bmi 1$ ; Return error code as functional value. Clr R0 ; Otherwise there is no error. Clc 1$: Mov Return,R1 ; Did the user want the return code (count)? Beq PutLExit ; No, exit. Mov Count,(R1) ; Yes, do it. PutLexit: MOV (SP)+,R1 MOV (SP)+,R2 MOV (SP)+,R3 MOV (SP)+,R4 MOV (SP)+,R5 RTS PC ;AND RETURN ;;**************************** Unit: .Word 0 ;Logical Unit number to transmit to. LnBuf: .Word 0 ;Address of User's Line Buffer. LnSize: .Word 0 ;Size of the User's Line Buffer. Count: .Word 0 ;Count of characters transmitted to buffer. Return: .Word 0 ;Address of User's Location for Return Code. Control: .Word 0 ;User specified control word. Terms: .Word 0 ;Address of User's Terminator Array. Timout: .Word 0 ;Maximum time to complete the Put Line. ;;************************************************************************** .END