DataMuseum.dk

Presents historical artifacts from the history of:

Jet Computer Jet80

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Jet Computer Jet80

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦448c083d3⟧ TextFile

    Length: 3072 (0xc00)
    Types: TextFile
    Names: »STRFCT.SRC«

Derivation

└─⟦c9df7130d⟧ Bits:30005915 Pascal MT+ Release 5.2 (Jet-80)
    └─ ⟦this⟧ »STRFCT.SRC« 

TextFile

;ROUTINES FOR STRING APPEND,INDEX,LENGTH AND SET LENGTH
;
	NAME STRFCT
	ENTRY L137,INDEX,LENGTH,SETLEN
	EXT STRERR
	INCLUDE DEFLT.SRC
	INCLUDE FCTMAC.SRC
;
;STRING APPEND
;
L137:	LXI	H,2
	DAD	S
	MOV	C,M	;MAX. LENGTH OF STRING TO APPEND
	INX	H
	MOV	B,M	
	DAD	B	;TOP OF STRING
	MOV	A,M	;TEST FOR ZERO ACTUAL LENGTH OF ADD STRING
	CPI	0
	LXI	D,4
	DAD	D	;HIGH BYTE OF ADDR. OF TARGET STRING
	PUSH	H
	JRZ	ZSTR	;ZERO LENGTH, NO APPEND NEEDED
	MOV	D,M	;DE GETS ADDRESS OF TARGET STRING
	DCX 	H
	MOV	E,M
	DCX	H
	DCX	H
	MOV	A,M	;A <- MAXIMUM LENGTH OF TARGET STRING
	DCX	H	;POINT TO ACTUAL LENGTH OF ADD STRING
	DCR	C	;C <- MAX LENGTH OF ADD STRING
	MOV	B,C
	MOV	C,M	;C <- ACTUAL LENGTH OF ADD STRING
	DCX	H	;(HL) -> 1ST CHAR OF ADD STRING
	XCHG		;(HL) -> ACTUAL LENGTH OF TARGET STRING
	SUB	C	;A <- MAXLEN(TARGET) - CURLEN( ADD )
	CMP	M	;WILL EVERYTHING FIT IN TARGET STRING?
	JC	STRERR	;DOESN'T FIT.  ERROR
STRFIT:	MOV 	A,C
	ADD	M
	MOV	B,M	;OLD ACTUAL LENGTH
	MOV	M,A	;NEW ACTUAL LENGTH
	MOV	A,C	;LENGTH OF STRING TO APPEND
	MOV	C,B	;OLD ACTUAL LENGTH
	MVI	B,0
	ORA	A	;CLEAR CARRY
	DSBC	B
	DCX	H	;FIRST EMPTY SPACE
	MOV	C,A	;LENGTH OF STRING TO APPEND
	XCHG
	LDDR		;TRANSFER AND DECR.
ZSTR:	POP	H	;HIGH BYTE OF ADDR.OF STRING
	POP	D	;RETURN ADDR
	INX	H
	SPHL		;NEW STACK POINTER
	XCHG
	XRA	A	
	PCHL		;RETURN
;
;STRING INDEX ROUTINE		
;
INDEX:	LXI	H,257
	DAD	S
	XCHG		;DE<-TOP OF SECOND STRING
	LXI	H,256
	DAD	D
	PUSH	H	;HL<-TOP OF FIRST STRING
	LDAX	D
	MOV	C,A	;LENGTH OF SECOND STRING
	MOV	A,M	;COMPARE LENGTHS
	SUB	C
	JRC	INOFIT	;2ND STRING TOO LONG
	MOV	B,A
	DCX	D	;1ST CHAR OF 2ND STRING
;BEGIN SEARCH
INDSCH:	MVI	A,1	;A COUNTS POSITION OF 2ND STR.
	DCX	H	;1ST LETTER OF FIRST STRING
	PUSH	H	;SAVE BEGINNINGS OF STRINGS
	PUSH	D
INDMAY:	EXAF
	LDAX	D
	CMP	M	;COMPARE CHARS.
	JRNZ	INEXT	;NO MATCH
	EXAF
	CMP	C	;LAST CHAR OF STRING?
	JRZ	IFND	;YES,MATCH FOUND
	INR	A	;NO
	DCX	H
	DCX	D
	JR	INDMAY	;CHECK NEXT CHAR
INEXT:	XRA	A
	CMP	B	;LAST TRY?
	JRZ	INDNON	;YES,NO MATCH
	DCR	B	;NO,PREPARE FOR NEXT ATTEMPT
	POP	D
	POP	H
	EXAF
	JR	INDSCH
IFND:	POP	D	;BEGINNING OF 2ND STRING
	POP	H	;BEGINNING OF 1ST STRING
	POP	H	;TOP OF 1ST STRING
	MOV	A,M	;CALC INDEX VALUE
	SUB	C	;LENGTH OF SECOND STRING
	SUB	B	;NUMBER OF TRIES LEFT
	INR	A	;INDEX VALUE IN A
ICLN:	INX	H
	POP	D	;RETURN ADDRESS
	SPHL
	XCHG
	MOV	E,A
	MVI	D,0	;DE RETURNS INDEX VALUE
	XRA	A
	PCHL
INDNON:	EXAF
	POP	D	;BEGINNING OF 2ND STRING
	POP	H	;BEGINNING OF 1ST STRING
INOFIT:	XRA	A	;RETURN ZERO INDEX VALUE
	POP	H	;TOP OF 1ST STRING
	JR	ICLN
;
;STRING LENGTH ROUTINE
;
LENGTH:	ENTR	D,2,0
	LXI	H,255+8
	PUSH	X
	POP	D
	DAD	D	;HL<-ACTUAL LENGTH BYTE
	MOV	A,M
	MOV	2(X),A	;RETURNS LENGTH
	EXIT	D,256
;
;
;SET STRING LENGTH
;
SETLEN:	ENTR	D,2,0
	LXI	H,11
	PUSH	X
	POP	D
	DAD	D
	MOV	H,11(X)	;HL <- ACTUAL LENGTH BYTE
	MOV	L,10(X)
	MOV	C,8(X)	;NEW LENGTH
	MOV	M,C	;ASSIGN NEW LENGTH
	EXIT	D,4
«eof»