home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
extra
/
probli.mac
< prev
next >
Wrap
Text File
|
1988-08-16
|
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