.MCall .Module .Module KEDCM5 RELEASE=V02 VERSION=13 COMMENT=,IDENT=NO,AUDIT=NO,GLOBAL=.KEDC5 ; Copyright (c) 1998 by Mentec, Inc., Nashua, NH. ; All rights reserved ; ; This software is furnished under a license for use only on a ; single computer system and may be copied only with the ; inclusion of the above copyright notice. This software, or ; any other copies thereof, may not be provided or otherwise ; made available to any other person except for use on such ; system and to one who agrees to these license terms. Title ; to and ownership of the software shall at all times remain ; in Mentec, Inc. ; ; The information in this document is subject to change without ; notice and should not be construed as a commitment by Digital ; Equipment Corporation, or Mentec, Inc. ; ; Digital and Mentec assume no responsibility for the use or ; reliability of its software on equipment which is not supplied ; by Digital or Mentec, and listed in the Software Product ; Description. ;+ ;COND ; ; Virt$ in KEDCPR to control generation of SOBs ; ; $KED$ ;- .Enabl LC .Enabl GBL ; ; MODULE: KEDCM5 ; ;ABSTRACT: ; ; This module contains the routines to implement the LOCAL command. ; ;AUTHOR: DARRELL DUFFY ; ;DATE: 16-July-1979 ; ;REVISION HISTORY: ; ; Darrell Duffy ; ; 16-July-79 Add support for VAX forms of local symbol block ; enable and disable ; ; Cheryl Vedoe ; ; 24-Oct-79 Fix LOCAL to work when cursor is positioned right ; after a symbol or .ENABL LSB ; ; Jim Williams ; ; 3-Dec-79 Fix LOCAL so it will work with LEARN (don't set up ; help message on success). ; ; ???????? Fix local to ignore FFs .SbTtl Error Macro Definitions ;+ ;ERROR ; .IIf NDF,$KED$, .Page .IIf NDF,$KED$, .SbTtl Errors from KEDCM5 module ; ; Module: KEDCM5 ; ; Define the error macros for this module ; .MCall ErrDef ErrDef C5,ERROR ;- ;+ ;HELPER ; .IIf NDF,$KED$, .Page .IIf NDF,$KED$, .SbTtl Help from KEDCM5 module ; ; Module: KEDCM5 ; ; Define the help macros for this module ; .MCall HlpDef HlpDef C5 ;- .SbTtl .SbTtl Patterns and data for local .SbTtl .SbTtl Pattern matching tables ; ; Pattern dispatch table ; .XX = 1 ;Value of pattern byte P$Tbl: .Irp X, ;~d~ P.'X = .XX .XX = .XX + 1 .Word P$'X .EndR P.Max = .XX ;MAX PATTERN BYTE ; ; Pattern tables for recursive patterns ; LSBTbl: .Word PLBPAT, VLBPAT, 0 ;~d~ ENBTbl: .Word PENPAT, VENPAT, 0 ;~d~ DSBTbl: .Word PDSPAT, PDEPAT, VDSPAT, 0 ;~d~ ABLTbl: .Word VENPAT, PENPAT, PDSPAT, PDEPAT, VDSPAT, 0 ;~d~ ; ; Patterns used in local ; ; ; Symbol definition ; .NList BEX SymPat: .Byte ':,P.Sym,P.Sp0,P.Lt,0 ;~d~ ; ; .ENABL LSB ; .ENABLE LOCAL_BLOCK ; EnbPat: .Byte P.LSB,P.Sp1,P.ENB,'.,P.SP0,P.LT,0 ;~d~ ; ; .DSABL LSB ; .DSABLE LSB ; .DISABLE LOCAL_BLOCK ; DSBPat: .Byte P.LSB,P.SP1,P.DSB,'.,P.SP0,P.LT,0 ;~d~ ; ; .ENABL LSB ; .ENABLE LOCAL_BLOCK ; .DSABL LSB ; .DSABLE LSB ; .DISABLE LOCAL_BLOCK ; ABLPat: .Byte P.LSB,P.SP1,P.ABL,'.,P.SP0,P.LT,0 ;~d~ ; ; Local symbol argument patterns ; PLbPat: .ASCIZ /BSL/ ;~d~ VLbPat: .ASCIZ /KCOLB_LACOL/ ;~d~ ; ; Enable patterns ; PEnPat: .ASCIZ /LBANE/ ;~d~ VEnPat: .ASCIZ /ELBANE/ ;~d~ ; ; Disable patterns ; PDsPat: .ASCIZ /LBASD/ ;~d~ PDePat: .ASCIZ /ELBASD/ ;~d~ VDsPat: .ASCIZ /ELBASID/ ;~d~ ; ; Local symbol def ; LSDPat: .Byte ':,'$,P.NUM1,P.SP0,P.LT,0 ;~d~ .Even .List BEX .SbTtl Impure data PSect IMPURE ; ; Local symbol ref ; LSRPat: ;~d~.BYTE '$, P.NUM, P.NON, 0 .BlkB 3+7 ;~d~ ; ; Local symbol ; LSym: .BlkB 10. ;~d~Space for a large local symbol ErrSP: .BlkW 1 ;~d~Saved stack pointer for ;error recovery LStr: .BlkW 1 ;~d~Start value of symbol LIncr: .BlkW 1 ;~d~Increment value EnbFnd: .BlkW 1 ;~d~Non zero for .enabl seen SymFnd: .BlkW 1 ;~d~Non zero for symbol seen PSect KEDCMD .SbTtl .SbTtl C.LOCL - Local symbol block reordering ;++ ;C.LOCL ; ;FUNCTIONAL DESCRIPTION: ; ; Reorder local symbol blocks in MACRO programs ; ;This routine reorders local symbol blocks in a macro source. ;It is called from KED through the command dispatcher and picks up ;its two arguments. ; ; LOCAL str incr ; ;'str' is the starting value of the symbol, 'incr' is the increment. ;10 is assumed for the value of both arguments. ; ;A local symbol block may begin with either a normal symbol definition ;or a .ENABL LSB. The cursor must be placed in the first formfeed delimited ;page of the local symbol block. If the local symbol block began with a ;symbol definition, it is terminated by a symbol definition or a .ENABL LSB. ;It is terminated by a .ENABL or .DSABL LSB if it began with a .ENABL LSB. ; ;INPUT: ; File with cursor in first page (formfeed delimited) ; of the local symbol block. ; R1 -> argument text string ended with zero byte ; ;OUTPUT: ; C set on return if error (^A, ^D ^E ^G may be in file) ; C clr if symbols reordered ; ;NOTE: ; ;We have no way of having a PSECT ending or starting a local symbol block ;like macro does since these are very often evoked in macros where they ;cannot be seen by a program of this type. ;-- .Enabl LSB C.Locl:: ;~x~ NoEChk ;~x~No command end check Tst Inspct ;Inspect mode?? Bne 60$ ;~x~Inspect mode Clr Un$Blk ;No undeletes now Mov #10.,LStr ;Set defaults for arguments Mov #10.,LIncr ;For both start and increment Call KNumQ ;~x~Convert first argument Bcs 10$ ;~x~Nope not specified Mov R2,LStr ;Save first argument Ble 70$ ;~x~Illegal argument 10$: Call KNumQ ;~x~Convert second Bcs 20$ ;~x~Nope none here either Mov R2,LIncr ;Save increment Ble 70$ ;~x~Illegal argument 20$: Call C1EndQ ;~x~See if command properly ended Mov SP,ErrSP ;Save initial stack pointer in ;case of error Clr SymFnd ;Symbol not found Clr EnbFnd ;ENABL or DSABL not found MovB @BCP,R0 ;Get current backward character Br 40$ ;~x~Don't move back to start ........... 30$: Call MvBkw ;~x~Move back one character Bcs 50$ ;~x~Beginning of file 40$: CmpB R0,..LcFf ;~x~Is it a formfeed to stop search? Bne 80$ ;~x~Yep 50$: Tst SymFnd ;~x~Start with symbol? Bne 110$ ;~x~Yes - ok Locl2: ;~x~Entry for error ;+ ;HELPER HELPER ;~x~ ;A symbol or .ENABL LSB was not found before beginning of file or a FF. ;- 60$: Jmp NoInsp ;~x~then tell operation is invalid .............. 70$: ;~x~ ;+ ;HELPER HELPER ;~x~ ; ;Start of increment was greater than 32767. or zero. ;- 80$: Mov #SymPat,R1 ;~x~Is this a symbol? Call SPeek ;~x~Look here Bne 100$ ;~x~Nope Tst SymFnd ;Do we already have one? Bne 90$ ;~x~Yep Call MovBak ;~x~Mark symbol as such Call MrkMrK ;~x~To remember where LSB could start 90$: Inc SymFnd ;~x~Count all symbols Br 30$ ;~x~Keep looking .......... 100$: Mov #ABLPat,R1 ;~x~Is this an .xxABL LSB?? Call SPeek ;~x~Look here Bne 30$ ;~x~Keep looking Mov #EnbPat,R1 ;If ENABLE its special (the start Call SPeek ;~x~of this block) Bne 110$ ;~x~Nope but quit looking anyway Inc EnbFnd ;A ENABLE start was found Call MrkBeg ;~x~Mark the beginning of the block Tst SymFnd ;Did we have a symbol? Beq 110$ ;~x~Nope Call RmvMrk ;~x~Remove the mark on that symbol Call MovBeg ;~x~And move to the beginning 110$: .Br LocEnd ;~x~ ; ; Now find end of the local symbol block ; .Enabl LSB LocEnd: Mov #AbLPat,R4 ;~x~We will want this a lot Mov R4,R3 ;Assume we started with .ENABL Tst EnbFnd ;Did we have an enable to start? Bne 10$ ;~x~Yes - ok Tst SymFnd ;A symbol found? Beq Locl2 ;~x~Nope- not a real LSB then Call RmvMrk ;~x~No- remove mark on the symbol Call MrkBeg ;~x~Mark the beginning of the block Mov #SymPat,R3 ;A symbol can end it 10$: Call MvFwd ;~x~Move forward Bcs 20$ ;~x~End of file Mov R4,R1 ;Get pattern for .ENABL or .DSABL Call SPeek ;~x~Look for the end Beq 20$ ;~x~Br if found Cmp R3,R4 ;Can LSB end with a symbol? Beq 10$ ;~x~Br if not Mov R3,R1 ;Else get pattern for symbol Call SPeek ;~x~Look for the end Bne 10$ ;~x~Br if not found 20$: Call MrkEnd ;~x~Else mark the end of the LSB .Br LocOrd ; ; Now order the LSB ; .Enabl LSB LocOrd: ;~x~ 10$: Call SymAsc ;~x~Convert the start symbol to ascii Add LIncr,LStr ;Increment the value of the symbol Call MovBeg ;~x~Move to the beginning of the LSB ; ; Search for the next definition ; 20$: Call MovFor ;~x~Move forward by one char Cmp R0,#LSB.E ;End of LSB? Beq 40$ ;~x~Yes - all done with reorder Mov #LSdPat,R1 ;Look for a definition of a LSYM Call SPeek ;~x~With a nifty pattern Bne 20$ ;~x~And keep looking til we find it ; ; Mark the definition so it won't be found again and pick it up ; Call MovBak ;~x~Back over : Call MovBak ;~x~Backup over $ Call MrkSym ;~x~Mark the symbol Call MovBak ;~x~Back over the mark Call SavSym ;~x~Save the symbol Call MovBeg ;~x~Back to beginning of LSB ; ; Find all references and change and mark them ; 30$: Call MovFor ;~x~Forward now Cmp R0,#LSB.E ;End of LSB Beq 10$ ;~x~Next definition Mov #LSRPat,R1 ;Look for a reference Call SPeek ;~x~To the current LSYM Bne 30$ ;~x~And on til a reference is found Call MovBak ;~x~Back over the $ Call RplSym ;~x~Replace the symbol Call MrkSym ;~x~Mark the symbol as done Br 30$ ;~x~And on for the next reference .......... ; ; Now clean up the mess by deleting all the marks ; 40$: Call MovBeg ;~x~Back to beginning Call RbChr ;~x~Delete the beginning mark 50$: Call MovFor ;~x~And forward now for all marks Cmp R0,#LSB.S ;Symbol mark? Bne 60$ ;~x~Nope Call DlChr ;~x~Delete it Br 50$ ;~x~And carry on .......... 60$: Cmp R0,#LSB.E ;~x~End mark Bne 50$ ;~x~No such luck Call DlChr ;~x~Delete the end mark too ; Call 70$ ;~x~Load the help message Clc ;But do not ring bell Return ;~x~ ...... 70$: ;~x~ ;+ Don't include this in error module ;error ;; HELPER ;~x~ ;Just a tone and message to say we are done ;- .SbTtl SYMASC - Convert symbol to ASCII ;++ ;SYMASC ; ;FUNCTIONAL DESCRIPTION: ; ; Convert symbol to ascii ; ;INPUT: ; LSTR = symbol value ; ;OUTPUT: ; LSYM = ascii string ; R0-R4 used ;-- .Enabl LSB SymAsc: Mov #LSym,R3 ;~x~The symbol buffer Mov R3,R4 ;Save address for check Mov #DgtTbl,R2 ;The digit table Mov LStr,R1 ;Symbol value 10$: Clr R0 ;~x~Accum here - this routine Tst @R2 ;Done? - end of tabl - is absolutly Beq 40$ ;~x~Yep end of digts - boring to 20$: Inc R0 ;~x~Count - read as well Sub @R2,R1 ;Reduce - write so I Bhis 20$ ;~x~Unsigned output - would sug- Add (R2)+,R1;Correct overage - gest you sk- Dec R0 ;Reduce count - ip reading Bne 30$ ;~x~Lead zero suppress - it and move Cmp R3,R4 ;Based on address check - on to some- Beq 10$ ;~x~Note zero will not work well- thing inter- 30$: Add #,R0 ;~x~Make ascii - esting and MovB R0,(R3)+;Stuff char away - novel like Br 10$ ;~x~And back for loop - the pattern .......... ; - matching 40$: ClrB (R3)+ ;~x~End string with zero - routines. Ret.1: Return ;~x~ ...... DgtTbl: .Word 10000.,1000.,100.,10.,1.,0. ;~d~Table of digit values .SbTtl SAVSYM - Save the symbol ;++ ;SAVSYM ; ;FUNCTIONAL DESCRIPTION: ; ; Save the symbol in the search buffer ; ;INPUT: ; BCP -> symbol to save ; ;OUTPUT: ; LSRPAT <- the symbol as a pattern ; R1-R2 used ;-- .Enabl LSB SavSym: Mov BCP,R2 ;~x~Get the pointer to the symbol Mov #LSRPat,R1 ;And where to put it Mov #7,R3 ;Maximum size of a symbol MovB #'$,(R1)+ ;Start pattern with a $ 10$: Call P$Num ;~x~Numeric? Bne 30$ ;~x~Nope- we are done MovB (R2),(R1)+ ;Remember patterns are backwards Dec R2 ;~x~Backup one char to next Sob R3,10$ ;~x~One less in count Call 20$ ;~x~Signal error Br ErRtn1 ;~x~And return from error .............. 20$: ;~x~ ;+ ;HELPER HELPER ;~x~ ;A definition contained over 6 digits. ;- 30$: MovB #P.Non,(R1)+ ;~x~End pattern with non RAD50 char ClrB (R1)+ ;End .Br RplSym ;Replace the definition .Dsabl LSB .SbTtl RPLSYM - Replace the current symbol ;++ ;RPLSYM ; ;FUNCTIONAL DESCRIPTION: ; ; Replace the current symbol reference ; ;INPUT: ; BCP -> last char of digits ; ;OUTPUT: ; DIGITS <- LSYM digits ;-- .Enabl LSB RplSym: ;~x~ 10$: Call RbChr ;~x~Delete a symbol char Bcs 30$ ;~x~Error during delete Mov BCP,R2 ;Point to next Call P$Num ;~x~Is next a digit? Beq 10$ ;~x~Yep - delete it too Mov #LSym,R1 ;Digit string to replace it 20$: MovB (R1)+,R0 ;~x~Get a digit Beq Ret.1 ;~x~All done Call Insrt ;~x~Insert it Bcc 20$ ;~x~Ok 30$: Call 40$ ;~x~Signal an error Errtn1: Jmp ErRtn ;~x~Error return ............. 40$: ;~x~ ;+ ;HELPER HELPER ;~x~ ;insert or delete failed during replace of local symbol ;- .DSABL LSB .SbTtl SPEEK - String pattern match ;++ ;SPEEK ; ;FUNCTIONAL DESCRIPTION: ; ; String pattern match ; ;INPUT: ; R1 -> pattern string in reverse order ended by zero byte ; ; QPEEK entry for recursive patterns ; R2 -> string in memory ; ;OUTPUT: ; R0-R2 used ; Z Clr if match not found ; Z Set if match found ; IF Z set R2 -> next char to be matched ;-- .Enabl LSB SPeek: Mov BCP,R2 ;~x~End of string QPeek: ;~x~Entry for recursive patterns 10$: CmpB @R1,#P.Max ;~x~Check for pattern match char Bhis 20$ ;~x~Nope MovB @R1,R0 ;Get byte Beq Ret.1 ;~x~End of string pattern Dec R0 ;Make proper range Asl R0 ;Make word offset Call @P$Tbl(R0) ;~x~Call routine Bne Ret.1 ;~x~All done- failure Br 30$ ;~x~And finish up .......... 20$: MovB (R2),R0 ;~x~Get normal char Call FixCaS ;~x~Fix to upper alpha CmpB R0,@R1 ;Match? Bne Ret.1 ;~x~Nope reject Dec R2 ;Backup one byte to next ;to be matched 30$: Inc R1 ;~x~Next pattern byte Br 10$ ;~x~And try again .......... .Dsabl LSB .SbTtl .SbTtl Pattern matching routines .SbTtl ;++ ;PATTERN MATCHING ROUTINES ; ; ROUTINE ENTRY - P$XXX, BYTE CODE = P.XXX ; ;FUNCTIONAL DESCRIPTION: ; ; Determine match to a particular type of sequence ; and skip over the sequence matched ; ;INPUT: ; R2 -> End of string to match ; ;OUTPUT: ; Z Set if match ; Z Clr if not match ; R2 -> next char to be matched ; R0 may be used ;-- .SbTtl Recursive pattern routines ; ; Recursive pattern routines ; ; These routines save the context of the SPEEK routine, ; setup a new pattern from a table and recall the QPEEK ; routine to look for a sub-pattern. The goal is to allow ; an OR condition of patterns at a position of the match. ; ; These routines are used to implement the .ENABLE and .DISABLE ; patterns since both MACRO-32 and MACRO-11 forms are accepted. ; .SbTtl P$ABL - Match any enable or disable form ; ; P$ABL -- Match any enable or disable form ; ; Matched forms are: ; ; .ENABL .DSABL .DSABLE .ENABLE .DISABLE ; P$Abl: Mov R1,-(SP) ;~x~Save R1 on stack Mov #AblTbl,R1 ;Table of allowed patterns Br TQPeek ;~x~The recursive pattern matcher .............. .SbTtl P$ENB - Match any enable form ; ; P$ENB -- Match any enable form ; ; Matched forms are: ; ; .ENABL .ENABLE ; P$Enb: Mov R1,-(SP) ;~x~Save R1 for the argument Mov #EnbTbl,R1 ;Table of allowed forms Br TQPeek ;~x~The recursive pattern matcher .............. .SbTtl P$DSB - Match any disable form ; ; P$DSB -- Match any disable form ; ; Matched forms are: ; ; .DSABL .DSABLE .DISABLE ; P$Dsb: Mov R1,-(SP) ;~x~Save R1 for the argument Mov #DsbTbl,R1 ;Table of allowed forms Br TQPeek ;~x~The recursive matcher of patterns .............. .SbTtl P$LSB - Match any form of LSB ; ; P$LSB -- Match any form of LSB ; ; Matched forms are: ; ; LSB LOCAL_BLOCK ; P$Lsb: Mov R1,-(SP) ;~x~The place for the argument Mov #LsbTbl,R1 ;The list of possible patterns .Br TQPeek ;The matcher of recursive patterns .SbTtl TQPEEK - Recursive pattern matcher ;++ ;TQPEEK ; ;FUNCTIONAL DESCRIPTION: ; ; This entry is used by recursive patterns to scan entries ; in a table and use QPEEK to look for each one. Fully ; recursive patterns are possible with this scheme. ; ;INPUT: ; R1 saved on the stack ; R1 -> table of patterns ended with zero word ; ;OUTPUT: ; Z set on match found for one of the patterns in table ; R2 -> end of match if match found ; Z Clr if no match found ; R2 -> same place if no match found ; R1 restored ;-- .Enabl LSB TQPeek: ;~x~ Mov R2,-(SP) ;Save old pointer to text to scan Mov R1,-(SP) ;Save table pointer ; ; Stack looks like this: ; ; R1 old ; R2 old ; Table -> <- SP ; 10$: Mov @0(SP),R1 ;~x~Next pattern from table Beq 20$ ;~x~We are all done with patterns, fail Add #2,(SP) ;Advance table pointer Call QPeek ;~x~Recursive entry to PEEK routine Beq 30$ ;~x~We found a match Mov 2(SP),R2 ;Restore -> to text for next pattern Br 10$ ;~x~Try for next pattern .......... ; ; Failure return ; 20$: Tst (SP)+ ;~x~Dump table address Mov (SP)+,R2 ;Restore the registers Mov (SP)+,R1 ;For a clean return ;>>>this assume R1<>0??? Return ;~x~Z clr for failure return ...... ; ; Success return ; 30$: Cmp (SP)+,(SP)+ ;~x~Dump old Table and R2 Mov (SP)+,R1 ;Restore R1 Br Sez.1 ;~x~Z set for success return ............. .SbTtl P$LT - Match line terminator ; ; P$LT -- line terminator (LF - FF) ; .Enabl LSB P$LT: Cmp R2,PlyGnd ;~x~Check for behind playground Blo Sez.1 ;~x~Return its a line terminator CmpB (R2),# ;Check range of line terms Bhi Clz.1 ;~x~Nope CmpB @R2,# ;And low of range Blo Clz.1 Dec R2 ;~x~Backup for next char Br Sez.1 ;~x~in range ............. .SbTtl P$SYM - Match a symbol ; ; P$SYM -- a symbol (RAD50 ending with alpha) ; .Enabl LSB P$Sym: Call P$Non ;~x~xNon RAD50? Beq 40$ ;~x~Yes, no good 10$: Dec R2 ;~x~Backup on a good char Call P$Non ;~x~Non RAD50 ? Bne 10$ ;~x~Ok keep looking CmpB (R2)+,(R2)+ ;Look at last char again Call P$AL1 ;~x~Alpha? Beq 30$ ;~x~Ok alpha is cool CmpB (R2),#'_ ;Underscore is legal for vax-11 macro Beq 20$ ;~x~So allow it CmpB (R2),#'$ ;. And $ are cool too Beq 20$ ;~x~So allow them CmpB (R2),#'. ;Since they are essentially alpha too Bne 30$ ;~x~xOk not a symbol 20$: Dec R2 ;~x~Backup for next char Sez.1: Sez ;~x~Say we are for real 30$: Return ;~x~ ...... 40$: Inc R2 ;~x~Fix R2 for return Return ;~x~ ...... .SbTtl P$NON - Match non RAD50 .SbTtl P$XX1 - Match one don't chare ; ; P$NON -- non RAD50 ; P$XX1 -- don't care for one char ; .Enabl LSB P$Non: Call P$Alph ;~x~Alpha? Beq Clz.1 ;~x~Ok RAD50 then Call P$Num ;~x~Numeric? Beq Clz.1 ;~x~Ok then CmpB (R2),#'_ ;Underscore is legal for VAX-11 macro Beq Clz.1 ;~x~So allow it CmpB (R2),#'. ;. And $ are legal too Beq Clz.1 ;~x~Ok CmpB (R2),#'$ ;Check $ Beq Clz.1 ;~x~ P$XX1: Dec R2 ;~x~Back it up Sez.2: Sez ;~x~ Return ;~x~ ...... Clz.1: Clz ;~x~Reverse the sense of the compare Return ;~x~ ...... .SbTtl P$SP0 - Match zero or more separators ; ; P$SP0 -- zero or more separators (TB, SP) ; .Enabl LSB P$SP0: ;~x~ 10$: Call P$Sepr ;~x~Is it a separator Bne Sez.2 ;~x~Always return success Dec R2 ;Peel off all the sep's Br 10$ ;~x~ .......... .SbTtl P$SP1 - Match one or more separators ; ; P$SP1 -- one or more separators (TB,SP) ; .Enabl LSB P$SP1: ;~x~ 10$: Call P$Sepr ;~x~Separator? Beq 20$ ;~x~Yep Return ;~x~ ...... 20$: Dec R2 ;~x~Backup Call P$SEPR ;~x~Again Beq 20$ ;~x~Til done Br Sez.2 ;~x~And return success ............. .SbTtl P$SEPR - Separator service routine ; ; P$SEPR -- separator service routine ; .Enabl LSB P$Sepr: CmpB (R2),# ;~x~Space Beq Ret.3 ;~x~Yep CmpB (R2),# ;Tab ; Bne - ;Nope Ret.3: Return ;~x~Return success or fail in Z ...... .SbTtl P$AL1 - Match at least one alpha ; ; P$AL1 -- alpha at least one ; .Enabl LSB P$AL1: ;~x~ 10$: Call P$Alph ;~x~Is it alpha? Bne Ret.3 ;~x~Nope- return now 20$: Dec R2 ;~x~Next char Call P$Alph ;~x~Look for alpha Beq 20$ ;~x~And keep looking Br Sez.2 ;~x~Return success ............. .SbTtl P$NUM1 - Match at least one numeric ; ; P$NUM1 -- at least one numeric ; .Enabl LSB P$Num1: Call P$Num ;~x~Check for digit Bne Ret.3 ;~x~Nope 10$: Dec R2 ;~x~Next char Call P$Num ;~x~Digit? Beq 10$ ;~x~Yep - keep looking Br Sez.2 ;~x~Return success ............. .SbTtl P$ALPH - Alpha service routine ; ; P$ALPH -- alpha service routine ; .Enabl LSB P$ALPH: Mov #"AZ,-(SP) ;~x~Compare range Br P$CTyp ;~x~The type checker .............. .SbTtl P$NUM - Numeric service routine ; ; P$NUM -- Number service routine ; P$Num: Mov #"09,-(SP) ;~x~Compare range fOr numbers .Br P$CTyp .SbTtl P$CTYP - Character range check routine ;++ ;P$CTYP ; ;FUNCTIONAL DESCRIPTION: ; ; Type checker ; ;INPUT: ; 2(SP) -> return address ; @SP -> two byte compare range ; ;OUTPUT: ; Z Set for in range ; Z Clr for outside range ;-- .Enabl LSB P$CTyp: MovB (R2),R0 ;~x~Get the character Call FixCas ;~x~For alpha fix the case CmpB R0,@SP ;Lower of range Blo 10$ ;~x~Below CmpB R0,1(SP) ;High of range Bhi 10$ ;~x~Out of range Tst (SP)+ ;Dump range Sez ;In range Return ;~x~ ...... 10$: Tst (SP)+ ;~x~Dump range Clz ;Out of range Return ;~x~ ...... .SbTtl FIXCAS - Convert to upper case ;++ ;FIXCAS ; ;FUNCTIONAL DESCRIPTION: ; ; Fix case of alpha to upper ; ;INPUT: ; R0 = char ; ;OUTPUT: ; R0 = upper char ;-- .Enabl LSB FixCas: CmpB R0,# ;~x~ Blo 10$ ;~x~Not alpha CmpB R0,# ;Lower only Bhi 10$ ;~x~Ok Sub #40,R0 ;Make upper 10$: Return ;~x~ ...... .SbTtl .SbTtl Movement routines .SbTtl .SbTtl MovBEG - Move to beginning of LSB ; ; MOVBEG -- move to beginning of lsb as marked ; .Enabl LSB MovBeg: ;~x~ 10$: CmpB @BCP,#LSB.B ;~x~Beginning mark here Beq 30$ ;~x~Yep - stop Call MvBkw ;~x~Move back one char Bcc 10$ ;~x~Ok keep going ErrMov: Call 20$ ;~x~Signal the error Br ErRtn ;~x~ ............. 20$: ;~x~ ;+ ;HELPER HELPER ;~x~ ;Unable to move for some reason or stopped by CTRL/C. ;- 30$: Return ;~x~ ...... .DSABL LSB .SbTtl MOVBAK - Move backward ; ; MOVBAK -- move backward with error check ; .Enabl LSB MovBak: Call MvBkw ;~x~One byte back Br 10$ ;~x~check for error ........... .SbTtl MOVFOR - Move forward ; ; MOVFOR -- move forward with error check ; MovFor: Call MvFwd ;~x~One byte forward 10$: Bcs ErrMov ;~x~Error report Return ;~x~ ...... .Dsabl LSB .SbTtl .SbTtl Mark handling routines .SbTtl .SbTtl RMVMRK - Remove mark ; ; RMVMRK -- remove mark from LSB ; ; Mark indicates symbol ; .Enabl LSB RmvMrk: ;~x~ 10$: Call MovFor ;~x~Forward for each char CmpB R0,#LSB.M ;Look for mark Bne 10$ ;~x~Nope Call DlChr ;~x~Delete it Bcs 20$ ;~x~Error Return ;~x~ ...... 20$: Call 30$ ;~x~Signal the error Br ErRtn ;~x~And return error ............. 30$: ;~x~ ;+ ;HELPER HELPER ;~x~ ;Something prevented a mark from being deleted. ;- .SbTtl MRKBEG - Mark beginning of LSB .SbTtl MRKEND - Mark end of LSB .SbTtl MRKSYM - Mark symbol .SbTtl MRKMRK - Mark possible start of LSB ; ; MRKBEG -- mark beginning of LSB ; MRKEND -- mark end of LSB ; MRKSYM -- mark a symbol in LSB ; MRKMRK -- mark possible start of LSB ; ;Insert appropriate mark in file ; ;Mark character values. These characters must not exist in the macro ;source for this command to work. ; LSB.B =: 1 ;Beginning of LSB LSB.E =: 4 ;End of LSB LSB.S =: 5 ;Symbol in LSB LSB.M =: 7 ;Special mark in LSB .Enabl LSB MrkBeg: Mov #LSB.B,R0 ;~x~Beginning Br 10$ ;~x~ ........... MrkEnd: Mov #LSB.E,R0 ;~x~End Br 10$ ;~x~ ........... MrkSym: Mov #LSB.S,R0 ;~x~Symbol Br 10$ ;~x~ ........... MrkMrk: Mov #LSB.M,R0 ;~x~Mark mark 10$: Call Insrt ;~x~Insert the character Bcs 20$ ;~x~Error Return ;~x~ ...... 20$: Call 30$ ;~x~Signal the error Br ErRtn ;~x~Error exit ............. 30$: ;~x~ ;+ ;HELPER HELPER ;~x~ ;Unable to insert a mark character into the file. ;Logic error or CTRL/C stop. ;- .SbTtl ERRTN - Error handler ;+ ; ERRTN -- error return for local errors ;- ERRTN: Mov ErrSP,SP ;~x~Reset stack Sec ;Return error Return ;~x~ ...... .END