2 TITLE READER FOR MUDDLE
8 READER==1 ;TELL MUDDLE > TO USE SOME SPECIAL HACKS
9 FRMSIN==1 ;FLAG SAYING WHETHER OR "." AND "'" HACKS EXIST
13 .GLOBAL CONS,VECTOR,NXTCHR,RLOOKU,CRADIX,SPTIME,QUOTE,TENTAB,CHMAK,FLUSCH,ITENTB
14 .GLOBAL SETDEV,OPNCHN,ILVAL,RADX,IDVAL,LSTCH,EVECTOR,EUVECTOR
20 FF=0 ;FALG REGISTER DURING NUMBER CONVERSION
22 ;FLAGS USED (RIGHT HALF)
24 NOTNUM==1 ;NOT A NUMBER
25 NFIRST==2 ;NOT FIRST CHARACTER BEING READ
26 DECFRC==4 ;FORCE DECIMAL CONVERSION
27 NEGF==10 ;NEGATE THIS THING
28 NUMWIN==20 ;DIGIT(S) SEEN
29 INSTRN==40 ;IN QUOTED CHARACTER STRING
30 FLONUM==100 ;NUMBER IS FLOOATING POINT
31 DOTSEN==200 ;. SEEN IN IMPUT STREAM
32 EFLG==400 ;E SEEN FOR EXPONENT
34 FRSDOT==1000 ;. CAME FIRST
35 USEAGN==2000 ;SPECIAL DOT HACK
40 VCNT==0 ;NUMBER OF ELEMENTS IN CURRENT VECTOR
41 ONUM==1 ;CURRENT NUMBER IN OCTAL
42 DNUM==3 ;CURRENT NUMBER IN DECIMAL
43 FNUM==5 ;CURRENTLY UNUSED
44 CNUM==7 ;IN CURRENT RADIX
45 NDIGS==11 ;NUMBER OF DIGITS
49 \f; TEXT FILE LOADING PROGRAM
55 HLRZ A,AB ;GET NO. OF ARGS
57 JRST TRY2 ;NO, TRY ANOTHER
58 HLRZ A,2(AB) ;GET TYPE
59 CAIE A,TOBLS ;IS IT OBLIST
63 TRY2: CAIE A,-2 ;IS ONE SUPPLIED
66 CHECK1: HLRZ A,(AB) ;GET TYPE
67 CAIE A,TCHAN ;IS IT A CHANNEL
70 LOAD1: HLRZ A,TB ;GET CURRENT TIME
71 PUSH TP,$TTIME ;AND SAVE IT
74 LOAD2: PUSH TP,(TB) ;USE TIME AS EOF ARG
76 PUSH TP,(AB) ;USE SUPPLIED CHANNEL
79 CAML AB,[-2,,0] ;CHECK FOR 2ND ARG
82 PUSH TP,2(AB) ;PUSH ON 2ND ARG
85 JRST CHKRET ;CHECK FOR EOF RET
88 CHKRET: CAMN A,(TB) ;IS TYPE EOF HACK
89 CAME B,1(TB) ;AND IS VALUE
90 JRST EVALIT ;NO, GO EVAL RESULT
105 ; OTHER FILE LOADING PROGRAM
108 \fMFUNCTION FLOAD,SUBR
112 MOVEI C,1 ;INITIALIZE OPEN'S ARG COUNT
113 PUSH TP,$TAB ;SLOT FOR SAVED AB
114 PUSH TP,[0] ;EMPTY FOR NOW
115 PUSH TP,$TCHSTR ;PUT IN FIRST ARG
117 MOVE A,AB ;COPY OF ARGUMENT POINTER
119 FARGS: JUMPGE A,CALOPN ;DONE? IF SO CALL OPEN
120 HLRZ B,(A) ;NO, CH
\0ECK TYPE OF THIS ARG
121 CAIN B,TOBLS ;OBLIST?
122 JRST OBLSV ;YES, GO SAVE IT
124 PUSH TP,(A) ;SAVE THESE ARGS
127 AOJA C,FARGS ;COUNT AND GO
129 OBLSV: MOVEM A,1(TB) ;SAVE THE AB
131 CALOPN: ACALL C,FOPEN ;OPEN THE FILE
133 JUMPE B,FNFFL ;FILE MUST NO EXIST
134 EXCH A,(TB) ;PLACE CHANNEL ON STACK
135 EXCH B,1(TB) ;OBTAINING POSSIBLE OBLIST
136 JUMPN B,2ARGS ;OBLIST SUOPPLIED?
138 MCALL 1,LOAD ;NO, JUST CALL
142 2ARGS: PUSH TP,(B) ;PUSH THE OBLIST
148 FNFFL: PUSH TP,$TATOM
149 PUSH TP,MQUOTE FILE-NOT-FOUND
152 \fMFUNCTION RREADC,SUBR,READCHR
155 PUSH P,[IREADC] ;WHERE TO GO AFTER BINDING
156 JRST READ0 ;GO BIND VARIABLES
158 MFUNCTION NXTRDC,SUBR,NEXTCHR
169 PUSH P,[IREAD1] ;WHERE TO GO AFTER BINDING
170 READ0: PUSH TP,$TTP ;SLOT FOR LAST THING READ (TYPE IS UNREADABLE)
172 PUSH TP,$TFIX ;SLOT FOR RADIX
174 PUSH TP,$TCHAN ;AND SLOT FOR CHANNEL
176 JUMPGE AB,READ1 ;NO ARGS, NO BINDING
177 MOVE B,AB ;GET A COPY OF THE ARG BLOCK
178 MOVEI D,0 ;ACCESS ARG TABLE
179 ARGLP: HLRZ C,(B) ;ISOLATE TYPE
180 XCT ARGS(D) ;DO THE APROPRIATE COMPARE
182 PUSH TP,[TATOM,,-1] ;PUSH THE ATOMS
184 PUSH TP,(B) ;PUSH ARGS
188 ADDI D,2 ;BUMP ARG TBL POINTER
189 ADD B,[2,,2] ;AND ARG POINTER
192 PUSHJ P,SPECBIND ;NO, GO BIND
195 \f; ARGUMENTS ARE BOUND, NOW GET THE VALUES OF THINGS
197 READ1: MOVE B,MQUOTE INCHAN,, ;GET INPUT CHANNEL
199 PUSHJ P,IDVAL ;NOW GOBBLE THE REAL CHANNEL
200 CAME A,$TCHAN ;IS IT A CHANNEL
202 MOVEM B,5(TB) ;SAVE CHANNEL
203 MOVEI B,DIRECT-1(B) ;POINT TO DIRECTION
204 PUSHJ P,CHRWRD ;GOBBLE AND CHECK
206 CAME B,[ASCIZ /READ/]
209 GETIO: MOVE A,IOINS(B) ;GOBBLE THE I/O INSTRUCTION
210 JUMPE A,OPNFIL ;GO REALLY OPEN THE CROCK
211 MOVE A,RADX(B) ;GET RADIX
213 MOVEM B,5(TB) ;SAVE CHANNEL
214 REREAD: MOVE D,LSTCH(B) ;ANY CHARS AROUND?
215 CAIN D,233 ;FLUSH THE TERMINATOR HACK
218 PUSHJ P,@(P) ;CALL INTERNAL READER
220 RFINIS: MOVE C,5(TB) ;GET CHANNEL
221 MOVE D,LSTCH(C) ;GET LAST CHR
222 CAIN D,233 ;SPECIAL ENDER?
223 SETZM LSTCH(C) ;YES CLOBBER
224 SUB P,[1,,1] ;POP OFF LOSER
227 BADTRM: CAIE B,3 ;READ 'FAILED' IS LOSER EOF
228 JRST CHLSTC ;NO, MUST BE UNMATCHED PARENS
229 PUSH TP,4(TB) ;CLOSE THE CHANNEL
232 MOVE B,MQUOTE EOF,, ;GET EOF
234 PUSHJ P,IDVAL ;GET LOCAL VALUE
235 CAMN A,$TUNBOU ;UNBOUND IS ONLY LOSER
237 PUSH TP,A ;SETUP CALL TO EVAL
239 MCALL 1,EVAL ;AND EVAL IT
240 JRST RFINIS ; AND RETURN
242 ;HERE TO ATTEMPT TO OPEN A CLOSED CHANNEL
244 OPNFIL: PUSHJ P,OPNCHN ;GO DO THE OPEN
245 JUMPE B,OPNERR ;LOSE IC B IS 0
249 CHLSTC: MOVE B,5(TB) ;GET CHANNEL BACK
252 \f;MAIN ENTRY TO READER
255 PUSHJ P,LSTCHR ;DON'T REREAD LAST CHARACTER
257 PUSH TP,(TB) ;SAVE LAST FORM
259 BDLP: PUSHJ P,NXTCH ;GOBBLE CHAR IN A AND TYPE IN D
261 JUMPN B,@.+1(B) ;ERROR ON ZERO TYPE OR FUNNY TYPE
263 DTBL: NUMLET ;HERE IF NUMBER OR LETTER
270 QUOTIT ;' - QUOTE THE FOLLOWING GOODIE
273 MACCAL ;% - INVOKE A READ TIME MACRO
275 NUMLET ;\ - ESCAPE,BEGIN ATOM
277 ESCTYP==.-DTBL ;TYPE OF ESCAPE CHARACTER
278 QMARK ;? - SEVERAL POSSIBILITIES
280 ALTACT ;_ - <ALTER ...>
282 GLOVAL ;, - GET GLOBAL VALUE
285 NONSPC==.-DTBL ;NUMBER OF NON-SPECIAL CHARACTERS
286 SPACE ;SPACING CHAR CR,LF,SP,TAB ETC.
287 SPATYP==.-DTBL ;TYPE FOR SPACE CHARS
290 ;THE FOLLOWING ENTRIES ARE VARIOUS PUNCTUATION CROCKS
292 LPAREN ;( - BEGIN LIST
294 RPAREN ;) - END CURRENT LEVEL OF INPUT
295 LBRACK ;[ -BEGIN ARRAY
297 RBRACK ;] - END OF ARRAY
298 CSTRING ;" - CHARACTER STRING
301 SPECTY ;# - SPECIAL TYPE TO BE READ
302 OPNANG ;< - BEGIN ELEMENT CALL
304 SLMNT==.-DTBL ;TYPE OF START OF SEGMENT
306 CLSANG ;> - END ELEMENT CALL
309 EOFCHR ;^C - END OF FILE
311 COMNT ;; - BEGIN COMMENT
317 ; EXTENDED TABLE FOR ! HACKS
319 SEGDOT ;!. - CALL TO LVAL (SEG)
321 UVECIN ;![ - INPUT UNIFORM VECTOR ]
323 QUOSEG ;!' - SEG CALL TO QUOTE
325 SINCHR ;!" - INPUT ONE CHARACTER
329 GLOSEG ;!, - SEG CALL TO GVAL
331 TERM ;!$ - (EXCAL-ALT MODE) PUT ALL CLOSES
335 ALTSEG ;!_ - !@<ALTER...>
340 ;TRANSLATION TABLE FOR EXTENDED THINGIES
342 EXTTBL: NUMCOD-1 ;!LETTER = LETTER
345 DOTEXT ;!. = !<LVAL....>, PROBABLY
347 QUOEXT ;!' = !<QUOTE...>
350 QMEXT ;!? = !<GIVEN...>
351 BAREXT ;!_ = !<ALTER...>
352 GLMEXT ;!, = !<GVAL...>
353 SPATYP ;!SPACE = SPACE
356 LBREXT ;![ = #UVECTOR[...]
358 CSEXT ;!" = ONE CHAR NEXT
360 SLMEXT ;!< = #SEGMENT(...)
365 SPACE: PUSHJ P,LSTCHR ;DON'T REREAD SPACE
367 ;HERE ON NUMBER OR LETTER, START ATOM
369 NUMLET: PUSHJ P,GOBBLE ;READ IN THE ATOM AND PUT PNTR ON ARG PDL
370 JRST RET ;NO SKIP RETURN I.E. NON NIL
372 ;HERE TO START BUILDING A CHARACTER STRING GOODIE
374 CSTRING: PUSHJ P,GOBBL1 ;READ IN STRING
377 ;ARRIVE HERE TO INVOKE A READ TIME MACRO FUNCTION
379 MACCAL: PUSHJ P,NXTCH1 ;READ ONE MORE CHARACTER
380 CAIE B,MACTYP ;IS IT ANOTHER MACRO CHAR
382 JRST MACAL1 ;NO, CALL MACRO AND USE VALUE
383 PUSHJ P,LSTCHR ;DONT REREAD %
384 PUSHJ P,MACAL1 ;OTHERWISE, USE SIDE EFFECCT, BUT NOT VALUE
388 MACAL1: PUSHJ P,IREAD1 ;READ FUNCTION NAME
389 PUSHJ P,ERRPAR ;BAD PARENS
390 PUSH TP,A ;SAVE THE RESULT
391 PUSH TP,B ;AND USE IT AS AN ARGUMENT
395 ;CALL GOBBLE TO FIND THE TYPE AND THEN IREAD TO READ IT
397 SPECTY: PUSHJ P,IREAD ;READ THE TYPES NAME (SHOULD BE AN ATOM)
399 PUSH TP,A ;BEGIN SETTING UP CHTYPE CALL
401 PUSHJ P,IREAD1 ;NOW READ STRUCTURE
402 PUSHJ P,ERRPAR ;LOSSAGE
403 EXCH A,-1(TP) ;USE AS FIRST ARG
405 PUSH TP,A ;USE OTHER AS 2D ARG
407 MCALL 2,CHTYPE ;ATTEMPT TO MUNG
410 ;THIS CODE CALLS IREAD RECURSIVELY TO READ THAT WHICH IS
411 ;BETWEEN (), ARRIVED AT WHEN ( IS READ
416 OPNANG: PUSH TP,$TFORM ;SAVE TYPE
421 PUSH TP,$TLIST ;START BY ASSUMING NIL
423 PUSHJ P,LSTCHR ;DON'T REREAD PARENS
424 LLPLOP: PUSHJ P,IREAD1 ;READ IT
425 JRST LDONE ;HIT TERMINATOR
427 ;HERE WHEN MUST ADD CAR TO CURRENT WINNER
429 GENCAR: PUSH TP,A ;SAVE TYPE OF VALUE
431 MCALL 1,NCONS ;GOBBLE NIL LISTE
432 MOVEM A,(TB) ;SAVE AWAY
433 MOVEM B,1(TB) ;FOR COMMENT
435 JUMPN C,CDRIN ;IF STACKED GOODIE NOT NIL SKIP
436 MOVE C,(TP) ;FIX UP LAT TYPE
438 PUSH TP,B ;AND USE AS TOTAL VALUE
439 PUSH TP,A ;SAVE THIS AS FIRSST THING ON LIST
440 JRST .+2 ;SKIP CDR SETTING
442 PUSH TP,B ;CLOBBER IN NEW PARTIAL GOODIE
443 JRST LLPLOP ;AND CONTINUE
445 ; HERE TO RAP UP LIST
447 LDONE: CAME B,(P) ;CHECK VALIDITY OF CHARACTER
448 PUSHJ P,MISMAT ;REPORT MISMATCH
450 POP TP,B ;GET VALUE OF PARTIAL RESULT
451 POP TP,A ;AND TYPE OF SAME
452 JUMPE B,RET ;VALUE IS NIL, DON'T POP AGAIN
453 POP TP,B ;POP FIRST LIST ELEMENT
457 ;THIS CODE IS SIMILAR TO LIST GENERATING CODE BUT IS FOR VECTORS
458 UVECIN: PUSH P,[EUVECTOR] ;PUSH NAME OF U VECT HACKER
461 LBRACK: PUSH P,[EVECTOR] ;PUSH GEN VECTOR HACKER
462 LBRAK2: PUSHJ P,LSTCHR ;FORCE READING NEW CHAR
463 PUSH P,[0] ;INITIALIZE TO (WILL COUNT VECTOR ELEMENTS)
465 LBRAK1: PUSHJ P,IREAD1 ;RECURSIVELY READ ELEMENTS OF ARRAY
466 JRST LBDONE ;RAP UP ON TERMINATOR
468 STAKIT: PUSH TP,A ;SAVE RESULT TYPE
470 AOS VCNT(P) ;AND COUNT
473 ; HERE TO RAP UP VECTOR
475 LBDONE: CAIE B,"] ;FINISHED RETURN (WAS THE RIGHT STOP USED?)
476 PUSHJ P,MISMAB ;WARN USER
478 ACALL A,@-1(P) ;MAKE THE VECTOR
483 ; BUILD A SINGLE CHARACTER ITEM
485 SINCHR: PUSHJ P,NXTC1 ;FORCE READ NEXT
486 CAIN B,ESCTYP ;ESCAPE?
488 LSHC A,29.-36. ;POSITION IN B
493 ; HERE ON RIGHT PAREN, BRACKET, ANGLE BRACKET OR CTL C
495 CLSANG: ;CLOSE ANGLE BRACKETS
496 RBRACK: ;COMMON RETURN FOR END OF ARRAY ALSO
497 RPAREN: PUSHJ P,LSTCHR ;DON'T REREAD
498 EOFCHR: MOVE B,A ;GETCHAR IN B
499 MOVSI A,TCHRS ;AND TYPE IN A
502 ; NORMAL RETURN FROM IREAD/IREAD1
504 RETCL: PUSHJ P,LSTCHR ;DONT REREAD
506 RET1: POP TP,1(TB) ;SAVE LAST READ CROCK
511 ;RANDOM MINI-SUBROUTINES USED BY THE READER
513 ;READ A CHAR INTO A AND TYPE CODE INTO D
515 NXTC1: MOVE B,5(TB) ;GET CHANNEL
517 NXTC: MOVE B,5(TB) ;GET CHANNEL
518 SKIPN A,LSTCH(B) ;CHAR IN A IF REUSE
519 NXTC2: XCT IOINS(B) ;GET CHARACTER FROM INPUT
520 ANDI A,377 ;INCASE IT IS EOF
521 MOVEM A,LSTCH(B) ;SAVE THE CHARACTER
522 TRZE A,200 ;DONT SKIP IF SPECIAL
523 JRST RETYPE ;GO HACK SPECIALLY
524 GETCTP: PUSH P,A ;AND SAVE FROM DIVISION
525 IDIVI A,CHRWD ;YIELDS WORD AND CHAR NUMBER
526 LDB B,BYTPNT(B) ;GOBBLE TYPE CODE
530 ; NXTCH AND NXTCH1 ARE SAME AS NXTC AND NXTC1 EXCEPT THEY CHECK !
533 NXTCH1: PUSHJ P,NXTC1 ;READ CHAR
535 NXTCH: PUSHJ P,NXTC ;READ CHAR
536 CAIE B,NTYPES+1 ;IF 1 > THAN MAX, MUST BE SPECIAL
537 POPJ P, ;OTHERWISE JUST RETURN
539 PUSHJ P,NXTC1 ;READ NEXT ONE
541 JRST UPLO ;YES, INVERT CASE
542 RETYP1: CAIN B,SPATYP ;SPACER?
543 JRST CHKALT ;YES, CHECK IT
544 MOVE B,EXTTBL-1(B) ;USE TABLE FOR ALL OTHERS
546 CRMLST: ADDI A,200 ;CLOBBER LASTCHR
548 MOVE B,5(TB) ;POINT TO CHANNEL
550 SUBI A,200 ;DECREASE CHAR
554 UPLO: ADDI A,40 ;CHANGE CASE OF LETTER IN A
559 RETYPE: PUSHJ P,GETCTP ;GET TYPE OF CHAR
563 CHKALT: CAIN A,33 ;ALT?
568 TERM: MOVEI B,0 ;RETURN A 0
573 ;TABLE OF BYTE POINTERS FOR GETTING CHARS
575 BYTPNT": 350700,,CHTBL(A)
581 ;HERE ARE THE TABLES OF CHXRACTERS (NOTE EVERYTHING NOT SPECIFIED IS
582 ;IN THE NUMBER LETTER CATAGORY)
584 SETCHR 2,[0123456789]
592 INCRCH 6,['%\?_,] ;NON-ATOM KILLING SPECIALS
594 SETCOD 14,[15,12,11,14,40,33] ;ALL ARE TYPE 14 (SPACING - FF,TAB,SPACE,ALT-MODE)
596 INCRCH 15,[()[]"#<>] ;GIVE THESE INCREASING CODES FROM 15
598 SETCOD 25,[3] ;^C - EOF CHARACTER
600 INCRCH 26,[;!] ;COMMENT AND SPECIAL
603 OUTTBL ;OUTPUT THE TABLE RIGHT HERE
607 ; THIS CODE ASSOCIATES A COMMENT WITH THE LAST READ GOODIE
609 COMNT: HLRZ A,(TB) ;CHECK THERE IS AN ITEM TO COMMENT
610 CAIN A,TTP ;TYPE TP MEANS NONE THERE
612 PUSH TP,(TB) ;SAVE THEM
614 MOVSI A,TTP ;RESET LAST GOODIE
617 PUSHJ P,IREAD ;CALL READER FLUSHING ,
620 PUSH TP,MQUOTE COMMENT
621 PUSH TP,A ;PUSH THE COMMENT
623 MCALL 3,PUT ;PUT THE COMMENT ON
626 ; THIS CODE FLUSHES WANDERING COMMENTS
628 NOCMNT: PUSHJ P,IREAD
632 ;SUBROUTINE TO READ CHARS ONTO STACK
634 GOBBL1: MOVEI FF,0 ;KILL ALL FLAGS
635 PUSHJ P,LSTCHR ;DON'T REREAD "
636 TROA FF,NOTNUM+INSTRN ;SURPRESS NUMBER CONVERSION
637 GOBBLE: MOVEI FF,0 ;FLAGS CONCERRNING CURRENT GOODIE IN HERE
638 MOVE A,TP ;GOBBLE CURRENT TP TO BE PUSHED
639 MOVEI C,6 ;NOW PUSH 6 0'S ON TO STACK
640 PUSH TP,$TFIX ;TYPE IS FIXED
641 PUSH TP,FF ;AND VALUE IS 0
642 SOJG C,.-2 ;FOUR OF THEM
643 PUSH TP,$TTP ;NOW SAVE OLD TP
644 ADD A,[1,,1] ;MAKE IT LOOK LIKE A TB
646 MOVEI D,0 ;ZERO OUT CHARACTER COUNT
647 GOB1: MOVEI C,0 ;SET UP FIRST WORD OF CHARS
648 PUSH P,[440700,,C] ;BYTE POINTER
649 GOB2: PUSH P,FF ;SAVE FLAG REGISTER
651 PUSHJ P,NXTCH ;READ A CHAACTER
652 POP P,FF ;AND RESTORE FLAG REGISTER
653 CAIN B,ESCTYP ;IS IT A CHARACTER TO BE ESCAPED
654 JRST ESCHK ;GOBBLE THE ESCAPED CHARACTER
655 TRNE FF,INSTRN ;ARE WE BUILDING A CHAR STRING
656 JRST ADSTRN ;YES, GO READ IN
657 CAILE B,NONSPC ;IS IT SPECIAL
658 JRST DONEG ;YES, RAP THIS UP
660 TRNE FF,NOTNUM ;IS NUMERIC STILL WINNING
661 JRST SYMB2 ;NO, ONLY DO CHARACTER HACKING
662 CAIL A,60 ;CHECK FOR DIGIT
664 JRST SYMB1 ;NOT A DIGIT
665 JRST CNV ;GO CONVERT TO NUMBER
668 ;ARRIVE HERE IF STILL BUILDING A NUMBER
669 CNV: MOVE B,(TP) ;GOBBLE POINTER TO TEMPS
670 TRO FF,NUMWIN ;SAY DIGITSSEEN
671 SUBI A,60 ;CONVERT TO A NUMBER
672 TRNE FF,EFLG ;HAS E BEEN SEEN
673 JRST ECNV ;YES, CONVERT EXPONENT
674 TRNE FF,DOTSEN ;HAS A DOT BEEN SEEN
676 JRST DECNV ;YES, THIS IS A FLOATING NUMBER
678 JFCL 17,.+1 ;KILL ALL FLAGS
679 MOVE E,CNUM(B) ;COMPUTE CURRENT RADIX
681 ADD E,A ;ADD IN CURRENT DIGIT
683 MOVEM E,CNUM(B) ;AND SAVE IT
687 ;INSERT OCTAL AND CRADIX CROCK HERE IF NECESSSARY
688 JRST DECNV1 ;CONVERT TO DECIMAL(FIXED)
691 DECNV: TRO FF,FLONUM ;SET FLOATING FLAG
692 DECNV1: JFCL 17,.+1 ;CLEAR ALL FLAGS
693 MOVE E,DNUM(B) ;GET DECIMAL NUMBER
695 JFCL 10,CNV2 ;JUMP IF OVERFLOW
696 ADD E,A ;ADD IN DIGIT
698 TRNE FF,FLONUM ;IS THIS FRACTION?
699 SOS NDIGS(B) ;YES, DECREASE EXPONENT BY ONE
701 CNV1: PUSHJ P,NXTCH ;RE-GOBBLE CHARACTER
702 JRST SYMB2 ;ALSO DEPOSIT INTO SYMBOL BEING MADE
\rîCNV2: ;OVERFLOW IN DECIMAL NUMBER
703 TRNE FF,DOTSEN ;IS THIS FRACTION PART?
704 JRST CNV1 ;YES,IGNORE DIGIT
705 AOS NDIGS(B) ;NO, INCREASE IMPLICIT EXPONENT BY ONE
706 TRO FF,FLONUM ;SET FLOATING FLAG BUT
707 JRST CNV1 ;DO NOT FORCE DECIMAL(DECFRC)
709 ECNV: ;CONVERT A DECIMAL EXPONENT
710 HRRZ E,ENUM(B) ;GET EXPONENT
712 ADD E,A ;ADD IN DIGIT
713 TLNN E,777777 ;IF OVERFLOW INTO LEFT HALF
714 HRRM E,ENUM(B) ;DO NOT STORE(CATCH ERROR LATER)
716 JRST SYMB2 ;ALSO DEPOSIT INTO SYMBOL BEING MADE
719 ;HERE TO PUT INTO IDENTIFIER BEING BUILT
721 ESCHK: PUSHJ P,NXTC1 ;GOBBLE NEXT CHAR
722 SYMB: MOVE B,(TP) ;GET BACK TEM POINTER
723 TRNE FF,EFLG ;IF E FLAG SET
724 HLRZ FF,ENUM(B) ;RESTORE SAVED FLAGS
725 TRO FF,NOTNUM ;SET NOT NUMBER FLAG
726 SYMB2: TRO FF,NFIRST ;NOT FIRST IN WORLD
727 SYMB3: IDPB A,(P) ;INSERT IT
728 PUSHJ P,LSTCHR ;READ NEW CHARACTER
729 TRNN C,377 ;WORD FULL?
730 JRST GOB2 ;NO, KEEP TRYING
731 MOVEM C,(P) ;YES,STORE IT
732 AOJA D,GOB1 ;COUNT WORD AND GO
734 ;HERE TO CHECK FOR +,-,. IN NUMBER
736 SYMB1: TRNE FF,NFIRST ;IS THIS THE FIRST CHARACTER
737 JRST CHECK. ;NO, ONLY LOOK AT DOT
738 CAIE A,"- ;IS IT MINUS
739 JRST .+3 ;NO CHECK PLUS
740 TRO FF,NEGF ;YES, NEGATE AT THE END
743 JRST SYMB2 ;ESSENTIALLY IGNORE IT
747 CHECK.: PUSHJ P,LSTCHR ;FLUSH LAST CHARACTER
749 TRNN FF,DOTSEN+EFLG ;IF ONE ALREADY SEEN
751 JRST CHECKE ;GO LOOK FOR E
754 TRNN FF,NFIRST ;IS IT THE FIRST
755 JRST DOT1 ;YES, COULD MEAN EVALUATE A VARIABLE
758 CHCK.1: TRO FF,DECFRC+DOTSEN ;FORCE DECIMAL
759 IFN FRMSIN, TRNN FF,FRSDOT ;IF NOT FIRST ., PUT IN CHAR STRING
760 JRST SYMB2 ;ENTER INTO SYMBOL
761 IFN FRMSIN, JRST GOB2 ;IGNORE THE "."
767 ;HERE TO SET UP FOR .FOO ..FOO OR.<ABC>
769 DOT1: PUSH P,FF ;SAVE FLAGS
770 PUSHJ P,NXTCH1 ;GOBBLE A NEW CHARACTER
771 POP P,FF ;RESTORE FLAGS
772 TRO FF,FRSDOT ;SET FLAG IN CASE
773 CAIN B,NUMCOD ;SKIP IF NOT NUMERIC
774 JRST CHCK.1 ;NUMERIC, COULD BE FLONUM
776 ; CODE TO HANDLE ALL IMPLICIT CALLS I.E. QUOTE, LVAL, GVAL
780 SUB P,[2,,2] ;POP OFF BYTE POINTER AND GOBBLE CALL
782 SUB TP,[1,,1] ;REMOVE TP JUNK
785 GLOSEG: SKIPA B,$TSEG ;SEG CALL TO GVAL
786 GLOVAL: MOVSI B,TFORM ;FORM CALL TO SAME
790 QUOSEG: SKIPA B,$TSEG ;SEG CALL TO QUOTE
791 QUOTIT: MOVSI B,TFORM
795 GIVSEG: MOVSI B,TSEG ;#SEGMENT
797 JRST IMPCAL ;(GIVEN...)
799 GIVACT: MOVSI B,TFORM ;#FORM
801 JRST IMPCA1 ;(GIVEN...)
803 ALTSEG: SKIPA B,$TSEG ;#SEGMENT
804 ALTACT: MOVSI B,TFORM ;#FORM
806 JRST IMPCAL ;(ALTER...)
808 SEGDOT: MOVSI B,TSEG ;SEG CALL TO LVAL
810 IMPCAL: PUSHJ P,LSTCHR ;FLUSH LAST CHAR EXCEPT
811 IMPCA1: PUSH TP,$TATOM ;FOR .FOO FLAVOR
816 IMPCA2: PUSH TP,A ;PUSH RESULTS
818 MCALL 2,LIST ;MAKE THE LIST
819 POP P,A ;GET FINAL TYPE
824 ;? CAN MEAN ? OR <GIVEN X> OR #UNASSIGNED(...)
826 QMARK: PUSHJ P,LSTCHR ;FLUSH "?"
827 PUSHJ P,NXTCH ;GET NEXT CHARACTER
829 JRST UNASIN ;YES- TYPE UNASSIGNED
830 CAILE B,NONSPC ;NEXT CHARACTER BREAKS ATOMS?
831 JRST ANY ;YES- HAVE STAND-ALONE "?"
832 JRST GIVACT ;NO- NEXT THING IS ATOM
833 UNASIN: PUSHJ P,IREAD1 ;READ NEXT THING
838 PUSH TP,MQUOTE UNASSIGNED
839 MCALL 2,CHTYPE ;CHANGE ITS TYPE TO UNASSIGNED
841 ANY: PUSH P,[ASCIZ /?/] ;? ALONE MUST BE ATOM
842 PUSH P,[1] ;WITH ONE WORD PNAME
844 MOVE B,MQUOTE OBLIST,
845 PUSHJ P,IDVAL ;PUT ON CURRENT OBLIST
849 ;HERE AFTER READING ATOM TO CALL VALUE
851 .SET: SUB P,[1,,1] ;FLUSH GOBBLE CALL
852 PUSH P,$TFORM ;GET WINNING TYPE
853 .SET1: PUSH TP,$TATOM
855 JRST IMPCA2 ;GO CONS LIST
859 ;HERE TO CHECK FOR "E" FLAVOR OF EXPONENT
861 CHECKE: TRNN FF,EFLG ;HAS ONE BEEN SEEN
862 CAIE A,"E ;IF NOT, IS THIS ONE
863 JRST SYMB ;NO, ENTER AS SYMBOL KILL NUMERIC WIN
865 TRNN FF,NUMWIN ;HAVE DIGITS BEEN SEEN?
866 JRST SYMB ;NO, NOT A NUMBER
867 MOVE B,(TP) ;GET POINTER TO TEMPS
868 HRLM FF,ENUM(B) ;SAVE FLAGS
869 HRRI FF,DECFRC+DOTSEN+EFLG ;SET NEW FLAGS
870 JRST SYMB3 ;ENTER SYMBOL
873 ;HERE ON READING CHARACTER STRING
875 ADSTRN: CAIN B,MANYT ;TERMINATE?
877 CAIE A,"" ;QUOTE CHAR?
878 JRST SYMB2 ;NO JUST INSERT IT
879 ADSTN1: PUSHJ P,LSTCHR ;DON'T REREAD """
882 ;HERE TO FINISH THIS CROCK
884 DONEG: TRNN FF,NUMWIN ;HAVE DIGITS BEEN SEEN?
885 TRO FF,NOTNUM ;NO,SET NOT NUMBER FLAG
886 POP P,A ;FLUSH POINT BYTER
887 JUMPE C,.+3 ;LAST WORD USED?
888 PUSH P,C ;YES, STORE IT
889 AOS D ;AND BUMP COUNT
891 TRNN FF,NOTNUM ;NUMERIC?
892 JRST NUMHAK ;IS NUMERIC, GO TO IT
895 MOVE A,(TP) ;GET POINTER TO TEMPS
896 MOVEM FF,NDIGS(A) ;USE TO HOLD FLAGS
898 TRNE FF,INSTRN ;ARE WE BUILDING A STRING
899 JRST MAKSTR ;YES, GO COMPLETE SAME
900 MOVSI A,TATOM ;GET AATOM TYPE
901 MOVE B,MQUOTE OBLIST,
902 PUSHJ P,IDVAL ;GET VALUE
906 MOVE C,(TP) ;SET TO REGOBBLE FLAGS
911 ;HERE TO RAP UP CHAR STRING ITEM
913 MAKSTR: MOVE C,D ;SETUP TO CALL CHMAK
914 PUSHJ P,CHMAK ;GO MAKE SAME
918 NUMHAK: MOVE C,(TP) ;REGOBBLETEMP POINTER
919 POP P,D ;POP OFF STACK TOP
920 HRLI D,(D) ;TOO BOTH HALVES
921 SUB P,D ;REMOVE CHAR STRING
922 TRNE FF,FLONUM+EFLG ;IS IT A FLOATING POINT NUMBER
923 JRST FLOATIT ;YES, GO MAKE IT WIN
926 MOVE B,DNUM(C) ;GRAB FIXED GOODIE
927 \rFINID2: MOVSI A,TFIX ;SAY FIXED POINT
928 FINID1: TRNE FF,NEGF ;NEGATE
930 FINID: POP TP,TP ;RESTORE OLD TP
931 SUB TP,[1,,1] ;FINISH HACK
933 TRNE FF,FRSDOT ;DID . START IT
934 JRST .SET ;YES, GO HACK
939 \fFLOATIT:î JFCL 17,.+1 ;CLEAR ALL ARITHMETIC FLAGS
940 \r TRNE FF,EFLG ;"E" SEEN?
941 JRST EXPDO ;YES, DO EXPONENT
942 MOVE D,NDIGS(C) ;GET IMPLICIT EXPONENT
944 FLOATE: MOVE A,DNUM(C) ;GET DECIMAL NUMBER
\0
945 IDIVI A,400000 ;SPLIT
946 FSC A,254 ;CONVER
\0T MOST SIGNIFICANT
947 FSC B,233 ; AND LEAST SIGNIFICANT
950 MOVM A,D ;GET MAGNITUDE OF EXPONENT
951 CAILE A,37. ;HOW BIG?
952 JRST FOOR ;TOO BIG-FLOATING OUT OF RANGE
953 JUMPGE D,FLOAT1 ;JUMP IF EXPONENT POSITIVE
954 FDVR B,TENTAB(A) ;DIVIDE BY TEN TO THE EXPONENT
957 FLOAT1: FMPR B,TENTAB(A) ;SCALE UP
959 SETFLO: JFCL 10,FOOR ;FLOATING OUT OF RANGE ON OVERFLOW
961 IFN FRMSIN, TRZ FF,FRSDOT ;FLOATING NUMBER NOT VALUE
965 HRRZ D,ENUM(C) ;GET EXPONENT
966 TRNE FF,NEGF ;IS EXPONENT NEGATIVE?
968 ADD D,NDIGS(C) ;ADD IMPLICIT EXPONENT
969 HLR FF,ENUM(C) ;RESTORE FLAGS
970 JUMPL D,FLOATE ;FLOATING IF EXPONENT NEGATIVE
971 CAIG D,10. ;OR IF EXPONENT TOO LARGE
972 TRNE FF,FLONUM ;OR IF FLAG SET
976 JFCL 10,FLOATE ;IF OVERFLOW, MAKE FLOATING
977 JRST FINID2 ;GO MAKE FIXED NUMBER
979 ; HERE TO READ ONE CHARACTER FOR USER.
981 INXTRD: SKIPA E,[JFCL] ;NULL CLEAR INS
982 IREADC: MOVE E,[PUSHJ P,LSTCHR] ;AVOID RE-READ
983 PUSHJ P,NXTC ;GOBBLE THE CHAR
984 XCT E ;CLEAR LSTCHR IF NECESSARY
986 JRST EOFCHR ;DO EOF RETURN
988 LSH B,29. ;LEFT JUSTIFY
989 MOVSI A,TCHRS ;AND TYPE
992 ; READER ERRORS COME HERE
994 ERRPAR: PUSH TP,$TCHRS ;DO THE OFFENDER
995 LSH B,29. ;POSITION IN WORD
998 PUSH TP,[40_29.] ;SPACE
1000 PUSH TP,MQUOTE WARNING-UNMATCHED
1004 PUSHJ P,LSTCHR ;FLUSH THE CHARACTER
1005 SOS (P) ;SIMULATE JRST .-1
1009 ;COMPLAIN ABOUT MISMATCHED CLOSINGS
1011 MISMAB: SKIPA A,["]]
1012 MISMAT: MOVE A,-1(P) ;GOBBLE THE DESIRED CHARACTER
1013 JUMPE B,CPOPJ ;IGNORE UNIVERSAL CLOSE
1018 PUSH TP,MQUOTE [ INSTEAD-OF ]
1029 ; HERE TO RESET A READ CHANNEL
1031 MFUNCTION RRRES,SUBR,RESET
1037 MOVE C,1(AB) ;GET CHANNEL
1038 MOVEI B,DIRECT-1(C) ;POINT TO DIRECTION
1039 PUSHJ P,CHRWRD ;CONVER T TO A WORD
1041 CAME B,[ASCII /READ/]
1043 MOVE B,1(AB) ;RESTORE CHANNEL
1045 PUSHJ P,RRESET" ;DO REAL RESET
1046 MOVE A,(AB) ;RETURN ARG
1050 ; HERE ON BAD INPUT CHARACTER
1052 BADCHR: PUSH TP,$TATOM
1053 PUSH TP,MQUOTE BAD CHARACTER IGNORED
1060 NEOF: PUSH TP,$TATOM ;GENERATE ERROR MESSAGE
1061 PUSH TP,MQUOTE EOF-REACHED
1064 ;LOSING CHANNEL FOR INPUT
1066 CHNLOS: PUSH TP,$TATOM
1067 PUSH TP,MQUOTE BAD-CHANNEL
1073 OPNERR: PUSH TP,$TATOM ;SETUP MESSAGE
1074 PUSH TP,MQUOTE OPEN-FAILED
1077 ;HERE FOR DIRECTION ERROR
1079 WRNGDI: PUSH TP,$TATOM ;SET UP ERROR
1080 PUSH TP,MQUOTE NOT-OPEN-FOR-READING
1085 WRONGT: PUSH TP,$TATOM
1086 PUSH TP,MQUOTE WRONG-TYPE
1089 ;FLOATING POINT NUMBER TOO LARGE OR SMALL
1090 FOOR: PUSH TP,$TATOM
1091 PUSH TP,MQUOTE NUMBER-OUT-OF-RANGE
1098 MOVE B,5(TB) ;GET CHANNEL
1105 ;TABLE OF NAMES OF ARGS AND ALLOWED TYPES
1108 IRP A,,[[[CAIN C,TUNBOU],EOF],[[CAIE C,TCHAN],INCHAN],[[PUSHJ P,CHOBL],OBLIST]]
1116 CHOBL: CAIE C,TLIST ;A LIST OR AN OBLIST