Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0028/macros.399
There are 2 other files named macros.399 in the archive. Click here to see a list.
SUBTTL THIS ASSEMBLY MADE WITH MACROS.399
IFNDEF REENTR,<REENTR==1>
; 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 <A>,<.%%K=.%%K+1>
IFNB <B>,<.%%K=.%%K+2>
IFNB <C>,<.%%K=.%%K+4>
IFNB <D>,<.%%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 <D><E>,<
CAMGE A0,B
JRST E
CAMG A0,B
JRST D
>
IFIDN <D><E>,<
CAMG A0,B
JRST E
>>
DEFINE ACOMP4 (B,C,D,E)<
CAMLE A0,B
JRST C
>
DEFINE ACOMP5 (B,C,D,E)<
IFDIF<C><E>,<
CAMLE A0,B
JRST C
CAME A0,B
JRST E
>
IFIDN <C><E>,<
CAME A0,B
JRST C
>>
DEFINE ACOMP6 (B,C,D,E)<
IFDIF <C><D>,<
CAMLE A0,B
JRST C
CAML A0,B
JRST D
>
IFIDN <C><D>,<
CAML A0,B
JRST C
>>
DEFINE ACOMP7 (B,C,D,E)<
%ACMP=0 ;;;KLUDGE TO EXPAND ONLY 1 OF THE FOLLOWING
;;;CONDITIONAL TESTS
IFIDN <C><D>,<
CAMGE A0,B
JRST E
JRST C
%ACMP=1
>
IFE %ACMP,<
IFIDN <C><E>,<
CAME A0,B
JRST C
JRST D
%ACMP=1
>>
IFE %ACMP,<
IFIDN <D><E>,<
CAMG A0,B
JRST D
JRST C
%ACMP=1
>>
IFE %ACMP,<
IFDIF <C><D>,<
ACOMP6 B,C,D,E
JRST E
%ACMP=1
>>
IFE %ACMP,<
IFDIF <C><E>,<
ACOMP6 B,C,D,E
JRST E
%ACMP=1
>>
IFE %ACMP,<
IFDIF <D><E>,<
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 <N><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 <N><0>,<
CAIGE A0,N
JRST LT
>
IFIDN <N><0>,<
SKIPGE DES
JRST LT
>
>
DEFINE ACOMC2(DES,N,GT,EQ,LT)<
IFDIF <N><0>,<
CAIN A0,N
JRST EQ
>
IFIDN <N><0>,<
SKIPN DES
JRST EQ
>
>
DEFINE ACOMC3(DES,N,GT,EQ,LT)<
IFDIF <N><0>,<
CAIGE A0,N
JRST LT
CAIG A0,N
JRST EQ
>
IFIDN <N><0>,<
SKIPGE DES
JRST LT
SKIPG DES
JRST EQ
>
>
DEFINE ACOMC4 (DES,N,GT,EQ,LT)<
IFDIF <N><0>,<
CAILE A0,N
JRST GT
>
IFIDN <N><0>,<
SKIPLE DES
JRST GT
>
>
DEFINE ACOMC5(DES,N,GT,EQ,LT)<
IFDIF <N><0>,<
CAILE A0,N
JRST GT
CAIE A0,N
JRST LT
>
IFIDN <N><0>,<
SKIPLE DES
JRST GT
SKIPE DES
JRST LT
>
>
DEFINE ACOMC6(DES,N,GT,EQ,LT)<
IFDIF <N><0>,<
CAILE A0,N
JRST GT
CAIL A0,N
JRST EQ
>
IFIDN <N><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 <N><0>,<
MOVE A0,DES
>
IFE %ACMC,<
IFIDN <GT><EQ>,<
CAIGE A0,N
JRST LT
JRST GT
%ACMC=1
>>
IFE %ACMC,<
IFIDN <GT><LT>,<
CAIE A0,N
JRST GT
JRST EQ
%ACMC=1
>>
IFE %ACMC,<
IFIDN <EQ><LT>,<
CAIG A0,N
JRST EQ
JRST GT
%ACMC=1
>>
IFE %ACMC,<
IFDIF <GT><EQ>,<
ACOMC6 DES,N,GT,EQ,LT
JRST LT
%ACMC=1
>>
IFE %ACMC,<
IFDIF <GT><LT>,<
ACOMC6 DES,N,GT,EQ,LT
JRST LT
%ACMC=1
>>
IFE %ACMC,<
IFDIF <EQ><LT>,<
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 <F>,<
JFCL ^O17,.+1 ;;CLEAR ARITH OVFLOW FLAGS
>
MOVE A0,D2
FADR A0,D3
IFNB <F>,<
JFCL F ;FLOATING OVERFLOW
>
MOVEM A0,D1
MOVE A1,D2+1 ;;TRANSFER REST OF DESCR
MOVEM A1,D1+1
IFNB <S>,<
JRST S
>
>
DEFINE AEQL (A,B,C,D)<
IFDIF <B><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 <B><0>,<
SKIPN A
JRST D
>
IFDIF <B><0>,<
CAMN A0,A
JRST D
>
>
DEFINE AEQL2 (A,B,C,D)<
IFIDN <B><0>,<
SKIPE A
JRST C
>
IFDIF <B><0>,<
CAME A0,A
JRST C
>
>
DEFINE AEQL3 (A,B,C,D)<
IFIDN <B><0>,<
SKIPE A
JRST C
JRST D
>
IFDIF <B><0>,<
CAME A0,A
JRST C
JRST D
>
>
DEFINE AEQLC (A,B,C,D)<
IFDIF <B><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=<N>*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=<N>/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 <A-1>,<
.%%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 <A-2>,<
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 <A-3>,<
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 <N-1>,<
SOS D
>
IFN <N-1>,<
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 <F>,<
HALT .
>
IFNB <F>,<
JRST F
>
MOVE A0,D2
IDIV A0,D3
MOVEM A0,D1
MOVE A0,D2+1
MOVEM A0,D1+1
IFNB <S>,<
JRST S
>>
DEFINE DUMP<>
DEFINE DVREAL (D1,D2,D3,F,S,%A) <
IFNB <F>,<
JFCL ^O17,.+1 ;;CLEAR ARITH FLAGS
>
SKIPN D3
IFB <F>,<
HALT .
>
IFNB <F>,<
JRST F
>
MOVE A0,D2
FDVR A0,D3 ;;DIVIDE
IFNB <F>,<
JFCL F ;;FLOATING OVERFLOW
>
MOVEM A0,D1
MOVE A1,D2+1 ;;TRANSFER REST OF DESCR
MOVEM A1,D1+1
IFNB <S>,<
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<F>,<
JRST F
>
IFB<F>,<
JFCL ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
>
PUSHJ PDP,EXP1.0
MOVEM 0,D1 ;;SAVE THE RESULT
MOVE A1,D2+1 ;;GET FLAGS
MOVEM A1,D1+1
IFNB<S>,<
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 <S>,<
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 <N-1>,<
SOS S+SPECL
IBP S+SPECO
>
IFN <N-1>,<
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 <N><0>,<
MOVE A0,@D2
>
IFDIF <N><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 <O>,<
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 <N><0>,<
MOVE A2,D2
MOVSI A2,N(A2)
>
IFIDN <N><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 <N><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 <N-1>,<
AOS D
>
IFN <N-1>,<
MOVEI A0,N
ADDM A0,D
>
>
DEFINE INCRV (D,N)<
IFE <N-1>,<
AOS D+1
>
IFN <N-1>,<
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 <N><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 <GT-LT>,<
CAIE A3,(A4)
JRST GT
>
IFN <GT-LT>,<
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 <S>,<
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 <F>,<
JRST F
>
IFB <F>,<
JRST %A
>
IFNB <S>,<
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 <F>,<
JRST F
>
IFB <F>,<
JRST %A
>
IFNB <S>,<
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 <D6>,<
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 <F>,<
CAMG A0,[EXP ^O777777000000]
JRST F
>
IFNB <S>,<
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 <F>,<
JFCL ^O17,.+1 ;;CLEAR FLAGS
>
MOVE A0,D2
FMPR A0,D3 ;;FLOATING MULTIPLY
IFNB <F>,<
JFCL F ;;OVERFLOW
>
MOVEM A0,D1 ;;STORE THE RESULT
MOVE A1,D2+1 ;;TRANSFER THE REST
MOVEM A1,D1+1
IFNB <S>,<
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 <F>,<
JFCL ^O17,.+1
>
IFDIF <D1><D2>,<
MOVE A0,D2
IMUL A0,D3
MOVEM A0,D1
MOVE A0,D2+1
MOVEM A0,D1+1
>
IFIDN <D1><D2>,<
MOVE A0,D3
IMULM A0,D1
>
IFNB <F>,<
JFCL F
>
IFNB <S>,<
JRST S
>
>
DEFINE MULTC (D1,D2,N)<
IFDIF <D1><D2>,<
MOVE A0,D2
IMULI A0,N
MOVEM A0,D1
SETZM D1+1
>
IFIDN <D1><D2>,<
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 <LIST>,<
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 <N><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 <D>,<
RXFER \..K,RCALD
XWD D,PR
>
IFB <D>,<
RXFER \..K,RCALX
XWD 0,PR
>
IRP LS,<
IFNB <LS>,<
JRST LS
>
IFB <LS>,<
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 <F>,<
CAILE 0,^O777777
JRST F
>
MOVEM 0,D2
MOVEI A0,I
MOVEM A0,D2+1
IFNB <S>,<
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 <DES>,<
MOVEI A2,DES
JRST RRTND
>
IFB <DES>,<
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 <F>,<
JFCL ^O17,.+1
>
MOVE A0,D2
FSBR A0,D3
IFNB <F>,<
JFCL F
>
MOVEM A0,D1
MOVE A1,D2+1
MOVEM A1,D1+1
IFNB <S>,<
JRST S
>
>
DEFINE SELBRA (D1,LIST,%A)<
MOVE A0,D1
JRST .+1(A0)
HALT . ;;GUARD AGAINST A CASE OF ZERO
IRP LIST,<
IFB <LIST>,<
JRST %A
>
IFNB <LIST>,<
JRST LIST
>>
%A:
>
DEFINE SETAC (D1,N)<
IFIDN <N><0>,<
SETZM D1
>
IFDIF <N><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 <N><0>,<
SETZM S1+SPECL
>
IFDIF <N><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 <N-1>,<
SOS S1+SPECL
>
IFN <N-1>,<
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 <F>,<
JRST F
>
IFB <F>,<
JRST %B
>
IFNB <S>,<
JRST S
>
IFB <F>,<
%B:
>
>
DEFINE SPEX (A,F,V,O,L)<
EXP A
XWD F+SPCFLG,V
IFDIF <O><0>,<
.%%K=<O>-<O>/5*5
POINT 7,A+<O>/5,.%%K*7-1
>
IFIDN <O><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 <F>,<
JRST F
>
IFB <F>,<
JRST %B
>
IFNB <S>,<
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 <SUCC>,<
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 <RO>,<
JRST RO
>
IFB <RO>,<
JRST %A
>
IFNB <SUC>,<
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 <F>,<
CAMLE A0,S3+SPECL
JRST F
>
IFDIF <S1><S3>,<
MOVE A1,[XWD S3,S1]
BLT A1,S1+SPECO
>
MOVEM A0,S1+SPECL
IFNB <S>,<
JRST S
>
>
DEFINE SUBTRT (D1,D2,D3,F,S,%A)<
IFNB <F>,<
JFCL ^O17,.+1
>
IFDIF <D1><D2>,<
MOVE A0,D2
MOVE A1,D2+1
MOVEM A1,D1+1
SUB A0,D3
IFNB <F>,<
JFCL F
>
MOVEM A0,D1
>
IFIDN <D1><D2>,<
MOVN A0,D3
ADDM A0,D1
IFNB <F>,<
JFCL F
>
>
IFNB <S>,<
JRST S
>
>
DEFINE SUM (D1,D2,D3,F,S,%A)<
IFNB <F>,<
JFCL ^O17,.+1
>
IFDIF <D1><D2>,<
MOVE A0,D3
ADD A0,D2
IFNB <F>,<
JFCL F
>
MOVEM A0,D1
MOVE A1,D2+1
MOVEM A1,D1+1
>
IFIDN <D1><D2>,<
MOVE A0,D3
ADDM A0,D1
IFNB <F>,<
JFCL F
>
>
IFNB <S>,<
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,<OBSIZ-1>*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 <N><0>,<
MOVEI A0,N
XFER \.%%K,AEQL,A2,A0,NE,EQ
>
IFIDN <N><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