SUBTTL THIS ASSEMBLY MADE WITH MACROS.399 IFNDEF REENTR, ; FOLLOWING ARE THE MACROS DEFINITIONS USED WITH THE ; BELL TELEPHONE LABORATORIES SOURCE TAPE(CONVERTED ; TO MACRO-10 FORMAT) WHICH PRODUCES SNOBOL4 FOR ; THE PDP-10. THIS SOURCE WORKS FOR VERSION 3.4 AS ; RELEASED BY BELL LABORATORIES. MLON RADIX 8 OPDEF STAK [261B8] OPDEF UNSTAK [262B8] OPDEF MSTIM [CALLI ^O23] OPDEF RUNTIM [CALLI ^O27] DEFINE WEIGHT (A,B,C,D)< .%%K=0 IFNB ,<.%%K=.%%K+1> IFNB ,<.%%K=.%%K+2> IFNB ,<.%%K=.%%K+4> IFNB ,<.%%K=.%%K+8>> ; "WEIGHT" WILL DETERMINE WHETHER A GIVEN ARGUMENT EXISTS AND IF ; SO IT WILL INCREMENT A VARIABLE WITH ITS CORRESPONDING WEIGHT VALUE. ; THIS WEIGHT IS THEN CONVERTED TO AN ASCII CHARACTER VIA THE "\" ; FEATURE IN MACRO-10 AND USED WITH THE "XFER" MACRO ; TO CHOSE A FORM OF THE ORIGINAL MACRO IN ORDER TO PICK ONE ; WHICH GENERATES OPTIMUM CODE. ;THE CALL IS IN REVERSE ORDER OF ARGUMENTS IN ORDER ;TO ALLOW CALLING THE MACRO WITH A VARIABLE NUMBER OF ;ARGUMENTS DEFINE XFER (A,B,C,D,E,F,G)< B'A C,D,E,F,G> ; "XFER" WILL PICK A VERSION OF A PARTICULAR MACRO WHICH WILL ; GENERATE OPTIMUM CODE DEPENDING ON THE EXISTENCE OF ARGUMENTS. ; ARGUMENT "B" PICKS THE BASE MACRO (I.E. ACOMP) AND ARGUMENT A ; (CALLED VIA "\") PICKS THE VERSION (I.E. 4). ;ARGUMENTS "A" SHOULD BE THOUGHT OF AS ITS BINARY EQUIVALENT ;WHERE 1'S IDENTIFY WHICH ARGUMENTS EXIST DEFINE ACOMP (A,B,C,D,E)< MOVE A0,A WEIGHT E,D,C XFER \.%%K,ACOMP,B,C,D,E > DEFINE ACOMP0 (B,C,D,E)< JFCL ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++ > DEFINE ACOMP1 (B,C,D,E)< CAMGE A0,B JRST E > DEFINE ACOMP2 (B,C,D,E)< CAMN A0,B JRST D JRST D > DEFINE ACOMP3 (B,C,D,E)< IFDIF ,< CAMGE A0,B JRST E CAMG A0,B JRST D > IFIDN ,< CAMG A0,B JRST E >> DEFINE ACOMP4 (B,C,D,E)< CAMLE A0,B JRST C > DEFINE ACOMP5 (B,C,D,E)< IFDIF,< CAMLE A0,B JRST C CAME A0,B JRST E > IFIDN ,< CAME A0,B JRST C >> DEFINE ACOMP6 (B,C,D,E)< IFDIF ,< CAMLE A0,B JRST C CAML A0,B JRST D > IFIDN ,< CAML A0,B JRST C >> DEFINE ACOMP7 (B,C,D,E)< %ACMP=0 ;;;KLUDGE TO EXPAND ONLY 1 OF THE FOLLOWING ;;;CONDITIONAL TESTS IFIDN ,< CAMGE A0,B JRST E JRST C %ACMP=1 > IFE %ACMP,< IFIDN ,< CAME A0,B JRST C JRST D %ACMP=1 >> IFE %ACMP,< IFIDN ,< CAMG A0,B JRST D JRST C %ACMP=1 >> IFE %ACMP,< IFDIF ,< ACOMP6 B,C,D,E JRST E %ACMP=1 >> IFE %ACMP,< IFDIF ,< ACOMP6 B,C,D,E JRST E %ACMP=1 >> IFE %ACMP,< IFDIF ,< ACOMP6 B,C,D,E JRST E >> > ; "ACOMP" COMPARES THE CONTENTS OF ARGUMENT1 WITH THE CONTENTS OF ; ARGUMENT2 AND ; 1. IF GT, TRANSFERS TO ARG3 ; 2. IF EQ, TRANSFERS TO ARG4 ; 3. IF LT, TRANSFERS TO ARG5 DEFINE ACOMPC (DES,N,GT,EQ,LT)< WEIGHT LT,EQ,GT IFDIF <0>,< MOVE A0,DES > XFER \.%%K,ACOMC,DES,N,GT,EQ,LT > DEFINE ACOMC0(A,B,C,D,E)< JFCL ;;++++++++++++++++++++++++++++ > DEFINE ACOMC1 (DES,N,GT,EQ,LT)< IFDIF <0>,< CAIGE A0,N JRST LT > IFIDN <0>,< SKIPGE DES JRST LT > > DEFINE ACOMC2(DES,N,GT,EQ,LT)< IFDIF <0>,< CAIN A0,N JRST EQ > IFIDN <0>,< SKIPN DES JRST EQ > > DEFINE ACOMC3(DES,N,GT,EQ,LT)< IFDIF <0>,< CAIGE A0,N JRST LT CAIG A0,N JRST EQ > IFIDN <0>,< SKIPGE DES JRST LT SKIPG DES JRST EQ > > DEFINE ACOMC4 (DES,N,GT,EQ,LT)< IFDIF <0>,< CAILE A0,N JRST GT > IFIDN <0>,< SKIPLE DES JRST GT > > DEFINE ACOMC5(DES,N,GT,EQ,LT)< IFDIF <0>,< CAILE A0,N JRST GT CAIE A0,N JRST LT > IFIDN <0>,< SKIPLE DES JRST GT SKIPE DES JRST LT > > DEFINE ACOMC6(DES,N,GT,EQ,LT)< IFDIF <0>,< CAILE A0,N JRST GT CAIL A0,N JRST EQ > IFIDN <0>,< SKIPLE DES JRST GT SKIPL DES JRST EQ > > DEFINE ACOMC7(DES,N,GT,EQ,LT)< %ACMC=0 ;;A KLUDGE TO ALLOW ONLY ONE OF THE FOLLOWING ;;CONDITIONALS TO EXPAND IFIDN <0>,< MOVE A0,DES > IFE %ACMC,< IFIDN ,< CAIGE A0,N JRST LT JRST GT %ACMC=1 >> IFE %ACMC,< IFIDN ,< CAIE A0,N JRST GT JRST EQ %ACMC=1 >> IFE %ACMC,< IFIDN ,< CAIG A0,N JRST EQ JRST GT %ACMC=1 >> IFE %ACMC,< IFDIF ,< ACOMC6 DES,N,GT,EQ,LT JRST LT %ACMC=1 >> IFE %ACMC,< IFDIF ,< ACOMC6 DES,N,GT,EQ,LT JRST LT %ACMC=1 >> IFE %ACMC,< IFDIF ,< ACOMC6 DES,N,GT,EQ,LT JRST LT %ACMC=1 >> > DEFINE ADDLG (A,B)< MOVE A0,B ADDM A0,A+SPECL > DEFINE ADDSIB (D1,D2)< MOVE A2,D2 MOVE A1,D1 ;;SET UP A2+RSIB WITH (A4) MOVE A0,RSIB(A1) MOVEM A0,RSIB(A2) MOVE A0,RSIB+1(A1) MOVEM A0,RSIB+1(A2) MOVE A0,FATHER(A1) AOS CODE+1(A0) ;;INCRMENT A3+CODE MOVEM A0,FATHER(A2) MOVE A0,FATHER+1(A1) MOVEM A0,FATHER+1(A2) MOVEM A2,RSIB(A1) MOVE A0,D2+1 MOVEM A0,RSIB+1(A1) > DEFINE ADDSON (D1,D2)< MOVE A1,D1 MOVE A2,D2 MOVEM A1,FATHER(A2) MOVE A0,D1+1 MOVEM A0,FATHER+1(A2) MOVE A0,LSON(A1) MOVEM A0,RSIB(A2) MOVE A0,LSON+1(A1) MOVEM A0,RSIB+1(A2) MOVEM A2,LSON(A1) MOVE A0,D2+1 MOVEM A0,LSON+1(A1) AOS CODE+1(A1) > DEFINE ADJUST (A,B,C)< MOVE A0,@B ADD A0,C MOVEM A0,A > DEFINE ADREAL (D1,D2,D3,F,S)< IFNB ,< JFCL ^O17,.+1 ;;CLEAR ARITH OVFLOW FLAGS > MOVE A0,D2 FADR A0,D3 IFNB ,< JFCL F ;FLOATING OVERFLOW > MOVEM A0,D1 MOVE A1,D2+1 ;;TRANSFER REST OF DESCR MOVEM A1,D1+1 IFNB ,< JRST S > > DEFINE AEQL (A,B,C,D)< IFDIF <0>,< MOVE A0,B > WEIGHT D,C XFER \.%%K,AEQL,A,B,C,D > DEFINE AEQL0 (A,B,C,D)< JFCL ;+++++++++++++++++++++++++++++++++++++++++++++++++++++ > DEFINE AEQL1 (A,B,C,D)< IFIDN <0>,< SKIPN A JRST D > IFDIF <0>,< CAMN A0,A JRST D > > DEFINE AEQL2 (A,B,C,D)< IFIDN <0>,< SKIPE A JRST C > IFDIF <0>,< CAME A0,A JRST C > > DEFINE AEQL3 (A,B,C,D)< IFIDN <0>,< SKIPE A JRST C JRST D > IFDIF <0>,< CAME A0,A JRST C JRST D > > DEFINE AEQLC (A,B,C,D)< IFDIF <0>,< MOVEI A0,B > WEIGHT D,C XFER \.%%K,AEQL,A,B,C,D > DEFINE AEQLIC(D1,N1,N2,NE,EQ)< MOVE A0,D1 MOVE A0,N1(A0) WEIGHT EQ,NE XFER \.%%K,AEQLI,N2,NE,EQ > DEFINE AEQLI0(N2,NE,EQ)< JFCL ;;++++++++++++++++++++++++++++++++++++++++++++++++++ > DEFINE AEQLI1(N2,NE,EQ)< CAIN A0,N2 JRST EQ > DEFINE AEQLI2(N2,NE,EQ)< CAIE A0,N2 JRST NE > DEFINE AEQLI3(N2,NE,EQ)< CAIE A0,N2 JRST NE JRST EQ > DEFINE APDSP (ST1,ST2)< MOVEI A0,ST1 MOVEI A1,ST2 ;;GET ADDRESS OF STRING TO APPEND EXTERN APPEND PUSHJ PDP,APPEND > DEFINE ARRAX (N,%A)< ..%%K=*DESCR %A: XLIST REPEAT ..%%K,< Z > LIST > DEFINE BKSIZE (A,B,%C,%D)< MOVE A0,B ;;GET FLAGS PLUS VALUE MOVE A0,1(A0) TLNN A0,STTL ;;STRING STRUCTURE? JRST [ ADDI A0,DESCR HRRZM A0,A JRST %C] TLZ A0,-1 ;;GET VALUE ONLY SUBI A0,1 IDIVI A0,CPD ADDI A0,5 LSH A0,1 ;;MULTIPLY BY TWO %D: MOVEM A0,A %C: SETZM A+1 > DEFINE BKSPCE(D)< EXTERN MBSR. MTOP. 02,@D > DEFINE BRANCH (A,B)< JRST A > DEFINE BRANIC (A,B)< MOVE A0,A JRST @B(A0) > DEFINE BUFFER(N,%A)< .%%K=/5+1 %A: XLIST REPEAT .%%K,< ASCII & & > LIST > DEFINE CHKVAL (A,B,C,D,E,F)< MOVE A0,C+SPECL ADD A0,B WEIGHT F,E,D XFER \.%%K,ACOMP,A,D,E,F > DEFINE CLERTB (T,K)< MOVE A0,[XWD K,K] MOVEI A2,^D128/2 MOVEM A0,T-1(A2) SOJG A2,.-1 > DEFINE COPY (A)< MDATA=1 PARMS=2 MLINK=3 RADIX 8 IFE ,< .%%K=0 ALPHA: REPEAT <^D128/5+1>,< Z0=.%%K Z1=.%%K+1 Z2=.%%K+2 Z3=.%%K+3 Z4=.%%K+4 .%%K=.%%K+5 EXPAND \Z0,\Z1,\Z2,\Z3,\Z4 > LALL AMPST: ASCII .&. COLSTR: ASCII .: . QTSTR: ASCII /'/ SEMSTR: ASCII .;. RADIX 10 XALL > IFE ,< LALL CPA=5 ;;NO. OF CHARACTERS/MACHINE ADDRESSING UNIT CHARNO=^D128 ALPHSZ=CHARNO DESCR=2 D=DESCR FNC=1 MARK=2 PTR=4 STTL=^O10 TTL=^O20 SPCFLG=^O40 ;;NEW FLAG DEFINED TO UNIQUELY DEFINE A SPECIFIER SIZLIM=^O777777 SPEC=4 INTERN UNITC,UNITI,UNITO,UNITP UNITC=^D99 ;;UNIT FOR CHARACTER I/O UNITI=5 ;;INPUT UNIT NUMBER UNITO=6 ;;OUTPUT UNIT NUMBER UNITP=7 ;;PUNCH UNIT NUMBER RADIX 10 XALL > IFE ,< JFCL ;;NO EXTERNAL LINKAGES PROVIDED NOW RADIX 10 > > DEFINE EXPAND (Z0,Z1,Z2,Z3,Z4)< LALL BYTE (7) Z0,Z1,Z2,Z3,Z4 XALL > DEFINE CPYPAT(D1,D2,D3,D4,D5,D6)< EXTERN CPYPAX MOVEI A1,D1 MOVEI A2,D2 MOVEI A3,D3 MOVEI A4,D4 MOVEI A5,D5 MOVEI A6,D6 PUSHJ PDP,CPYPAX > DEFINE DATE (SP)< EXTERN DATX ;;TO AVIOD CONFLICT WITH MACRO NAME ;;AND EXTERN THE SAME EXTERN DATBUF PUSHJ PDP,DATX ;;GO TO THE DATE SUBROUTINE MOVE A0,[POINT 7,DATBUF,] MOVEM A0,SP+SPECO MOVEI A0,^D9 HRRM A0,SP+SPECL > DEFINE DECRA (D,N)< IFE ,< SOS D > IFN ,< MOVNI A0,N ADDM A0,D ;;SUBTRACT > > DEFINE DEQL (D1,D2,NE,EQ)< MOVE A0,D1 MOVE A1,D1+1 WEIGHT EQ,NE XFER \.%%K,DEQL,D2,NE,EQ > DEFINE DEQ0 (D2,NE,EQ)< JFCL ;+++++++++++++++++++++++++++++++++++++++++ > DEFINE DEQL1 (D2,NE,EQ)< CAME A0,D2 JRST .+3 CAMN A1,D2+1 JRST EQ > DEFINE DEQL2 (D2,NE,EQ)< CAME A0,D2 JRST NE CAME A1,D2+1 JRST NE > DEFINE DEQL3 (D2,NE,EQ)< CAME A0,D2 JRST NE CAMN A1,D2+1 JRST EQ JRST NE > DEFINE DESCX (A,F,V)< EXP A XWD F,V > DEFINE DIVIDE(D1,D2,D3,F,S)< SKIPN D3 IFB ,< HALT . > IFNB ,< JRST F > MOVE A0,D2 IDIV A0,D3 MOVEM A0,D1 MOVE A0,D2+1 MOVEM A0,D1+1 IFNB ,< JRST S >> DEFINE DUMP<> DEFINE DVREAL (D1,D2,D3,F,S,%A) < IFNB ,< JFCL ^O17,.+1 ;;CLEAR ARITH FLAGS > SKIPN D3 IFB ,< HALT . > IFNB ,< JRST F > MOVE A0,D2 FDVR A0,D3 ;;DIVIDE IFNB ,< JFCL F ;;FLOATING OVERFLOW > MOVEM A0,D1 MOVE A1,D2+1 ;;TRANSFER REST OF DESCR MOVEM A1,D1+1 IFNB ,< JRST S > > DEFINE ENDEX(A,%A)< EXTERN RESTRT JRST RESTRT > DEFINE ENFILE (A)< EXTERNAL TPFCN.,EXIT. MTOP. 04,@A > DEFINE EQU (A)<> DEFINE EXPINT(D1,D2,D3,F,S)< EXTERN EXP1.0 MOVE 0,D2 SKIPN 1,D3 IFNB,< JRST F > IFB,< JFCL ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; > PUSHJ PDP,EXP1.0 MOVEM 0,D1 ;;SAVE THE RESULT MOVE A1,D2+1 ;;GET FLAGS MOVEM A1,D1+1 IFNB,< JRST S >> DEFINE EXREAL(D1,D2,D3,F,S)< ;RAISE A REAL NUMBER TO A REAL POWER EXTERN EXP3.2 MOVE 2,D2 MOVE 3,D3 PUSHJ PDP,EXP3.2 MOVEM 2,D1 MOVE A0,D2+1 MOVEM A0,D1+1 IFNB ,< JRST S > > DEFINE FIRSTH< IFN REENTR,< TWOSEG ;;INDICATE THERE ARE TWO SEGMENTS FOLLOWING RELOC ^O400000 ;;PUT FOLLOWING CODE IN HIGH SEGMENT > > DEFINE FIRSTL< IFN REENTR,< RELOC 0 ;;PUT FOLLOWING CODE IN LOW SEGMENT > > DEFINE FORMAT (A)< ASCII \A\ > DEFINE FSHRTN (S,N)< IFE ,< SOS S+SPECL IBP S+SPECO > IFN ,< MOVNI A0,N ADDM A0,S+SPECL IBP S+SPECO AOJL A0,.-1 > SKIPGE S+SPECL ;;GUARD AGAINST NEGATIVE LENGTH STRINGS SETZM S+SPECL > DEFINE GETAC (D1,D2,N)< IFIDN <0>,< MOVE A0,@D2 > IFDIF <0>,< MOVE A0,D2 MOVE A0,N(A0) > MOVEM A0,D1 > DEFINE GETBAL (S,D,F,O,%A,%B,%C,%D,%E)< MOVEI J,1 MOVE SPEC1,S+SPECO MOVE LOOP,S+SPECL JUMPE LOOP,.+3 IBP SPEC1 SOJG LOOP,.-1 MOVE LOOP,D ILDB CH,SPEC1 CAIN CH,")" JRST F CAIE CH,"(" JRST %E SUBI LOOP,1 ;;ACCOUNT FOR "(" MOVEI COUNT,1 %D: ILDB CH,SPEC1 ADDI J,1 CAIN CH,")" JRST %B CAIN CH,"(" AOS COUNT %C: SOJG LOOP,%D JRST F %B: SOJE COUNT,%E JRST %C %E: ADDM J,S+SPECL IFNB ,< JRST O >> DEFINE GETD (D1,D2,D3)< MOVE A0,D2 ADD A0,D3 MOVSI A0,(A0) HRRI A0,D1 BLT A0,D1+1 > DEFINE GETDC (D1,D2,N)< IFDIF <0>,< MOVE A2,D2 MOVSI A2,N(A2) > IFIDN <0>,< HRL A2,D2 > HRRI A2,D1 BLT A2,D1+1 > DEFINE GETLG (D,S)< MOVE A0,S+SPECL MOVEM A0,D SETZM D+1 > DEFINE GETLTH (D1,D2)< MOVE A0,D2 SUBI A0,1 IDIVI A0,CPD ADDI A0,4 IMULI A0,DESCR MOVEM A0,D1 SETZM D1+1 > DEFINE GETSIZ (D1,D2)< MOVE A0,D2 HRRZ A0,1(A0) MOVEM A0,D1 SETZM D1+1 > DEFINE GETSPC (S,D,N)< MOVE A0,D IFDIF <0>,< ADDI A0,N > HRLI A0,(A0) HRRI A0,S BLT A0,S+SPECL > DEFINE HIGH< RELOC > DEFINE IFILEW<> DEFINE OFILEW<> DEFINE FILEM(UNIT,NAME)<> DEFINE IFILEM(UNIT,NAME)< EXTERN IFFAIL,IFILEX SETZM IFFAIL MOVEI A1,UNIT MOVEI A2,NAME PUSHJ PDP,IFILEX ;;TRANSFER THE STRING AND DO THE IFILE MOVEI A0,0 EXCH A0,IFFAIL JUMPN A0,FAIL ;;SIGNAL FUNCTION FAILURE > DEFINE OFILEM(UNIT,NAME)< EXTERN OFILEX,IFFAIL SETZM IFFAIL MOVEI A1,UNIT MOVEI A2,NAME PUSHJ PDP,OFILEX MOVEI A0,0 EXCH A0,IFFAIL JUMPN A0,FAIL ;;SIGNAL FUNCTION FAILURE > DEFINE INCRA (D,N)< IFE ,< AOS D > IFN ,< MOVEI A0,N ADDM A0,D > > DEFINE INCRV (D,N)< IFE ,< AOS D+1 > IFN ,< MOVEI A0,N ADDM A0,D+1 > > DEFINE INIT < INTERN DMPCL,LISTCL INTERN DTLIST,ARTHNO,R INTERN FRSGPT,HDSGPT,TLSGP1,OCALIM EXTERN PDL,TOTAVL,STCORE,ICORE EXTERN INTCOR,INTDEV,JOBAPR EXTERN OFILE,IFILE,LSTFIL,SRCFIL EXTERNAL FORSE.,EOFC,JOBREN INTERN SNOBOL INTERN OVER INTERN R INTERN I EXTERN RENCOM,DMPFLG,UNFLAG INTERN SYSCUT SNOBOL: RESET. MOVE PDP,PDL ;;PUSH DOWN LIST POINTER PUSHJ PDP,INTDEV ;;INITIALIZE I/O DEVICES PUSHJ PDP,INTCOR ;;CORE INITIALIZATION MOVEI A0,RENCOM ;;GIVE CUT BY SYSTEM MSG FOR REENTRY MOVEM A0,JOBREN MOVEI A0,1 ;;MAKE LIST LEFT DEFAULT MOVEM A0,LLIST SKIPE DMPFLG MOVEM A0,DMPCL ;;SET &DUMP KEYWORD FOR /D SKIPE UNFLAG SETZM LISTCL ;;SET -UNLIST FOR /U > DEFINE INSERT (D1,D2)< MOVE A1,D1 MOVE A2,D2 MOVE A3,FATHER(A1) MOVE A4,LSON(A3) MOVEM A3,FATHER(A2) MOVE A0,FATHER+1(A1) MOVEM A0,FATHER+1(A2) MOVEM A2,FATHER(A1) MOVEM A2,RSIB(A4) MOVE A0,D2+1 MOVEM A0,FATHER+1(A1) MOVEM A0,RSIB+1(A4) MOVEM A1,LSON(A2) MOVE A0,D1+1 MOVEM A0,LSON+1(A2) AOS CODE+1(A2) > DEFINE INTRL (A,B)< EXTERNAL FLOAT JSA Q,FLOAT ARG B MOVEM 0,A MOVEI A0,R MOVEM A0,A+1 > DEFINE INTSPC (S,DES)< MOVEI A0,S MOVE A1,DES EXTERN INTSPX PUSHJ PDP,INTSPX > DEFINE ISTACK(A) < MOVE CSTACK,[XWD -STSIZE,STACK+DESCR-1] MOVE OSTACK,CSTACK ;;OLD STACK POSITION=CURRENT STACK POS. > DEFINE LCOMP (S1,S2,GT,EQ,LT)< MOVE A0,S1+SPECL WEIGHT LT,EQ,GT XFER \.%%K,ACOMP,S2+SPECL,GT,EQ,LT > DEFINE LEQLC (S,N,NE,EQ)< IFDIF <0>,< MOVEI A0,N > WEIGHT EQ,NE XFER \.%%K,AEQL,S+SPECL,N,NE,EQ > DEFINE LEXCMP (S1,S2,GT,EQ,LT)< MOVE A0,S1+SPECO MOVE A1,S2+SPECO MOVE A3,S1+SPECL MOVE A4,S2+SPECL WEIGHT LT,EQ,GT XFER1 \.%%K,LEX,GT,EQ,LT > DEFINE XFER1 (A,B,C,D,E)< B'A C,D,E> DEFINE LEX0 (GT,EQ,LT)< JFCL ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; > DEFINE LEX1 (GT,EQ,LT,%A)< AOS LEX1CT LEX7 %A,%A,LT EXTERN LEX1CT %A: > DEFINE LEX2 (GT,EQ,LT,%A)< AOS LEX2CT LEX7 %A,EQ,%A EXTERN LEX2CT %A:> DEFINE LEX3 (GT,EQ,LT,%A)< AOS LEX3CT LEX7 %A,EQ,LT EXTERN LEX3CT %A: > DEFINE LEX4 (GT,EQ,LT,%A)< AOS LEX4CT LEX7 GT,%A,%A EXTERN LEX4CT %A: > DEFINE LEX5 (AGT,AEQ,ALT,%A)< .%%K=%A AOS LEX5CT LEX7 AGT,%A,ALT EXTERN LEX5CT %A: > DEFINE LEX6 (GT,EQ,LT,%A)< AOS LEX6CT LEX7 GT,EQ,%A EXTERN LEX6CT %A: > DEFINE LEX7 (GT,EQ,LT,%A,%B,%C,%D,%E,%F)< AOS LEX7CT IFE ,< CAIE A3,(A4) JRST GT > IFN ,< CAIE A3,(A4) JRST %D > CAIE A3,(A4) JRST %D ;;LENGTHS NOT EQUAL JUMPE A3,EQ %C: ILDB CH,A0 ILDB CH1,A1 CAILE CH,(CH1) JRST GT CAIE CH,(CH1) JRST LT SOJG A3,%C JRST EQ %D: JUMPE A3,LT JUMPE A4,GT %E: ILDB CH,A0 ILDB CH1,A1 CAIE CH,(CH1) JRST %F SOJE A3,LT SOJE A4,GT JRST %E %F: CAILE CH,(CH1) JRST GT JRST LT EXTERN LEX7CT %A: > DEFINE LHERE <> DEFINE LINK(D1,D2,D3,D4,F,S) < INTERN INTR10 EXTERN LINKFC MOVEI A1,D1 MOVEI A2,D2 MOVEI A3,D3 MOVEI A4,D4 PUSHJ PDP,LINKFC JRST F IFNB ,< JRST S > > DEFINE LINKOR (D1,D2,%A,%B)< MOVE A0,D2 MOVE A1,D1 ;;GET START ADDRESS %B: SKIPN A2,2*D(A1) JRST %A MOVE A1,D1 ADD A1,A2 JRST %B %A: MOVEM A0,2*D(A1) ;;STORE THE RESULT > DEFINE LOAD (D,S1,S2)< EXTERN LOAFNC INTERN UNDF MOVEI A1,D MOVEI A2,S1 MOVEI A3,S2 PUSHJ PDP,LOAFNC > DEFINE LOCAPT (D1,D2,D3,F,S,%A)< EXTERN LOCATX MOVEI A11,D2 MOVEI A6,D1 MOVEI A10,D3 PUSHJ PDP,LOCATX ;;LOCATED IN COMMON IFNB ,< JRST F > IFB ,< JRST %A > IFNB ,< JRST S > %A: > DEFINE LOCAPV (D1,D2,D3,F,S,%A)< EXTERN LOCAVX MOVEI A11,D2 MOVEI A6,D1 MOVEI A10,D3 PUSHJ PDP,LOCAVX ;;LOCATED IN COMMON IFNB ,< JRST F > IFB ,< JRST %A > IFNB ,< JRST S > %A: > DEFINE LOCSPX (SP,DES)< EXTERN LOCSPR MOVEI A0,DES MOVEI A1,SP PUSHJ PDP,LOCSPR ;;LOCATE SPECIFIER ROUTINE > DEFINE LOW< RELOC > DEFINE LVALUE (D1,D2,%A,%B)< MOVE A7,D2 ;;SET A7=A ADDI A7,2*D ;;SET A7=A+2D MOVEI A10,D(A7) ;;SET A10=A+3D MOVEI A1,(A7) ;;SAVE FOR LATER USE MOVEI A2,(A10) MOVE A3,(A2) ;;SET INITIAL AS MINIMUM %B: MOVE A4,(A1) ;;GET N(I) MOVE A5,(A2) ;;GET I(J) JUMPE A4,%A ;;END OF LIST,CHECK FOR ONE MORE CAILE A3,(A5) ;;NEW VALUE LT OLD VALUE? MOVEI A3,(A5) ;;YES MOVEI A1,(A7) ;;REINITIALIZE MOVEI A2,(A10) ADDI A1,(A4) ;;FORM A+N(K)+2D ADDI A2,(A4) ;;FORM A+N(K)+3D JRST %B %A: CAILE A3,(A5) ;;LAST VALUE LT OLD? MOVEI A3,(A5) ;;YES, RENEW I MOVEM A3,D1 ;;STORE VALUE SETZM D1+1 > DEFINE MAKNOD (D1,D2,D3,D4,D5,D6)< MOVE A0,D2 ;;GET A2 MOVE A1,D5 MOVEM A1,D(A0) MOVE A1,D5+1 MOVEM A1,D+1(A0) MOVE A1,D4 MOVEM A1,2*D(A0) MOVE A1,D3 MOVEM A1,3*D(A0) IFNB ,< MOVE A1,D6 MOVEM A1,4*D(A0) MOVE A1,D6+1 MOVEM A1,4*D+1(A0) > MOVE A1,D2 MOVEM A1,D1 MOVE A1,D2+1 MOVEM A1,D1+1 > DEFINE MNREAL (D1,D2)< MOVN A0,D2 MOVEM A0,D1 > DEFINE MNSINT (D1,D2,F,S)< MOVE A0,D2+1 ;;TRANSFER THE DESCRS MOVEM A0,D1+1 MOVN A0,D2 MOVEM A0,D1 IFNB ,< CAMG A0,[EXP ^O777777000000] JRST F > IFNB ,< JRST S > > DEFINE MOVA (D1,D2)< MOVE A0,D2 MOVEM A0,D1 > DEFINE MOVBLK (D1,D2,D3)< HRL A0,D2 ;;"FROM" HRR A0,D1 ;;"TO" HRRZ A1,A0 ADD A0,[XWD DESCR,DESCR] ADD A1,D3 BLT A0,1(A1) > DEFINE MOVD (D1,D2)< MOVSI A0,D2 ;;FROM HRRI A0,D1 ;;TO BLT A0,D1+1 > DEFINE MOVDIC (D1,N1,D2,N2)< MOVE A1,D1 MOVE A2,D2 MOVE A0,N2(A2) MOVEM A0,N1(A1) MOVE A0,N2+1(A2) MOVEM A0,N1+1(A1) > DEFINE MOVV (D1,D2)< HRR A0,D2+1 HRRM A0,D1+1 > DEFINE MPREAL (D1,D2,D3,F,S,%A)< IFNB ,< JFCL ^O17,.+1 ;;CLEAR FLAGS > MOVE A0,D2 FMPR A0,D3 ;;FLOATING MULTIPLY IFNB ,< JFCL F ;;OVERFLOW > MOVEM A0,D1 ;;STORE THE RESULT MOVE A1,D2+1 ;;TRANSFER THE REST MOVEM A1,D1+1 IFNB ,< JRST S > > DEFINE MSTIME (D)< MOVEI A0,0 ;;FORCE TO USE THIS JOBS TIME RUNTIM A0, ;;THIS CALL MEASURES RUN TIME AND NOT ;;ELAPSED TIME AS ON OTHER SYSTEMS MOVEM A0,D SETZM D+1 > DEFINE MULT (D1,D2,D3,F,S)< IFNB ,< JFCL ^O17,.+1 > IFDIF ,< MOVE A0,D2 IMUL A0,D3 MOVEM A0,D1 MOVE A0,D2+1 MOVEM A0,D1+1 > IFIDN ,< MOVE A0,D3 IMULM A0,D1 > IFNB ,< JFCL F > IFNB ,< JRST S > > DEFINE MULTC (D1,D2,N)< IFDIF ,< MOVE A0,D2 IMULI A0,N MOVEM A0,D1 SETZM D1+1 > IFIDN ,< MOVEI A0,N IMULM A0,D1 SETZM D1+1 > > DEFINE ORDVST < INTERNAL OBSIZ,OBSTRT EXTERNAL ORDVSX PUSHJ PDP,ORDVSX > DEFINE OUTPUX (DES,FOR,LIST)< MOVEI A1,FOR OUT. 01,@DES IFNB ,< IRP LIST,< DATA. 02,LIST >> FIN. > DEFINE PLUGTB (TAB,KEY,SP,%A,%B)< MOVE A0,SP+SPECL ;;GET NO. OF ENTRIES TO PLUG MOVEI A1,KEY MOVE A4,SP+SPECO JUMPE A0,%A %B: SETZM CH1 ILDB CH,A4 IDIVI CH,2 ;;REMAINDER IN CH1 SKIPN CH1 ;;LEFT OR RIGHT HALF OF TABLE JRST .+3 ;;RIGHT HALF HRLM A1,TAB(CH) ;;LEFT HALF SKIPA HRRM A1,TAB(CH) SOJG A0,%B %A: > DEFINE POP (A)< IRP A,< UNSTAK CSTACK,A+1 UNSTAK CSTACK,A > > DEFINE PROC (D1,N,D2)<> DEFINE PSTACK (A)< MOVEI A0,-DESCR-1(CSTACK) MOVEM A0,A SETZM A+1 > DEFINE PUSH (A)< IRP A,< STAK CSTACK,A STAK CSTACK,A+1 >> DEFINE PUTAC (D1,N,D2)< MOVE A0,D2 MOVE A1,D1 MOVEM A0,N(A1) > DEFINE PUTD (D1,D2,D3)< MOVSI A0,D3 ;;FROM HRR A0,D1 ADD A0,D2 ;;TO HRRI A1,(A0) ;;END TEST BLT A0,1(A1) > DEFINE PUTDC (D1,N,D2)< HRLI A0,D2 ;;"FROM" HRR A0,D1 ;;"TO" IFDIF <0>,< ADDI A0,N > MOVEI A1,(A0) BLT A0,1(A1) > DEFINE PUTLG (SP,DES)< MOVE A0,DES MOVEM A0,SP+SPECL > DEFINE PUTSPC (DES,N,SP)< MOVSI A0,SP HRR A0,DES ADDI A0,N HRRI A1,(A0) BLT A0,SPECL(A1) > DEFINE PUTVC (D1,N,D2)< MOVE A0,D1 HRR A1,D2+1 HRRM A1,N+1(A0) > DEFINE RXFER(A,B)< JSP A2,B'A > EXTERN RCALX0,RCALX1,RCALX2,RCALX3,RCALX4,RCALX5 EXTERN RCALX6,RCALX7 EXTERN RCALD0,RCALD1,RCALD2,RCALD3,RCALD4,RCALD5 EXTERN RCALD6,RCALD7 DEFINE RCALL(D,PR,DS,LS,%A,%B)< ; THE BULK OF THE TIME DS HAS EITHER ZERO OR ONE MEMBERS ; SO IT IS BENEFICIAL TO OPTIMIZE AROUND THIS CASE. .%%R=A4 .%%K=0 IRP DS,< .%%K=.%%K+1> ..K=.%%K REPEAT .%%K,< ..Z=1 IRP DS,< IFE <..Z-.%%K>,< MOVEI .%%R,DS .%%R=.%%R+1 > ..Z=..Z+1 > .%%K=.%%K-1 > IFNB ,< RXFER \..K,RCALD XWD D,PR > IFB ,< RXFER \..K,RCALX XWD 0,PR > IRP LS,< IFNB ,< JRST LS > IFB ,< JRST %A > > %A: IF2,< PURGE %A > > DEFINE RCOMP (D1,D2,GT,EQ,LT)< ACOMP D1,D2,GT,EQ,LT > DEFINE REALST (SP,DES,%A)< MOVEI A0,SP ;;LOCATION OF STRING MOVEI A1,DES ;;LOCATION OF REAL NUMBER EXTERN REALSX PUSHJ PDP,REALSX ;;CONVERT IT > DEFINE REMSX (S1,S2,S3)< MOVN A3,S3+SPECL ;;SAVE FOR LATER USE SETSP S1,S2 ADDM A3,S1+SPECL ;;FORM L2-L3 SKIPE A3 ;;DON'T INCREMENT IF ZERO IBP S1+SPECO AOJL A3,.-1 > DEFINE RESETF (DES,FLAG)< HRLI A0,FLAG ANDCAM A0,DES+1 > DEFINE REWIND (DES)< MTOP. 00,@DES > DEFINE RLINT (D1,D2,F,S)< EXTERN IFIX JSA ^O16,IFIX JUMP D1 IFNB ,< CAILE 0,^O777777 JRST F > MOVEM 0,D2 MOVEI A0,I MOVEM A0,D2+1 IFNB ,< JRST S > > DEFINE RPLACE (S1,S2,S3,%A,%B,%C,%D,%E)< MOVE A1,S1+SPECL ;;ITERATE OVER THIS AMOUNT JUMPE A1,%A MOVE A2,S1+SPECL MOVE A4,S1+SPECO %D: MOVE A5,S3+SPECO MOVE A3,S2+SPECO MOVE A0,S2+SPECL ILDB CH1,A4 MOVEI A10,0 %C: ILDB CH,A3 IBP A5 CAMN CH,CH1 JRST %B ;;CHARACTER MATCHES, SUBSTITUTE %E: SOJG A0,%C ;;LOOK AT MORE OF SOURCE STRING SKIPE A10 DPB A10,A4 SOJG A2,%D ;;LOOK FOR OCCURRENCES OF NEXT ;;REPLACEMENT CHARACTER JRST %A ;;DONE LOOKING SO QUIT %B: LDB A10,A5 ;;REPLACE IT WITH THIS CHARACTER JRST %E ;;CHECK FOR ENDING CONDITIONS NOW %A: > DEFINE RRTURN (DES,N)< EXTERN RRTND,RRTNX MOVEI A1,N-1 IFNB ,< MOVEI A2,DES JRST RRTND > IFB ,< JRST RRTNX > > DEFINE RSETFI (D,F)< MOVE A0,D MOVSI A1,F ANDCAM A1,1(A0) > DEFINE SAVEM(SP,%A)< INTERN RETNUL,SAVECL INTERN INTERP,INIT EXTERN SAVCOR INTERN FAIL %A: JUMP ^D29 ;;DEFINE THE DEFAULT DEVICE NUMBER OFILEM(%A,SP) ;;OPEN THE FILE MOVEI A2,SP PUSHJ PDP,SAVCOR ;;WRITE THE DATA OUT ENFILE(%A) ;;CLOSE THE FILE > DEFINE SBREAL (D1,D2,D3,F,S,%A)< IFNB ,< JFCL ^O17,.+1 > MOVE A0,D2 FSBR A0,D3 IFNB ,< JFCL F > MOVEM A0,D1 MOVE A1,D2+1 MOVEM A1,D1+1 IFNB ,< JRST S > > DEFINE SELBRA (D1,LIST,%A)< MOVE A0,D1 JRST .+1(A0) HALT . ;;GUARD AGAINST A CASE OF ZERO IRP LIST,< IFB ,< JRST %A > IFNB ,< JRST LIST >> %A: > DEFINE SETAC (D1,N)< IFIDN <0>,< SETZM D1 > IFDIF <0>,< MOVEI A0,N MOVEM A0,D1 > > DEFINE SETAV (D1,D2)< HRRZ A0,D2+1 MOVEM A0,D1 SETZM D1+1 > DEFINE SETF (D1,F)< MOVSI A0,F IORM A0,D1+1 > DEFINE SETFI (D1,F)< MOVSI A0,F MOVE A1,D1 IORM A0,1(A1) > DEFINE SETLC (S1,N)< IFIDN <0>,< SETZM S1+SPECL > IFDIF <0>,< MOVEI A0,N MOVEM A0,S1+SPECL > > DEFINE SETSIZ (D1,D2)< MOVE A0,D2 MOVE A1,D1 HRRM A0,1(A1) > DEFINE SETSP (S1,S2)< MOVSI A0,S2 ;;"FROM" HRRI A0,S1 ;;"TO" BLT A0,S1+SPECL > DEFINE SETVA (D1,D2)< MOVE A0,D2 HRRM A0,D1+1 > DEFINE SETVC (D1,N)< MOVEI A0,N HRRM A0,D1+1 > DEFINE SHORTN (S1,N)< IFE ,< SOS S1+SPECL > IFN ,< MOVNI A0,N ADDM A0,S1+SPECL > > DEFINE SPCINT (D1,SPE,F,S,%B)< MOVEI A0,SPE ;;INPUT STRING MOVEI A1,D1 ;;WHERE TO STORE RESULT EXTERN SPCINX PUSHJ PDP,SPCINX IFNB ,< JRST F > IFB ,< JRST %B > IFNB ,< JRST S > IFB ,< %B: > > DEFINE SPEX (A,F,V,O,L)< EXP A XWD F+SPCFLG,V IFDIF <0>,< .%%K=-/5*5 POINT 7,A+/5,.%%K*7-1 > IFIDN <0>,< POINT 7,A, > XWD 0,L > DEFINE SPOP (A)< IRP A,< UNSTAK CSTACK,A+3 UNSTAK CSTACK,A+2 UNSTAK CSTACK,A+1 UNSTAK CSTACK,A > > DEFINE SPUSH (A)< IRP A,< STAK CSTACK,A STAK CSTACK,A+1 STAK CSTACK,A+2 STAK CSTACK,A+3 >> DEFINE SPREAL(DES,SP,F,S,%B)< EXTERNAL SPREAX MOVEI A0,DES ;;WHERE TO STORE RESULT MOVEI A1,SP ;;INPUT STRING PUSHJ PDP,SPREAX IFNB ,< JRST F > IFB ,< JRST %B > IFNB ,< JRST S > %B: > DEFINE STPRNT (D1,D2,SP)< EXTERN OUTPTS MOVE A0,D2 MOVE A1,2*DESCR(A0) MOVEI A1,4*DESCR(A1) ;;GET FORMAT NUMBER HRRZ A10,DESCR(A0) OUT. 01,0(A10) MOVEI A2,SP ;;ADDRESS OF STRING TO PRINT PUSHJ PDP,OUTPTS ;;LOCATED IN COMMON > DEFINE STREAD (SP,DES,EOF,ERR,SUCC)< EXTERN BUFPNT,BUFIN EXTERN STREAX MOVEI A1,ERR MOVEI A2,EOF MOVE A3,DES MOVEI A4,SP PUSHJ PDP,STREAX IFNB ,< JRST SUCC >> DEFINE STREAM (S1,S2,TAB,ERR,RO,SUC,%A)< INTERN STYPE MOVEI A4,S1 ;;INPUT STRING MOVEI A5,S2 MOVEI A3,TAB ;;TABLE TO START STREAMING WITH EXTERN STREEM PUSHJ PDP,STREEM JRST ERR IFNB ,< JRST RO > IFB ,< JRST %A > IFNB ,< JRST SUC > %A: > DEFINE STRING (A)< .%%K=0 IRPC A,<.%%K=.%%K+1> ;DONT'T COUNT SINGLE QUOTES EXP .+4 Z POINT 7,.+2, EXP .%%K ASCII \A\ > DEFINE SUBSP (S1,S2,S3,F,S)< HRRZ A0,S2+SPECL IFNB ,< CAMLE A0,S3+SPECL JRST F > IFDIF ,< MOVE A1,[XWD S3,S1] BLT A1,S1+SPECO > MOVEM A0,S1+SPECL IFNB ,< JRST S > > DEFINE SUBTRT (D1,D2,D3,F,S,%A)< IFNB ,< JFCL ^O17,.+1 > IFDIF ,< MOVE A0,D2 MOVE A1,D2+1 MOVEM A1,D1+1 SUB A0,D3 IFNB ,< JFCL F > MOVEM A0,D1 > IFIDN ,< MOVN A0,D3 ADDM A0,D1 IFNB ,< JFCL F > > IFNB ,< JRST S > > DEFINE SUM (D1,D2,D3,F,S,%A)< IFNB ,< JFCL ^O17,.+1 > IFDIF ,< MOVE A0,D3 ADD A0,D2 IFNB ,< JFCL F > MOVEM A0,D1 MOVE A1,D2+1 MOVEM A1,D1+1 > IFIDN ,< MOVE A0,D3 ADDM A0,D1 IFNB ,< JFCL F > > IFNB ,< JRST S > > DEFINE TESTF (D,FLAG,F,S,%A)< MOVE A0,D+1 WEIGHT S,F XFER \.%%K,TESTF,FLAG,F,S > DEFINE TESTFI (D,FLAG,F,S,%A)< MOVE A0,D MOVE A0,1(A0) WEIGHT S,F XFER \.%%K,TESTF,FLAG,F,S > DEFINE TESTF0 (FLAG,F,S)< JFCL ;+++++++++++++++++++++++++++++++++++++++++ > DEFINE TESTF1 (FLAG,F,S)< TLNE A0,FLAG JRST S > DEFINE TESTF2 (FLAG,F,S)< TLNN A0,FLAG JRST F > DEFINE TESTF3 (FLAG,F,S)< TLNN A0,FLAG JRST F JRST S > DEFINE TIMER(D)< MOVEI A0,0 MSTIM A0, MOVEM A0,D SETZM D+1 > TITWRD=1 DEFINE TITLE (A)< IFN TITWRD,< PURGE TITLE TITLE A TITWRD=0 DEFINE TITLE (B,C,D,E,F,G)< SUBTTL B,C,D,E,F,G PAGE > > > DEFINE TOP (D1,D2,D3,%A,%B)< SETZM D2 SETZM D2+1 MOVEI A1,DESCR MOVE A0,D3 ;;GET A %B: MOVE A2,1(A0) ;;GET FLAG FIELD TLNE A2,TTL JRST %A ;;FLAG FOUND ADDM A1,D2 SUBI A0,DESCR ;;A-I*D JRST %B %A: MOVEM A0,D1 MOVE A1,D3+1 MOVEM A1,D1+1 > DEFINE TRIMSP(S1,S2)< INTERNAL ETMCL EXTERN TRIMIT MOVEI A5,S2 MOVEI A6,S1 PUSHJ PDP,TRIMIT > DEFINE UNLOAD(S)< EXTERN UNLFNC MOVEI A1,S PUSHJ PDP,UNLFNC > ; THE FOLLOWING ALGORITH WAS MODIFIED AD HOC WITH .394 ; WITH A RESULTING IMPROVEMENT OF ABOUT 2 1/2 TIMES SPEEDUP ; IN ELAPSED TIME. THE BIG KILLER WAS CAUSED BY USING THE 'IMULI' ; IN THE MAIN LOOP. ABOUT EVERY TIME THRU VARID THIS WOULD ;CAUSE AN OVERFLOW AT LEAST ONCE. WITH THE ADDITION OF TRPINI ; THIS WOULD INVOKE LOTS MORE CODE I.E. AT OVTRAP. ; ; SO WITH EXPERIMENTING AROUND I FOUND THAT THE XOR INDEXED ; INTO A TABLE OF PSUEDO RANDOM CONSTANTS FOR EACH CHARACTER ; RESULTED IN A FAIRLY UNIFORM DISTIBUTION OF HASH CODES. THE ; TABLE HAPPENS TO BE THE CODE FOLLOWING VARID ITSELF WHICH IS ; NOW AND FOREVER SHOULD BE PURE CODE, ELSE THE SAME STRING ; WILL GENERATE DIFFERENT HASH CODES (HEAVEN FORBID). DEFINE VARID (D,S,%A,%B,%C)< HRRZ A0,S+SPECL ;;GET NO. OF CHARACTERS MOVE A1,S+SPECO SETZB A5,A6 MOVEI A5,5 ;;START WITH SOME NON-ZERO NUMBER JUMPE A0,%A %B: ILDB A2,A1 XOR A5,.(A2) ;;MAGIC ALGORITHM SOJG A0,%B %A: %C: JFFO A5,.+1 ;;FIND NO. OF LEADING ZEROS MOVEI A0,^D36 ;;36 BITS IN A WORD SUBI A0,(A6) ;;THIS MANY ONES IN M1*M2 MOVEI A2,(A0) ;;SAVE NUMBER OF ONES LSH A0,-2 ;;DIVIDE FIELD SIZE BY FOURTH MOVEI A6,0 ;;CLEAR THE RESULT REGISTER MOVN A7,A0 ; THE FIRST AND LAST QUARTERS ARE USED SINCE THE MIDDLE ; HALVES TEND TO BE CONSTANT (I.E. 400000 BIT IS ON) AND ; CAUSES CLUSTERING AROUND ZERO LSHC A5,(A7) ;;SHIFT RIGHT-GET FOURTH OF THE ONES ROT A6,(A0) ;;POSITION IN PROPER PLACE LSH A6,1 ;;MULTIPLY BY DESCR CAIGE A6,*DESCR JRST .+3 LSH A6,-2 ;;DIVIDE BY 4 JRST .-4 MOVEM A6,D MOVEI A6,0 LSH A5,(A7) ;;DROP OFF THIRD QUARTER LSHC A5,(A7) ;;GET REST OF ONES ROT A6,(A0) HRRM A6,D+1 EXTERN STRREF AOS STRREF ;;COUNT THE NUMBER OF TIMES THROUGH HERE ;;THIS GIVES US THE NUMBER OF TIMES A STRING ;;LOOKUP IS MADE IN VARIABLE STORAGE > DEFINE VCMPIC (D1,N,D2,GT,EQ,LT)< MOVE A0,D1 HRRZ A0,N+1(A0) WEIGHT LT,EQ,GT HRRZ A1,D2+1 XFER \.%%K,ACOMP,A1,GT,EQ,LT > DEFINE VEQL (D1,D2,NE,EQ)< WEIGHT EQ,NE HRRZ A2,D1+1 HRRZ A0,D2+1 XFER \.%%K,AEQL,A2,A0,NE,EQ > DEFINE VEQLC (D,N,NE,EQ)< WEIGHT EQ,NE HRRZ A2,D+1 IFDIF <0>,< MOVEI A0,N XFER \.%%K,AEQL,A2,A0,NE,EQ > IFIDN <0>,< XFER \.%%K,AEQL,A2,0,NE,EQ > > DEFINE ZERBLK (D1,D2)< HRRZ A0,D1 SETZM (A0) HRL A0,D1 ADDI A0,1 HRRZ A1,D1 ADD A1,D2 BLT A0,1(A1) > TITLE SNOBOL4 (VERSION 3.4) FOR THE PDP-10/ LARRY WADE