SUBTTL MUDDLE DEFINITIONS AND FLAGS ;---------------------------------------------------------------- ; TYPE DEFINITIONS USED IN PASS 1 PARSER ;---------------------------------------------------------------- U%FORM==:0 ;FORM U%FCLS==:1 ;END OF A FORM U%LIST==:2 ;LIST U%LCLS==:3 ;END OF A LIST U%BKT==:4 ;BRAKCETED TYPE U%CBKT==:5 ;END OF " U%VECT==:6 ;VECTOR U%VCLS==:7 ;END OF A VECTOR U%UVCT==:10 ;UVECTOR U%UCLS==:11 ;END OF A UVECTOR U%SEG==:12 ;SEGMENT U%SCLS==:13 ;END OF A SEGMENT U%QUOT==:14 ;QUOTED OBJECT U%ATOM==:15 ;ATOM ;U%TYPE WAS HERE... U%CHAR==:17 ;SINGLE CHARACTER TYPE U%STR==:20 ;STRING. ;------------------------------------------------ ; TYPES USED IN SYMBOL TABLE ;------------------------------------------------ U%FUNC: ATYPE [Funct] ;FUNCTION "f U%MACR: ATYPE [Macro] ;MACRO "m U%GLBL: ATYPE [Globl] ;GLOBAL VARIABLE "g U%PCKG: ATYPE [Pkg] ;PACKAGE "p U%TYPE: ATYPE [Type] ;NEWTYPE "t U%LOCL: ATYPE [Local] ;paramtere or localized atom "l U%LREF: ATYPE [Local Ref] ". U%GREF: ATYPE [Global Ref] ", SUBTTL PASS 1 PROCESSING FOR MUDDLE CODE 1MUDDL: MOVEM P,LISPP ;SAVE STACK PTR FOR RETURNS TO TOP-LEVEL IN PARSE SETOM MDLFLG ;AND TELL THE WORLD IT'S MUDDLE CODE COMING THRU. MOVEI R,5 ;GOING TO ASCII MOVEM R,CHS%WD ;5 CHARACTERS/WORD INSTEAD OF 6 CAMLE A,MAXSSZ ; } MOVEM A,MAXSSZ ; } SET MAXIMUM-SEEN SYMBOL CAMLE A,MAXTSZ ; } AND TYPE LENGTHS AT 5 CHARS. MOVEM A,MAXTSZ ; } 1ULOOP: MOVE P,LISPP ;RETURN-TO-TOP-LEVEL BRANCH TARGET PUSHJ P,1UOBJ ;PROCESS THE NEXT MUDDLE OBJECT JRST 1ULOOP ;AND CONTINUE UNTIL END OF FILE. 1ULOSE: STRT [ASCIZ/Error in MUDDLE code. Return to top-level forced. /] JRST 1ULOOP ;FORCE HIM BACK TO TOP LEVEL. ;-------------------------------------------------------- ; MUDDLE OBJECT PARSER ;-------------------------------------------------------- 1UOBJ: 1GETCH XCT 1UTBL(CH) ; PERFORM CHARACTER-DEPENDENT ACTIONS. POPJ P, ; RETURN TO A HIGHER LEVEL ;-------------------------------------------------------- ; PARSE A FORM ;-------------------------------------------------------- 1UFORM: XCT UPFRM ;PERFORM ANY PARSING EXIT ROUTINE SETZM SYLBUF ;ZERO FOR ATOM-TESTING SETZM SYLBUF+1 ;DITTO PUSHJ P,1UOBJ ;GET FIRST OBJECT SKIPA ;HAS AN ELEMENT TO IT JRST 1UFRM2 ;NO ELEMENTS; FIND OUT IF THIS IS CORRECT END. CAIE A,U%ATOM ;IS THIS AN ATOM? JRST 1UFRM1 ;NO, GO TO NORMAL-OBJECT MODE. JSP H,UBLOOK ;IS THIS A SPECIAL ATOM? (e.g., DEFINE) JRST 1UFRM1 ;NO HLRZ C,UBARRAY+1(C) ; GET THE ADDRESS OF THE APPLY-HANDLER FOR PASS 1 PUSHJ P,(C) ; AND CALL IT. ;CONTINUE OBJECT SEARCH 1UFRM1: PUSHJ P,1UOBJ ;MOVE OVER EVERY OBJECT IN THE FORM JRST 1UFRM1 ;UNTIL WE HIT AN UNMATCHED CLOSE BKT 1UFRM2: CAIE A,U%FCLS ;THIS THE END FOR A FORM (">")? JRST 1ULOSE ;NO--COMPLAIN ABOUT A MISMATCH MOVEI A,U%FORM ;TELL THE NEXT HIGHER LEVEL WHAT WE WERE. POPJ P, ;AND RETURN ;-------------------------------------------------------- ; PARSE AN ATOM ; ; RETURNS: ; A/ U%ATOM (TYPE) ; B/ # OF CHARS IN THE PNAME ; SYLBUF et seq/ PNAME (IN ASCII) ; ;-------------------------------------------------------- 1UBKSL: MOVE CP,[440700,,SYLBUF] ;"\"-QUOTED CHARS ALSO START ATOMS. XCT UPATOM ; PERFORM PARSING EXIT ROUTINE 1UATM4: 1GETCH CAIN CH,^M ;IF IT'S A CR, GO DO CR HANDLING. PUSHJ P,1UCR2 ; AND PROCEED. CAIN CH,^L ;IF IT'S A FORM-FEED, MOVE TO NEXT PAGE ALWAYS. PUSHJ P,1UFF2 ; (HANDLE THE FORM-FEED AND COME BACK HERE.) JRST 1UATM2 ; SKIP ATOM-INIT CODE 1UATOM: MOVE CP,[440700,,SYLBUF] ;BYTE PTR TO ATOM BUFFER XCT UPATOM ;PERFORM PARSING EXIT ROUTINE 1UATM2: IDPB CH,CP ;STORE AWAY THE 1ST CHAR 1UATM1: 1GETCH ;GRAB THE NEXT CHARACTER XCT 1UTBL2(CH) ;DISPATCH ON NEW CHAR 1UATM3: DBP7 IP ;BACK INPUT UP ONE CHAR. MOVEI B,0 ;FILL OUT THIS WIRD OF SYLBUF WITH ZEROES SETZ H, ;EXCESS CHARACTER COUNTER 1UATM5: IDPB B,CP TLNE CP,760000 ;ARE WE AT THE END OF A WORD? AOJA H,1UATM5 ; NO. KEEP CLEARING, AND COUNT CLEARED CHARS MOVEI A,U%ATOM ;RETURN THE TYPE MOVNI R,(CP) HRLI R,SYLBUF-1(R) HRRI R,SYLBUF MOVEI B,(CP) ;ADDRESS OF LAST WORD IN PNAME SUBI B,SYLBUF-1 ; LESS START, GIVING LENGTH OF PNAME IN WORDS IMUL B,CHS%WD ; TIMES CHARS/WORD GIVES CHAR COUNT SUBI B,(H) ; LESS CLEARED CHARS GIVES TRUE LENGTH OF PNAME POPJ P, ;------------------------------------------------ ; PARSE A LIST ;------------------------------------------------ 1ULIST: XCT UPLIST ;PERFORM ANY PASING EXIT ROUTINE 1ULST2: MOVE A,[PUSHJ P,1UTFN2] MOVE A,[PUSHJ P,1UTFN2] PUSHJ P,1UOBJ ;READ ALL THE OBJECTS IN THE LIST JRST 1ULIST ;UNTIL WE HIT AN UNMATCHED CLOSE BRACKET CAIE A,U%LCLS ;IF IT WASN'T A ")", JRST 1ULOSE ;--COMPLAIN AND RETURN TO TOP LEVEL MOVEI A,U%LIST ;DATA TYPE POPJ P, ;------------------------------------------------ ; PARSE A "{"-OBJECT ;------------------------------------------------ 1UBKT: XCT UPBRKT ;PASING EXIT PUSHJ P,1UOBJ ;SCAN ALL THE OBJECTS IN THE WHATEVER JRST 1UBKT ;UNTIL WE HIT THE END CAIE A,U%CBKT ;IF IT ISN'T A CLOSE BRACKET("]") JRST 1ULOSE ;COMPLAIN HORRIBLY MOVEI A,U%BKT ;TYPE POPJ P, ;RETURN TO HIGHER LEVEL. ;------------------------------------------------ ; PARSE A VECTOR ;------------------------------------------------ 1UVECT: XCT UPVECT PUSHJ P,1UOBJ ;READ EVERY OBJECT IN THE VECTOR JRST 1UVECT CAIE A,U%VCLS ;IF NOT A CLOSE BRACKET "]", JRST 1ULOSE ;PUNT MOVEI A,U%VECT POPJ P, ;------------------------------------------------ ; PARSE A UVECTOR ;------------------------------------------------ 1UUVCT: XCT UPUVEC ;PARSING EXIT ROUTINE PUSHJ P,1UOBJ JRST 1UUVCT CAIN A,U%VCLS ;CAN BE CLOSED BY "]" JRST 1UUV1 CAIE A,U%UCLS ;OR BY A "!]". JRST 1ULOSE 1UUV1: MOVEI A,U%UVCT POPJ P, ;------------------------------------------------ ; PARSE A SEGMENT ;------------------------------------------------ 1USEG: XCT UPSEG ;PARSING EXIT ROUTINE PUSHJ P,1UOBJ JRST 1USEG CAIN A,U%FCLS ;CAN BE ENDED BY JUST A ">", JRST 1USEG1 CAIE A,U%SCLS ;OR BY A "!>" JRST 1ULOSE 1USEG1: MOVEI A,U%SEG POPJ P, ;------------------------------------------------ ; QUOTED-OBJECT HANDLER ;------------------------------------------------ 1UQUOT: PUSHJ P,1UOBJ ;SKIP PRECISELY 1 OBJECT SKIPA JRST 1ULOSE ;COMPLAINING IF IT'S NOT THERE MOVEI A,U%QUOT POPJ P, ;------------------------------------------------ ; HANDLE A #TYPE... ;------------------------------------------------ 1UTYPE: PUSHJ P,1UOBJ ;GRAB AN ATOM CAIE A,U%ATOM ;(IF NOT AN ATOM, JRST 1ULOSE ; COMPLAIN ABOUT IT) JSP H,UBLOOK ; IF IT'S A SPECIAL ATOM, JRST 1UTYP1 ; (NOPE...) HLRZ C,UBARRAY+2(C) ;GET HANDLER ADDRESS PUSHJ P,(C) ;INVOKE HANDLER. JRST 1UTYP2 ;(SKIPPED TO HANDLE OBJECT IN DEFAULT MANNER) 1UTYP1: PUSHJ P,1UOBJ ;GET THE NEXT OBJECT (THE REAL GUTS) SKIPA JRST 1ULOSE 1UTYP2: MOVEI A,U%TYPE POPJ P, ;------------------------------------------------ ; EXCL (!) HANDLER ;------------------------------------------------ 1UEXCL: 1GETCH ; GET THE NEXT CHARACTER CAIN CH," ; IF IT'S A BLANK, KEEP LOOKING. JRST 1UEXCL CAIN CH,"< ;HANDLE JRST 1USEG ;SEGMENT-EVALUATION CAIN CH,"[ ;UVECTORS JRST 1UUVCT CAIN CH,"\ ;CHARACTER DATA JRST 1UCHAR CAIN CH,"> ;END OF A SEGMENT JRST 1USCLS CAIN CH,"] ;END OF A UVECTOR JRST 1UUCLS CAIN CH,". ;LVAL JRST 1UDOT CAIN CH,", ;GVAL JRST 1UCOMA CAIE CH,"" ;ALSO CHARACTER JRST 1ULOSE ;(DIDN'T FIND ANYTHING) DROPTHRUTO 1UCHAR ;THIS IS A CONSISTENCY CHECK, NOT A COMMENT. ;------------------------------------------------ ; CHARACTER DATA-TYPE HANDLER ;------------------------------------------------ 1UCHAR: 1GETCH ;IGNORE THAT CHARACTER CAIN CH,3 ;CONTROL-C? PUSHJ P,1MORE0 ;YES. GET NEXT CHUNK OF BUFFER. CAIN CH,^J ;IF IT'S A LF PUSHJ P,1ULF2 CAIN CH,^M ;IF IT'S A CR PUSHJ P,1UCR2 ;;GO HANDLE IT. MOVEI A,U%CHAR ;SAY IT WAS A CHARACTER POPJ P, ;------------------------------------------------ ; STRING PARSER ;------------------------------------------------ 1USTR1: 1GETCH ; FOR READING "\"-QUOTED CHARACTERS 1USTR: 1GETCH ;(ENTRY PT) GET NEXT CHAR IN STRING 1USTR2: CAIN CH,3 ;IF CONTROL-C, PUSHJ P,1MORE0 ;GET MORE INPUT BUFFER (IF ANY) CAIN CH,^J ;LINE-FEED HANDLER JRST 1ULF3 CAIN CH,^M ;CARRIAGE-RETURN HANDLER JRST 1UCR3 CAIN CH,"\ ;MUDDLE QUOTE CHARACTER? JRST 1USTR1 ;YES. IGNORE THE NEXT CHAR CAIE CH,"" ;END OF THE STRING? JRST 1USTR ;NO -- KEEP READING MOVEI A,U%STR ;TELL THE CALER IT'S A STRING POPJ P, ;AND RETURN. 1UCR3: PUSHJ P,1UCR2 ;HANDLE THE CR (AND LF) CAIN CH,^J JRST 1USTR2 ;DON'T BOTHER WITH ANOTHER CHARACTER. JRST 1USTR 1ULF3: PUSHJ P,1ULF2 JRST 1USTR ;------------------------------------------------ ; COMMENT HANDLER ;------------------------------------------------ 1USEMI: PUSHJ P,1UOBJ ;IGNORE THE NEXT OBJECT. JRST 1UOBJ ;AND FORGET WE SAW ANYTHING. JRST 1ULOSE ;BAD BUSINESS IF IT'S NOT BALANCED. ;------------------------------------------------ ; GVAL HANDLER ;------------------------------------------------ 1UCOMA: PUSHJ P,1UOBJ ;SKIP THE NEXT OBJECT POPJ P, JRST 1ULOSE ;------------------------------------------------ ; LVAL HANDLER ;------------------------------------------------ 1UDOT: PUSHJ P,1UOBJ ;SKIP THE NEXT OBJECT. POPJ P, JRST 1ULOSE ;------------------------------------------------ ; ; VARIOUS CLOSING BRACKET HANDLERS ; ; THESE ALL SKIP-RETURN TO INDICATE ; THAT THEY ARE CLOSING-BRACKETS OF ; VARIOUS KINDS. ; ;------------------------------------------------ 1ULCLS: MOVEI A,U%LCLS ; ) AOS (P) POPJ P, 1UFCLS: MOVEI A,U%FCLS ; > AOS (P) POPJ P, 1UVCLS: MOVEI A,U%VCLS ; ] AOS (P) POPJ P, 1USCLS: MOVEI A,U%SCLS ; !> AOS (P) POPJ P, 1UUCLS: MOVEI A,U%UCLS ; !] AOS (P) POPJ P, 1UCBKT: MOVEI A,U%CBKT ; } AOS (P) POPJ P, ;------------------------------------------------ ; HANDLE CR, LF, AND FF ;------------------------------------------------ 1UCR: PUSHJ P,1UCR2 JRST 1UOBJ 1UCR2: TLNE F,FLSCR ;CHECK STRAY-CR IGNORE FLAG POPJ P, 1GETCH ; GET NEXT CHARACTER CAIN CH,^J ;LINE FEED? ADDI N,1 POPJ P, 1ULF: PUSHJ P,1ULF2 JRST 1UOBJ 1ULF2: TLNE F,FLSCR ; CHECK IGNORE-STRAY-LF FLAG ADDI N,1 ; BUMP THE LINE COUNT POPJ P, 1UFF: PUSHJ P,1UFF2 ;MOOVE TO THE NEXT PAGE JRST 1ULOOP ;AND FORCE A RETURN TO TOP-LEVEL. 1UFF2: SKIPE LNDFIL ; IF THIS FILE HAS SOS LINE NUMBERS, PUSHJ P,CKLNM ; GET AROUND IT TRO N,-1 ; KILL LINE NUMBER AOJ N, ; bump page no. ITS,[ HLRZ B,N ; SHOW PAGE NO IN PEEK HRLI B,[SIXBIT/P1/] .SUSET [.SWHO3,,B] ] ; END ITS POPJ P, ;RETURN TO PLAY WITH FF ELSEWHERE. ;------------------------------------------------ ; READ A LOCAL-VARIABLE LIST ; AND MAKE THE DEFINITIONS ;------------------------------------------------ 1ULOCL: PUSH P,UPLIST ;PUSH LIST PARSING EXIT. MOVE A,[JRST UDFL1] ; HANDLER FOR THE LOCAL-VARIABLE LIST MOVEM A,UPLIST PUSHJ P,1UOBJ ;GRAB THE NEXT OBJECT, SKIPA JRST 1ULOSE ;WHICH -MUST- INCLUDE AN ARGS LIST. CAIE A,U%LIST ;IF IT WASN'T A LIST JRST 1ULOSE ;COMPLAIN, SINCE IT BETTER BE. POP P,UPLIST ;GET BACK OLD LIST HANDLER (PROBABLY THE NULL ONE) POPJ P, ;RETURN TO NORMAL FORM HANDLER ;------------------------------------------------ ; LIST-PARSING EXIT ROUTINE ; TO HANDLE LOCALIZATION LISTS ; FOR 1ULOCL ;------------------------------------------------ UDFL1: PUSH P,UPLIST ; PUSH THE POINTER TO THIS MOVE A,[JRST UDFL2] ; TO GET NAMES OF INITIALIZED LOCALS MOVEM A,UPLIST UDFL1A: PUSHJ P,1UOBJ ;GET THE NEXT OBJECT SKIPA JRST UDFL9 ;POTENTIAL END OF LIST -- GO CHECK IT. MOVE B,A MOVE A,R MOVEI R,U%LOCL ; (LOCAL-VARIABLE FLAG) CAIN B,U%ATOM ;IF THIS IS AN ATOM, PUSHJ P,1UNAM2 ; GO DEFINE IT AS A LOCAL. JRST UDFL1A ;GO BACK FOR MORE. UDFL2: PUSH P,UPLIST ; PUSH POINTER TO THIS MOVE A,[JFCL] MOVEM A,UPLIST ; IGNORE ANY LISTS AT LOWER LEVELS. PUSHJ P,1UOBJ ; GET THE FIRST OBJECT SKIPA JRST 1ULOSE ; AN INITTED LOCAL LIST CANNOT BE NULL. MOVE B,A MOVE A,R MOVEI R,U%LOCL CAIN B,U%ATOM ;IF THIS IS AN ATOM, PUSHJ P,1UNAM2 ; DEFINE IT UDFL2A: PUSHJ P,1UOBJ ;SKIP THE REST OF THE LIST. JRST UDFL2A UDFL9: POP P,UPLIST ;POP THE HANDLER SPEC CAIE A,U%LCLS ;IF THIS ISN'T THE END OF A LIST JRST 1ULOSE ; COMPLAIN MOVEI A,U%LIST ;TELL IT WE HAD LA LIST, AND POPJ P, ;RETURN TO NEXT HIGHER LEVEL. ;---------------------------------------------------------------- ; DISPATCH TABLE FOR TOKEN LOOKUP ;---------------------------------------------------------------- 1UTBL: REPEAT 3., JRST 1UOBJ ; ^@ - ^B PUSHJ P,1MORE ; ^C repeat 6., JRST 1UOBJ ; ^D THRU ^I JRST 1ULF ; LINE FEED JRST 1UOBJ ; ^K JRST 1UFF ; FORM FEED JRST 1UCR ; CARRIAGE RETURN REPEAT 18., JRST 1UOBJ ;IGNORE CTRL-CHARS. THRU ^_. JRST 1UOBJ ;IGNORE SPACES JRST 1UEXCL ;EXCLAMATION POINT JRST 1USTR ; " REPEAT 5, JRST 1UATOM ; # TO ' JRST 1ULIST ; ) JRST 1ULCLS ; ( REPEAT 2, JRST 1UATOM ; * AND + JRST 1UCOMA ; , JRST 1UATOM ; - JRST 1UDOT ; . REPEAT 12., JRST 1UATOM ; / THRU : JRST 1USEMI ; SEMICOLON JRST 1UFORM ; < JRST 1UATOM ; = JRST 1UFCLS ; > REPEAT 28., JRST 1UATOM ; ?, @, AND A-Z (UPPER CASE) JRST 1UVECT ; JRST 1UBKSL ; \ JRST 1UVCLS ; REPEAT 29., JRST 1UATOM ; ^, _, AND a-z (LOWER CASE) JRST 1UBKT ; JRST 1UATOM ; | JRST 1UCBKT ; JRST 1UATOM ; ~ JRST 1UOBJ ; RUBOUT IFN .-1UTBL-200, .ERR 1UTBL IS THE WRONG SIZE. ;---------------------------------------------------------------- ; DISPATCH TABLE FOR END-OF-ATOM HUNT. ;---------------------------------------------------------------- 1UTBL2: REPEAT 3., JRST 1UATM3 PUSHJ P,1MORE ; ^C REPEAT 29., JRST 1UATM3 ; END OF ATOM JRST 1UATM2 ; ! JRST 1UATM3 ; " REPEAT 4, JRST 1UATM2 ; STILL IN THE ATOM REPEAT 3, JRST 1UATM3 ; OUT REPEAT 2, JRST 1UATM2 JRST 1UATM3 ; , REPEAT 14., JRST 1UATM2 ; - THRU : REPEAT 2, JRST 1UATM3 ; ; AND < JRST 1UATM2 ; = JRST 1UATM3 ; > REPEAT 28., JRST 1UATM2 ; ?, @, AND A-Z (UPPER CASE) JRST 1UATM3 ; JRST 1UATM4 ; \ JRST 1UATM3 ; REPEAT 29., JRST 1UATM2 ; ^, _, AND a-z (LOWER CASE) JRST 1UATM3 ; JRST 1UATM2 ; | JRST 1UATM3 ; JRST 1UATM2 ; ~ JRST 1UATM3 ; RUBOUT IFN .-1UTBL2-200, .ERR 1UTBL2 IS THE WRONG SIZE. SUBTTL PASS 1 MUDDLE EXIT ROUTINE VECTOR FOR PARSING ;------------------------------------------------ ; DISPATCH TABLE FOR PARSE ; EXIT ROUTINES ; ; -These are used for special-purpose ; processing of MUDDLE objects, such ; as the use of a list for specifying ; the local variables in a function. ; ; -The exit routine receives control ; as soon as an object is recognized, ; and before anything else occurs. It ; may perform any processing it sees ; fit, and then returns to the main ; object parser to either snarf the ; rest of the object, or to verify ; that we have hit its end. ; ;------------------------------------------------ PTHI==. ? .==PTLO ;THIS TABLE IS IMPURE UPFRM: JFCL ;FORM UPATOM: JFCL ;ATOM UPLIST: JFCL ;LIST UPBRKT: JFCL ;BRACKETED THING UPVECT: JFCL ;VECTOR UPUVEC: JFCL ;UVECTOR UPSEG: JFCL ;SEGMENT PTLO==. ? .==PTHI ;BACK TO PURE CODE. SUBTTL PASS 1 MUDDLE SPECIAL ATOM HANDLERS ;----------------------------------------------------------- ; PROGRAMS FOR SPECIAL ATOMS ;----------------------------------------------------------- 1UDFN: MOVEI R,U%FUNC ;DEFINE PUSHJ P,1UNAME ;GO NAME THE FUNCTION. PUSHJ P,1ULOCL ;GO READ LIST OF LOCALIZED ATOMS POPJ P, ;AND RETURN TO REGULAR FORM HANDLER. 1UDFM: MOVEI R,U%MACR ;DEFMAC JRST 1UNAME 1UFCN: PUSHJ P,1ULOCL ; -- READ LOCAL VARIABLE LIST POPJ P, ;AND RETURN TO THE REGULAR FORM HANDLER 1UPCKG: MOVEI R,U%PCKG ;PACKAGE JRST 1UNAME 1USETG: MOVEI R,U%GLBL ;SETG JRST 1UNAME 1UNTYP: MOVEI R,U%TYPE ;NEWTYPE JRST 1UNAME 1UTFCN: PUSH P,UPLIST ; #FUNCTION HANDLER MOVE A,[JRST 1UTFN2] MOVEM A,UPLIST PUSHJ P,1UOBJ ;GET THE BODY OF THE FUNCTION CAIE A,U%LIST ;MUST BE A LIST JRST 1ULOSE ;AND NOT AN UNBALANCED CLOSE BKT POP P,UPLIST ;GET BACK LIST EXIT ROUTINE POPJ P, 1UTFN2: PUSHJ P,1ULOCL ;READ LOCAL VARIABLE LIST MOVE A,[JFCL] MOVEM A,UPLIST JRST 1ULST2 ;GO READ REST OF THE LIST. SUBTTL MUDDLE OBJECT-ARRAY AND SEARCH ROUTINES ;----------------------------------------------------------- ; MUDDLE SYMBOL-DEFINITION ROUTINE ;----------------------------------------------------------- 1UNAME: PUSH P,R ;SAVE TYPE TO STOW IN ATOM'S SYMTBL SLOT PUSHJ P,1UOBJ ;GET NEXT ITEM SKIPA JRST 1UNM1 ;POP R AND GO CONTINUE SCAN (1UFRM2) CAIE A,U%ATOM ;IS IT AN ATOM? JRST 1UNM2 ;NO, CAN'T DEFINE MOVE A,R ;AOBJN POINTER TO THE SYMBOL. POP P,R 1UNAM2: JSP H,LDEFSYM ;JUST AS THE LISP (PG.101, LINE 011) HRRM R,S.TYPE(L) ;PUT TYPE IN MOVEM N,S.PAGE(L) ;PUT IN POINT IT WAS DEFINED. POPJ P, ; RETURN TO PASING THE MAIN FORM. 1UNM1: POP P,R ; BAIL OUT, AFTER CLEAING STACK JRST 1ULOSE ; AND COMPLAIN ABOUT BAD SYNTAX. 1UNM2: POP P,R ; PUNT THIS FORM. POPJ P, ;------------------------------------------------ ; MACROS FOR DEFINING UATOMS ;------------------------------------------------ IF1 [ ;ON PASS 1, JUST LEAVE ROOM IN TABLE FOR THE ATOM DEFINE UATOM JUNK/ BLOCK 3 TERMIN ] ;END IF1 IF2 [ ; ON PASS 2 ASSEMBLE THE ATOM HEADERS IN-LINE, AND ; PNAMES AT "UPNAME", USING ATMPTR AS AN OFFSET. DEFINE UATOM NAME=DEFINE,1L=1USUBR,2L=2USUBR,1K=1VSUBR,2K=2VSUBR ATMPTR ;PNAME POINTER 1L,,2L ;HANDLERS FOR PASS1,,PASS2 1K,,2K ;HANDLERS FOR #atom ... PASS1,,PASS2 ZZ==. .==ATMPTR ;MOVE INTO PNAME TABLE ASCIZ /NAME/ ATMPTR==. .==ZZ ;RETURN TO MAINLINE. TERMIN ATMPTR==UPNAME ;INITIALIZE THE ATOM NAME POINTER ] ;END OF IF2. .XCREF UATOM 1USUBR:2USUBR:1VSUBR:2VSUBR: STRT [ASCIZ/ Invalid use of a special atom. /] JRST 1ULOSE ;----------------------------------------------------------- ; ATOM TABLE FOR MUDDLE DEFINITIONS ; (MUST BE IN ALPHABETICAL ORDER) ;----------------------------------------------------------- UBARRAY: UATOM ,1UDFN ;DEFINE UATOM DEFMAC,1UDFM UATOM FUNCTION,1UFCN,,1UTFCN UATOM NEWTYPE,1UNTYP UATOM PACKAGE,1UPCKG UATOM PROG,1UFCN UATOM REPEAT,1UFCN UATOM SETG,1USETG ;----------------------------------------------------------- ; FILL TABLE OUT TO POWER-OF-2 LENGTH ;----------------------------------------------------------- MUBARRAY==:<.-UBARRAY>/3 RADIX 2. LOG2MUB==:CONC .LENGTH /,\MUBARRAY-1,/ RADIX 8. REPEAT <1_LOG2MUB>-MUBARRAY,[ [377777777777] 1LSUBR,,2LSUBR 1KSUBR,,2KSUBR ] ;END OF REPEAT <1_LOG2MUB>-MUBARRAY UPNAME: BLOCK 2*MUBARRAY ;LEAVE SPACE FOR PNAMES. ON P2, ATOM NAME ASSEMBLES INTO THIS SPACE. ;------------------------------------------------ ; MUDDLE SPECIAL-ATOM LOOKUP ROUTINE ; TAKES AN AOBJN POINTER TO THE ATOM ; NAME (IN SYLBUF) IN R. SKIPS IF THE ; ATOM IS FOUND, WITH OFFSET INTO ; UBARRAY IN C. IF NOT FOUND, NO SKIP. ;------------------------------------------------ UBLOOK: MOVE A,R HLRZ R,A ;ROUTINE TO FIND SPECIAL ATOMS CAIGE R,-2 ;IF NONE ARE FOUND, DOESN'T SKIP. JRST (H) ;IF ARE FOUND, OFFSET FROM UBARRAY IS LEFT MOVE L,(A) ;IN C AND IT SKIPS. CAIE R,-1 SKIPA R,1(A) SETZ R, SETZ C, REPEAT LOG2MUB,[ HRRZ D,UBARRAY+<3_>(C) CAME L,(D) JRST .+4 CAML R,1(D) JRST .+3 JRST .+3 CAML L,(D) ADDI C,3_ ] ;END OF REPEAT LOG2MUB HRRZ D,UBARRAY(C) CAMN L,(D) CAME R,1(D) JRST (H) JRST 1(H) ;THIS ENDS UBLOOK. SUBTTL PASS 2 PROCESSING FOR MUDDLE CODE 2MUDDL: MOVEM P,LISPP ;SAVE STACK PTR FOR RETURNS TO TOP-LEVEL IN PARSE 2ULOOP: SETZM MDLCMT ;GET OUT OF COMMENT MODE. TLNE F,FLFNT3 ;REVERT TO "MAIN TEXT" FONT, IF NEED BE. TRNE F,FRFNT3 JRST 2ULUP2 2PATCH 177 ;XGP ESCAPE 2PATCH 1 ;"FONT SELECT" 2PATCH 1 ; FONT 2 2ULUP2: MOVE P,LISPP ;RETURN-TO-TOP-LEVEL BRANCH TARGET PUSHJ P,2UOBJ ;PROCESS THE NEXT MUDDLE OBJECT JRST 2ULUP2 ;AND CONTINUE UNTIL END OF FILE. 2ULOSE: JRST 2ULOOP ;FORCE HIM BACK TO TOP LEVEL. NO MESSAGE 2ND PASS. ;-------------------------------------------------------- ; MUDDLE OBJECT PARSER ;-------------------------------------------------------- 2UOBJ: TRZE F,FRSQZ ;IF THE READ-AHEAD FLAG IS SET, THEN JRST 2UOBJ1 ;DON'T BOTHER READING A CHARACTER (RESETS THE FLAG, TOO) 2GETCH 2UOBJ1: XCT 2UTBL(CH) ; PERFORM CHARACTER-DEPENDENT ACTIONS. POPJ P, ; RETURN TO A HIGHER LEVEL ;-------------------------------------------------------- ; PARSE A FORM ;-------------------------------------------------------- 2UFORM: PUSHJ P,2UOBJ ;READ EVERY OBJECT IN THE FORM JRST 2UFORM CAIE A,U%FCLS ;MAKE SURE WE ENDED WITH A > JRST 2ULOSE MOVEI A,U%FORM POPJ P, ;-------------------------------------------------------- ; PARSE AN ATOM ; ; RETURNS: ; A/ U%ATOM (TYPE) ; B/ # OF CHARS IN THE PNAME ; SYLBUF et seq/ PNAME (IN ASCII) ; ;-------------------------------------------------------- 2UBKSL: MOVE CP,[440700,,SYLBUF] ;"\"-QUOTED CHARS ALSO START ATOMS. XCT UPATOM ; PERFORM PARSING EXIT ROUTINE 2UATM4: 2GETCH JRST 2UATM2 ; SKIP ATOM-INIT CODE 2UATOM: MOVE CP,[440700,,SYLBUF] ;BYTE PTR TO ATOM BUFFER XCT UPATOM ;PERFORM PARSING EXIT ROUTINE 2UATM2: IDPB CH,CP ;STORE AWAY THE 1ST CHAR 2UATM1: 2GETCH ;GRAB THE NEXT CHARACTER XCT 2UTBL2(CH) ;DISPATCH ON NEW CHAR 2UATM3: TRO F,FRSQZ ;SET READ-AHEAD FLAG FOR 2UOBJ MAIN LOOP. MOVEI B,0 ;FILL OUT THIS WIRD OF SYLBUF WITH ZEROES SETZ H, ;EXCESS CHARACTER COUNTER 2UATM5: IDPB B,CP TLNE CP,760000 ;ARE WE AT THE END OF A WORD? AOJA H,2UATM5 ; NO. KEEP CLEARING, AND COUNT CLEARED CHARS MOVNI R,(CP) HRLI R,SYLBUF-1(R) HRRI R,SYLBUF MOVEI B,(CP) ;ADDRESS OF LAST WORD IN PNAME SUBI B,SYLBUF-1 ; LESS START, GIVING LENGTH OF PNAME IN WORDS IMUL B,CHS%WD ; TIMES CHARS/WORD GIVES CHAR COUNT SUBI B,(H) ; LESS CLEARED CHARS GIVES TRUE LENGTH OF PNAME MOVE A,R JSP H,@LOOKIT ;LOOK UP THE SYMBOL POPJ P, ;NOT SEEN ON 1ST PASS (IGNORE IT) JSP H,REFSYM ;SEEN -- PUT IN A CREF ENTRY POPJ P, ;------------------------------------------------ ; PARSE A LIST ;------------------------------------------------ 2ULIST: PUSHJ P,2UOBJ ;READ ALL THE OBJECTS IN THE LIST JRST 2ULIST ;UNTIL WE HIT AN UNMATCHED CLOSE BRACKET CAIE A,U%LCLS ;IF IT WASN'T A ")", JRST 2ULOSE ;--COMPLAIN AND RETURN TO TOP LEVEL MOVEI A,U%LIST ;DATA TYPE POPJ P, ;------------------------------------------------ ; PARSE A "{"-OBJECT ;------------------------------------------------ 2UBKT: PUSHJ P,2UOBJ ;SCAN ALL THE OBJECTS IN THE WHATEVER JRST 2UBKT ;UNTIL WE HIT THE END CAIE A,U%CBKT ;IF IT ISN'T A CLOSE BRACKET("]") JRST 2ULOSE ;COMPLAIN HORRIBLY MOVEI A,U%BKT ;TYPE POPJ P, ;RETURN TO HIGHER LEVEL. ;------------------------------------------------ ; PARSE A VECTOR ;------------------------------------------------ 2UVECT: PUSHJ P,2UOBJ ;READ EVERY OBJECT IN THE VECTOR JRST 2UVECT CAIE A,U%VCLS ;IF NOT A CLOSE BRACKET "]", JRST 2ULOSE ;PUNT MOVEI A,U%VECT POPJ P, ;------------------------------------------------ ; PARSE A UVECTOR ;------------------------------------------------ 2UUVCT: PUSHJ P,2UOBJ JRST 2UUVCT CAIN A,U%VCLS ;CAN BE CLOSED BY "]" JRST 2UUV1 CAIE A,U%UCLS ;OR BY A "!]". JRST 2ULOSE 2UUV1: MOVEI A,U%UVCT POPJ P, ;------------------------------------------------ ; PARSE A SEGMENT ;------------------------------------------------ 2USEG: PUSHJ P,2UOBJ JRST 2USEG CAIN A,U%FCLS ;CAN BE ENDED BY JUST A ">", JRST 2USEG1 CAIE A,U%SCLS ;OR BY A "!>" JRST 2ULOSE 2USEG1: MOVEI A,U%SEG POPJ P, ;------------------------------------------------ ; QUOTED-OBJECT HANDLER ;------------------------------------------------ 2UQUOT: PUSHJ P,2UOBJ ;SKIP PRECISELY 1 OBJECT SKIPA JRST 2ULOSE ;COMPLAINING IF IT'S NOT THERE MOVEI A,U%QUOT POPJ P, ;------------------------------------------------ ; HANDLE A #TYPE... ;------------------------------------------------ 2UTYPE: PUSHJ P,2UOBJ ;GRAB AN ATOM CAIE A,U%ATOM ;(IF NOT AN ATOM, JRST 2ULOSE ; COMPLAIN ABOUT IT) MOVE A,R ;GET AOBJN PTR TO THE ATOM JSP H,@LOOKIT ;IF IT WAS NOT SEEN ON PASS 1, SKIPA ; IGNORE IT. ELSE JSP H,REFSYM ;MAKE A CREF ENTRY FOR IT. PUSHJ P,2UOBJ ;GET THE NEXT OBJECT (THE REAL GUTS) SKIPA JRST 2ULOSE MOVEI A,U%TYPE POPJ P, ;------------------------------------------------ ; EXCL (!) HANDLER ;------------------------------------------------ 2UEXCL: 2GETCH ; GET THE NEXT CHARACTER CAIN CH," ; IF IT'S A BLANK, KEEP LOOKING. JRST 2UEXCL CAIN CH,"< ;HANDLE JRST 2USEG ;SEGMENT-EVALUATION CAIN CH,"[ ;UVECTORS JRST 2UUVCT CAIN CH,"\ ;CHARACTER DATA JRST 2UCHAR CAIN CH,"> ;END OF A SEGMENT JRST 2USCLS CAIN CH,"] ;END OF A UVECTOR JRST 2UUCLS CAIE CH,"" ;ALSO CHARACTER JRST 2ULOSE ;(DIDN'T FIND ANYTHING) DROPTHRUTO 2UCHAR ;THIS IS A CONSISTENCY CHECK, NOT A COMMENT. ;------------------------------------------------ ; CHARACTER DATA-TYPE HANDLER ;------------------------------------------------ 2UCHAR: 2GETCH ;IGNORE THAT CHARACTER MOVEI A,U%CHAR ;SAY IT WAS A CHARACTER POPJ P, ;------------------------------------------------ ; STRING PARSER ;------------------------------------------------ 2USTR1: 2GETCH ; FOR READING "\"-QUOTED CHARACTERS 2USTR: 2GETCH ;(ENTRY PT) GET NEXT CHAR IN STRING CAIN CH,"\ ;MUDDLE QUOTE CHARACTER? JRST 2USTR1 ;YES. IGNORE THE NEXT CHAR CAIE CH,"" ;END OF THE STRING? JRST 2USTR ;NO -- KEEP READING MOVEI A,U%STR POPJ P, ;------------------------------------------------ ; COMMENT HANDLER ;------------------------------------------------ 2USEMI: PUSH P,MDLCMT ;PUSH THE STATE OF THE "COMMENT" FLAG SETOM MDLCMT ;WE'RE INSIDE A COMMENT NOW, FOR SURE. SETOM 2MCCOL TLNE F,FLFNT3 TRNE F,FRFNT3 JRST 2USMI2 2PATCH 177 2PATCH 1 2PATCH 2 2USMI2: PUSHJ P,2UOBJ ;IGNORE THE NEXT OBJECT. SKIPA JRST 2ULOSE ;BAD BUSINESS IF IT'S NOT BALANCED. POP P,MDLCMT ;GET BACK OLD COMMENT SWITCH. SKIPE MDLCMT ;IF WE'RE OUT OF THE OUTERMOST COMMENT, POPJ P, TLNN F,FLFNT2 ;(AND WE'RE USING MULTIPLE FONTS) POPJ P, 2PATCH 177 ;SWITCH BACK TO THE TEXT FONT 2PATCH 1 2PATCH 2 POPJ P, ;------------------------------------------------ ; GVAL HANDLER ;------------------------------------------------ 2UCOMA: PUSHJ P,2UOBJ ;SKIP THE NEXT OBJECT POPJ P, JRST 2ULOSE ;------------------------------------------------ ; LVAL HANDLER ;------------------------------------------------ 2UDOT: PUSHJ P,2UOBJ ;SKIP THE NEXT OBJECT. POPJ P, JRST 2ULOSE ;------------------------------------------------ ; ; VARIOUS CLOSING BRACKET HANDLERS ; ; THESE ALL SKIP-RETURN TO INDICATE ; THAT THEY ARE CLOSING-BRACKETS OF ; VARIOUS KINDS. ; ;------------------------------------------------ 2ULCLS: MOVEI A,U%LCLS ; ) AOS (P) POPJ P, 2UFCLS: MOVEI A,U%FCLS ; > AOS (P) POPJ P, 2UVCLS: MOVEI A,U%VCLS ; ] AOS (P) POPJ P, 2USCLS: MOVEI A,U%SCLS ; !> AOS (P) POPJ P, 2UUCLS: MOVEI A,U%UCLS ; !] AOS (P) POPJ P, 2UCBKT: MOVEI A,U%CBKT ; } AOS (P) POPJ P, ;------------------------------------------------ ; DISPATCH TABLE FOR TKOEN LOOKUP ;------------------------------------------------ 2UTBL: REPEAT 3., JRST 2UOBJ ; ^@ - ^B JRST 2UOBJ repeat 6., JRST 2UOBJ ; ^D THRU ^I JRST 2UOBJ JRST 2UOBJ ; ^K JRST 2UOBJ JRST 2UOBJ REPEAT 18., JRST 2UOBJ ;IGNORE CTRL-CHARS. THRU ^_. JRST 2UOBJ ;IGNORE SPACES JRST 2UEXCL ;EXCLAMATION POINT JRST 2USTR ; " REPEAT 5, JRST 2UATOM ; # TO ' JRST 2ULIST ; ) JRST 2ULCLS ; ( REPEAT 2, JRST 2UATOM ; * AND + JRST 2UCOMA ; , JRST 2UATOM ; - JRST 2UDOT ; . REPEAT 12., JRST 2UATOM ; / THRU : JRST 2USEMI ; SEMICOLON JRST 2UFORM ; < JRST 2UATOM ; = JRST 2UFCLS ; > REPEAT 28., JRST 2UATOM ; ?, @, AND A-Z (UPPER CASE) JRST 2UVECT ; JRST 2UBKSL ; \ JRST 2UVCLS ; REPEAT 29., JRST 2UATOM ; ^, _, AND a-z (LOWER CASE) JRST 2UBKT ; JRST 2UATOM ; | JRST 2UCBKT ; JRST 2UATOM ; ~ JRST 2UOBJ ; RUBOUT IFN .-2UTBL-200, .ERR 2UTBL IS THE WRONG SIZE. ;---------------------------------------------------------------- ; DISPATCH TABLE FOR END-OF-ATOM HUNT. ;---------------------------------------------------------------- 2UTBL2: REPEAT 3., JRST 2UATM3 JRST 2UATM3 REPEAT 29., JRST 2UATM3 ; END OF ATOM JRST 2UATM2 ; ! JRST 2UATM3 ; " REPEAT 4, JRST 2UATM2 ; STILL IN THE ATOM REPEAT 3, JRST 2UATM3 ; OUT REPEAT 2, JRST 2UATM2 JRST 2UATM3 ; , REPEAT 14., JRST 2UATM2 ; - THRU : REPEAT 2, JRST 2UATM3 ; ; AND < JRST 2UATM2 ; = JRST 2UATM3 ; > REPEAT 28., JRST 2UATM2 ; ?, @, AND A-Z (UPPER CASE) JRST 2UATM3 ; JRST 2UATM4 ; \ JRST 2UATM3 ; REPEAT 29., JRST 2UATM2 ; ^, _, AND a-z (LOWER CASE) JRST 2UATM3 ; JRST 2UATM2 ; | JRST 2UATM3 ; JRST 2UATM2 ; ~ JRST 2UATM3 ; RUBOUT IFN .-2UTBL2-200, .ERR 2UTBL2 IS THE WRONG SIZE.