Columbia Kermit/kermit.zip/decpro300/probli.mac

Text File | 2020-01-01 | 5KB | 199 lines

    .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,<FILCHR,FILLEN,FILPTR>
    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,<FCHCHR,FCHPTR,FCHLEN>
    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,<CHRLEN,CHRSRC,CHRDST>
    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,<SRCLEN,SRCPTR,FILCHR,DSTLEN,DSTPTR,NUMARG>
    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