github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-18 17:16:59 +00:00
Code Issues Releases Wiki Activity
PDP-10.its/src/sysen2/@muddl.64
Eric Swenson 5c56e4d45a Added @, the cross ref generation tool.
2016-12-08 21:37:45 +01:00

1182 lines
28 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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 ;<FUNCTION ...> -- 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 <atom ...> 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_<LOG2MUB-.RPCNT-1>>(C)
CAME L,(D)
JRST .+4
CAML R,1(D)
JRST .+3
JRST .+3
CAML L,(D)
ADDI C,3_<LOG2MUB-.RPCNT-1>
] ;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.
Reference in New Issue View Git Blame Copy Permalink