perm filename RUNMAC.FAI[TNX,AIL] blob
sn#129509 filedate 1974-11-10 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 DEFINE FUNC (NAME,RTYPE,LTYPE,PARAMS) <
C00009 ENDMK
C⊗;
DEFINE FUNC (NAME,RTYPE,LTYPE,PARAMS) <
$$LEN ← <FOR I E <NAME><1+>0> ;LENGTH OF NAME
II ← <ASCII/NAME/> ≥ $$LEN ;ASCII FOR NAME XOR LENGTH
II ← MOD (II,$$NBUK)
IFGE II,<$$BUCK←II;>$$BUCK←-II ;HASH BUCKET
$$LTYP ← LTYPE
IFN $$LTYP & EXTRNL,<EXTERNAL NAME>
$$NPW ← 0
$$NPS ← =30
$$PAR0 ← 0
$$PAR1 ← 0
$$PAR2 ← 0 ;INITIAL CONTENTS OF PARAMETER BYTE WORDS
PARAMS ;GET NUMBER AND TYPE OF PARAMETERS
$$HERE ← $$FVRB ← . ;DEFINE $$FVRB FOR CALL BY PREVIOUS SYMBOL
PURGE $$FVRB ;UNDEFINE IT FOR FUTURE CALL BY THIS SYMBOL
%($$BK,\$$BUCK) ;BEGINNING OF SEMBLK
$$LEN ;WORD 1 OF STRING DESC
POINT 7,.+10 ;WORD 2
XWD EXTRNL ! LTYPE,PROCED ! FORWRD ! RTYPE ;TBITS
0 ;SBITS
XWD IFN $$LTYP & EXTRNL,<NAME+>0,IFN DCS,<NAME;>0
$$PAR0
$$PAR1
$$PAR2
XWD $$FVRB,$$BVRB ;VARB RING CHAINING
ASCII /NAME/ ;STRING NAME
%($$BK,\$$BUCK) ← $$BVRB ← $$HERE ;BACKWARD LINKS
>
DEFINE $$INIT <
BEGIN RESTAB
IFNDEF DCS,<DCS←←0>
↑RESYM:
↑IPROC:
;LSTON(SMTB)
?$$PRIM←=43
FOR @# I←0,$$PRIM-1< ;INITIALIZE THE HASH TABLE
$$TY#I←←0>
?$$NTYP←←0
?$$NBUK←←=11
FOR @# I←0,$$NBUK<
$$BK#I←←0>
UNTYPE←0
>;DEF $$INIT
DEFINE MAIN (NAME,RTYPE,LTYPE,PARAMS) <
$$LEN ← <FOR I E <NAME><1+>0> ;LENGTH OF NAME
II ← <ASCII/NAME/> ≥ $$LEN ;ASCII FOR NAME XOR LENGTH
II ← MOD (II,$$NBUK)
IFGE II,<$$BUCK←II;>$$BUCK←-II ;HASH BUCKET
$$LTYP ← LTYPE
IFN $$LTYP & EXTRNL,<EXTERNAL NAME>
$$NPW ← 0
$$NPS ←=30
$$PAR0 ← 0
$$PAR1 ← 0
$$PAR2 ← 0
PARAMS ;GET NUMBER AND TYPE OF PARAMETERS
$$HERE ← $$FVRB ← . ;DEFINE $$FVRB FOR CALL BY PREVIOUS SYMBOL
PURGE $$FVRB ;UNDEFINE IT FOR FUTURE CALL BY THIS SYMBOL
%($$BK,\$$BUCK) ;BEGINNING OF SEMBLK
$$LEN ;WORD 1 OF STRING DESC
POINT 7,.+11 ;WORD 2
XWD EXTRNL ! LTYPE,PROCED ! FORWRD ! RTYPE ;TBITS
0 ;SBITS
XWD IFN $$LTYP & EXTRNL,<NAME+>0,IFN DCS,<NAME;>0
$$PAR0
$$PAR1
$$PAR2
XWD $$FVRB,$$BVRB ;VARB RING CHAINING
0
ASCII /NAME/ ;STRING NAME
%($$BK,\$$BUCK) ← $$BVRB ← $$HERE ;BACKWARD LINKS
>
DEFINE SLABL (LAB) <↑LAB:>
DEFINE MOD (I,J) <(I- I/J*J)>
DEFINE PAR (RTYPE,LTYPE,DEFLT) <
$$TYPE ← (LTYPE) ⊗ =18 ! RTYPE
$$K←$$TYPE - $$TYPE/$$PRIM*$$PRIM ;INITIAL HASH
IFE %($$TY,\$$K),<
%($$TY,\$$K)←$$TYPE
$$NTYP←$$NTYP+1
%($$TP,\$$K)←$$NTYP ;ADD NEW ONE
%($$TQ,\$$NTYP)←$$TYPE >
$$TEMP←$$TYPE-%($$TY,\$$K)
IFE $$TEMP,<%($$PAR,\$$NPW) ← %($$PAR,\$$NPW)+ %($$TP,\$$K)⊗$$NPS>
IFN $$TEMP,<$$COLL ($$TYPE,$$K)> ;RESOLVE COLLISION
IFIDN <DEFLT><$><%($$PAR,\$$NPW)←%($$PAR,\$$NPW)+ =32⊗$$NPS> ;DEFAULT BIT
$$NPS←$$NPS-6 ;NEXT PARAMETER BYTE SHIFTED 6 FEWER PLACES
IFL $$NPS,<$$NPW←$$NPW+1
$$NPS←=30> ;CORRECT FOR EXCEEDING 6 PER WORD
>
DEFINE $$COLL (TYPE,INDEX) <
INDEX←INDEX+1
IFE INDEX-$$PRIM,<INDEX←0>
IFE %($$TY,\INDEX),<
%($$TY,\INDEX)←TYPE
$$NTYP←$$NTYP+1
%($$TP,\$$K)←$$NTYP ;ADD NEW ONE
%($$TQ,\$$NTYP)←TYPE >
$$TEMP←TYPE-%($$TY,\INDEX)
IFE $$TEMP,<%($$PAR,\$$NPW) ← %($$PAR,\$$NPW)+ %($$TP,\INDEX)⊗$$NPS>
IFN $$TEMP,<$$COLL (TYPE,INDEX)> ;LINEAR PROBE
>
DEFINE % ≤ (PREFIX,SUFFIX) <PREFIX≤SUFFIX> ;CONCATENATION
DEFINE $$BLTT < ;BUILDS TYPE TABLE
↑BLTTBL←.-1 ;ORIGIN
FOR @# I←1,$$NTYP <
$$TQ#I ;THE BITS FOR THAT TYPE >
>
DEFINE $$SEC (A,B) <B>
DEFINE MBOD (BODY) <
FOR I E <BODY><
IFN $$QUOT,<$$QUOT←0
$$ADDM ("I")>;IFN $$QUOT
IFE $$QUOT,<
IFN $$MARK,<$$MARK←0
$$ADDM (177)
$$ADDM ( "I"-"0")>;IFN $$MARK
IFE $$MARK,<
IFN $$QUES,<$$QUES←0
IFIDN<I><≤><$$ADDM ($$LSS)>
IFIDN<I><≥><$$ADDM ($$GTR)>
IFIDN<I><≠><$$ADDM ($$ALT)>
IFIDN<I><[><$$ADDM ($$SETO)>
IFIDN<I><]><$$ADDM ($$SETC)> >;IFN $$QUES
IFE $$QUES,<
IFIDN<I><#><$$MARK←1>
IFIDN<I><@><$$QUOT←1>
IFIDN<I><?><$$QUES←1>
IFE $$MARK+$$QUOT+$$QUES,<$$ADDM ("I")> >;IFE $$QUES
>;IFE $$MARK
>;IFE $$QUOT
>;FOR I E BODY
>;DEFINE MBOD
$$QUOT←$$MARK←$$QUES←0
$$LSS←←74
$$GTR←←76
$$ALT←←175
$$SETO←←173
$$SETC←←176
DEFINE $$ADDM (CHAR) <$$CONM (\$$MBOD,CHAR)>
DEFINE $$CONM ≤ (X,Y,Z) <DEFINE $$MBOD <0,<Y,Z>>>
DEFINE MACRO (NAME,BODY) <
DEFINE $$MBOD <0,<BYTE (7) " ">>
MBOD <BODY>
$$SEC (\$$MBOD)
>