Trailing-Edge
-
PDP-10 Archives
-
decuslib10-04
-
43,50347/tulip.mac
There are 4 other files named tulip.mac in the archive. Click here to see a list.
UNIVERSAL TULIP - PARAMETER FILE FOR USE WITH TULIP
SUBTTL E.A.TAFT/EAT/EJW -- 12-JAN-75
SEARCH C ;USE DEC'S PARAMETER FILE
IF1,< END >
ND FTDBUG,0 ;ON TO ASSEMBLE CONSISTANCY CHECK CODE
ND FTCREF,0 ;OFF TO ELIMINATE A LOT OF USELESS CREFAGE
ND FTCMU,0 ;ON FOR STUFF LIKE CMUPPN PRINTING
ND FTIMP,0 ;ON FOR ARPANET CODE
GLOB <FTDBUG,FTCREF,FTCMU,FTIMP>;TO LET LOADER FIND INCONSISTANCIES
;MACRO TO ASSEMBLE VERSION NUMBERS IN STANDARD DEC FORM
XP(%%%TLP,0) ;FIRST TIME THROUGH, NEEDS A VALUE
DEFINE VERSION(V,U,E,W,VAL) <
%VVERS==V
%VUPDA=="U"&77
%VEDIT==E
%VWHO== W
DEFINE VERSTR <
XX V,U,E,W
>
IFNB <VAL>,<
VAL== BYTE (3) W (9) V (6) "U" (18) E
>IFB <VAL>,<
LOC 137
BYTE (3) W (9) V (6) "U" (18) E
RELOC
>
XP(%%%TLP,%%%TLP) ;ENSURE THAT TULIP VERSION ENTERS SYMBOL TABLE
>
VERSION(1,,2,0,%TULIP) ;ASSIGN VERSION # FOR THOSE INTERESTED
XP(%%%TLP,%VVERS) ;AND MAKE SPECIAL NOTE OF MAJOR VERSION
;ACCUMULATOR ASSIGNMENTS FOR UUO HANDLER PACKAGE.
;ALL AC'S ARE PROTECTED OVER UUO CALLS, EXCEPT FOR
;CERTAIN FLAGS IN THE FLAG REGISTER DESIGNATED FOR USE BY THE
;UUO HANDLER ALONE.
;*** GROUPED AC'S SHOULD NOT BE SEPARATED ***
F= 0 ;FLAGS
T1= 1 ;UTILITY AND SCRATCH. USED FOR ARGUMENT PASSING
T2= 2 ; AND RETURNING. THESE ACCUMULATORS NOT NORMALLY
T3= 3 ; PROTECTED ACROSS SUBROUTINE CALLS.
T4= 4 ;
P1= 5 ;PROTECTED REGISTERS. NOT NORMALLY MODIFIED
P2= 6 ; BY CALLED ROUTINES EXCEPT FOR "CONSTRUCTIVE"
P3= 7 ; UPDATING OF VALUES IN REGISTERS USED AT
P4= 10 ; HIGHER LEVELS.
U1= 14 ;HOLDS E FIELD OF UUO *** PROTECTED
U2= 15 ;SECOND TEMP FOR UUO HANDLERS *** BY UUO
U3= 16 ;HOLDS AC FIELD OF UUO *** ROUTINES.
P= 17 ;PUSHDOWN POINTER
;MACRO FOR DEFINING FLAGS IN THE RH OF THE FLAG REGISTER.
;NOTE THAT ONLY ONE OTHER SUBPROGRAM (BESIDES TULIP.MAC) MAY INVOKE
;THE "FLAG" MACRO TO OBTAIN UNIQUE FLAGS.
DEFINE FLAG(L) <
IRP L <IFNDEF L,<L== 1B<$FLAGN==$FLAGN-1>>
>>
$FLAGN==^D36 ;WE ASSIGN FLAGS FROM THE RIGHT
;FLAGS USED IN THE UUO HANDLER
FLAG (LZEFLG) ;LEADING ZEROES NOT TO BE SUPPRESSED
SUBTTL FILE MACRO
;MACRO FOR DEFINING A FILE BLOCK.
; FORMAT IS AS FOLLOWS:
; FILE CH,DIR,LOC,<SPEC(ARG),SPEC(ARG), ... ,SPEC(ARG)
; ,SPEC(ARG),SPEC(ARG)>
; WHERE THE FOLLOWING ARGUMENTS ARE REQUIRED:
; CH = USER CHANNEL NUMBER
; DIR = DIRECTION (I=INPUT, O=OUTPUT)
; LOC = WHERE BLOCK WILL RESIDE AT RUNTIME.
; ALL OTHER PARAMETERS ARE OPTIONAL, AND ARE SPECIFIED IN THE FORM
; SPEC(ARG)
; WHERE SPECIFIERS ARE THE FOLLOWING:
; DEV(N) DEVICE NAME IS N (DEFAULT = DSK)
; NAME(N) FILE NAME IS N (DEFAULT = BLANK)
; EXT(N) FILE EXTENSION IS N (DEFAULT = BLANK)
; PPN(N) PROJECT-PROGRAMMER NUMBER (DEFAULT=0)
; NOTE: COMMAS MAY NOT BE USED IN N, SO EITHER DEFINE A
; SYMBOL OR USE THE FORM PPN(1B17+4) FOR [1,4]
; STATUS(S) INITIAL FILE STATUS (DEFAULT = 0)
; OPEN(L) L IS LABEL OF USER-SUPPLIED ERROR ROUTINE
; FOR HANDLING OPEN ERROR (DEFAULT= ILERI1,ILERO1)
; LOOKUP(L) LOOKUP ERROR (DEFAULT = ILERI2,ILERO2)
; ENTER(L) ENTER ERROR (SAME FIELD AS LOOKUP)
; INPUT(L) INPUT ERROR (DEFAULT = ILERI3,ILERO3)
; OUTPUT(L) OUTPUT ERROR (SAME FIELD AS INPUT)
; EOF(L) END-OF-FILE (DEFAULT = ILERI3,ILERO3)
; OTHER(L) LOW-SEGMENT LOCATION OF MATING FILE BLOCK
; IF INPUT AND OUTPUT TO BE DONE ON THE SAME CHANNEL
; <INST(<I>)> PROGRAMMER-SUPPLIED BYTE INPUT/OUTPUT INSTRUCTION
; (DEFAULT = PUSHJ P,I1BYTE OR O1BYTE)
; EACH COMMA IN THE FILE MACRO MUST IMMEDIATELY PRECEDE A SPECIFIER.
;MACRO FOR DEFINING A PSEUDO-FILE BLOCK
; FORMAT IS AS FOLLOWS:
; PFILE LOC,<INST>,DAT
; WHERE THE FOLLOWING ARGUMENTS ARE REQUIRED:
; LOC = WHERE BLOCK WILL RESIDE AT RUNTIME
; INST = INSTRUCTION TO EXECUTE TO READ/WRITE 1 BYTE
; DAT = INITIAL DATA TO BE ASSEMBLED INTO FILCHN WORD (MAY BE
; LEFT BLANK).
DEFINE FILE(CH,DIR,LOC,SP) <
.XCREF
$DEFLT <DEV>,SIXBIT/DSK/
$DEFLT <NAME,EXT>,SIXBIT//
$DEFLT <STATUS,OTHER,PPN>,0
$DEFLT <OPEN>,ILER'DIR'1##
$DEFLT <LOOKUP>,ILER'DIR'2##
$DEFLT <INPUT,EOF>,ILER'DIR'3##
$DEFLT <INST>,<PUSHJ P,DIR'1BYTE##>
IRP SP <CONC F$,SP>
ZZ== <$FIBTS==0>
$FILOC==.
RELOC .+1
-FBSIZE,,LOC ;;FHDLOC--FOR SETTING UP FILE BLOCK
ALWNZ<V$INST> ;;FILXCT--INPUT/OUTPUT A CHAR INSTRUCTION
IFNZ<0> ;;FILBAK--BACKUP INPUT CHARACTER
IFNZ<0> ;;FILCUR--CURRENT INPUT CHARACTER
IFNZ<<CH>B12> ;;FILCHN--FILE CHANNEL NUMBER
IFNZ<V$STAT> ;;FILSTS--INITIAL FILE STATUS
IFNZ<V$DEV> ;;FILDEV--DEVICE NAME
IFIDN<DIR><I>,<
ALWNZ<V$OTHER,,LOC+FILHDR> ;;FILHDP--INPUT HEADER PTR FOR OPEN
>
IFIDN<DIR><O>,<
ALWNZ<LOC+FILHDR,,V$OTHER> ;;FILHDP--OUTPUT HEADER PTR FOR OPEN
>
IFNZ<V$NAME> ;;FILNAM--FILE NAME
IFNZ<V$EXT> ;;FILEXT--EXTENSION
IFNZ<0> ;;FILDAT--DATE, PROT, MODE, ETC.
IFNZ<V$PPN> ;;FILPP1--PROJ-PROG FOR LOOKUP/ENTER
IFNZ<V$PPN> ;;FILPPN--PROG-PROG FOR RESTORING FILPP1
IFNZ<0> ;;FILHDR--RING POINTER
IFNZ<0> ;;FILPTR--BYTE POINTER
IFNZ<0> ;;FILCTR--BYTE COUNTER
ALWNZ<V$OPEN,,V$LOOK> ;;FILER1--OPEN,,LOOKUP/ENTER ERROR DISPATCH
ALWNZ<V$EOF,,V$INPUT> ;;FILER2--EOF,,INPUT/OUTPUT ERROR DISPATCH
$FILC1==.
RELOC $FILOC
EXP $FIBTS ;;FHDBTS--REL. LOCATIONS OF NONZERO WORDS
RELOC $FILC1
.CREF
>
DEFINE $DEFLT(L,V) <
IRP L <DEFINE V$'L <V>>
>
DEFINE F$DEV(N) <DEFINE V$DEV <SIXBIT/N/>>
DEFINE F$NAME(N) <DEFINE V$NAME <SIXBIT/N/>>
DEFINE F$EXT(N) <DEFINE V$EXT <SIXBIT/N/>>
DEFINE F$PPN(N) <DEFINE V$PPN <N>>
DEFINE F$STAT(N) <DEFINE V$STAT <N>>
DEFINE F$OPEN(L) <DEFINE V$OPEN <L>>
DEFINE F$LOOK(L) <DEFINE V$LOOK <L>>
SYN F$LOOK,F$ENTER
DEFINE F$INPU(L) <DEFINE V$INPU <L>>
SYN F$INPU,F$OUTP
DEFINE F$EOF(L) <DEFINE V$EOF <L>>
DEFINE F$OTHER(L) <DEFINE V$OTHE <L+FILHDR>>
DEFINE F$INST(I) <DEFINE V$INST <I>>
DEFINE PFILE(LOC,INST,DAT) <
.XCREF
ZZ== <$FIBTS==0>
$FILOC==.
RELOC .+1
-PBSIZE,,LOC ;;FHDLOC--FOR SETTING UP PSEUDO-FILE BLOCK
ALWNZ<INST> ;;FILXCT--INPUT/OUTPUT A CHAR INSTRUCTION
IFNZ<0> ;;FILBAK--BACKUP INPUT CHARACTER
IFNZ<0> ;;FILCUR--CURRENT INPUT CHARACTER
IFNZ<DAT> ;;FILCHN--MISC DATA FOR FILE BLOCK
$FILC1==.
RELOC $FILOC
EXP $FIBTS ;;FHDBTS--REL. LOCATIONS OF NONZERO WORDS
RELOC $FILC1
.CREF
>
DEFINE IFNZ(WORD) <
IFN <WORD>,<
WORD
$FIBTS==$FIBTS!1B<ZZ>
>
ZZ== ZZ+1
>
DEFINE ALWNZ(WORD) <
WORD
$FIBTS==$FIBTS!1B<ZZ>
ZZ== ZZ+1
>
;MNEMONICS FOR RELATIVE LOCATIONS IN A FILE BLOCK
FILXCT==0 ;INSTRUCTION TO XCT TO INPUT/OUTPUT A BYTE
FILBAK==1 ;BACKUP CHARACTER
FILCUR==2 ;CURRENT CHARACTER
FILCHN==3 ;CHANNEL # IN BITS 9-12 (IF REAL FILE BLOCK)
BAKFLG==1B35 ;BACKUP FLAG
PBSIZE==4 ;SIZE OF PSEUDO-FILE BLOCK
;THE FOLLOWING LOCATIONS ARE PRESENT ONLY IN A REAL FILE BLOCK
FILSTS==4 ;INITIAL CHANNEL FILE STATUS
FILDEV==5 ;DEVICE NAME IN SIXBIT
FILHDP==6 ;[LH]OUTPUT, [RH]INPUT POINTER TO RING HEADER
FILNAM==7 ;FILE NAME IN SIXBIT
FILEXT==10 ;[LH] EXTENSION, [RH] ACCESS DATE, ERROR CODE
FILDAT==11 ;PROTECTION, MODE, TIME, DATE
FILPP1==12 ;PPN, SIZE, OTHER JUNK (CLOBBERED BY LOOKUP,ENTER)
FILPPN==13 ;PROJECT,PROGRAMMER NUMBER (MOVED TO FILPP1)
FILHDR==14 ;CURRENT BUFFER POINTER *** 3-WORD
FILPTR==15 ;BYTE POINTER *** RING
FILCTR==16 ;BYTE COUNTER *** HEADER
FILER1==17 ;[LH] OPEN [RH] LOOKUP/ENTER ERROR DISPATCH
FILER2==20 ;[LH] EOF [RH] INPUT/OUTPUT ERROR DISPATCH
FBSIZE==21 ;SIZE OF FILE BLOCK
FHDBTS==0 ;NONZERO MARKING BITS FOR SETTING UP FILE BLOCK
FHDLOC==1 ;AOBJN POINTER FOR SETTING UP FILE BLOCK
FHDOFS==2 ;OFFSET OF FIRST REAL DATA WORD IN HISEG BLOCK
SUBTTL CHARACTER CONSTANTS
NULL== 000 ;CHAR CODE FOR NULL
BELL== 007 ;BELL
TAB== 011 ;TAB
LF== 012 ;LINE FEED
VT== 013 ;VERTICAL TAB
FF== 014 ;FORM FEED
CR== 015 ;CARRIAGE RETURN
CTRLZ== 032 ;CONTROL-Z
ALT== 033 ;ALTMODE
DBLQ== 042 ;DOUBLE QUOTE
SNGLQ== "'" ;SINGLE QUOTE
LPAREN=="(" ;LEFT PAREN
RPAREN==")" ;RIGHT PAREN
COMMA== "," ;COMMA
SEMI== ";" ;SEMICOLON
LANGLE=="<" ;LEFT ANGLE BRACKET
RANGLE==">" ;RIGHT ANGLE BRACKET
LSQUAR=="[" ;LEFT SQUARE BRACKET
RSQUAR=="]" ;RIGHT SQUARE BRACKET
RUBOUT==177 ;RUBOUT
CRLF== <CR>B28+LF ;CARRIAGE RETURN, LINE FEED
SUBTTL ATTRIBUTES OF ALL ASCII CHARACTERS
DEFINE CLASSES <
CLASS LETTER,<RANGE<"A","Z",141,172>>
CLASS DIGIT,<RANGE<"0","9">>
CLASS BLANK,<CODES<" ",TAB>>
CLASS BREAK,<CODES<BELL,LF,VT,FF,CTRLZ,ALT>>
CLASS LGLSIX,<RANGE<040,137>>
>
;ALLOCATE CHARACTER CLASS BITS
$NCHFL==0
IFDEF CLASSES,<
DEFINE CLASS(S,D) <
S== 1B<^D36-<$NCHFL==$NCHFL+1>>
>
CLASSES
IFG $NCHFL-^D18,<PRINTX TOO MANY CHARACTER CLASSES>
PURGE CLASS
IFG $NCHFL,<
$NBYPW==^D36/$NCHFL
>>;END CLASSES CONDITIONAL
SUBTTL DEFINITION OF USER UUO'S
;THE FOLLOWING MACRO DECLARES ALL UUO'S AND SUBUUO'S
DEFINE UUOS <
UUO (UUO000,CPOPJ) ;;ILLEGAL UUO 000
UUO (FWRT,,< ;;WRITE TO FILE
SUUO (WCH) ;;WRITE ONE CHARACTER
SUUO (WCHI) ;;WRITE ONE CHARACTER IMMEDIATE
SUUO (W2CH) ;;WRITE TWO CHARACTERS (ASCII ONLY)
SUUO (W2CHI) ;;WRITE TWO CHARACTERS IMMEDIATE (ASCII ONLY)
SUUO (WASC) ;;WRITE ASCII STRING
SUUO (EWASC) ;;WRITE ASCII STRING TO ERROR DEVICE
SUUO (DIASC) ;;WRITE ASCII EDIT LIST
SUUO (EDIASC) ;;WRITE ASCII EDIT LIST TO ERROR DEVICE
SUUO (DISIX) ;;WRITE SIXBIT EDIT LIST
SUUO (EDISIX) ;;WRITE SIXBIT EDIT LIST TO ERROR DEVICE
SUUO (EWSIX) ;;WRITE SIXBIT STRING TO ERROR DEVICE
>)
UUO (WSIX) ;;WRITE SIXBIT STRING (AC FIELD = LENGTH)
UUO (WDEC) ;;WRITE DECIMAL NUMBER (AC FIELD = LENGTH)
UUO (WDECI) ;;WRITE DECIMAL NUMBER IMMEDIATE
UUO (WOCT) ;;WRITE OCTAL NUMBER
UUO (WOCTI) ;;WRITE OCTAL NUMBER IMMEDIATE
UUO (FUTIL,UFUTIL,< ;;FILE UTILITY UUOS
SUUO (FISEL) ;;SELECT INPUT FILE BLOCK
SUUO (FOSEL) ;;SELECT OUTPUT FILE BLOCK
SUUO (FIOPEN) ;;PERFORM INPUT OPEN AND LOOKUP
SUUO (FOOPEN) ;;PERFORM OUTPUT OPEN AND ENTER
SUUO (FIGET) ;;PERFORM JUST INPUT OPEN
SUUO (FOGET) ;;PERFORM JUST OUTPUT OPEN
SUUO (FLOOK) ;;PERFORM JUST INPUT LOOKUP
SUUO (FENT) ;;PERFORM JUST OUTPUT ENTER
SUUO (FICLOS) ;;PERFORM INPUT CLOSE AND RELEASE
SUUO (FOCLOS) ;;PERFORM OUTPUT CLOSE AND RELEASE
SUUO (FICLS) ;;PERFORM JUST INPUT CLOSE
SUUO (FOCLS) ;;PERFORM JUST OUTPUT CLOSE
SUUO (FREL) ;;PERFORM JUST RELEASE (INPUT OR OUTPUT)
>)
UUO (FUTL2,,< ;;MORE FILE UTILITY UUOS
SUUO (FSETUP) ;;SETUP LOW-SEGMENT FILE BLOCK
SUUO (WNAME) ;;WRITE SIXBIT NAME WITHOUT TRAILING BLANKS
SUUO (WPPN) ;;WRITE [PROJ,PROG] NUMBER
SUUO (WNAMX) ;;WRITE FILENAME.EXTENSION
SUUO (WFNAME) ;;WRITE DEVICE:FILENAME.EXTENSION[PROJ,PROG]
SUUO (RCH) ;;READ NEXT CHARACTER
SUUO (CCH) ;;FETCH CURRENT CHARACTER
SUUO (LCH) ;;READ PREVIOUS CHARACTER
IFN $NCHFL,<
SUUO (RFLG) ;;READ ATTRIBUTE FLAGS FOR GIVEN CHAR
SUUO (RCHF) ;;READ NEXT CHAR AND FLAGS
SUUO (CCHF) ;;FETCH CURRENT CHAR WITH FLAGS
SUUO (LCHF) ;;READ PREVIOUS CHAR AND FLAGS
> >)
UUO (FERROR,UFERRO,< ;;ERROR PRINTOUT UUOS
SUUO (WERIOP) ;; OPEN
SUUO (WEROOP) ;; "
SUUO (ERRIOP) ;; "
SUUO (ERROOP) ;; "
SUUO (WERLK) ;; LOOKUP/ENTER
SUUO (WERENT) ;; "
SUUO (ERRLK) ;; "
SUUO (ERRENT) ;; "
SUUO (WERIN) ;; INPUT/OUTPUT
SUUO (WEROUT) ;; "
SUUO (ERRIN) ;; "
SUUO (ERROUT) ;; "
>)
IFN FTIMP,< ;;ONLY FOR THE ARPANET
UUO (FTPFN,,< ;;SPECIAL UUO'S CONVENIENT IN FTPSRV
SUUO (SIXPTY) ;;WSIX TO PTY
SUUO (SIXIMP) ;;WSIX TO IMP
SUUO (DSXPTY) ;;DISIX TO PTY
SUUO (DSXIMP) ;;DISIX TO IMP
>)>
>; END DEFINITION OF UUOS MACRO
;ASSIGN THE OPCODES FOR THE UUOS
DEFINE UUO(NAME,LABEL,SUBS) <
$UUON==$UUON+1 ;USE NEXT OPCODE
IFB <SUBS>,< ;DEFINE NAME ONLY FOR USED UUOS
OPDEF NAME [<$UUON>B8]
>IFNB <SUBS>,<
ZZ== 0
SUBS
IFG ZZ-20,<
PRINTX ?TOO MANY SUBUUOS OF NAME
>>>
DEFINE SUUO(NAME,LABEL) <
OPDEF NAME [BYTE(9)$UUON(4)ZZ]
ZZ== ZZ+1
>
$UUON== -1
UUOS
IFG $UUON-37,<
PRINTX ?TOO MANY USER UUOS
>
PURGE UUO,SUUO
SUBTTL USEFUL MACROS AND OPDEFS
;PERFORM INITIALIZATION OF THE UUO PACKAGE.
; EVERY PROGRAM SHOULD BEGIN WITH THE FOLLOWING:
; MOVE P,[PUSHDOWN POINTER]
; START
DEFINE START <SALL ;;SUPPRESS EXPANSION OF MOVX TYPES
PUSHJ P,USTART## ;;AND FIRE UP UUO PROCESSOR
>
;SAVE CALL FROM TOTAL DESTRUCTION BELOW
OPDEF MCALL [CALL] ;USED MAINLY SITE SPECIFIC UUOS
;CALL AND RETURN FROM A SUBROUTINE
OPDEF CALL [PUSHJ P,]
OPDEF RETURN [POPJ P,]
;SAVE A LIST OF REGISTERS ON THE STACK
DEFINE SAVE(L) <
IRP L <
PUSH P,L
>>
;RESTORE A LIST OF REGISTERS FROM THE STACK. THEY SHOULD BE LISTED
;IN REVERSE ORDER OF THE CORRESPONDING SAVE.
DEFINE RESTORE(L) <
IRP L <
POP P,L
>>
;DECLARE A GLOBAL SYMBOL
; IF THE SYMBOL IS NOT DEFINED ON PASS 1 (E.G. AS A LABEL), IT
; WILL STILL EXIST IN MACRO'S SYMBOL TABLE AT THE BEGINNING OF
; PASS 2, BUT THE IFNDEF WILL BE TRUE, EVEN IF THE SYMBOL IS ALSO
; A BUILT-IN OPCODE. ALSO, MACRO CANNOT PURGE A PARTIALLY-DEFINED
; SYMBOL; HENCE THE NEED TO GIVE IT A VALUE BEFORE PURGING IT.
DEFINE GLOBAL(S) <
IF1,< INTERN S>
IF2,<IFNDEF S,<
SYN T1,S ;;GETS AROUND PROBLEM OF BLANKS BETWEEN
;; SYMBOL AND "=="
PURGE S
EXTERN S
>>>
;CONCATENATE UP TO FOUR QUANTITIES FOR ASSEMBLY ANYWHERE
DEFINE CONC(A,B,C,D) <A'B'C'D>
;MACRO FOR GENERATING A HALFWORD DISPATCH TABLE.
; GIVEN A MACRO DEFINITION OF THE FORM:
; DEFINE MACRO <
; SUBMAC (LABEL1)
; SUBMAC (LABEL2)
; ...
; SUBMAC (LABELN)
;>
; THE MACRO CALL:
; HWDGEN (LABEL,MACRO,SUBMAC,PREFIX)
; GENERATES A DISPATCH TABLE OF THE FORM:
;LABEL: PREFIXLABEL1 ,, PREFIXLABEL2
; PREFIXLABEL3 ,, ...
; ... ,, PREFIXLABELN
; THE "LABEL" AND "PREFIX" ARGUMENTS MAY BE LEFT BLANK.
DEFINE HWDGEN(LABEL,MACRO,SUBMAC,PREFIX) <
ZZ== 0 ;; ;INIT ENTRY COUNTER
IFB <LABEL>,<
ZZ== 2 ;; ;SUPPRESS LABEL GENERATION IF BLANK
>
DEFINE SUBMAC(ARG,X,Y,Z) <;; ;ALLOW AND IGNORE EXTRA ARGS
GLOBAL (PREFIX''ARG) ;; ;DECLARE ARGUMENT GLOBAL
IFE ZZ,<
DEFINE $HWD(B) < ;; ;GENERATE LABEL IF REQUIRED
LABEL: PREFIX''ARG ,, B ;; ;LEAVE RH VARIABLE FOR NEXT CALL
>>
IFN ZZ,<IFE ZZ&1,< ;; ;ARG IS DESTINED FOR LH OF WORD
DEFINE $HWD(B) <
PREFIX''ARG ,, B ;; ;LEAVE RH VARIABLE FOR NEXT CALL
>>
IFN ZZ&1,< ;; ;ARG IS DESTINED FOR RH OF WORD
$HWD (PREFIX''ARG) ;; ;ASSEMBLE AND LIST THE WORD
DEFINE $HWD(B) <> ;; ;RESET FOR NEXT WORD
>>
ZZ== ZZ+1 ;; ;INCREMENT ENTRY COUNTER
>;; ;END DEF OF SUBMAC WITHIN HWDGEN
MACRO ;; ;ASSEMBLE THE TABLE
$HWD (0) ;; ;POLISH OFF LAST WORD IF REQ'D
>;; ;END DEF OF HWDGEN
;MACROS FOR GENERATING PRODUCTION TABLES.
; A PRODUCTION TABLE IS IN THE FORM:
;TABLE: XWD T1,D$TABL
; PROD( .. .. ..)
; ... ... ... ;ANY NUMBER OF PRODUCTIONS
;N$TABL:A.POPJ,,A.ACT1 ;DISPATCH TABLE FOR ALL ACTIONS
; A.ACT2,,A.ACT3 ; USED IN THE ABOVE PRODUCTIONS
; ...
; THIS IS GENERATED THROUGH THE FOLLOWING MACRO CALLS:
; TBLBEG (NAME)
; NAME = LABEL OF BEGINNING OF TABLE. THIS IS USED IN THE CALL TO LEXINT.
; THIS ASSEMBLES THE FIRST WORD OF THE TABLE, WHICH IS THE INDEXED
; POINTER OFF TO THE ACTION DISPATCH TABLE.
; PROD( TEST ,ACTION ,SCAN,NEXT)
; TEST = A CHARACTER CODE, OR A UNION OF CHARACTER CLASSES ENCLOSED
; IN ANGLE BRACKETS, POSSIBLY PRECEDED BY "-".
; ACTION = THE NAME OF AN ACTION ROUTINE (WHICH NEED NOT BE IN THE
; SAME SUBPROGRAM). THIS ACTION ROUTINE IS ACTUALLY CALLED A.ACTION.
; SCAN = ONE OF "*", "_", OR " ", INDICATING FORWARD, REVERSE, OR NO
; SCAN AFTER ACTION ROUTINE IS EXECUTED. NOTE THAT LEXINT NOW
; HAS ONLY A ONE-CHARACTER BACKUP CAPABILITY, BUT FOR ANY SOURCE
; OF INPUT.
; NEXT = LABEL OF NEXT PRODUCTION TO BE INTERPRETED.
; TBLEND
; THIS MACRO CALL IS REQUIRED! IT FINISHES OFF THE TABLE BY GENERATING
; THE HALFWORD ACTION DISPATCH TABLE AND PURGING ALL THE ACTION DEFINITIONS
; IN PREPARATION FOR ASSEMBLING A NEW TABLE.
DEFINE TBLBEG(NAME) <
INTERN NAME
IFE FTDBUG,<
NAME: XWD T4,D$'NAME ;POINTER TO ACTION DISPATCH TBL
>
IFN FTDBUG,<
XWD T3,A$'NAME ;PTR TO ACTION NAME TBL, FOR TRACE
NAME: 400000+T3,,D$'NAME ;POINTER TO ACTION DISPATCH TBL
>
PHASE 0 ;; ;SO LABELS ARE RELATIVE TO BASE
$ACTN==<N$POPJ==0> ;; ;INIT SOME VARIABLES
;; INITIALIZE THE $NWACT MACRO, WHICH ACCUMULATES NAMES OF ALL ACTIONS USED
REDEF <
$ACT (POPJ)
>
DEFINE $TBLFN < ;; ;THIS REMEMBERS THE NAME OF THE TABLE
HWDGEN (D$'NAME,<$NWACT<REPEAT 1,>>,$ACT,A.)
IFN FTDBUG,<
DEFINE $ACT(A) <;; ;THIS GENERATES AN ACTION NAME TABLE
A$'NAME:<ASCII/A/>&777777777400
DEFINE $ACT(B) <
<ASCII/B/>&777777777400
>>
$NWACT <REPEAT 1,>
>>>
DEFINE PROD(TEST,ACTION,SCAN,NEXT) <
$ANG== <$NEG==0> ;; ;INIT SOME VARIABLES
IFNB <ACTION>,<IFNDEF N$'ACTION,<
ZZ== <$ACTN==$ACTN+1>;; ;ASSIGN NEXT ACTION NUMBER
SYN ZZ,N$'ACTION
$NWACT REDEF,< $ACT (ACTION) ;;REMEMBER NAME OF ACTION
>>>
IRPC TEST <TSTANG( TEST)> ;; ;TEST FOR ANGLE BRACKETS
$TESTF==EXP TEST ;; ;GET VALUE OF TEST FIELD
IFL $TESTF,< ;; ;IF TEST FIELD NEGATIVE
$TESTF==-$TESTF ;; ;THEN NEGATE IT
$NEG== 1 ;; ;AND SET "-" FLAG
>
IFN $TESTF&NEGBIT,< ;; ;TEST FOR SG
$NEG== 1
$TESTF==0
>
IFNB <NEXT>,<$NEXT==NEXT> ;; ;IF NEXT NONBLANK, USE IT
IFB <NEXT>,<$NEXT==.+1> ;; ;ELSE USE .+1
BYTE(1)IFIDN<SCAN><*>,<1>,IFIDN<SCAN><_>,<1>,$ANG,$NEG(6)IFNB<ACTION>,<N$'ACTION>(8)$NEXT(18)$TESTF
>
DEFINE TBLEND <
IFG .-377,<
PRINTX ?PRODUCTION TABLE OVER 256 WORDS LONG
>
IFG $ACTN-77,<
PRINTX ?OVER 63 ACTIONS IN ONE TABLE EXCEEDS WIDTH OF FIELD
>
DEPHASE
$TBLFN ;; ;GENERATE ACTION DISPATCH TABLE
DEFINE $ACT(S) < ;; ;PURGE ALL THE ACTION NUMBERS
PURGE N$'S
>
$NWACT <REPEAT 1,>
>
DEFINE REDEF(THIS) <
DEFINE $NWACT(OP,NEW) <
OP <THIS''NEW>
>>
DEFINE TSTANG(C) <
IFE ASCII\C\-2017B11,<$ANG==1>
>
;FORMAT OF A PRODUCTION WORD
; BIT 0 - "*" BIT - MUST BE SIGN
; BIT 1 - "_" BIT
; BIT 2 - 0=CHAR TEST, 1=CLASS TEST
; BIT 3 - "-" BIT
; BITS 4-9 - ACTION NUMBER
; BITS 10-17 - NEXT PRODUCTION
; BITS 18-35 - CHAR OR FLAG BITS TO BE TESTED
SCNBIT==1B0 ;"*" BIT
RSCBIT==1B1 ;"_" BIT
CLSBIT==1B2 ;CHAR/CLASS BIT
NEGBIT==1B3 ;"-" BIT
SG== NEGBIT ;"SIGMA" DEFINED AS -<>
END