.TITLE WYL_MISC - Miscellaneous routines.  .IDENT /0-01/ ( 2;++ <; F; TITLE: WYLMISC Short instruction-like module group. P; Z; FACILITY: WYLVAX d; n; ABSTRACT: x; ; Procedures to utilize or simulate a single VAX ; machine instruction. ; ; ENVIRONMENT: Run at any access mode - AST re-entrant ; ; AUTHOR: Douglas Palmer, CREATION DATE: 26-JUL-1980 ; ;-- .PSECT WYL_CODE,PIC,USR,CON,REL,LCL,SHR,EXE,RD,NOWRT .PAGE .SBTTL WYL_MOVC5 - Move characters 5 operand  ;++ ; ; FUNCTIONAL DESCRIPTION: ; "; Arguments are directly presented to the MOVC5 instruction. ,; 6; CALLING SEQUENCE: @; J; Rem_bytes.wlc.v = WYL_MOVC5(srclen.rw.r,srcaddr.ra.r, T; fill.rbu.r,dstlen.rw.r,dstaddr.ra.r) ^; h; INPUT PARAMETERS: r; |; srclen Address of word specifying number of bytes to move. ; ; srcaddr Address of source string. ; ; fill Address of character to pad out bytes not filled ; by source string. ; ; dstlen Address of word giving length of destination string. ; ; OUTPUT PARAMETERS: ; ; dstaddr Address of destination string. ; ; COMPLETION STATUS: ; ; rem_bytes Number of unmoved bytes remaining in the ; source string. Returns zero if destination &; string is longer than source string. 0; :;-- D NSRCLEN = 4 XSRCADDR = 8 bFILL = 12 lDSTLEN = 16 vDSTADDR = 20   .ENTRY WYL_MOVC5, ^M  MOVC5 @SRCLEN(AP), -  @SRCADDR(AP), -  @FILL(AP), -  @DSTLEN(AP), -  @DSTADDR(AP)  RET   .PAGE  .SBTTL WYL_MOVC3 - Move characters 3 operand  ;++ ; ; FUNCTIONAL DESCRIPTION: ; ; Arguments are directly presented to the MOVC3 instruction. ; Provides fastest means known of moving one block of memory to ; another. *; 4; CALLING SEQUENCE: >; H; Mov_bytes.wlc.v = WYL_MOVC3(srclen.ru.r,srcaddr.ra.r, R; dstaddr.ra.r) \; f; INPUT PARAMETERS: p; z; srclen Address of word specifying number of bytes to move. ; ; srcaddr Address of source string. ; ; OUTPUT PARAMETERS: ; ; dstaddr Address of destination string. ; ; COMPLETION STATUS: ; ; mov_bytes Number of moved bytes. ; ;--  SRCLEN = 4 SRCADDR = 8 DSTADDR = 12 $ . .ENTRY WYL_MOVC3, ^M 8 MOVC3 @SRCLEN(AP), @SRCADDR(AP), @DSTADDR(AP) B MOVZWL @SRCLEN(AP), R0 L RET V ` .PAGE j .SBTTL WYL_FLNBC - Find last nonblank character. t ~;++ ; ; FUNCTIONAL DESCRIPTION: ; ; String is scanned looking for the last occurence of a nonblank ; character. ; ; CALLING SEQUENCE: ; ; Column.wlv.u = WYL_FLNBC(dscaddr.rt.dx) ; ; INPUT PARAMETERS: ; ; dscaddr Address of source string descriptor. ; ; OUTPUT PARAMETERS: ; ; lascol Last nonblank column in string. ; (; COMPLETION STATUS: 2; <; Column Last non-blank column in string. F; P;-- Z dDSCADDR = 4 n x .ENTRY WYL_FLNBC, ^M  MOVQ @DSCADDR(AP), R6 ; Move descriptor  MOVZWL R6, R6 ; Zero extend len  TSTL R6 ; Len=0?  BEQL FLNBC_TRM ; Yep. Finish  ADDL2 R6, R7 ; Add length to address FLNBC_STRT:  CMPB -(R7), #^X20 ; Move char. to CHAR  BNEQ FLNBC_TRM ; If noblank go to fin  DECL R6 ; Decrease index by 1  BNEQ FLNBC_STRT ; No! Go to start FLNBC_TRM:  MOVL R6, R0 ; Put last column in R0  RET ; Return   .PAGE  .SBTTL WYL_SUBC - Substitute characters in string. " ,;++ -; .; FUNCTIONAL DESCRIPTION: 6; @; All occurences of a given object string found within a string J; are converted to the substitution string. This Macro type T; procedure steps ahead in the string to avoid macro explosions. ^; h; CALLING SEQUENCE: r; |; Nsub.wlc.v = WYL_SUBC(srcstr.ma.dx,objstr.ra.dx[,substr.ra.dx]) ; ; INPUT PARAMETERS: ; ; srcstr Address of character string descriptor pointing to ; a buffer containing the source string. ; ; objstr Address of character string descriptor pointing to ; a buffer containing the object string to locate in the ; source string. ; ; substr Address of character string descriptor pointing to ; a buffer containing the substitution string. ; If this argument is omitted then the object string ; is eliminated from the source string. ; ; OUTPUT PARAMETERS: &; 0; None. :; D; COMPLETION STATUS: N; X; Nsub Number of substitutions made. b; l;-- v SRCSTR = 4 OBJSTR = 8 SUBSTR = 12   .ENTRY WYL_SUBC, ^M  MOVQ @SRCSTR(AP), R2 ; R2, R3 <-- Desc  MOVZWL R2, R2  MOVQ @OBJSTR(AP), R8 ; R8, R9 <-- Descr.  MOVZWL R8, R8  MOVL #0, R10 ; R10 <-- Len RSTR  SUBL2 #12, SP ; Make room on stack  CLRL 8(SP) ; NCNT = 0  CMPB #3, (AP) ; 3 args?  BNEQ SUBC_LOOP ; No. Go on.  TSTL SUBSTR(AP) ; Valid address?  BEQL SUBC_LOOP ; No. Go on.  MOVQ @SUBSTR(AP), R10 ; R10, R11 <-- desc * MOVZWL R10, R10 ; R10 extended 4SUBC_LOOP: > MATCHC R8, (R9), R2, (R3) ; Find object string H BEQL SUBC_MOVE ; Exists. Go on. R MOVL 8(SP), R0 \ RET fSUBC_MOVE: p INCL 8(SP) ; NCNT = NCNT + 1 z ADDL3 R8, R2, R6 ; # left-L1  SUBL3 R10, R6, R4 ; R4 <-- Dst len  SUBL3 R8, R3, R7  ADDL3 R10, R7, R5 ; R5 <-- Dst addr  MOVQ R4, (SP) ; Push on stack  CMPL R8, R10 ; L1 = L2?  BEQL SUBC_SUBS ; Yep.  TSTL R4 ; Enough space?  BLEQ SUBC_SUBS ; Nope.  MOVC5 R2, (R3), #^X20, R4, (R5) SUBC_SUBS:  CMPL R10, R6 ; Last in line?  BGEQ SUBC_STF ; Nope. Go on.  MOVC3 R10, (R11), (R7) ; Put in replacement  MOVQ (SP), R2  BRB SUBC_LOOP  SUBC_STF: $ MOVC3 R6, (R11), (R7) ; Put in replacement . MOVL 8(SP), R0 8 RET B L V .PAGE ` .SBTTL WYL_FIND - Find represented character. j t ;++ u ; v ; FUNCTIONAL DESCRIPTION: ~ ; ; The first string is scanned for the first character also ; represented in the second string. The column number is ; returned. Zero is returned if no character in string1 is ; found in string2. ; ; CALLING SEQUENCE: ; ; Column.wlc.v = WYL_FIND(string1.rt.dx,string2.rt.dx) ; ; INPUT PARAMETERS: ; ; string1 Address of the scanned string descriptor. This string ; will be searched for a character represented in ; string2.  ;  ; string2 Address of source string descriptor. ( ; 2 ; OUTPUT PARAMETERS: < ; F ; None. P ; Z ; COMPLETION STATUS: d ; n ; Column Column number of first byte in string1 represented x ; in string2. Returns zero none represented. ; ;-- STRING1 = 4 STRING2 = 8 .ENTRY WYL_FIND, ^M MOVQ @STRING1(AP), R2 ; R2, R3 <-- Descr MOVZWL R2, R2 ; Zero extend length BEQL 20$ MOVQ @STRING2(AP), R4 ; R4, R5 <-- Descr MOVZWL R4, R4 ; Zero extend length BEQL 20$  CLRL R6 ; R6 is the col. index  10$:  LOCC (R3)[R6], R4, (R5) ; Character found? " BNEQ 30$ , AOBLSS R2, R6, 10$ ; Loop. Next character 6 20$: @ CLRL R0 ; Not found J RET T 30$: ^ ADDL3 #1, R6, R0 ; Column position h RET r | .PAGE .SBTTL WYL_VERIFY - Find nonrepresented character. ;++ ; ; FUNCTIONAL DESCRIPTION: ; ; The first string is scanned for the first character not ; represented in the second string. The column number is ; returned. Zero is returned if all characters in string1 are ; found in string2. ; ; CALLING SEQUENCE: ; ; Column.wlc.v = WYL_VERIFY(string1.rt.dx,string2.rt.dx) ;  ; INPUT PARAMETERS:  ;  ; string1 Address of the scanned string descriptor. This string & ; will be searched for a character not represented in 0 ; string2. : ; D ; string2 Address of source string descriptor. N ; X ; OUTPUT PARAMETERS: b ; l ; None. v ; ; COMPLETION STATUS: ; ; Column Column number of first byte in string1 not represented ; in string2. Returns zero if all are represented. ; ;-- STRING1 = 4 STRING2 = 8 .ENTRY WYL_VERIFY, ^M MOVQ @STRING1(AP), R2 ; R2, R3 <-- Descr MOVZWL R2, R2 ; Zero extend length  BEQL 20$ MOVQ @STRING2(AP), R4 ; R4, R5 <-- Descr  MOVZWL R4, R4 ; Zero extend length BEQL 20$ * CLRL R6 ; R6 is the col. index 4 10$: > LOCC (R3)[R6], R4, (R5) ; Character found? H BEQL 30$ R AOBLSS R2, R6, 10$ ; Loop. Next character \ 20$: f CLRL R0 ; Not found p RET z 30$: ADDL3 #1, R6, R0 ; Column position RET .PAGE .SBTTL WYL_INDEX - Find substring in string. ;++ ; ; FUNCTIONAL DESCRIPTION: ; ; The source string is searched for an object string which ; lies within specified columns. If not found zero returned. ; ; CALLING SEQUENCE: ; ; Column.wlc.v = WYL_INDEX(srcdsc.rt.dx,objdsc.rt.dx ; ,col1.rl.v,col2.rl.v) ; $; INPUT PARAMETERS: .; 8; srcdsc Address of source string descriptor. This string B; will be searched for the substring. L; V; objdsc Address of object string descriptor. This occurence `; of this string is sought in srcdsc. j; t; col1 Value of word specifying the first column ~; of the column range in which to find the object string. ; ; col2 Value of word specifying the last column in ; which to find the object string. ; ; OUTPUT PARAMETERS: ; ; None. ; ; COMPLETION STATUS: ; ; column Address of longword to accept the column number ; of the object string. Returns zero if not found. ; ;--  SRCDSC = 4 (OBJDSC = 8 2COL1 = 12 <COL2 = 16 F P .ENTRY WYL_INDEX, ^M Z MOVQ @OBJDSC(AP), R0 ; R0, R1 <-- OBJ DSC d MOVQ @SRCDSC(AP), R2 ; R2, R3 <-- SRC DSC n SUBL3 #1, COL1(AP), R4 ; COL1-1 x SUBW2 R4, R2 ; LEN-COL1+1 <-- R2  BLEQ 100$ ; Invalid  MATCHC R0, (R1), R2, (R3)[R4] ; Find substr in text  BNEQU 100$ ; If NEQ, not found.  SUBW3 @OBJDSC(AP), @SRCDSC(AP), R0 ; LEN(SRC) - LEN(OBJ)  SUBL2 R2, R0 ; Relative col position  INCL R0  CMPL R0, COL2(AP) ; Compare to COL2  BGTR 100$  RET 100$:  CLRL R0  RET   .PAGE  .SBTTL WYL_BRACKET- Find terminating bracket.  ";++ #; $; FUNCTIONAL DESCRIPTION: ,; 6; Procedure to enclose a string within brackets. @; The first character of the source string is expected to J; be the opening bracket and the termination character is T; the closing bracket. Both must be balanced within the ^; source string. In this way any level of nesting will be h; within the returned string. E.G. if the source string is: r; "(1+5*(3+4))" and the termination character is ')' then |; the full string will be indicated. ; ; CALLING SEQUENCE: ; ; Column.wlc.v = WYL_BRACKET(srcdsc.rt.dx,trmchr.rt.dx) ; ; INPUT PARAMETERS: ; ; srcdsc Address of source string descriptor. This string ; will be searched for the terminating character. ; ; trmchr Address of terminator string descriptor. If this ; character is the same as the terminator no ; termination takes place. ; ; OUTPUT PARAMETERS: ; &; None. 0; :; COMPLETION STATUS: D; N; column Address of longword to accept the column number X; of the terminator. Returns zero if not found. b; l;-- v SRCDSC = 4 TRMCHR = 8   .ENTRY WYL_BRACKET,^M  MOVQ @SRCDSC(AP), R2 ; R2, R3 <-- Descr  MOVZWL R2, R2 ; Longword extend  BLEQ 50$  MOVL TRMCHR(AP), R0 ; Ext descr addr  MOVZBL @4(R0), R1 ; Ext byte  MOVZWL #1, R0 ; Index  CLRL R4 ; Ext count 10$:  CMPB -1(R3)[R0], (R3) ; Terminator?  BNEQ 20$  INCL R4 ; Increase count 20$:  CMPB -1(R3)[R0], R1 ; Extenuator? * BNEQ 30$ 4 DECL R4 ; Decrease count > BNEQ 30$ H RET R30$: \ AOBLEQ R2, R0, 10$ f50$: p CLRL R0 z RET   .PAGE  .SBTTL WYL_EQUAL - Match keywords.  ;++ ; ; FUNCTIONAL DESCRIPTION: ; ; A test string is compared to the reference string to ; determine logical equality. The reference string may ; include an abbreviation qualifier. The comparison is case ; sensitive so that both strings must be presented in uppercase. ; ; CALLING SEQUENCE: ; ; Logeqv.wlc.v = WYL_EQUAL(tststr.rt.dx,refstr.rt.dx) ; ; INPUT PARAMETERS: $; .; tststr Address character string descriptor pointing to 8; a buffer containing the test string to match against B; the reference string. L; V; refstr Address of character string descriptor pointing `; to a buffer containing the reference string. This j; reference string specifies the desired keyword in the t; following form: If the desired response is: MOUNT but ~; MOUN and MOU are also sufficient then the reference ; string is specified as: MOU*NT. e.g. the asterisk ; specifies the minimum number of characters to recognize ; in the test string. ; If the asterisk is omitted then all characters must ; match. If the asterisk is in column 1 then any ; test string will match. ; ; OUTPUT PARAMETERS: ; ; None. ; ; COMPLETION STATUS: ; ; 1 = Logically equivalent, 0 = inequivalency. ; ;-- ( 2TSTSTR = 4 <REFSTR = 8 F P .ENTRY WYL_EQUAL, ^M Z MOVL REFSTR(AP), R6 ; R6 <-- Descr addr d LOCC #^A/*/, (R6), @4(R6) ; Find asterisk n MOVQ R0, R4 ; Save LOCC output x MOVQ @TSTSTR(AP), R1 ; R1, R2 <-- Descr  SUBW3 R0, (R6), R0 ; R0 <-- Min # chrs.  CMPC5 R0, @4(R6), #32, R1, (R2) ; Compare?  TSTL R0 ; Refstr exhausted?  BNEQ FAILURE ; Nope. Fail test.  LOCC #32, R2, (R3) ; Last blank?  SUBL2 R0, R2 ; R2 <-- # test chrs.  BEQL SUCCESS ; Exhausted?  CMPC5 R4, 1(R5), #32, R2, (R3) ; Rest compare?  TSTL R2 ; Tststr exhausted?  BEQL SUCCESS ; Yep. Test succeeds. FAILURE:  MOVZBL #0, R0 ; Result zero.  RET SUCCESS:  MOVL #-1, R0 ; Result -1.  RET " , 6 .PAGE @ .SBTTL WYL_EXPAND - Convert tabs to blanks. J T;++ U; V; FUNCTIONAL DESCRIPTION: ^; h; Tabs are removed from the specified string and replaced with r; an appropriate number of blanks when the string is copied. |; Destination string is not blank filled. ; Input and output strings must not be the same or even ; overlap. ; ; CALLING SEQUENCE: ; ; Sts.wlc.v = WYL_EXPAND(inpstr.mt.dx,outstr.wt.dx, ; outlen.wl.r,offset.rl.v) ; ; INPUT PARAMETERS: ; ; inpstr Address of source string descriptor. ; ; outlen Address of longword to receive the size of ; output string. ; ; offset Offset count for expanding tabs from prompt input. &; Must be supplied or dummied. 0; :; OUTPUT PARAMETERS: D; N; outstr Address of output string descriptor. X; b; COMPLETION STATUS: l; v; WYL__NORMAL Normal successful completion. ; WYL_OUTSTRTRU Output string truncated. ; ;--  INPSTR = 4 OUTSTR = 8 OUTLEN = 12 OFFSET = 16   .ENTRY WYL_EXPAND,^M  MOVAL G^LIB$SIG_TO_RET, 0(FP) ; Sig to return  MOVQ @INPSTR(AP), R0 ; R0, R1 <-- Descr  MOVQ @OUTSTR(AP), R4 ; R4, R5 <-- Descr  MOVZWL R4, R6 ; Output string length  MOVL OFFSET(AP), R10 ; Prompt offset EX_COPY:  MOVAB G^WYL_AB_NRMTBL, R3 ; Address of table * MOVTUC R0, (R1), #^X09, (R3), R4, (R5) ; Move till tab 4 BVS EX_FILL ; If tab BR. > BGTRU EX_TRUNC H MOVL #WYL__NORMAL, R0 R SUBL3 R4, R6, @OUTLEN(AP) \ RET fEX_FILL: p SUBL3 R4, R6, R2 ; Tab column - 1 z ADDL2 R10, R2 ; Add offset  ADDL3 #8, R2, R3 ; Add offset  BICL2 #^X7, R3 ; MODULO 8 - 1  SUBL2 R2, R3 ; Fill count  MOVQ R0, R7 ; R7 = R0, R8 = R1  SUBL3 R3, R4, R9 ; R9 = Dst len  BLSS EX_FINISH  MOVC5 #00, (FP), #32, R3, (R5) ; Blank fill  SUBL3 #1, R7, R0 ; Src len  ADDL3 #1, R8, R1 ; Src adr  MOVL R3, R5 ; Dst adr  MOVL R9, R4 ; Dst len  BGEQ EX_COPY EX_TRUNC:  MOVL #WYL__OUTSTRTRU, R0  MOVL R6, @OUTLEN(AP)  RET $EX_FINISH: . MOVC5 #00, (FP), #32, R4, (R5) ; Blank fill 8 MOVL R6, @OUTLEN(AP) B MOVL #WYL__OUTSTRTRU, R0 L RET V .END