1
0
mirror of https://github.com/PDP-10/its.git synced 2026-03-28 10:52:52 +00:00
Files
PDP-10.its/src/draw/find.501
2018-05-05 19:19:09 +02:00

767 lines
14 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
VERSION(FIND,1)
;TXTLST SETUP, FIND NEXT
;HERE WE DEFINE THE INDICES FOR WHAT TO FIND
DEFINE %FBLST
<
%FBVAL(BNAM,BODY NAME) ;FIND BODY BY NAME (OR # OF PINS PC)
%FBVAL(BLOC,BODY LOCATION) ;FIND BODY BY LOC
%FBVAL(BDIP,DIP TYPE NAME) ;FIND BODY BY DIP NAME
%FBVAL(PLOC,CONNECTOR OR DIP PIN LOCATION) ;FIND POINT BY LOC (CPIN)
%FBVAL(PTXT,TEXT) ;FIND POINT BY TEXT
MD,<
%FBVAL(PSIG,SIGNAL NAME) ;FIND SIGNAL NAME
%FBVAL(LNAM,LIBRARY BODY NAME) ;FIND LIBRARY BODIES
%FBVAL(LDIP,LIBRARY BODY DIP TYPE NAME) ;FIND LIBRARY BODIES BY DIP TYPE
%FBVAL(LPIN,LIBRARY BODY DEFAULT PIN LOCATION)
%FBVAL(LTXT,LIBRARY BODY TEXT/PROP)
%FBVAL(LPRP,LIBRARY BODY PROPERTY NAME)
%FBVAL(BTXT,BODY TEXT)
%FBVAL(BPRP,BODY PROPERTY NAME)
>;MD
>
;GENERATE INDICES
DEFINE %FBVAL $ (A,B)
< %F$A__%FBIND
%FBIND__%FBIND+1
>
%FBIND__0
%FBLST
DEFINE %FBVAL $ (A,B)
<FN$A: JSP H,FNDALL
>
FINDTB:
%FBLST
DEFINE %FBVAL (A,B)
< [ASCIZ\B\]
>
%PROMPT:%FBLST
MD,<
FNLPN0: MOVEI T,1
LSH T,@MODE
TDNN T,[1EDTPM] ;MUST BE IN CORRECT MODE BEFORE DISPATCHING THROUGH NORMAL ENTRY
JRST PERRET
JRST FNLPIN
>;MD
FNDALL: MOVEI H,-FINDTB-1(H) ;GENERATE INDEX
TLNE M,DSKACT!MACACT
JRST NPRMPT
OUTSTR[ASCIZ/
/]
OUTSTR @%PROMPT(H)
OUTSTR[ASCIZ/ SEARCH STRING?/]
NPRMPT: PUSHJ P,GETLIN
CAIN C,12
JRST [ SKIPN @FSTRTB(H) ;HE WANTS OLD, IS THERE ONE?
JRST PERRET
JRST DOFND]
GETFS(B)
MOVE A,B
ADD A,[POINT 7,1]
SETZM (B)
SETZM 1(B)
MOVE D,C ;SAVE OTHER CHAR
MOVEI C,BELCHR ;GET BEGIN LINE CHAR
XCT DLMTAB(H) ;STUFF IN DELIMITER IF NEEDED
MOVE C,D
FNREAD: CAIN C,ALTMOD
JRST PUTFS ;ALTMODE, FLUSH STRING
PUSHJ P,FNPUT
PUSHJ P,GETLIN
CAIE C,12
JRST FNREAD
MOVEI C,BELCHR
XCT DLMTAB(H) ;CHECK FOR ANOTHER
SETZ C,
PUSHJ P,FNPUT ;PUT ZERO AT END
EXCH B,@FSTRTB(H) ;REPLACE OLD WITH NEW
PUSHJ P,PUTFS ;GIVE BACK OLD STRING
DOFND: SETZM FIND
SKIPE E,@LSTTAB(H)
PUSHJ P,ADDLST
MPC,< SKIPE E,@LSTTB2(H)
PUSHJ P,ADDLST
>;MPC
FNDCNT: MOVE T,FIND
MOVEM T,FNDNUM ;STORE FOR MACRO CALL AT ;R
JUMPE T,PTFNDN
SETOM FIND
TLNE M,DSKACT!MACACT
POPJ P,
PUSHJ P,DECOUT
OUTSTR[ASCIZ/ ITEMS FOUND!
/]
POPJ P,
PTFNDN: TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/NO MATCHES FOUND!
/]
POPJ P,
FNPUT: TLNE A,760000
JRST FNPUT1
GETFS(T)
HRRM T,-1(A)
HRR A,T
SETZM (T)
SETZM 1(T)
FNPUT1: IDPB C,A
POPJ P,
;ADDLST SUBR
ADDLST: PUSH P,E
PUSHJ P,@ADDCLR(H) ;CLEAR BITS FIRST
POP P,E
ADDISP: JRST @ATHING(H)
MD,<
ADPSIG: MOVE A,FPSSTR
ADD A,[POINT 7,1]
PUSHJ P,SIGMAA ;MAKE COMPARE STRING
ADPSG1: FETCH(A,E,PTXT)
JUMPE A,ADPSG2
FETCH(A,A,TCSTR)
ADD A,[POINT 7,1]
MOVEI B,SIGTAB
PUSHJ P,SIGMAT
JRST ADPSG2
JFCL
AOS FIND
SETBIT(FOUNDP,T,E,PBIT)
ADPSG2: FETCH(E,E,PNXT)
JUMPN E,ADPSG1
POPJ P,
>;MD
ADPTXT: FETCH(A,E,PTXT)
JUMPE A,ADTXTX
FETCH(A,A,TCSTR)
HRRZS (P) ;CLEAR THING TO RETURN
ADTXTT: MOVE T,@FSTRTB(H) ;SEARCH STRING
PUSHJ P,MATCHS
JRST ADTXTE ;NO MATCH
AOS FIND
SETBIT(FOUNDP,T,E,PBIT)
ADTXTE: HLRZ B,(P)
SKIPE B
PUSHJ P,PUTFS ;GIVE BACK TEMP STRING
ADTXTX: HRRZ E,(E) ;NEXT POINT OR BODY
JUMPN E,ADDISP ;GO BACK TO CORRECT ROUTINE
POPJ P,
ADPLOC: PUSHJ P,SETTT7 ;SETUP TO MAKE STRING
HRLM A,(P) ;SAVE POINTER TO TEMP STRING
MOVE A,E ;POINT
PUSHJ P,STFPLC ;USE STUFF ROUTINE IN POINT
JRST ADTXTE ;GIVE BACK STRING AND LOOP
HLRZ A,(P) ;GET TEXT STRING
JRST ADTXTT ;DO COMPARE
MD,<
ADBDIP:
ADBNAM: HRRZS (P) ;NOTHING TO GIVE BACK
CAIN H,%FBDIP
JRST [ HRRZ A,E
PUSHJ P,FNDDIP
JRST ADTXTE
FETCH(A,T,TXVAL)
JRST ADBNM0]
FETCH(A,E,BTYP)
FETCH(A,A,TNAM)
ADBNM0:
>;MD
MPC,<
ADBDIP: HRRZS (P)
FETCH(A,E,BNAM)
JUMPE A,ADTXTE ;IF ANY
>;MPC
ADBNM1: MOVE T,@FSTRTB(H)
PUSHJ P,MATCHS
JRST ADTXTE
SETBIT(FOUNDB,T,E,BBIT)
AOS FIND
JRST ADTXTE
ADBLOC: PUSHJ P,SETTT7
HRLM A,(P)
MD,< FETCH(D,E,BLOC)
JUMPE D,ADBNM1
FETCH(A,E,BRSLOC)
>;MD
MPC,< FETCH(T,E,BLN)
JUMPE T,ADBNM1
MOVE A,T
>;MPC
PUSHJ P,SLTLPN
HLRZ A,(P)
JRST ADBNM1
MPC,<
ADBNAM: FETCH(D,E,TNAM)
PUSHJ P,SETTT7
HRLM A,(P)
PUSHJ P,STFNAM ;MAKE # OF PINS STRING (ALSO SEPERATION IF 2 PINS)
JRST ADBNM1
>;MPC
MD,<
ADLDIP:
ADLNAM: FETCH(T,E,TLIB)
JUMPN T,ADLNME ;SKIP LIBRARY BODIES SINCE THEY MAY NOT BE READ IN
CAIN H,%FLDIP
JRST [ MOVE A,E
MOVEI TT,[ASCIZ/DIPTYPE/]
PUSHJ P,ASCCOP
PUSH P,T
PUSHJ P,FPROP
JRST [ POP P,B
PUSHJ P,PUTFS
JRST ADLNME]
POP P,B
PUSHJ P,PUTFS
FETCH(A,T,TXVAL)
JRST ADLNM1]
FETCH(A,E,TNAM) ;GET BODY NAME
ADLNM1: JUMPE A,ADLNME ;UNLESS NONE
MOVE T,@FSTRTB(H) ;GET SEARCH STRING
PUSHJ P,MATCHS ;COMPARE
JRST ADLNME ;NO MATCH
SETBIT(FOUNDL,T,E,TBIT)
AOS FIND ;AND COUNT IT
ADLNME: FETCH(E,E,TNXT)
JUMPN E,ADLNAM
POPJ P,
ADLPIN: FETCH(E,E,TPIN)
JUMPE E,CPOPJ
ADLPN2: PUSHJ P,SETTT7
HRLM A,(P)
MOVE T,E ;TYPIN BLOCK
PUSHJ P,OUTPID
MOVE T,@FSTRTB(H)
HLRZ A,(P) ;CLOBBERED BY OUTPID
PUSHJ P,MATCHS
JRST ADLPN3
SETBIT(FOUNDD,T,E,TPBIT)
AOS FIND
ADLPN3: HLRZ B,(P)
PUSHJ P,PUTFS
ADLPN1: FETCH(E,E,TPNX)
JUMPN E,ADLPN2
POPJ P,
ADBPRP:
ADBTXT: FETCH(E,E,BTXT)
JRST ADBLPT
ADLPRP:
ADLTXT: FETCH(E,E,TPROP)
ADBLPT: JUMPE E,CPOPJ
ADLTX1: FETCH(A,E,TXBIT)
TRNE A,TXBIND
JRST ADLTX2 ;JUMP IF THIS IS INDIRECT BLOCK
CAIE H,%FBPRP
CAIN H,%FLPRP
JRST [ FETCH(A,E,TXNAM)
JUMPE A,ADLTX2
JRST ADLTX3]
FETCH(A,E,TXVAL)
FETCH(T,A,TSSIZ)
TLNN M,%IDENT
JUMPE T,ADLTX2
ADLTX3: MOVE T,@FSTRTB(H)
PUSHJ P,MATCHS
JRST ADLTX2
MOVSI T,1
IORM T,ADDR(E,TXXY) ;MARK THIS ONE FOUND
AOS FIND
ADLTX2: FETCH(E,E,TXNXT)
JUMPN E,ADLTX1
POPJ P,
>;MD
;HERE WE FIND THE NEXT INSTANCE OF WHATEVER
FNEXTP:
MPC,< MOVEI T,1
LSH T,@MODE
TDNN T,[1PNTM!1TXTM]
JRST PERRET
>;MPC
SETZB F,FIND ;NOTHING FOUND YET
SKIPE A,PONPNT
PUSHJ P,FNNXTP
SKIPE F
JRST IFNDP
MPC,< SKIPE A,PONPN2
PUSHJ P,FNNXTP
SKIPE F
JRST IFNDP
>;MPC
NOFNDA: TLNN M,DSKACT!MACACT
JRST PERRET
POPJ P,
IFNDP:
MPC,< FETCHL(T,F,PBIT)
EQV T,SID
JUMPL T,NOSIDC
SWITCH
TRO MCHG!NEEDCL
NOSIDC:
>;MPC
TRZ INMOV!INLIN
CLRBIT(FOUNDP,T,F,PBIT)
IFNDBA: SETOM FIND
MOVE T,F
JRST SCLOSP ;SET AS CLOSEST, AND MOVE THERE
FNEXTB: SETZB F,FIND
SKIPN A,DBODPN
JRST NOFNDA
FNNXTB: FETCHL(T,A,BBIT)
TLNN T,FOUNDB
JRST FNXTB2
MOVE F,A
TLNE M,DSKACT!MACACT
JRST IFNDB ;WIN IMMEDIATELY IF IN DSKIN OR MACRO
FETCH(T,A,BXY)
PUSHJ P,ONSCR
CAIA
JRST IFNDB
FNXTB2: HRRZ A,(A)
JUMPN A,FNNXTB
JUMPE F,NOFNDA
IFNDB: TRZ INMOV!INLIN
CLRBIT(FOUNDB,TT,F,BBIT)
JRST IFNDBA
FNNXTP: FETCHL(T,A,PBIT)
TLNN T,FOUNDP
JRST FNXTP1
MOVE F,A
TLNE M,DSKACT!MACACT
JRST CPOPJ1 ;WIN IMMEDIATELY IF IN DSKIN OR MACRO
FETCH(T,A,PXY)
PUSHJ P,ONSCR
CAIA
JRST CPOPJ1
FNXTP1: HRRZ A,(A)
JUMPN A,FNNXTP
POPJ P,
MD,<
FNEXTL: MOVEI T,1
LSH T,@MODE ;GET CURRENT MODE AS BIT
TDNN T,[1BTXTM!1SETM!1PNTM!1TXTM!1LINM!1BODM]
JRST PERRET ;CAN'T GET TO EDIT MODE FROM HERE
SKIPN A,BODPNT
JRST NOFNDA
FNNXTL: FETCH(T,A,TYP1)
JUMPE T,FNXTL2 ;GET NEXT IF NO DEF HERE
FETCH(TT,A,TBIT)
TRZE TT,FOUNDL ;BIT ON?
JRST FNXTL1 ;YES, STORE BACK WITH BIT OFF
FNXTL2: FETCH(A,A,TNXT)
JUMPN A,FNNXTL
JRST NOFNDA
FNXTL1: STORE(TT,A,TBIT)
SETOM FIND
JRST ALREAD ;EDIT BODY IN A
FNEXBP: MOVEI T,1
LSH T,@MODE
TDNN T,[1EDTPM]
JRST PERRET
SETZB F,FIND
MOVE A,CURBOD
FETCH(A,A,TPIN)
JUMPE A,FNXBP4
FNXBP2: FETCH(T,A,TPBIT)
TRNN T,FOUNDD
JRST FNXBP1
MOVE F,A
TLNE M,DSKACT!MACACT
JRST FNXBP3
FETCH(T,A,TPXY)
PUSHJ P,ONSCR
CAIA
JRST FNXBP3
FNXBP1: FETCH(A,A,TPNX)
JUMPN A,FNXBP2
FNXBP4: JUMPE F,NOFNDA
FNXBP3: TRZ INMOV
CLRBIT(FOUNDD,TT,F,TPBIT)
JRST IFNDBA
FNEXBT: MOVE A,BTBODY
MOVEM A,CLXY ;SAVE BODY POINTER HERE
FETCH(A,A,BTXT)
JRST FNEXLB
FNEXLT: MOVE A,CURBOD
SETZM CLXY
FETCH(A,A,TPROP)
FNEXLB: SETZB F,FIND
JUMPE A,NOFNDA
FNXBT1: FETCH(T,A,TXXY)
TLNN T,1 ;MARKED?
JRST FNXBT2 ;NO
FETCH(TT,A,TXVAL)
FETCH(TT,TT,TSSIZ)
TLNN M,%IDENT
JUMPE TT,FNXBT2 ;ONLY VISIBLE ONES
MOVE F,A
TLNN M,DSKACT!MACACT
JRST FNXBT3
FETCH(T,A,TXXY)
TDZ T,[1,,1]
SKIPN TT,CLXY
JRST FNXBT4
PUSH P,F
FETCH(F,TT,BORI)
PUSHJ P,ORIENT
POP P,F
ADJUST(ADD,T,<ADDR(TT,BXY)>)
FNXBT4: PUSHJ P,ONSCR
CAIA
JRST FNXBT3
FNXBT2: HRRZ A,(A)
JUMPN A,FNXBT1
JUMPE F,NOFNDA
FNXBT3: TRZ INMOV
MOVSI TT,1
ANDCAM TT,ADDR(F,TXXY) ;CLEAR MARK BIT
JRST IFNDBA
>;MD
;CLEAR BITS
ACLRP: CLRBIT(FOUNDP,TT,E,PBIT)
HRRZ E,(E)
JUMPN E,ACLRP
POPJ P,
ACLRB: CLRBIT(FOUNDB,TT,E,BBIT)
HRRZ E,(E)
JUMPN E,ACLRB
POPJ P,
MD,<
ACLRL: FETCH(T,E,TYP1)
JUMPE T,ACLRL1
CLRBIT(FOUNDL,TT,E,TBIT)
ACLRL1: FETCH(E,E,TNXT)
JUMPN E,ACLRL
POPJ P,
ACLRLP: FETCH(E,E,TPIN)
JUMPE E,CPOPJ
ACLLP1: CLRBIT(FOUNDD,TT,E,TPBIT)
ACLLP2: FETCH(E,E,TPNX)
JUMPN E,ACLLP1
POPJ P,
ACLRBT: FETCH(E,E,BTXT)
JRST ACLRLB
ACLRLT: FETCH(E,E,TPROP)
ACLRLB: JUMPE E,CPOPJ
MOVSI TT,1
ACLBT1: ANDCAM TT,ADDR(E,TXXY)
FETCH(E,E,TXNXT)
JUMPN E,ACLBT1
POPJ P,
>;MD
;FIND TABLES
DLMTAB: JFCL ;BODY NAME
PUSHJ P,FNPUT ;BODY LOCATION
JFCL ;DIP TYPE NAME
PUSHJ P,FNPUT ;CONNECTOR OR DIP PIN LOCATION
JFCL ;TEXT
MD,< JFCL ;SIGNAL NAME
JFCL ;LIBRARY BODY NAME
JFCL ;LIBRARY BODY DIP TYPE NAME
JFCL ;LIBRARY BODY DEFAULT PIN LOCATION
JFCL ;LIBRARY BODY TEXT
JFCL ;LIBRARY BODY PROPERTY NAME
JFCL ;BODY TEXT
JFCL ;BODY PROPERTY NAME
>;MD
LSTTAB: DBODPN ;BODY NAME
DBODPN ;BODY LOCATION
DBODPN ;DIP TYPE NAME
PONPNT ;CONNECTOR OR DIP PIN LOCATION
PONPNT ;TEXT
MD,< PONPNT ;SIGNAL NAME
BODPNT ;LIBRARY BODY NAME
BODPNT ;LIBRARY BODY DIP TYPE NAME
CURBOD ;LIBRARY BODY DEFAULT PIN LOCATION
CURBOD ;LIBRARY BODY TEXT
CURBOD ;LIBRARY BODY PROPERTY NAME
BTBODY ;BODY TEXT
BTBODY ;BODY PROPERTY NAME
>;MD
FSTRTB: FBNSTR ;BODY NAME
FBLSTR ;BODY LOCATION
FBDSTR ;DIP TYPE NAME
FPLSTR ;CONNECTOR OR DIP PIN LOCATION
FPTSTR ;TEXT
MD,< FPSSTR ;SIGNAL NAME
FLNSTR ;LIBRARY BODY NAME
FLDSTR ;LIBRARY BODY DIP TYPE NAME
FLPSTR ;LIBRARY BODY DEFAULT PIN LOCATION
FLTSTR ;LIBRARY BODY TEXT
FLRSTR ;LIBRARY BODY PROPERTY NAME
FBTSTR ;BODY TEXT
FBRSTR ;BODY PROPERTY NAME
>;MD
MPC,<
LSTTB2: [0]
[0]
[0]
PONPN2
PONPN2
>;MPC
ADDCLR: ACLRB ;BODY NAME
ACLRB ;BODY LOCATION
ACLRB ;DIP TYPE NAME
ACLRP ;CONNECTOR OR DIP PIN LOCATION
ACLRP ;TEXT
MD,< ACLRP ;SIGNAL NAME
ACLRL ;LIBRARY BODY NAME
ACLRL ;LIBRARY BODY DIP TYPE NAME
ACLRLP ;LIBRARY BODY DEFAULT PIN LOCATION
ACLRLT ;LIBRARY BODY TEXT
ACLRLT ;LIBRARY BODY PROPERTY NAME
ACLRBT ;BODY TEXT
ACLRBT ;BODY PROPERTY NAME
>;MD
DEFINE %FBVAL $ (A)
< AD$A
>
ATHING:
%FBLST
;MATCH
MATCHS: MOVEM T,ALTSTR ;SAVE SEARCH STRING
SETOM BEGLIN
ADD A,[POINT 7,1] ;WILL ILDB TO FIRST CHR
JRST MATCHZ
MATCH: TLNN A,760000
JRST [ HRR A,-1(A)
TRNN A,-1
POPJ P,
JRST .+1]
IBP A ;ADVANCE PAST LAST MATCH
MATCHZ: AOS FSTART
SKIPN BEGLIN ;AT BEGINNING?
JRST MATCH1 ;NO, NO BEGIN LINE CHECK
NODEC,< TRNE M,SEXACT ;EXACT MATCH?
JRST MATCH0 ;YES, NO SPECIAL CHECK
MOVE TTT,A
ILDB T,TTT ;GET FIRST 2 CHARS
ILDB TT,TTT
CAIE T,NOT
JRST [ CAIN T,TILDA
CAIE TT,NOT
JRST MATCH0
JRST MATCHX]
CAIE TT,TILDA
JRST MATCH0
MATCHX: MOVE A,TTT ;SKIP THESE CHARS
AOS FSTART
AOS FSTART
>;NODEC
MATCH0: MOVE C,ALTSTR
LDB C,[POINT 7,1(C),6] ;GET FIRST CHAR
CAIN C,BELCHR ;BEGIN LINE CHAR?
JRST MATCHB ;TRY TO MATCH BEGINNING
MATCH1: SETZM FLEN ;NO CHARS MATCHED YET
MOVE B,ALTSTR
ADD B,[POINT 7,1]
TRNE M,SPACES
JRST DOMAT
MOVE T,A
NOMAT: TLNN T,760000
JRST [ HRR T,-1(T)
TRNN T,-1
JRST DOMAT ;NO MORE
JRST .+1]
ILDB TT,T
CAIE TT,DBLARR
CAIN TT," "
JRST [ MOVE A,T ;DON'T START ON SPACE
AOS FSTART ;COUNT A CHAR SKIPPED
JRST NOMAT] ;TRY FOR ANOTHER
DOMAT: PUSH P,A ;SAVE FOR BACKUP
PUSHJ P,TRYMAT ;CALL MATCH SUBR
JRST [ POP P,A
JRST CPOPJ1] ;MATCHED
POP P,A
SETZM BEGLIN ;NO LONGER BEGINNING OF STRING
SETZM FLEN ;USE THIS TO COUNT FSTART
PUSHJ P,GETA ;MOVE FORWARD IN STRING
JFCL ;TO GET COUNT
MOVE T,FLEN ;THIS IS HOW MANY REAL CHARS WE MOVED
ADDM T,FSTART ;OVER TO GET TO NEXT LOGICAL ONE
JUMPN C,MATCH1 ;GO ON IF NOT EOL
POPJ P, ;EOL, NO MATCH, FSTART IS COUNT TO END
MATCHB: MOVE B,ALTSTR
ADD B,[POINT 7,1,6] ;SKIP FIRST CHAR
SETZM FLEN
PUSHJ P,TRYMAT ;TRY TO MATCH REST
AOS (P) ;MATCH
POPJ P, ;NO MATCH
TRYMAT: PUSHJ P,GETB
POPJ P,
CAIN D,INFCHR ;ANY # OF NEXT CHAR
JRST INFCHK
PUSHJ P,MATCHD
JRST TRYMAT ;MATCH, TRY SOME MORE
JRST CPOPJ1 ;NO MATCH
MATCHA: PUSHJ P,GETB ;GET A CHAR FROM MATCH STRING
POPJ P, ;END OF MATCH STRING, THIS IS MATCH
MATCHD: CAIN D,BELCHR ;END OF LINE CHAR?
JRST EOLCHK
CAIN D,NFCHR ;NOT CHAR?
JRST NOTCHK
CAIN D,ANYCHR ;ANY CHAR?
JRST ANYCHK
CAIN D,QUOCHR ;QUOTE NEXT CHAR
JRST QUOCHK
CAIN D,LETCHR ;LETTER?
JRST LETCHK
CAIN D,DIGCHR ;DIGIT?
JRST DIGCHK
CAIN D,ALFCHR ;ALPHANUMERIC?
JRST ALFCHK
MATCHC: PUSHJ P,GETA
JRST CPOPJ1 ;EOL, NO MATCH
CAME C,D
AOS (P) ;NO MATCH
POPJ P,
LETCHK: PUSHJ P,GETA
JRST CPOPJ1
LETCK1: CAIL C,"A"
CAILE C,"z"
JRST CPOPJ1
CAIGE C,"a"
CAIG C,"Z"
POPJ P,
JRST CPOPJ1
DIGCHK: PUSHJ P,GETA
JRST CPOPJ1
DIGCK1: CAIL C,"0"
CAILE C,"9"
AOS (P)
POPJ P,
ALFCHK: PUSHJ P,GETA
JRST CPOPJ1
PUSHJ P,DIGCK1 ;CHECK FOR DIGIT
POPJ P, ;MATCH
JRST LETCK1 ;NO, TRY LETTER
EOLCHK: PUSHJ P,GETA
POPJ P, ;EOL, OK
JRST CPOPJ1 ;NO MATCH
NOTCHK: PUSHJ P,MATCHA ;TRY THE FOLLOWING MATCH
;NOTE: WE DISALLOW 
AOS (P) ;MATCH, NO MATCH
POPJ P,
ANYCHK: PUSHJ P,GETA
AOS (P) ;EOL, NO MATCH
POPJ P,
QUOCHK: PUSHJ P,GETB
POPJ P, ;EOL, MATCH
JRST MATCHC ;SKIP SPECIAL CHECK
INFCHK: PUSH P,B ;SAVE MATCH STRING POINTER FOR BACKUP
INFCK1: PUSHJ P,MATCHA ;TRY NEXT CHAR
CAIA ;MATCH
JRST [ POP P,(P) ;NO MATCH POSSIBLE
JRST CPOPJ1]
PUSH P,A ;SAVE BOTH STRING POINTER
PUSH P,FLEN ;AND SUBSTR LENGTH
PUSHJ P,TRYMAT ;TRY TO MATCH THE REST
JRST [ POP P,(P)
POP P,(P)
POP P,(P)
POPJ P,] ;PERFECT MATCH
POP P,FLEN
POP P,A ;BACKUP THESE POINTERS
MOVE B,(P)
JRST INFCK1 ;TRY A FURTHER MATCH ON STRING
GETA: AOS FLEN ;COUNT A CHAR SCARFED
TLNN A,760000 ;STRING OUT?
JRST [ TRNE A,-1
HRR A,-1(A)
TRNE A,-1
JRST .+1
SETZ C,
POPJ P,]
ILDB C,A
JUMPE C,CPOPJ ;NULL IS EOL
TRNE M,SPACES
JRST GETA1
CAIE C,DBLARR
CAIN C," "
JRST GETA
GETA1: TRNE M,SEXACT
JRST CPOPJ1
CAIN C,DBLARR
JRST [ MOVEI C," "
JRST CPOPJ1]
NODEC,< CAIN C,TILDA
JRST [ MOVEI C,NOT
JRST CPOPJ1]
>;NODEC
CAIL C,"a"
CAILE C,"z"
JRST CPOPJ1
SUBI C,40
JRST CPOPJ1
GETB: TLNN B,760000
HRR B,-1(B)
ILDB D,B
JUMPE D,CPOPJ ;NULL IS EOL
TRNE M,SPACES
JRST GETB1
CAIE D,DBLARR
CAIN D," "
JRST GETB
GETB1: TRNE M,SEXACT
JRST CPOPJ1
CAIN D,DBLARR
JRST [ MOVEI D," "
JRST CPOPJ1]
NODEC,< CAIN D,TILDA
JRST [ MOVEI D,NOT
JRST CPOPJ1]
>;NODEC
CAIL D,"a"
CAILE D,"z"
JRST CPOPJ1
SUBI D,40
JRST CPOPJ1