.TITLE KERBLI - Bliss-16 support routines .SBTTL Robert C. McQueen 30-November-1983 ; Version number .IDENT /1.0.000/ ; IDENT ; Directives .LIBRARY /KERMLB/ ; Pro/Kermit macro library .SBTTL Revision History ; ; 1.0.000 By: Robert C. McQueen On: 30-November-1983 ; Create this module ; .SBTTL System macros and other definitions ;++ ; The following will cause the external macros and symbol definitions ; to be included in this module ;-- .MCALL BLSRTN ; Macro to define a BLISS routine .SBTTL BL$FIL - Support CH$FILL function ;++ ; This routine will support the special case that is found in the KERMSG ; routine. This is only for use will Pro/Kermit and may not work in any ; other case ; ; Calling sequence: ; ; Bliss: ; ; CH$FILL(Character, Max_length, Character_pointer); ; ;-- ; Offsets FILCHR= 6 ; Fill character FILLEN= 4 ; Fill length FILPTR= 2 ; Pointer to place to store info .PSECT $CODE$, RO BLSRTN BL$FIL,2, MOV FILLEN(SP),R1 ; Get the count of characters BEQ 99$ ; Branch if no more characters MOV FILPTR(SP),R0 ; Get the pointer to store into MOVB FILCHR(SP),R2 ; Get the fill character 10$: MOVB R2,(R0)+ ; Store the character SOB R1,10$ ; Loop back 99$: RTS PC ; Return to the caller .SBTTL BL$FCH - Support the CH$FIND_CH function ;++ ; This routine will support the Bliss CH$FIND_CH function. It will find ; the first occurance of a character within a character string. ; ; Usage: ; ; Bliss: ; ; POINTER = CH$FIND_CH(Character, Pointer, Length); ; ;-- BLSRTN BL$FCH,2, MOV FCHLEN(SP),R1 ; Get the length of the string BEQ 90$ ; If zero, character can't be there MOV FCHPTR(SP),R0 ; Get the address of the first byte MOVB FCHCHR(SP),R2 ; And get the character to search for 10$: CMPB R2,(R0)+ ; Is this the character? BEQ 95$ ; Yes, fix the pointer and return SOB R1,10$ ; Otherwise, loop unless out of characters ; Here if we can't find the character 90$: CLR R0 ; Flag it wasn't there RTS PC ; And return ; Here if we have found the character. Fix the pointer back by one. 95$: DEC R0 ; Back up so we point at byte we just found RTS PC ; And return .SBTTL BL$MOV - Support the CH$MOVE function ;++ ; This routine will support the Bliss CH$MOVE function. This routine will ; only work the the calls from KERMSG. It is not expected that this routine ; will work with any other Bliss module ; ; Calling sequence: ; ; Bliss: ; ; CH$MOVE(Character_string_length, From_pointer, Dest_pointer); ; ;-- BLSRTN BL$MOV,2, MOV CHRDST(SP),R0 ; Get the destination MOV CHRLEN(SP),R1 ; Get the number of characters BEQ 99$ ; Leave if finished MOV CHRSRC(SP),R2 ; Get the source 10$: MOVB (R2)+,(R0)+ ; Move a character SOB R1,10$ ; Loop if more characters 99$: RTS PC ; Return to the caller .SBTTL BL$CPY - Support the Bliss CH$COPY function ;++ ; This routine will provide support for the CH$COPY function from Bliss. ; This routine will only work with the calls from KERMSG. It is not ; expected that this routine will work correctly with any other module. ; ; Calling sequence: ; ; Bliss: ; ; CH$COPY(Source_length, Source_pointer, Fill_character, ; Destination_length, Destination_pointer); ;-- BLSRTN BL$CPY,5, MOV DSTPTR(SP),R0 ; Get the destination pointer MOV DSTLEN(SP),R1 ; Get the length BEQ 99$ ; Zero, just get out MOV NUMARG(SP),R4 ; Get the number of arguments ADD #5,R4 ; Number of source pairs (0 to n-1) NEG R4 ; Complement ASL R4 ; Make this a word offset ADD SP,R4 ; Point to the argument 10$: MOV SRCLEN(R4),R2 ; Get the source length BEQ 25$ ; No characters to move? MOV SRCPTR(R4),R3 ; Get the pointer to the source ; Here to loop moving characters around 20$: MOVB (R3)+,(R0)+ ; Move a byte DEC R1 ; Count down the destination BEQ 99$ ; If zero, then done SOB R2,20$ ; Loop for the rest of the source ; Here to advance to the next source pointers 25$: CMP R4,SP ; Finished yet BEQ 30$ ; Yes, get out CMP -(R4),-(R4) ; Back up two pairs BR 10$ ; And loop back ; Here to fill characters as required. 30$: MOVB FILCHR(SP),(R0)+ ; Move the fill character SOB R1,30$ ; Loop for all characters ; Here to return to the caller 99$: RTS PC .SBTTL BL$ABS - Support Bliss ABS function ;++ ; This routine will provide support for the Bliss ABS function. This routine ; is expected to work ONLY with the calls from KERMSG. ; ; Calling sequence: ; ; Bliss: ; ; Value = ABS(.item); ; ;-- ; Argument offsets: ITEM= 2 ; Offset on the stack of item BL$ABS::MOV 2(SP),R0 ; Get the argument TST R0 ; Test if .lt. zero BGE 99$ ; Just reutrn if ok NEG R0 ; Negate the value 99$: RTS PC ; Return to the caller .SBTTL End of KERBLI .END