mirror of
https://github.com/PDP-10/its.git
synced 2026-01-17 08:43:21 +00:00
2203 lines
45 KiB
Plaintext
2203 lines
45 KiB
Plaintext
|
||
TITLE READER FOR MUDDLE
|
||
|
||
;C. REEVE DEC. 1970
|
||
|
||
RELOCA
|
||
|
||
READER==1 ;TELL MUDDLE > TO USE SOME SPECIAL HACKS
|
||
FRMSIN==1 ;FLAG SAYING WHETHER OR "." AND "'" HACKS EXIST
|
||
KILTV==1 ;FLAG SAYING THAT (TVP) SHOULD BE REMOVED (MUDDLE 54 ONLY)
|
||
|
||
.INSRT MUDDLE >
|
||
|
||
F==PVP
|
||
G==TVP
|
||
|
||
.GLOBAL CONS,VECTOR,NXTCHR,RLOOKU,CRADIX,SPTIME,QUOTE,CHMAK,FLUSCH,IGET
|
||
.GLOBAL SETDEV,OPNCHN,ILVAL,RADX,IDVAL,LSTCH,EVECTOR,EUVECTOR,CHUNW,NONSPC
|
||
.GLOBAL CHRWRD,EOFCND,DIRECT,ACCESS,IOINS,ROOT,DIRECT,DOIOTI,DOACCS,IGVAL,BYTDOP
|
||
.GLOBAL ICONS,INCONS,IEVECT,IEUVEC,BUFSTR,TYPFND,SQUTOA,SQUKIL,IBLOCK,GRB
|
||
.GLOBAL BADCHN,WRONGD,CHNCLS,FNFFL,IPUT,IGET,ILOC,RXCT,WXCT,IUNWIN,UNWIN2
|
||
.GLOBAL CNXTCH,CREADC,MPOPJ,CREDC1,CNXTC1,IREMAS,CBYTES,PVSTOR,SPSTOR,DSTORE
|
||
.GLOBAL SFIX
|
||
.GLOBAL C%11,C%22,C%33,C%44,C%55,C%66,C%0,C%1,C%2,C%3,C%M1,C%M2,C%M10
|
||
.GLOBAL C%M20,C%M30,C%M40,C%M60
|
||
|
||
BUFLNT==100
|
||
|
||
FF=0 ;FALG REGISTER DURING NUMBER CONVERSION
|
||
|
||
;FLAGS USED (RIGHT HALF)
|
||
|
||
NOTNUM==1 ;NOT A NUMBER
|
||
NFIRST==2 ;NOT FIRST CHARACTER BEING READ
|
||
DECFRC==4 ;FORCE DECIMAL CONVERSION
|
||
NEGF==10 ;NEGATE THIS THING
|
||
NUMWIN==20 ;DIGIT(S) SEEN
|
||
INSTRN==40 ;IN QUOTED CHARACTER STRING
|
||
FLONUM==100 ;NUMBER IS FLOOATING POINT
|
||
DOTSEN==200 ;. SEEN IN IMPUT STREAM
|
||
EFLG==400 ;E SEEN FOR EXPONENT
|
||
FRSDOT==1000 ;. CAME FIRST
|
||
USEAGN==2000 ;SPECIAL DOT HACK
|
||
|
||
OCTWIN==4000
|
||
OCTSTR==10000
|
||
OVFLEW==40000
|
||
ENEG==100000
|
||
EPOS==200000
|
||
;TEMPORARY OFFSETS
|
||
|
||
VCNT==0 ;NUMBER OF ELEMENTS IN CURRENT VECTOR
|
||
ONUM==-4 ;CURRENT NUMBER IN OCTAL
|
||
DNUM==-4 ;CURRENT NUMBER IN DECIMAL
|
||
CNUM==-2 ;IN CURRENT RADIX
|
||
NDIGS==0 ;NUMBER OF DIGITS
|
||
ENUM==-2 ;EXPONENT
|
||
NUMTMP==6
|
||
|
||
; TABLE OF POWERS OF TEN
|
||
|
||
TENTAB: REPEAT 39. 10.0^<.RPCNT-1>
|
||
|
||
ITENTB: REPEAT 11. 10.^<.RPCNT-1>
|
||
|
||
|
||
; TEXT FILE LOADING PROGRAM
|
||
|
||
MFUNCTION MLOAD,SUBR,[LOAD]
|
||
|
||
ENTRY
|
||
|
||
HLRZ A,AB ;GET NO. OF ARGS
|
||
CAIE A,-4 ;IS IT 2
|
||
JRST TRY2 ;NO, TRY ANOTHER
|
||
GETYP A,2(AB) ;GET TYPE
|
||
CAIE A,TOBLS ;IS IT OBLIST
|
||
CAIN A,TLIST ; OR LIST THEREOF?
|
||
JRST CHECK1
|
||
JRST WTYP2
|
||
|
||
TRY2: CAIE A,-2 ;IS ONE SUPPLIED
|
||
JRST WNA
|
||
|
||
CHECK1: GETYP A,(AB) ;GET TYPE
|
||
CAIE A,TCHAN ;IS IT A CHANNEL
|
||
JRST WTYP1
|
||
|
||
LOAD1: HLRZ A,TB ;GET CURRENT TIME
|
||
PUSH TP,$TTIME ;AND SAVE IT
|
||
PUSH TP,A
|
||
|
||
MOVEI C,CLSNGO ; LOCATION OF FUNNY CLOSER
|
||
PUSHJ P,IUNWIN ; SET UP AS UNWINDER
|
||
|
||
LOAD2: PUSH TP,(AB) ;USE SUPPLIED CHANNEL
|
||
PUSH TP,1(AB)
|
||
PUSH TP,(TB) ;USE TIME AS EOF ARG
|
||
PUSH TP,1(TB)
|
||
CAML AB,C%M20 ; [-2,,0] ;CHECK FOR 2ND ARG
|
||
JRST LOAD3 ;NONE
|
||
PUSH TP,2(AB) ;PUSH ON 2ND ARG
|
||
PUSH TP,3(AB)
|
||
MCALL 3,READ
|
||
JRST CHKRET ;CHECK FOR EOF RET
|
||
|
||
LOAD3: MCALL 2,READ
|
||
CHKRET: CAMN A,(TB) ;IS TYPE EOF HACK
|
||
CAME B,1(TB) ;AND IS VALUE
|
||
JRST EVALIT ;NO, GO EVAL RESULT
|
||
PUSH TP,(AB)
|
||
PUSH TP,1(AB)
|
||
MCALL 1,FCLOSE
|
||
MOVE A,$TCHSTR
|
||
MOVE B,CHQUOTE DONE
|
||
JRST FINIS
|
||
|
||
CLSNGO: PUSH TP,$TCHAN
|
||
PUSH TP,1(AB)
|
||
MCALL 1,FCLOSE
|
||
JRST UNWIN2 ; CONTINUE UNWINDING
|
||
|
||
EVALIT: PUSH TP,A
|
||
PUSH TP,B
|
||
MCALL 1,EVAL
|
||
JRST LOAD2
|
||
|
||
|
||
|
||
; OTHER FILE LOADING PROGRAM
|
||
|
||
|
||
|
||
MFUNCTION FLOAD,SUBR
|
||
|
||
ENTRY
|
||
|
||
MOVEI C,1 ;INITIALIZE OPEN'S ARG COUNT
|
||
PUSH TP,$TAB ;SLOT FOR SAVED AB
|
||
PUSH TP,C%0 ; [0] ;EMPTY FOR NOW
|
||
PUSH TP,$TCHSTR ;PUT IN FIRST ARG
|
||
PUSH TP,CHQUOTE READ
|
||
MOVE A,AB ;COPY OF ARGUMENT POINTER
|
||
|
||
FARGS: JUMPGE A,CALOPN ;DONE? IF SO CALL OPEN
|
||
GETYP B,(A) ;NO, CHECK TYPE OF THIS ARG
|
||
CAIE B,TOBLS ;OBLIST?
|
||
CAIN B,TLIST ; OR LIST THEREOF
|
||
JRST OBLSV ;YES, GO SAVE IT
|
||
|
||
PUSH TP,(A) ;SAVE THESE ARGS
|
||
PUSH TP,1(A)
|
||
ADD A,C%22 ; [2,,2] ;BUMP A
|
||
AOJA C,FARGS ;COUNT AND GO
|
||
|
||
OBLSV: MOVEM A,1(TB) ;SAVE THE AB
|
||
|
||
CALOPN: ACALL C,FOPEN ;OPEN THE FILE
|
||
|
||
JUMPGE B,FNFFL ;FILE MUST NO EXIST
|
||
EXCH A,(TB) ;PLACE CHANNEL ON STACK
|
||
EXCH B,1(TB) ;OBTAINING POSSIBLE OBLIST
|
||
JUMPN B,2ARGS ;OBLIST SUOPPLIED?
|
||
|
||
MCALL 1,MLOAD ;NO, JUST CALL
|
||
JRST FINIS
|
||
|
||
|
||
2ARGS: PUSH TP,(B) ;PUSH THE OBLIST
|
||
PUSH TP,1(B)
|
||
MCALL 2,MLOAD
|
||
JRST FINIS
|
||
|
||
|
||
FNFFL: PUSH TP,$TATOM
|
||
PUSH TP,EQUOTE FILE-SYSTEM-ERROR
|
||
JUMPE B,CALER1
|
||
PUSH TP,A
|
||
PUSH TP,B
|
||
MOVEI A,2
|
||
JRST CALER
|
||
|
||
MFUNCTION READ,SUBR
|
||
|
||
ENTRY
|
||
|
||
PUSH P,[SETZ IREAD1] ;WHERE TO GO AFTER BINDING
|
||
READ0: PUSH TP,$TTP ;SLOT FOR LAST THING READ (TYPE IS UNREADABLE)
|
||
PUSH TP,C%0
|
||
PUSH TP,$TFIX ;SLOT FOR RADIX
|
||
PUSH TP,C%0
|
||
PUSH TP,$TCHAN ;AND SLOT FOR CHANNEL
|
||
PUSH TP,C%0
|
||
PUSH TP,C%0 ; USER DISP SLOT
|
||
PUSH TP,C%0
|
||
PUSH TP,$TSPLICE
|
||
PUSH TP,C%0 ;SEGMENT FOR SPLICING MACROS
|
||
JUMPGE AB,READ1 ;NO ARGS, NO BINDING
|
||
GETYP C,(AB) ;ISOLATE TYPE
|
||
CAIN C,TUNBOU
|
||
JRST WTYP1
|
||
PUSH TP,[TATOM,,-1] ;PUSH THE ATOMS
|
||
PUSH TP,IMQUOTE INCHAN
|
||
PUSH TP,(AB) ;PUSH ARGS
|
||
PUSH TP,1(AB)
|
||
PUSH TP,C%0 ;DUMMY
|
||
PUSH TP,C%0
|
||
MOVE B,1(AB) ;GET CHANNEL POINTER
|
||
ADD AB,C%22 ;AND ARG POINTER
|
||
JUMPGE AB,BINDEM ;MORE?
|
||
PUSH TP,[TVEC,,-1]
|
||
ADD B,[EOFCND-1,,EOFCND-1]
|
||
PUSH TP,B
|
||
PUSH TP,(AB)
|
||
PUSH TP,1(AB)
|
||
ADD AB,C%22
|
||
JUMPGE AB,BINDEM ;IF ANY MORE ARGS GO PROCESS AND BIND THEM
|
||
GETYP C,(AB) ;ISOLATE TYPE
|
||
CAIE C,TLIST
|
||
CAIN C,TOBLS
|
||
SKIPA
|
||
JRST WTYP3
|
||
PUSH TP,[TATOM,,-1] ;PUSH THE ATOMS
|
||
PUSH TP,IMQUOTE OBLIST
|
||
PUSH TP,(AB) ;PUSH ARGS
|
||
PUSH TP,1(AB)
|
||
PUSH TP,C%0 ;DUMMY
|
||
PUSH TP,C%0
|
||
ADD AB,C%22 ;AND ARG POINTER
|
||
JUMPGE AB,BINDEM ; ALL DONE, BIND ATOMS
|
||
GETYP 0,(AB) ; GET TYPE OF TABLE
|
||
CAIE 0,TVEC ; SKIP IF BAD TYPE
|
||
JRST WTYP ; ELSE COMPLAIN
|
||
PUSH TP,[TATOM,,-1]
|
||
PUSH TP,IMQUOTE READ-TABLE
|
||
PUSH TP,(AB)
|
||
PUSH TP,1(AB)
|
||
PUSH TP,C%0
|
||
PUSH TP,C%0
|
||
ADD AB,C%22 ; BUMP TO NEXT ARG
|
||
JUMPL AB,TMA ;MORE ?, ERROR
|
||
BINDEM: PUSHJ P,SPECBIND
|
||
JRST READ1
|
||
|
||
MFUNCTION RREADC,SUBR,READCHR
|
||
|
||
ENTRY
|
||
PUSH P,[SETZ IREADC]
|
||
JRST READC0 ;GO BIND VARIABLES
|
||
|
||
MFUNCTION NXTRDC,SUBR,NEXTCHR
|
||
|
||
ENTRY
|
||
|
||
PUSH P,[SETZ INXTRD]
|
||
READC0: CAMGE AB,C%M40 ; [-5,,]
|
||
JRST TMA
|
||
PUSH TP,(AB)
|
||
PUSH TP,1(AB)
|
||
JUMPL AB,READC1
|
||
MOVE B,IMQUOTE INCHAN
|
||
PUSHJ P,IDVAL
|
||
GETYP 0,A
|
||
CAIE 0,TCHAN
|
||
JRST BADCHN
|
||
MOVEM A,-1(TP)
|
||
MOVEM B,(TP)
|
||
READC1: PUSHJ P,@(P)
|
||
JRST .+2
|
||
JRST FINIS
|
||
|
||
PUSH TP,-1(TP)
|
||
PUSH TP,-1(TP)
|
||
MCALL 1,FCLOSE
|
||
MOVE A,EOFCND-1(B)
|
||
MOVE B,EOFCND(B)
|
||
CAML AB,C%M20 ; [-3,,]
|
||
JRST .+3
|
||
MOVE A,2(AB)
|
||
MOVE B,3(AB)
|
||
PUSH TP,A
|
||
PUSH TP,B
|
||
MCALL 1,EVAL
|
||
JRST FINIS
|
||
|
||
|
||
MFUNCTION PARSE,SUBR
|
||
|
||
ENTRY
|
||
|
||
PUSHJ P,GAPRS ;GET ARGS FOR PARSES
|
||
PUSHJ P,GPT ;GET THE PARSE TABLE
|
||
PUSHJ P,NXTCH ; GET A CHAR TO TEST FOR ! ALT
|
||
SKIPN 11.(TB) ; EOF HIT, COMPLAIN TO LOOSER
|
||
JRST NOPRS
|
||
MOVEI A,33 ; CHANGE IT TO AN ALT, SNEAKY HUH?
|
||
CAIN B,MANYT ; TYPE OF MULTIPLE CLOSE, I.E. ! ALT
|
||
MOVEM A,5(TB)
|
||
PUSHJ P,IREAD1 ;GO DO THE READING
|
||
JRST .+2
|
||
JRST LPSRET ;PROPER EXIT
|
||
NOPRS: ERRUUO EQUOTE CAN'T-PARSE
|
||
|
||
MFUNCTION LPARSE,SUBR
|
||
|
||
ENTRY
|
||
|
||
PUSHJ P,GAPRS ;GET THE ARGS TO THE PARSE
|
||
JRST LPRS1
|
||
|
||
GAPRS: PUSH TP,$TTP
|
||
PUSH TP,C%0
|
||
PUSH TP,$TFIX
|
||
PUSH TP,[10.]
|
||
PUSH TP,$TFIX
|
||
PUSH TP,C%0 ; LETTER SAVE
|
||
PUSH TP,C%0
|
||
PUSH TP,C%0 ; PARSE TABLE MAYBE?
|
||
PUSH TP,$TSPLICE
|
||
PUSH TP,C%0 ;SEGMENT FOR SPLICING MACROS
|
||
PUSH TP,C%0 ;SLOT FOR LOCATIVE TO STRING
|
||
PUSH TP,C%0
|
||
JUMPGE AB,USPSTR
|
||
PUSH TP,[TATOM,,-1]
|
||
PUSH TP,IMQUOTE PARSE-STRING
|
||
PUSH TP,(AB)
|
||
PUSH TP,1(AB) ; BIND OLD PARSE-STRING
|
||
PUSH TP,C%0
|
||
PUSH TP,C%0
|
||
PUSHJ P,SPECBIND
|
||
ADD AB,C%22
|
||
JUMPGE AB,USPSTR
|
||
GETYP 0,(AB)
|
||
CAIE 0,TFIX
|
||
JRST WTYP2
|
||
MOVE 0,1(AB)
|
||
MOVEM 0,3(TB)
|
||
ADD AB,C%22
|
||
JUMPGE AB,USPSTR
|
||
GETYP 0,(AB)
|
||
CAIE 0,TLIST
|
||
CAIN 0,TOBLS
|
||
SKIPA
|
||
JRST WTYP3
|
||
PUSH TP,[TATOM,,-1]
|
||
PUSH TP,IMQUOTE OBLIST
|
||
PUSH TP,(AB)
|
||
PUSH TP,1(AB) ; HE WANTS HIS OWN OBLIST
|
||
PUSH TP,C%0
|
||
PUSH TP,C%0
|
||
PUSHJ P,SPECBIND
|
||
ADD AB,C%22
|
||
JUMPGE AB,USPSTR
|
||
GETYP 0,(AB)
|
||
CAIE 0,TVEC
|
||
JRST WTYP
|
||
PUSH TP,[TATOM,,-1]
|
||
PUSH TP,IMQUOTE PARSE-TABLE
|
||
PUSH TP,(AB)
|
||
PUSH TP,1(AB)
|
||
PUSH TP,C%0
|
||
PUSH TP,C%0
|
||
PUSHJ P,SPECBIND
|
||
ADD AB,C%22
|
||
JUMPGE AB,USPSTR
|
||
GETYP 0,(AB)
|
||
CAIE 0,TCHRS
|
||
JRST WTYP
|
||
MOVE 0,1(AB)
|
||
MOVEM 0,5(TB) ; STUFF IN A LOOK-AHEAD CHARACTER IF HE WANTS
|
||
ADD AB,C%22
|
||
JUMPL AB,TMA
|
||
USPSTR: MOVE B,IMQUOTE PARSE-STRING
|
||
PUSHJ P,ILOC ; GET A LOCATIVE TO THE STRING, WHEREVER
|
||
GETYP 0,A
|
||
CAIN 0,TUNBOUND ; NONEXISTANT
|
||
JRST BDPSTR
|
||
GETYP 0,(B) ; IT IS POINTING TO A STRING
|
||
CAIE 0,TCHSTR
|
||
JRST BDPSTR
|
||
MOVEM A,10.(TB)
|
||
MOVEM B,11.(TB)
|
||
POPJ P,
|
||
|
||
LPRS1: PUSHJ P,GPT ; GET THE VALUE OF PARSE-TABLE IN SLOT
|
||
PUSH TP,$TLIST
|
||
PUSH TP,C%0 ; HERE WE ARE MAKE PLACE TO SAVE GOODIES
|
||
PUSH TP,$TLIST
|
||
PUSH TP,C%0
|
||
LPRS2: PUSHJ P,IREAD1
|
||
JRST LPRSDN ; IF WE ARE DONE, WE ARE THROUGH
|
||
MOVE C,A
|
||
MOVE D,B
|
||
PUSHJ P,INCONS
|
||
SKIPN -2(TP)
|
||
MOVEM B,-2(TP) ; SAVE THE BEGINNING ON FIRST
|
||
SKIPE C,(TP)
|
||
HRRM B,(C) ; PUTREST INTO IT
|
||
MOVEM B,(TP)
|
||
JRST LPRS2
|
||
LPRSDN: MOVSI A,TLIST
|
||
MOVE B,-2(TP)
|
||
LPSRET: SKIPLE C,5(TB) ; EXIT FOR PARSE AND LPARSE
|
||
CAIN C,400033 ; SEE IF NO PEEK AHEAD OR IF ! ALTMODE
|
||
JRST FINIS ; IF SO NO NEED TO BACK STRING ONE
|
||
SKIPN C,11.(TB)
|
||
JRST FINIS ; IF ATE WHOLE STRING, DONT GIVE BACK ANY
|
||
BUPRS: MOVEI D,1
|
||
ADDM D,(C) ; AOS THE COUNT OF STRING LENGTH
|
||
SKIPG D,1(C) ; SEXIER THAN CLR'S CODE FOR DECREMENTING
|
||
SUB D,[430000,,1] ; A BYTE POINTER
|
||
ADD D,[70000,,0]
|
||
MOVEM D,1(C)
|
||
HRRZ E,2(TB)
|
||
JUMPE E,FINIS ; SEE IF WE NEED TO BACK UP TWO
|
||
HLLZS 2(TB) ; CLEAR OUT DOUBLE CHR LOOKY FLAG
|
||
JRST BUPRS ; AND BACK UP PARSE STRING A LITTLE MORE
|
||
|
||
; ARGUMENTS ARE BOUND, NOW GET THE VALUES OF THINGS
|
||
|
||
|
||
GRT: MOVE B,IMQUOTE READ-TABLE
|
||
SKIPA ; HERE TO GET TABLE FOR READ
|
||
GPT: MOVE B,IMQUOTE PARSE-TABLE
|
||
MOVSI A,TATOM ; TO FILL SLOT WITH PARSE TABLE
|
||
PUSHJ P,ILVAL
|
||
GETYP 0,A
|
||
CAIN 0,TUNBOUND
|
||
POPJ P,
|
||
CAIE 0,TVEC
|
||
JRST BADPTB
|
||
MOVEM A,6(TB)
|
||
MOVEM B,7(TB)
|
||
POPJ P,
|
||
|
||
READ1: PUSHJ P,GRT
|
||
MOVE B,IMQUOTE INCHAN
|
||
MOVSI A,TATOM
|
||
PUSHJ P,IDVAL ;NOW GOBBLE THE REAL CHANNEL
|
||
TLZ A,TYPMSK#777777
|
||
HLLZS A ; INCASE OF FUNNY BUG
|
||
CAME A,$TCHAN ;IS IT A CHANNEL
|
||
JRST BADCHN
|
||
MOVEM A,4(TB) ; STORE CHANNEL
|
||
MOVEM B,5(TB)
|
||
HRRZ A,-2(B)
|
||
TRNN A,C.OPN
|
||
JRST CHNCLS
|
||
TRNN A,C.READ
|
||
JRST WRONGD
|
||
HLLOS 4(TB)
|
||
TRNE A,C.BIN ; SKIP IF NOT BIN
|
||
JRST BREAD ; CHECK FOR BUFFER
|
||
HLLZS 4(TB)
|
||
GETIOA: MOVE B,5(TB)
|
||
GETIO: MOVE A,IOINS(B) ;GOBBLE THE I/O INSTRUCTION
|
||
JUMPE A,OPNFIL ;GO REALLY OPEN THE CROCK
|
||
MOVE A,RADX(B) ;GET RADIX
|
||
MOVEM A,3(TB)
|
||
MOVEM B,5(TB) ;SAVE CHANNEL
|
||
REREAD: HRRZ D,LSTCH(B) ;ANY CHARS AROUND?
|
||
MOVEI 0,33
|
||
CAIN D,400033 ;FLUSH THE TERMINATOR HACK
|
||
HRRM 0,LSTCH(B) ; MAKE ! ALT INTO JUST ALT IF IT IS STILL AROUND
|
||
|
||
PUSHJ P,@(P) ;CALL INTERNAL READER
|
||
JRST BADTRM ;LOST
|
||
RFINIS: SUB P,C%11 ;POP OFF LOSER
|
||
PUSH TP,A
|
||
PUSH TP,B
|
||
JUMPE C,FLSCOM ; FLUSH TOP LEVEL COMMENT
|
||
PUSH TP,C
|
||
PUSH TP,D
|
||
MOVE A,4(TB)
|
||
MOVE B,5(TB) ; GET CHANNEL
|
||
MOVSI C,TATOM
|
||
MOVE D,IMQUOTE COMMENT
|
||
PUSHJ P,IPUT
|
||
RFINI1: POP TP,B
|
||
POP TP,A
|
||
JRST FINIS
|
||
|
||
FLSCOM: MOVE A,4(TB)
|
||
MOVE B,5(TB)
|
||
MOVSI C,TATOM
|
||
MOVE D,IMQUOTE COMMENT
|
||
PUSHJ P,IREMAS
|
||
JRST RFINI1
|
||
|
||
BADTRM: MOVE C,5(TB) ; GET CHANNEL
|
||
JUMPGE B,CHLSTC ;NO, MUST BE UNMATCHED PARENS
|
||
SETZM LSTCH(C) ; DONT REUSE EOF CHR
|
||
PUSH TP,4(TB) ;CLOSE THE CHANNEL
|
||
PUSH TP,5(TB)
|
||
MCALL 1,FCLOSE
|
||
PUSH TP,EOFCND-1(B)
|
||
PUSH TP,EOFCND(B)
|
||
MCALL 1,EVAL ;AND EVAL IT
|
||
SETZB C,D
|
||
GETYP 0,A ; CHECK FOR FUNNY ACT
|
||
CAIE 0,TREADA
|
||
JRST RFINIS ; AND RETURN
|
||
|
||
PUSHJ P,CHUNW ; UNWIND TO POINT
|
||
MOVSI A,TREADA ; SEND MESSAGE BACK
|
||
JRST CONTIN
|
||
|
||
;HERE TO ATTEMPT TO OPEN A CLOSED CHANNEL
|
||
|
||
OPNFIL: PUSHJ P,OPNCHN ;GO DO THE OPEN
|
||
JUMPGE B,FNFFL ;LOSE IC B IS 0
|
||
JRST GETIO
|
||
|
||
|
||
CHLSTC: MOVE B,5(TB) ;GET CHANNEL BACK
|
||
JRST REREAD
|
||
|
||
|
||
BREAD: MOVE B,5(TB) ; GET CHANNEL
|
||
SKIPE BUFSTR(B)
|
||
JRST GETIO
|
||
MOVEI A,BUFLNT ; GET A BUFFER
|
||
PUSHJ P,IBLOCK
|
||
MOVEI C,BUFLNT(B) ; POINT TO END
|
||
HRLI C,440700
|
||
MOVE B,5(TB) ; CHANNEL BACK
|
||
MOVEI 0,C.BUF
|
||
IORM 0,-2(B)
|
||
MOVEM C,BUFSTR(B)
|
||
MOVSI C,TCHSTR+.VECT.
|
||
MOVEM C,BUFSTR-1(B)
|
||
JRST GETIO
|
||
;MAIN ENTRY TO READER
|
||
|
||
NIREAD: PUSHJ P,LSTCHR
|
||
NIREA1: PUSH P,C%M1 ; [-1] ; DONT GOBBLE COMMENTS
|
||
JRST IREAD2
|
||
|
||
IREAD:
|
||
PUSHJ P,LSTCHR ;DON'T REREAD LAST CHARACTER
|
||
IREAD1: PUSH P,C%0 ; FLAG SAYING SNARF COMMENTS
|
||
IREAD2: INTGO
|
||
BDLP: SKIPE C,9.(TB) ;HAVE WE GOT A SPLICING MACRO LEFT
|
||
JRST SPLMAC ;IF SO GIVE HIM SOME OF IT
|
||
PUSHJ P,NXTCH ;GOBBLE CHAR IN A AND TYPE IN D
|
||
MOVMS B ; FOR SPECIAL NEG HACK OF MACRO TABLES
|
||
CAIG B,ENTYPE
|
||
JUMPN B,@DTBL-1(B) ;ERROR ON ZERO TYPE OR FUNNY TYPE
|
||
JRST BADCHR
|
||
|
||
|
||
SPLMAC: HRRZ D,(C) ;GET THE REST OF THE SEGMENT
|
||
MOVEM D,9.(TB) ;AND PUT BACK IN PLACE
|
||
GETYP D,(C) ;SEE IF DEFERMENT NEEDED
|
||
CAIN D,TDEFER
|
||
MOVE C,1(C) ;IF SO, DO DEFEREMENT
|
||
MOVE A,(C)
|
||
MOVE B,1(C) ;GET THE GOODIE
|
||
AOS -1(P) ;ALWAYS A SKIP RETURN
|
||
POP P,(P) ;DONT WORRY ABOUT COMMENT SEARCHAGE
|
||
SETZB C,D ;MAKE SURE HE DOESNT THINK WE GOT COMMENT
|
||
POPJ P, ;GIVE HIM WHAT HE DESERVES
|
||
|
||
DTBL:
|
||
CODINI==0
|
||
IRP A,,[[LETCOD,LETTER],[NUMCOD,NUMBER],[PLUCOD,PNUMBE],[NEGCOD,NNUMBE],[ASTCOD,ASTSTR],[DOTTYP,DOTSTR],[ETYPE,LETTER]
|
||
[SPATYP,SPACE],[LPATYP,LPAREN],[RPATYP,RPAREN],[LBRTYP,LBRACK],[RBRTYP,RBRACK]
|
||
[QUOTYP,QUOTIT],[MACTYP,MACCAL],[CSTYP,CSTRING],[ESCTYP,ESCSTR],[SPCTYP,SPECTY]
|
||
[SLMNT,OPNANG],[CNGTYP,CLSANG],[EOFTYP,EOFCHR],[COMTYP,COMNT],[GLMNT,GLOVAL]
|
||
[TMPTYP,ILLSQG],[NTYPES,CLSBRA],[EXCEXC,LETTER],[DOTEXT,SEGDOT],[LBREXT,UVECIN]
|
||
[RBREXT,RBRACK],[QUOEXT,QUOSEG],[CSEXT,SINCHR],[SLMEXT,SEGIN],[ELMEXT,CLSANG]
|
||
[GLMEXT,GLOSEG],[PATHTY,LOSPATH],[BSLEXT,SINCHR],[MANYT,TERM],[USTYP1,USRDS1]
|
||
[USTYP2,USRDS2]]
|
||
|
||
IRP B,C,[A]
|
||
CODINI==CODINI+1
|
||
B==CODINI
|
||
SETZ C
|
||
.ISTOP
|
||
TERMIN
|
||
TERMIN
|
||
|
||
EXPUNGE CODINI
|
||
|
||
ENTYPE==.-DTBL
|
||
|
||
NONSPC==ETYPE
|
||
|
||
SPACE: PUSHJ P,LSTCHR ;DONT REREAD SPACER
|
||
JRST BDLP
|
||
|
||
USRDS1: SKIPA B,A ; GET CHAR IN B
|
||
USRDS2: MOVEI B,200(A) ; ! CHAR, DISP 200 FURTHER
|
||
ASH B,1
|
||
ADD B,7(TB) ; POINT TO TABLE ENTRY
|
||
GETYP 0,(B)
|
||
CAIN 0,TLIST
|
||
MOVE B,1(B) ; IF LIST, USE FIRST ITEM-SPECIAL NO BREAK HACK
|
||
SKIPL C,5(TB) ; GET CHANNEL POINTER (IF ANY)
|
||
JRST USRDS3
|
||
ADD C,[EOFCND-1,,EOFCND-1]
|
||
PUSH TP,$TBVL
|
||
MOVE SP,SPSTOR+1
|
||
HRRM SP,(TP) ; BUILD A TBVL
|
||
MOVE SP,TP
|
||
MOVEM SP,SPSTOR+1
|
||
PUSH TP,C
|
||
PUSH TP,(C)
|
||
PUSH TP,1(C)
|
||
MOVE PVP,PVSTOR+1
|
||
MOVEI D,PVLNT*2+1(PVP)
|
||
HRLI D,TREADA
|
||
MOVEM D,(C)
|
||
MOVEI D,(TB)
|
||
HLL D,OTBSAV(TB)
|
||
MOVEM D,1(C)
|
||
USRDS3: PUSH TP,(B) ; APPLIER
|
||
PUSH TP,1(B)
|
||
PUSH TP,$TCHRS ; APPLY TO CHARACTER
|
||
PUSH TP,A
|
||
PUSHJ P,LSTCHR ; FLUSH CHAR
|
||
MCALL 2,APPLY ; GO TO USER GOODIE
|
||
SKIPL 5(TB)
|
||
JRST USRDS9
|
||
MOVE SP,SPSTOR+1
|
||
HRRZ E,1(SP) ; POINT TO EOFCND SLOT
|
||
HRRZ SP,(SP) ; UNBIND MANUALLY
|
||
MOVEI D,(TP)
|
||
SUBI D,(SP)
|
||
MOVSI D,(D)
|
||
HLL SP,TP
|
||
SUB SP,D
|
||
MOVEM SP,SPSTOR+1
|
||
POP TP,1(E)
|
||
POP TP,(E)
|
||
SUB TP,C%22 ; FLUSH TP CRAP
|
||
USRDS9: GETYP 0,A ; CHECK FOR DISMISS?
|
||
CAIN 0,TSPLICE
|
||
JRST GOTSPL ; RETURN OF SEGMENT INDICATES SPLICAGE
|
||
CAIN 0,TREADA ; FUNNY?
|
||
JRST DOEOF
|
||
CAIE 0,TDISMI
|
||
JRST RET ; NO, RETURN FROM IREAD
|
||
JRST BDLP ; YES, IGNORE RETURN
|
||
|
||
GOTSPL: MOVEM B,9.(TB) ; STICK IN THE SPLICAGE SLOT SO IREADS WILL GET HIM
|
||
JRST BDLP ; GO BACK AND READ FROM OUR SPLICE, OK?
|
||
|
||
|
||
;HERE ON NUMBER OR LETTER, START ATOM
|
||
|
||
ESCSTR: PUSHJ P,NXTC1 ; ESCAPE FIRST
|
||
LETTER: MOVEI FF,NOTNUM ; LETTER
|
||
JRST ATMBLD
|
||
|
||
ASTSTR: MOVEI FF,OCTSTR
|
||
DOTST1: MOVEI B,0
|
||
JRST NUMBLD
|
||
|
||
NUMBER: MOVEI FF,NUMWIN ; SYMBOL OR NUMBER
|
||
NUMBR1: MOVEI B,(A) ; TO A NUMBER
|
||
SUBI B,60
|
||
JRST NUMBLD
|
||
|
||
PNUMBE: SETZB FF,B
|
||
JRST NUMBLD
|
||
|
||
NNUMBE: MOVEI FF,NEGF
|
||
MOVEI B,0
|
||
|
||
NUMBLD: PUSH TP,$TFIX
|
||
PUSH TP,B
|
||
PUSH TP,$TFIX
|
||
PUSH TP,B
|
||
PUSH TP,$TFIX
|
||
PUSH TP,C%0
|
||
|
||
ATMBLD: LSH A,<36.-7>
|
||
PUSH P,A
|
||
MOVEI D,1 ; D IS CHAR COUNT
|
||
MOVSI C,350700+P ; BYTE PNTR
|
||
PUSHJ P,LSTCHR
|
||
|
||
ATLP: PUSH P,FF
|
||
INTGO
|
||
|
||
PUSHJ P,NXTCH ; GET NEXT CHAR
|
||
POP P,FF
|
||
TRNN FF,NOTNUM ; IF NOT NUMBER, SKIP
|
||
JRST NUMCHK
|
||
|
||
ATLP2: CAILE B,NONSPC ; SKIP IF STILL LETTER OR NUMBER
|
||
JRST CHKEND
|
||
|
||
ATLP1: PUSHJ P,LSTCHR ; DONT REUSE
|
||
IDPB A,C ; INTO ATOM
|
||
TLNE C,760000 ; SKIP IF OK WORD
|
||
AOJA D,ATLP
|
||
|
||
PUSH P,C%0
|
||
MOVSI C,440700+P
|
||
AOJA D,ATLP
|
||
|
||
CHKEND: CAIN B,ESCTYP ; ESCAPE?
|
||
JRST DOESC1
|
||
|
||
CHKEN1: SKIPGE C ; SKIP IF TOP SLOT FULL
|
||
SUB P,C%11
|
||
PUSH P,D ; COUNT OF CHARS
|
||
|
||
JRST LOOPA ; GO HACK TRAILERS
|
||
|
||
|
||
; HERE IF STILL COULD BE A NUMBER
|
||
|
||
NUMCHK: CAIN B,NUMCOD ; STILL NUMBER
|
||
JRST NUMCH1
|
||
|
||
CAILE B,NONSPC ; NUMBER FINISHED?
|
||
JRST NUMCNV
|
||
|
||
CAIN B,DOTTYP
|
||
TROE FF,DOTSEN
|
||
JRST NUMCH2
|
||
TRNE FF,OCTSTR+EFLG
|
||
JRST NUMCH3 ; NO . IN OCTAL OR EXPONENT
|
||
TRO FF,DECFRC ; MUST BE DECIMAL NOW
|
||
JRST ATLP1
|
||
|
||
NUMCH1: TRO FF,NUMWIN
|
||
MOVEI B,(A)
|
||
SUBI B,60
|
||
TRNE FF,OCTSTR+OCTWIN ; IS THIS *DDDDDD* HACK
|
||
JRST NUMCH4 ; YES, GO DO IT
|
||
TRNE FF,EFLG
|
||
JRST NUMCH7 ; DO EXPONENT
|
||
|
||
TRNE FF,DOTSEN ; FORCE FLOAT
|
||
JRST NUMCH5
|
||
|
||
JFCL 17,.+1 ; KILL ALL FLAGS
|
||
MOVE E,CNUM(TP) ; COMPUTE CURRENT RADIX
|
||
IMUL E,3(TB)
|
||
ADDI E,(B) ; ADD IN CURRENT DIGIT
|
||
JFCL 10,.+3
|
||
MOVEM E,CNUM(TP)
|
||
JRST NUMCH6
|
||
|
||
MOVE E,3(TB) ; SEE IF CURRENT RADIX DECIMAL
|
||
CAIE E,10.
|
||
JRST NUMCH5 ; YES, FORCE FLOAT
|
||
TROA FF,OVFLEW
|
||
|
||
NUMCH5: TRO FF,FLONUM ; SET FLOATING FLAG
|
||
NUMCH6: JFCL 17,.+1 ; CLEAR ALL FLAGS
|
||
MOVE E,DNUM(TP) ; GET DECIMAL NUMBER
|
||
IMULI E,10.
|
||
JFCL 10,NUMCH8 ; JUMP IF OVERFLOW
|
||
ADDI E,(B) ; ADD IN DIGIT
|
||
MOVEM E,DNUM(TP)
|
||
TRNE FF,FLONUM ; IS THIS FRACTION?
|
||
SOS NDIGS(TP) ; YES, DECREASE EXPONENT BY ONE
|
||
JRST ATLP1
|
||
|
||
NUMCH8: TRNE FF,DOTSEN ; OVERFLOW IN DECMIMAL
|
||
JRST ATLP1 ; OK, IN FRACTION
|
||
|
||
AOS NDIGS(TP)
|
||
TRO FF,FLONUM ; MAKE IT FLOATING TO FIT
|
||
JRST ATLP1
|
||
|
||
NUMCH4: TRNE FF,OCTWIN
|
||
JRST NUMCH3 ; ALREADY ONE, MORE DIGITS LOSE
|
||
MOVE E,ONUM(TP)
|
||
TLNE E,700000 ; SKIP IF WORD NOT FULL
|
||
TRO FF,OVFLEW
|
||
LSH E,3
|
||
ADDI E,(B) ; ADD IN NEW ONE
|
||
MOVEM E,ONUM(TP)
|
||
JRST ATLP1
|
||
|
||
NUMCH3: SUB TP,[NUMTMP,,NUMTMP] ; FLUSH NUMBER CRUFT
|
||
TRO FF,NOTNUM
|
||
JRST ATLP2
|
||
|
||
NUMCH2: CAIN B,ASTCOD ; POSSIBLE END OF OCTAL
|
||
TRZN FF,OCTSTR ; RESET FLAG AND WIN
|
||
JRST NUMCH9
|
||
|
||
TRO FF,OCTWIN
|
||
JRST ATLP2
|
||
|
||
NUMCH9: CAIN B,ETYPE
|
||
TROE FF,EFLG
|
||
JRST NUMC10 ; STILL COULD BE +- EXPONENT
|
||
|
||
TRZ FF,NUMWIN ; IN CASE NO MORE DIGITS
|
||
SETZM ENUM(TP)
|
||
JRST ATLP1
|
||
|
||
NUMCH7: MOVE E,ENUM(TP)
|
||
IMULI E,10.
|
||
ADDI E,(B)
|
||
MOVEM E,ENUM(TP) ; UPDATE ECPONENT
|
||
TRO FF,EPOS ; FLUSH IF SIGN COMES NOW
|
||
JRST ATLP1
|
||
|
||
NUMC10: TRNN FF,EFLG ; IF NOT IN EXPONENT, LOSE
|
||
TRNE FF,ENEG+EPOS ; SIGN FOR EXPONENT SEEN?
|
||
JRST NUMCH3 ; NOT A NUMBER
|
||
CAIN B,PLUCOD
|
||
TRO FF,EPOS
|
||
CAIN B,NEGCOD
|
||
TRO FF,ENEG
|
||
TRNE FF,EPOS+ENEG
|
||
JRST ATLP1
|
||
JRST NUMCH3
|
||
|
||
; HERE AFTER \ QUOTER
|
||
|
||
DOESC1: PUSHJ P,NXTC1 ; GET CHAR
|
||
JRST ATLP1 ; FALL BACK INTO LOOP
|
||
|
||
|
||
; HERE TO CONVERT NUMBERS AS NEEDED
|
||
|
||
NUMCNV: CAIE B,ESCTYP
|
||
TRNE FF,OCTSTR
|
||
JRST NUMCH3
|
||
TRNN FF,NUMWIN
|
||
JRST NUMCH3
|
||
ADDI D,4
|
||
IDIVI D,5
|
||
SKIPGE C ; SKIP IF NEW WORD ADDED
|
||
ADDI D,1
|
||
HRLI D,(D) ; TOO BOTH HALVES
|
||
SUB P,D ; REMOVE CHAR STRING
|
||
MOVE D,3(TB) ; IS RADIX 10?
|
||
CAIE D,10.
|
||
TRNE FF,DECFRC
|
||
TRNN FF,FLONUM+EFLG ;IS IT A FLOATING POINT NUMBER
|
||
TRNE FF,EFLG
|
||
JRST FLOATIT ;YES, GO MAKE IT WIN
|
||
TRNE FF,OVFLEW
|
||
JRST FOOR
|
||
MOVE B,CNUM(TP)
|
||
TRNE FF,DECFRC
|
||
MOVE B,DNUM(TP) ;GRAB FIXED GOODIE
|
||
TRNE FF,OCTWIN ; SKIP IF NOT OCTAL
|
||
MOVE B,ONUM(TP) ; USE OCTAL VALUE
|
||
FINID2: MOVSI A,TFIX ;SAY FIXED POINT
|
||
FINID1: TRNE FF,NEGF ;NEGATE
|
||
MOVNS B ;YES
|
||
SUB TP,[NUMTMP,,NUMTMP] ;FINISH HACK
|
||
JRST RET ;AND RETURN
|
||
|
||
|
||
FLOATIT:
|
||
JFCL 17,.+1 ;CLEAR ALL ARITHMETIC FLAGS
|
||
TRNE FF,EFLG ;"E" SEEN?
|
||
JRST EXPDO ;YES, DO EXPONENT
|
||
MOVE D,NDIGS(TP) ;GET IMPLICIT EXPONENT
|
||
|
||
FLOATE: MOVE A,DNUM(TP) ;GET DECIMAL NUMBER
|
||
IDIVI A,400000 ;SPLIT
|
||
FSC A,254 ;CONVERT MOST SIGNIFICANT
|
||
FSC B,233 ; AND LEAST SIGNIFICANT
|
||
FADR B,A ;COMBINE
|
||
|
||
MOVM A,D ;GET MAGNITUDE OF EXPONENT
|
||
MOVSI E,(1.0)
|
||
JFCL 17,.+1 ; CLEAR ALL OVERFLOW/UNDERFLOW BITS
|
||
CAIG A,38. ;HOW BIG?
|
||
JRST .+3 ;TOO BIG-FLOATING OUT OF RANGE
|
||
MOVE E,[1.0^38.]
|
||
SUBI A,38.
|
||
JUMPGE D,FLOAT1 ;JUMP IF EXPONENT POSITIVE
|
||
FDVR B,E
|
||
FDVR B,TENTAB(A) ;DIVIDE BY TEN TO THE EXPONENT
|
||
JRST SETFLO
|
||
|
||
FLOAT1: FMPR B,E
|
||
FMPR B,TENTAB(A) ;SCALE UP
|
||
|
||
SETFLO: JFCL 17,FOOR ;FLOATING OUT OF RANGE ON OVERFLOW
|
||
MOVSI A,TFLOAT
|
||
TRZ FF,FRSDOT ;FLOATING NUMBER NOT VALUE
|
||
JRST FINID1
|
||
|
||
EXPDO:
|
||
HRRZ D,ENUM(TP) ;GET EXPONENT
|
||
TRNE FF,ENEG ;IS EXPONENT NEGATIVE?
|
||
MOVNS D ;YES
|
||
ADD D,NDIGS(TP) ;ADD IMPLICIT EXPONENT
|
||
JUMPL D,FLOATE ;FLOATING IF EXPONENT NEGATIVE
|
||
CAIG D,10. ;OR IF EXPONENT TOO LARGE
|
||
TRNE FF,FLONUM ;OR IF FLAG SET
|
||
JRST FLOATE
|
||
MOVE B,DNUM(TP) ;
|
||
IMUL B,ITENTB(D)
|
||
JFCL 10,FLOATE ;IF OVERFLOW, MAKE FLOATING
|
||
JRST FINID2 ;GO MAKE FIXED NUMBER
|
||
|
||
|
||
; HERE TO START BUILDING A CHARACTER STRING GOODIE
|
||
|
||
CSTRING:
|
||
PUSH P,C%0
|
||
MOVEI D,0 ; CHARCOUNT
|
||
MOVSI C,440700+P ; AND BYTE POINTER
|
||
|
||
CSLP: PUSH P,FF
|
||
INTGO
|
||
PUSHJ P,NXTC1 ; GET NEXT CHAR
|
||
POP P,FF
|
||
|
||
CAIN B,CSTYP ; END OF STRING?
|
||
JRST CSLPEND
|
||
|
||
CAIN B,ESCTYP ; ESCAPE?
|
||
PUSHJ P,NXTC1
|
||
|
||
IDPB A,C ; INTO ATOM
|
||
TLNE C,760000 ; SKIP IF OK WORD
|
||
AOJA D,CSLP
|
||
|
||
PUSH P,C%0
|
||
MOVSI C,440700+P
|
||
AOJA D,CSLP
|
||
|
||
CSLPEND:
|
||
SKIPGE C
|
||
SUB P,C%11
|
||
PUSH P,D
|
||
PUSHJ P,CHMAK
|
||
PUSHJ P,LSTCHR
|
||
|
||
JRST RET
|
||
|
||
;ARRIVE HERE TO INVOKE A READ TIME MACRO FUNCTION
|
||
|
||
MACCAL: PUSHJ P,NXTCH1 ;READ ONE MORE CHARACTER
|
||
CAIE B,MACTYP ;IS IT ANOTHER MACRO CHAR
|
||
|
||
JRST MACAL2 ;NO, CALL MACRO AND USE VALUE
|
||
PUSHJ P,LSTCHR ;DONT REREAD %
|
||
PUSHJ P,MACAL1 ;OTHERWISE, USE SIDE EFFECCT, BUT NOT VALUE
|
||
JRST IREAD2
|
||
|
||
MACAL2: PUSH P,CRET
|
||
MACAL1: PUSHJ P,IREAD1 ;READ FUNCTION NAME
|
||
PUSHJ P,RETERR
|
||
PUSH TP,C
|
||
PUSH TP,D ; SAVE COMMENT IF ANY
|
||
PUSH TP,A ;SAVE THE RESULT
|
||
PUSH TP,B ;AND USE IT AS AN ARGUMENT
|
||
MCALL 1,EVAL
|
||
POP TP,D
|
||
POP TP,C ; RESTORE COMMENT IF ANY...
|
||
CRET: POPJ P,RET12
|
||
|
||
;CALL GOBBLE TO FIND THE TYPE AND THEN IREAD TO READ IT
|
||
|
||
SPECTY: PUSHJ P,NIREAD ; READ THE TYPES NAME (SHOULD BE AN ATOM)
|
||
PUSHJ P,RETERR
|
||
PUSH TP,A
|
||
PUSH TP,B
|
||
GETYP A,A
|
||
CAIN A,TFIX
|
||
JRST BYTIN
|
||
PUSHJ P,NXTCH ; GET NEXT CHAR
|
||
CAIN B,TMPTYP ; SKIP IF NOT TEMPLATE START
|
||
JRST RDTMPL
|
||
SETZB A,B
|
||
EXCH A,-1(TP)
|
||
EXCH B,(TP)
|
||
PUSH TP,A ;BEGIN SETTING UP CHTYPE CALL
|
||
PUSH TP,B
|
||
PUSHJ P,IREAD1 ;NOW READ STRUCTURE
|
||
PUSHJ P,RETERR
|
||
MOVEM C,-3(TP) ; SAVE COMMENT
|
||
MOVEM D,-2(TP)
|
||
EXCH A,-1(TP) ;USE AS FIRST ARG
|
||
EXCH B,(TP)
|
||
PUSH TP,A ;USE OTHER AS 2D ARG
|
||
PUSH TP,B
|
||
MCALL 2,CHTYPE ;ATTEMPT TO MUNG
|
||
RET13: POP TP,D
|
||
POP TP,C ; RESTORE COMMENT
|
||
RET12: SETOM (P) ; DONT LOOOK FOR MORE!
|
||
JRST RET
|
||
|
||
RDTMPL: PUSH P,["}] ; SET UP TERMINATE TEST
|
||
MOVE B,(TP)
|
||
PUSHJ P,IGVAL
|
||
MOVEM A,-1(TP)
|
||
MOVEM B,(TP)
|
||
PUSH P,[BLDTMP] ; FLAG FOR VECTOR READING CODE
|
||
JRST LBRAK2
|
||
|
||
BLDTMP: ADDI A,1 ; 1 MORE ARGUMENT
|
||
ACALL A,APPLY ; DO IT TO IT
|
||
POPJ P,
|
||
|
||
BYTIN: PUSHJ P,NXTCH ; CHECK FOR OPENR
|
||
CAIN B,SPATYP
|
||
PUSHJ P,SPACEQ
|
||
JRST .+3
|
||
PUSHJ P,LSTCHR
|
||
JRST BYTIN
|
||
CAIE B,TMPTYP
|
||
ERRUUO EQUOTE BAD-USE-OF-BYTE-STRING
|
||
PUSH P,["}]
|
||
PUSH P,[CBYTE1]
|
||
JRST LBRAK2
|
||
|
||
CBYTE1: AOJA A,CBYTES
|
||
|
||
RETERR: SKIPL A,5(TB)
|
||
MOVEI A,5(TB)-LSTCH ;NO CHANNEL, USE SLOT
|
||
HRRM B,LSTCH(A) ; RESTORE LAST CHAR
|
||
PUSHJ P,ERRPAR
|
||
SOS (P)
|
||
SOS (P)
|
||
POPJ P,
|
||
|
||
|
||
;THIS CODE CALLS IREAD RECURSIVELY TO READ THAT WHICH IS
|
||
;BETWEEN (), ARRIVED AT WHEN ( IS READ
|
||
|
||
SEGIN: PUSH TP,$TSEG
|
||
JRST OPNAN1
|
||
|
||
OPNANG: PUSH TP,$TFORM ;SAVE TYPE
|
||
OPNAN1: PUSH P,[">]
|
||
JRST LPARN1
|
||
|
||
LPAREN: PUSH P,[")]
|
||
PUSH TP,$TLIST ;START BY ASSUMING NIL
|
||
LPARN1: PUSH TP,C%0
|
||
PUSHJ P,LSTCHR ;DON'T REREAD PARENS
|
||
LLPLOP: PUSHJ P,IREAD1 ;READ IT
|
||
JRST LDONE ;HIT TERMINATOR
|
||
|
||
;HERE WHEN MUST ADD CAR TO CURRENT WINNER
|
||
|
||
GENCAR: PUSH TP,C ; SAVE COMMENT
|
||
PUSH TP,D
|
||
MOVE C,A ; SET UP CALL
|
||
MOVE D,B
|
||
PUSHJ P,INCONS ; CONS ON TO NIL
|
||
POP TP,D
|
||
POP TP,C
|
||
POP TP,E ;GET CDR
|
||
JUMPN E,CDRIN ;IF STACKED GOODIE NOT NIL SKIP
|
||
PUSH TP,B ;AND USE AS TOTAL VALUE
|
||
PUSH TP,$TLIST ;SAVE THIS AS FIRSST THING ON LIST
|
||
MOVE A,-2(TP) ; GET REAL TYPE
|
||
JRST .+2 ;SKIP CDR SETTING
|
||
CDRIN: HRRM B,(E)
|
||
PUSH TP,B ;CLOBBER IN NEW PARTIAL GOODIE
|
||
JUMPE C,LLPLOP ; JUMP IF NO COMMENT
|
||
PUSH TP,C
|
||
PUSH TP,D
|
||
MOVSI C,TATOM
|
||
MOVE D,IMQUOTE COMMENT
|
||
PUSHJ P,IPUT
|
||
JRST LLPLOP ;AND CONTINUE
|
||
|
||
; HERE TO RAP UP LIST
|
||
|
||
LDONE: CAME B,(P) ;CHECK VALIDITY OF CHARACTER
|
||
PUSHJ P,MISMAT ;REPORT MISMATCH
|
||
SUB P, C%11
|
||
POP TP,B ;GET VALUE OF PARTIAL RESULT
|
||
POP TP,A ;AND TYPE OF SAME
|
||
JUMPE B,RET ;VALUE IS NIL, DON'T POP AGAIN
|
||
POP TP,B ;POP FIRST LIST ELEMENT
|
||
POP TP,A ;AND TYPE
|
||
JRST RET
|
||
|
||
;THIS CODE IS SIMILAR TO LIST GENERATING CODE BUT IS FOR VECTORS
|
||
OPNBRA: PUSH P,["}] ; SAVE TERMINATOR
|
||
UVECIN: PUSH P,[135] ; CLOSE SQUARE BRACKET
|
||
PUSH P,[SETZ IEUVECTOR] ;PUSH NAME OF U VECT HACKER
|
||
JRST LBRAK2 ;AND GO
|
||
|
||
LBRACK: PUSH P,[135] ; SAVE TERMINATE
|
||
PUSH P,[SETZ IEVECTOR] ;PUSH GEN VECTOR HACKER
|
||
LBRAK2: PUSHJ P,LSTCHR ;FORCE READING NEW CHAR
|
||
PUSH P,C%0 ; COUNT ELEMENTS
|
||
PUSH TP,$TLIST ; AND SLOT FOR GOODIES
|
||
PUSH TP,C%0
|
||
|
||
LBRAK1: PUSHJ P,IREAD1 ;RECURSIVELY READ ELEMENTS OF ARRAY
|
||
JRST LBDONE ;RAP UP ON TERMINATOR
|
||
|
||
STAKIT: EXCH A,-1(TP) ; STORE RESULT AND GET CURRENT LIST
|
||
EXCH B,(TP)
|
||
AOS (P) ; COUNT ELEMENTS
|
||
JUMPE C,LBRAK3 ; IF NO COMMENT, GO ON
|
||
MOVEI E,(B) ; GET CDR
|
||
PUSHJ P,ICONS ; CONS IT ON
|
||
MOVEI E,(B) ; SAVE RS
|
||
MOVSI C,TFIX ; AND GET FIXED NUM
|
||
MOVE D,(P)
|
||
PUSHJ P,ICONS
|
||
LBRAK3: PUSH TP,A ; SAVE CURRENT COMMENT LIST
|
||
PUSH TP,B
|
||
JRST LBRAK1
|
||
|
||
; HERE TO RAP UP VECTOR
|
||
|
||
LBDONE: CAME B,-2(P) ; FINISHED RETURN (WAS THE RIGHT STOP USED?)
|
||
PUSHJ P,MISMAB ; WARN USER
|
||
POP TP,1(TB) ; REMOVE COMMENT LIST
|
||
POP TP,(TB)
|
||
MOVE A,(P) ; COUNT TO A
|
||
PUSHJ P,-1@(P) ; MAKE THE VECTOR
|
||
SUB P,C%33
|
||
|
||
; PUT COMMENTS ON VECTOR (OR UVECTOR)
|
||
|
||
MOVNI C,1 ; INDICATE TEMPLATE HACK
|
||
CAMN A,$TVEC
|
||
MOVEI C,1
|
||
CAMN A,$TUVEC ; SKIP IF UVECTOR
|
||
MOVEI C,0
|
||
PUSH P,C ; SAVE
|
||
PUSH TP,A ; SAVE VECTOR/UVECTOR
|
||
PUSH TP,B
|
||
|
||
VECCOM: SKIPN C,1(TB) ; ANY LEFT?
|
||
JRST RETVEC ; NO, LEAVE
|
||
MOVE A,1(C) ; ASSUME WINNING TYPES
|
||
SUBI A,1
|
||
HRRZ C,(C) ; CDR THE LIST
|
||
HRRZ E,(C) ; AGAIN
|
||
MOVEM E,1(TB) ; SAVE CDR
|
||
GETYP E,(C) ; CHECK DEFFERED
|
||
MOVSI D,(E)
|
||
CAIN E,TDEFER ; SKIP IF NOT DEFERRED
|
||
MOVE C,1(C)
|
||
CAIN E,TDEFER
|
||
GETYPF D,(C) ; GET REAL TYPE
|
||
MOVE B,(TP) ; GET VECTOR POINTER
|
||
SKIPGE (P) ; SKIP IF NOT TEMPLATE
|
||
JRST TMPCOM
|
||
HRLI A,(A) ; COUNTER
|
||
LSH A,@(P) ; MAYBE SHIFT IT
|
||
ADD B,A
|
||
MOVE A,-1(TP) ; TYPE
|
||
TMPCO1: PUSH TP,D
|
||
PUSH TP,1(C) ; PUSH THE COMMENT
|
||
MOVSI C,TATOM
|
||
MOVE D,IMQUOTE COMMENT
|
||
PUSHJ P,IPUT
|
||
JRST VECCOM
|
||
|
||
TMPCOM: MOVSI A,(A)
|
||
ADD B,A
|
||
MOVSI A,TTMPLT
|
||
JRST TMPCO1
|
||
|
||
RETVEC: SUB P,C%11
|
||
POP TP,B
|
||
POP TP,A
|
||
JRST RET
|
||
|
||
; BUILD A SINGLE CHARACTER ITEM
|
||
|
||
SINCHR: PUSHJ P,NXTC1 ;FORCE READ NEXT
|
||
CAIN B,ESCTYP ;ESCAPE?
|
||
PUSHJ P,NXTC1 ;RETRY
|
||
MOVEI B,(A)
|
||
MOVSI A,TCHRS
|
||
JRST RETCL
|
||
|
||
|
||
; HERE ON RIGHT PAREN, BRACKET, ANGLE BRACKET OR CTL C
|
||
|
||
CLSBRA:
|
||
CLSANG: ;CLOSE ANGLE BRACKETS
|
||
RBRACK: ;COMMON RETURN FOR END OF ARRAY ALSO
|
||
RPAREN: PUSHJ P,LSTCHR ;DON'T REREAD
|
||
EOFCH1: MOVE B,A ;GETCHAR IN B
|
||
MOVSI A,TCHRS ;AND TYPE IN A
|
||
RET1: SUB P,C%11
|
||
POPJ P,
|
||
|
||
EOFCHR: SETZB C,D
|
||
JUMPL A,EOFCH1 ; JUMP ON REAL EOF
|
||
JRST RRSUBR ; MAYBE A BINARY RSUBR
|
||
|
||
DOEOF: MOVE A,[-1,,3]
|
||
SETZB C,D
|
||
JRST EOFCH1
|
||
|
||
|
||
; NORMAL RETURN FROM IREAD/IREAD1
|
||
|
||
RETCL: PUSHJ P,LSTCHR ;DONT REREAD
|
||
RET: AOS -1(P) ;SKIP
|
||
POP P,E ; POP FLAG
|
||
RETC: JUMPL E,RET2 ; DONT LOOK FOR COMMENTS
|
||
PUSH TP,A ; SAVE ITEM
|
||
PUSH TP,B
|
||
CHCOMN: PUSHJ P,NXTCH ; READ A CHARACTER
|
||
CAIE B,COMTYP ; SKIP IF COMMENT
|
||
JRST CHSPA
|
||
PUSHJ P,IREAD ; READ THE COMMENT
|
||
JRST POPAJ
|
||
MOVE C,A
|
||
MOVE D,B
|
||
JRST .+2
|
||
POPAJ: SETZB C,D
|
||
POP TP,B
|
||
POP TP,A
|
||
RET2: POPJ P,
|
||
|
||
CHSPA: CAIN B,SPATYP
|
||
PUSHJ P,SPACEQ ; IS IT A REAL SPACE
|
||
JRST POPAJ
|
||
PUSHJ P,LSTCHR ; FLUSH THE SPACE
|
||
JRST CHCOMN
|
||
|
||
;RANDOM MINI-SUBROUTINES USED BY THE READER
|
||
|
||
;READ A CHAR INTO A AND TYPE CODE INTO D
|
||
|
||
NXTC3: SKIPL B,5(TB) ;GET CHANNEL
|
||
JRST NXTPR4 ;NO CHANNEL, GO READ STRING
|
||
SKIPE LSTCH(B)
|
||
PUSHJ P,CNTACC ; COUNT ON ACCESS POINTER
|
||
PUSHJ P,RXCT
|
||
TRO A,200
|
||
JRST GETCTP
|
||
|
||
NXTC1: SKIPL B,5(TB) ;GET CHANNEL
|
||
JRST NXTPR1 ;NO CHANNEL, GO READ STRING
|
||
SKIPE LSTCH(B)
|
||
PUSHJ P,CNTACC ; COUNT ON ACCESS POINTER
|
||
JRST NXTC2
|
||
NXTC: SKIPL B,5(TB) ;GET CHANNEL
|
||
JRST NXTPRS ;NO CHANNEL, GO READ STRING
|
||
SKIPE A,LSTCH(B) ;CHAR IN A IF REUSE
|
||
JRST PRSRET
|
||
NXTC2: PUSHJ P,RXCT ;GET CHAR FROM INPUT
|
||
TLO A,200000 ; BIT TO AVOID ^@ LOSSAGE
|
||
HLLZS 2(TB) ;FLAG INDICATING ONE CHAR LOOK AHEAD
|
||
MOVEM A,LSTCH(B) ;SAVE THE CHARACTER
|
||
PRSRET: TLZ A,200000
|
||
TRZE A,400000 ;DONT SKIP IF SPECIAL
|
||
TRO A,200 ;GO HACK SPECIALLY
|
||
GETCTP: PUSH P,A ;AND SAVE FROM DIVISION
|
||
ANDI A,377
|
||
IDIVI A,CHRWD ;YIELDS WORD AND CHAR NUMBER
|
||
LDB B,BYTPNT(B) ;GOBBLE TYPE CODE
|
||
POP P,A
|
||
ANDI A,177 ; RETURN REAL ASCII
|
||
POPJ P,
|
||
|
||
NXTPR4: MOVEI F,400000
|
||
JRST NXTPR5
|
||
|
||
NXTPRS: SKIPE A,5(TB) ;GET OLD CHARACTER IF ONE EXISTS
|
||
JRST PRSRET
|
||
NXTPR1: MOVEI F,0
|
||
NXTPR5: MOVE A,11.(TB)
|
||
HRRZ B,(A) ;GET THE STRING
|
||
SOJL B,NXTPR3
|
||
HRRM B,(A)
|
||
ILDB A,1(A) ;GET THE CHARACTER FROM THE STRING
|
||
IORI A,(F)
|
||
NXTPR2: MOVEM A,5(TB) ;SAVE IT
|
||
JRST PRSRET ;CONTINUE
|
||
|
||
NXTPR3: SETZM 8.(TB)
|
||
SETZM 9.(TB) ;CLEAR OUT LOCATIVE, AT END OF STRING
|
||
MOVEI A,400033
|
||
JRST NXTPR2
|
||
|
||
; NXTCH AND NXTCH1 ARE SAME AS NXTC AND NXTC1 EXCEPT THEY CHECK !
|
||
; HACKS
|
||
|
||
NXTCH1: PUSHJ P,NXTC1 ;READ CHAR
|
||
JRST .+2
|
||
NXTCH: PUSHJ P,NXTC ;READ CHAR
|
||
PUSHJ P,CHKUS1 ; CHECK FOR USER DISPATCH
|
||
|
||
CAIE B,NTYPES+1 ; SKIP IF ! ING NEXT CHAR
|
||
POPJ P,
|
||
PUSHJ P,NXTC3 ;READ NEXT ONE
|
||
HLLOS 2(TB) ;FLAG FOR TWO CHAR LOOK AHEAD
|
||
|
||
CRMLST: IORI A,400000 ;CLOBBER LASTCHR
|
||
PUSH P,B
|
||
SKIPL B,5(TB) ;POINT TO CHANNEL
|
||
MOVEI B,5(TB)-LSTCH ;NO CHANNEL, POINT AT SLOT
|
||
HRRM A,LSTCH(B)
|
||
ANDI A,377777 ;DECREASE CHAR
|
||
POP P,B
|
||
|
||
CHKUS2: SKIPN 7(TB) ; SKIP IF USER TABLE
|
||
POPJ P,
|
||
MOVEI F,200(A)
|
||
ASH F,1 ; POINT TO SLOT
|
||
HRLI F,(F)
|
||
ADD F,7(TB)
|
||
JUMPGE F,CPOPJ ;IS THERE VECTOR ENOUGH?
|
||
SKIPN 1(F) ; NON-ZERO==>USER FCN EXISTS
|
||
JRST CPOPJ ; HOPE HE APPRECIATES THIS
|
||
MOVEI B,USTYP2
|
||
CHKRDO: PUSH P,0 ; CHECK FOR REDOING IF CHAR IN TABLE
|
||
GETYP 0,(F)
|
||
CAIE 0,TCHRS
|
||
JRST CHKUS5
|
||
POP P,0 ;WE ARE TRANSMOGRIFYING
|
||
MOVE A,1(F) ;GET NEW CHARACTER
|
||
PUSH P,7(TB)
|
||
PUSH P,2(TB) ; FLAGS FOR NUM OF CHRS IN LOOK AHEAD
|
||
PUSH P,5(TB) ; TO AVOID SMASHING LSTCHR
|
||
SETZM 5(TB) ; CLEAR OUT CHANNEL
|
||
SETZM 7(TB) ;CLEAR OUT TABLE
|
||
TRZE A,200 ; ! HACK
|
||
TRO A,400000 ; TURN ON PROPER BIT
|
||
PUSHJ P,PRSRET
|
||
POP P,5(TB) ; GET BACK CHANNEL
|
||
POP P,2(TB)
|
||
POP P,7(TB) ;GET BACK OLD PARSE TABLE
|
||
POPJ P,
|
||
|
||
CHKUS5: PUSH P,A
|
||
CAIE 0,TLIST
|
||
JRST .+4 ; SPECIAL NON-BREAK TYPE HACK
|
||
MOVNS (P) ; INDICATE BY NEGATIVE
|
||
MOVE A,1(F) ; GET <1 LIST>
|
||
GETYP 0,(A) ; AND GET THE TYPE OF THAT
|
||
CAIE 0,TFIX ; SEE IF HE WANTS SAME CHAR WITH DIFF TYPE
|
||
JRST CHKUS6 ; JUST A VANILLA HACK
|
||
MOVE A,1(F) ; PRETEND IT IS SAME TYPE AS NEW CHAR
|
||
PUSH P,7(TB) ; CLEAR OUT TRANSLATE TABLE
|
||
PUSH P,2(TB) ; FLAGS FOR # OF CHRS IN LOOK AHEAD
|
||
SETZM 7(TB)
|
||
TRZE A,200
|
||
TRO A,400000 ; TURN ON PROPER BIT IF ! HACK
|
||
PUSHJ P,PRSRET ; REGET TYPE
|
||
POP P,2(TB)
|
||
POP P,7(TB) ; PUT TRANSLATE TABLE BACK
|
||
CHKUS6: SKIPGE -1(P) ; SEE IF A SPECIAL NON-BREAK
|
||
MOVNS B ; SEXY, HUH?
|
||
POP P,A
|
||
POP P,0
|
||
MOVMS A ; FIX UP A POSITIVE CHARACTER
|
||
POPJ P,
|
||
|
||
CHKUS4: POP P,A
|
||
POPJ P,
|
||
|
||
CHKUS1: SKIPN 7(TB) ; USER CHECK FOR NOT ! CASE
|
||
POPJ P,
|
||
MOVEI F,(A)
|
||
ASH F,1
|
||
HRLI F,(F)
|
||
ADD F,7(TB)
|
||
JUMPGE F,CPOPJ
|
||
SKIPN 1(F)
|
||
POPJ P,
|
||
MOVEI B,USTYP1
|
||
JRST CHKRDO ; TRANSMOGRIFY CHARACTER?
|
||
|
||
CHKUS3: POP P,A
|
||
POPJ P,
|
||
|
||
UPLO: POPJ P, ; LETS NOT AND SAY WE USED TO
|
||
; AVOID STRANGE ! BLECHAGE
|
||
NXTCS: PUSHJ P,NXTC
|
||
PUSH P,A ; HACK TO NOT TRANSLATE CHAR
|
||
PUSHJ P,CHKUS1 ; BUT DO TRANSLATION OF TYPE IF HE WANTS
|
||
POP P,A ; USED TO BUILD UP STRINGS
|
||
POPJ P,
|
||
|
||
CHKALT: CAIN A,33 ;ALT?
|
||
MOVEI B,MANYT
|
||
JRST CRMLST
|
||
|
||
|
||
TERM: MOVEI B,0 ;RETURN A 0
|
||
JRST RET1
|
||
;AND RETURN
|
||
|
||
CHKMIN: CAIN A,"- ; IF CHAR IS -, WINNER
|
||
MOVEI B,PATHTY
|
||
JRST CRMLST
|
||
|
||
LOSPAT: PUSHJ P,LSTCHR ; FIX RECURSIVE LOSAGE
|
||
ERRUUO EQUOTE UNATTACHED-PATH-NAME-SEPARATOR
|
||
|
||
|
||
; HERE TO SEE IF READING RSUBR
|
||
|
||
RRSUBR: PUSHJ P,LSTCHR ; FLUSH JUST READ CHAR
|
||
SKIPL B,5(TB) ; SKIP IF A CHANNEL EXISTS
|
||
JRST SPACE ; ELSE LIKE A SPACE
|
||
HRRZ C,BUFSTR(B) ; SEE IF FLAG SAYS START OF RSUBR
|
||
MOVE C,(C)
|
||
TRNN C,1 ; SKIP IF REAL RSUBR
|
||
JRST EOFCH2 ; NO, IGNORE FOR NOW
|
||
|
||
; REALLY ARE READING AN RSUBR
|
||
|
||
HRRZ 0,4(TB) ; GET READ/READB INDICATOR
|
||
MOVE C,ACCESS(B) ; GET CURRENT ACCESS
|
||
JUMPN 0,.+3 ; ALREADY WORDS, NO NEED TO DIVIDE
|
||
ADDI C,4 ; ROUND UP
|
||
IDIVI C,5
|
||
PUSH P,C ; SAVE WORD ACCESS
|
||
MOVEI A,(C) ; COPY IT FOR CALL
|
||
JUMPN 0,.+3
|
||
IMULI C,5
|
||
MOVEM C,ACCESS(B) ; FIXUP ACCESS
|
||
HLLZS ACCESS-1(B) ; FOR READB LOSER
|
||
PUSHJ P,DOACCS ; AND GO THERE
|
||
PUSH P,C%0 ; FOR READ IN
|
||
HRROI A,(P) ; PREPARE TO READ LENGTH
|
||
PUSHJ P,DOIOTI ; READ IT
|
||
POP P,C ; GET READ GOODIE
|
||
JUMPGE A,.+4 ; JUMP IF WON
|
||
SUB P,C%11
|
||
EOFCH2: HRROI A,3
|
||
JRST EOFCH1
|
||
MOVEI A,(C) ; COPY FOR GETTING BLOCK
|
||
ADDI C,1 ; COUNT COUNT WORD
|
||
ADDM C,(P)
|
||
PUSH TP,$TUVEC ; WILL HOLD UVECTOR OF FIXUPS IF THEY STAY
|
||
PUSH TP,C%0
|
||
PUSHJ P,IBLOCK ; GET A BLOCK
|
||
PUSH TP,$TUVEC
|
||
PUSH TP,B ; AND SAVE
|
||
MOVE A,B ; READY TO IOT IT IN
|
||
MOVE B,5(TB) ; GET CHANNEL BACK
|
||
MOVSI 0,TUVEC ; SETUP A'S TYPE
|
||
MOVE PVP,PVSTOR+1
|
||
MOVEM 0,ASTO(PVP)
|
||
PUSHJ P,DOIOTI ; IN COMES THE WHOLE BLOCK
|
||
MOVE PVP,PVSTOR+1
|
||
SETZM ASTO(PVP) ; A NO LONGER SPECIAL
|
||
MOVEI C,BUFSTR-1(B) ; NO RESET BUFFER
|
||
PUSHJ P,BYTDOP ; A POINTS TO DOPW WORD
|
||
SUBI A,2
|
||
HRLI A,010700 ; SETUP BYTE POINTER TO END
|
||
HLLZS BUFSTR-1(B) ; ZERO CHAR COUNNT
|
||
MOVEM A,BUFSTR(B)
|
||
HRRZ A,4(TB) ; READ/READB FLG
|
||
MOVE C,(P) ; ACCESS IN WORDS
|
||
SKIPN A ; SKIP FOR ASCII
|
||
IMULI C,5 ; BUMP
|
||
MOVEM C,ACCESS(B) ; UPDATE ACCESS
|
||
PUSHJ P,NIREAD ; READ RSUBR VECTOR
|
||
JRST BRSUBR ; LOSER
|
||
GETYP A,A ; VERIFY A LITTLE
|
||
CAIE A,TVEC ; DONT SKIP IF BAD
|
||
JRST BRSUBR ; NOT A GOOD FILE
|
||
PUSHJ P,LSTCHR ; FLUSH REREAD CHAR
|
||
MOVE C,(TP) ; CODE VECTOR BACK
|
||
MOVSI A,TCODE
|
||
HLR A,B ; FUNNY COUNT
|
||
MOVEM A,(B) ; CLOBBER
|
||
MOVEM C,1(B)
|
||
PUSH TP,$TRSUBR ; MAKE RSUBR
|
||
PUSH TP,B
|
||
|
||
; NOW LOOK OVER FIXUPS
|
||
|
||
MOVE B,5(TB) ; GET CHANNEL
|
||
MOVE C,ACCESS(B)
|
||
HLLZS ACCESS-1(B) ; FOR READB LOSER
|
||
HRRZ 0,4(TB) ; READ/READB FLG
|
||
JUMPN 0,RSUB1
|
||
ADDI C,4 ; ROUND UP
|
||
IDIVI C,5 ; TO WORDS
|
||
MOVEI D,(C) ; FIXUP ACCESS
|
||
IMULI D,5
|
||
MOVEM D,ACCESS(B) ; AND STORE
|
||
RSUB1: ADDI C,1 ; ACCOUNT FOR EXTRA COUNTERS
|
||
MOVEM C,(P) ; SAVE FOR LATER
|
||
MOVEI A,-1(C) ; FOR DOACS
|
||
MOVEI C,2 ; UPDATE REAL ACCESS
|
||
SKIPN 0 ; SKIP FOR READB CASE
|
||
MOVEI C,10.
|
||
ADDM C,ACCESS(B)
|
||
PUSHJ P,DOACCS ; DO THE ACCESS
|
||
PUSH TP,$TUVEC ; SLOT FOR FIXUP BUFFER
|
||
PUSH TP,C%0
|
||
|
||
; FOUND OUT IF FIXUPS STAY
|
||
|
||
MOVE B,IMQUOTE KEEP-FIXUPS
|
||
PUSHJ P,ILVAL ; GET VALUE
|
||
GETYP 0,A
|
||
MOVE B,5(TB) ; CHANNEL BACK TO B
|
||
CAIE 0,TUNBOU
|
||
CAIN 0,TFALSE
|
||
JRST RSUB4 ; NO, NOT KEEPING FIXUPS
|
||
PUSH P,C%0 ; SLOT TO READ INTO
|
||
HRROI A,(P) ; GET LENGTH OF SAME
|
||
PUSHJ P,DOIOTI
|
||
POP P,C
|
||
MOVEI A,(C) ; GET UVECTOR FOR KEEPING
|
||
ADDM C,(P) ; ACCESS TO END
|
||
PUSH P,C ; SAVE LENGTH OF FIXUPS
|
||
PUSHJ P,IBLOCK
|
||
MOVEM B,-6(TP) ; AND SAVE
|
||
MOVE A,B ; FOR IOTING THEM IN
|
||
ADD B,C%11 ; POINT PAST VERS #
|
||
MOVEM B,(TP)
|
||
MOVSI C,TUVEC
|
||
MOVE PVP,PVSTOR+1
|
||
MOVEM C,ASTO(PVP)
|
||
MOVE B,5(TB) ; AND CHANNEL
|
||
PUSHJ P,DOIOTI ; GET THEM
|
||
MOVE PVP,PVSTOR+1
|
||
SETZM ASTO(PVP)
|
||
MOVE A,(TP) ; GET VERS
|
||
PUSH P,-1(A) ; AND PUSH IT
|
||
JRST RSUB5
|
||
|
||
RSUB4: PUSH P,C%0
|
||
PUSH P,C%0 ; 2 SLOTS FOR READING
|
||
MOVEI A,-1(P)
|
||
HRLI A,-2
|
||
PUSHJ P,DOIOTI
|
||
MOVE C,-1(P)
|
||
MOVE D,(P)
|
||
ADDM C,-2(P) ; NOW -2(P) IS ACCESS TO END OF FIXUPS
|
||
RSUB5: MOVEI C,BUFSTR-1(B) ; FIXUP BUFFER
|
||
PUSHJ P,BYTDOP
|
||
SUBI A,2 ; POINT BEFORE D.W.
|
||
HRLI A,10700
|
||
MOVEM A,BUFSTR(B)
|
||
HLLZS BUFSTR-1(B)
|
||
SKIPE -6(TP)
|
||
JRST RSUB2A
|
||
SUBI A,BUFLNT-1 ; ALSO MAKE AN IOT FLAVOR BUFFER
|
||
HRLI A,-BUFLNT
|
||
MOVEM A,(TP)
|
||
MOVSI C,TUVEC
|
||
MOVE PVP,PVSTOR+1
|
||
MOVEM C,ASTO(PVP)
|
||
PUSHJ P,DOIOTI
|
||
MOVE PVP,PVSTOR+1
|
||
SETZM ASTO(PVP)
|
||
RSUB2A: PUSH P,-1(P) ; ANOTHER COPY OF LENGTH OF FIXUPS
|
||
|
||
; LOOP FIXING UP NEW TYPES
|
||
|
||
RSUB2: PUSHJ P,WRDIN ; SEE WHAT NEXT THING IS
|
||
JRST RSUB3 ; NO MORE, DONE
|
||
JUMPL E,STSQ ; MUST BE FIRST SQUOZE
|
||
MOVNI 0,(E) ; TO UPDATE AMNT OF FIXUPS
|
||
ADDB 0,(P)
|
||
HRLI E,(E) ; IS LENGTH OF STRING IN WORDS
|
||
ADD E,(TP) ; FIXUP BUFFER POINTER
|
||
JUMPL E,.+3
|
||
SUB E,[BUFLNT,,BUFLNT]
|
||
JUMPGE E,.-1 ; STILL NOT RIGHT
|
||
EXCH E,(TP) ; FIX UP SLOT
|
||
HLRE C,E ; FIX BYTE POINTER ALSO
|
||
IMUL C,[-5] ; + CHARS LEFT
|
||
MOVE B,5(TB) ; CHANNEL
|
||
PUSH TP,BUFSTR-1(B)
|
||
PUSH TP,BUFSTR(B)
|
||
HRRM C,BUFSTR-1(B)
|
||
HRLI E,440700 ; AND BYTE POINTER
|
||
MOVEM E,BUFSTR(B)
|
||
PUSHJ P,NIREAD ; READ ATOM NAME OF TYPE
|
||
TDZA 0,0 ; FLAG LOSSAGE
|
||
MOVEI 0,1 ; WINNAGE
|
||
MOVE C,5(TB) ; RESET BUFFER
|
||
POP TP,BUFSTR(C)
|
||
POP TP,BUFSTR-1(C)
|
||
JUMPE 0,BRSUBR ; BAD READ OF RSUBR
|
||
GETYP A,A ; A LITTLE CHECKING
|
||
CAIE A,TATOM
|
||
JRST BRSUBR
|
||
PUSHJ P,LSTCHR ; FLUSH REREAD CHAR
|
||
HRRZ 0,4(TB) ; FIXUP ACCESS PNTR
|
||
MOVE C,5(TB)
|
||
MOVE D,ACCESS(C)
|
||
HLLZS ACCESS-1(C) ; FOR READB HACKER
|
||
ADDI D,4
|
||
IDIVI D,5
|
||
IMULI D,5
|
||
SKIPN 0
|
||
MOVEM D,ACCESS(C) ; RESET
|
||
TYFIXE: PUSHJ P,TYPFND ; SEE IF A LEGAL TYPE NAME
|
||
JRST TYPFIX ; GO SEE USER ABOUT THIS
|
||
PUSHJ P,FIXCOD ; GO FIX UP THE CODE
|
||
JRST RSUB2
|
||
|
||
; NOW FIX UP SUBRS ETC. IF NECESSARY
|
||
|
||
STSQ: MOVE B,IMQUOTE MUDDLE
|
||
PUSHJ P,IGVAL ; GET CURRENT VERS
|
||
CAME B,-1(P) ; SKIP IF NO FIXUPS NEEDED
|
||
JRST DOFIX0 ; MUST DO THEM
|
||
|
||
; ALL DONE, ACCESS PAST FIXUPS AND RETURN
|
||
RSUB31: PUSHJ P,SQUKIL ; DONE FIXING UP, KILL SQUOZE TABLE IF IN INTERP
|
||
RSUB3: MOVE A,-3(P)
|
||
MOVE B,5(TB)
|
||
MOVEI C,(A) ; UPDATE CHANNEL ACCESS IN CASE SKIPPING
|
||
HRRZ 0,4(TB) ; READ/READB FLAG
|
||
SKIPN 0
|
||
IMULI C,5
|
||
MOVEM C,ACCESS(B) ; INTO ACCESS SLOT
|
||
HLLZS ACCESS-1(B)
|
||
PUSHJ P,DOACCS ; ACCESSED
|
||
MOVEI C,BUFSTR-1(B) ; FIX UP BUFFER
|
||
PUSHJ P,BYTDOP
|
||
SUBI A,2
|
||
HRLI A,10700
|
||
MOVEM A,BUFSTR(B)
|
||
HLLZS BUFSTR-1(B)
|
||
SKIPN A,-6(TP) ; SKIP IF KEEPING FIXUPS
|
||
JRST RSUB6
|
||
PUSH TP,$TUVEC
|
||
PUSH TP,A
|
||
MOVSI A,TRSUBR
|
||
MOVE B,-4(TP)
|
||
MOVSI C,TATOM
|
||
MOVE D,IMQUOTE RSUBR
|
||
PUSHJ P,IPUT ; DO THE ASSOCIATION
|
||
|
||
RSUB6: MOVE C,-4(TP) ; DO SPECIAL FIXUPS
|
||
PUSHJ P,SFIX
|
||
MOVE B,-2(TP) ; GET RSUBR
|
||
MOVSI A,TRSUBR
|
||
SUB P,C%44 ; FLUSH P CRUFT
|
||
SUB TP,[10,,10]
|
||
JRST RET
|
||
|
||
; FIXUP SUBRS ETC.
|
||
|
||
DOFIX0: SKIPN C,-6(TP) ; GET BUFFER IF KEEPING
|
||
JRST DOFIXE
|
||
MOVEM B,(C) ; CLOBBER
|
||
JRST DOFIXE
|
||
|
||
FIXUPL: PUSHJ P,WRDIN
|
||
JRST RSUB31
|
||
DOFIXE: JUMPGE E,BRSUBR
|
||
TLZ E,740000 ; KILL BITS
|
||
IFN KILTV,[
|
||
CAME E,[SQUOZE 0,DSTO]
|
||
JRST NOOPV
|
||
MOVE E,[SQUOZE 40,DSTORE]
|
||
MOVE A,(TP)
|
||
SKIPE -6(TP)
|
||
MOVEM E,-1(A)
|
||
MOVEI E,53
|
||
HRLM E,(A)
|
||
MOVEI E,DSTORE
|
||
JRST .+3
|
||
NOOPV:
|
||
]
|
||
PUSHJ P,SQUTOA ; LOOK IT UP
|
||
PUSHJ P,BRSUB1
|
||
MOVEI D,(E) ; FOR FIXCOD
|
||
PUSHJ P,FIXCOD ; FIX 'EM UP
|
||
JRST FIXUPL
|
||
|
||
; BAD SQUOZE, BE MORE SPECIFIC
|
||
|
||
BRSUB1: PUSHJ P,SQSTR
|
||
PUSH TP,$TATOM
|
||
PUSH TP,EQUOTE SQUZE-SYMBOL-NOT-FOUND-ERRET CORRECTION
|
||
PUSH TP,A
|
||
PUSH TP,B
|
||
PUSH TP,$TATOM
|
||
PUSH TP,MQUOTE READ
|
||
MCALL 3,ERROR
|
||
GETYP A,A
|
||
CAIE A,TFIX
|
||
ERRUUO EQUOTE VALUE-MUST-BE-FIX
|
||
MOVE E,B
|
||
POPJ P,
|
||
|
||
; CONVERT SQUOZE TO A MUDDLE STRING FOR USER
|
||
|
||
SQSTR: PUSHJ P,SPTT
|
||
PUSH P,C
|
||
CAIN B,6 ; 6 chars?
|
||
PUSH P,D
|
||
PUSH P,B
|
||
PUSHJ P,CHMAK
|
||
POPJ P,
|
||
|
||
SPTT: SETZB B,C
|
||
MOVE A,[440700,,C]
|
||
MOVEI D,0
|
||
|
||
SPT1: IDIVI E,50
|
||
PUSH P,F
|
||
JUMPE E,SPT3
|
||
PUSHJ P,SPT1
|
||
SPT3: POP P,E
|
||
ADDI E,"0-1
|
||
CAILE E,"9
|
||
ADDI E,"A-"9-1
|
||
CAILE E,"Z
|
||
SUBI E,"Z-"#+1
|
||
CAIN E,"#
|
||
MOVEI E,".
|
||
CAIN E,"/
|
||
SPC: MOVEI E,40
|
||
IDPB E,A
|
||
ADDI B,1
|
||
POPJ P,
|
||
|
||
|
||
;0 1-12 13-44 45 46 47
|
||
;NULL 0-9 A-Z . $ %
|
||
|
||
; ROUTINE TO FIXUP ACTUAL CODE
|
||
|
||
FIXCOD: MOVEI E,0 ; FOR HWRDIN
|
||
PUSH P,D ; NEW VALUE
|
||
PUSHJ P,HWRDIN ; GET HW NEEDED
|
||
MOVE D,(P) ; GET NEW VAL
|
||
MOVE A,(TP) ; AND BUFFER POINTER
|
||
SKIPE -6(TP) ; SAVING?
|
||
HRLM D,-1(A) ; YES, CLOBBER
|
||
SUB C,(P) ; DIFFERENCE
|
||
MOVN D,C
|
||
|
||
FIXLP: PUSHJ P,HWRDIN ; GET AN OFFSET
|
||
JUMPE C,FIXED
|
||
HRRES C ; MAKE NEG IF NEC
|
||
JUMPL C,LHFXUP
|
||
ADD C,-4(TP) ; POINT INTO CODE
|
||
IFN KILTV,[
|
||
LDB 0,[220400,,-1(C)] ; GET INDEX FIELD
|
||
CAIE 0,7
|
||
JRST NOTV
|
||
KIND: MOVEI 0,0
|
||
DPB 0,[220400,,-1(C)]
|
||
JRST DONTV
|
||
NOTV: CAIE 0,6 ; IS IT PVP
|
||
JRST DONTV
|
||
HRRZ 0,-1(C)
|
||
CAIE 0,12 ; OLD DSTO
|
||
JRST DONTV
|
||
MOVEI 0,33.
|
||
ADDM 0,-1(C)
|
||
JRST KIND
|
||
DONTV:
|
||
]
|
||
ADDM D,-1(C)
|
||
JRST FIXLP
|
||
|
||
LHFXUP: MOVMS C
|
||
ADD C,-4(TP)
|
||
MOVSI 0,(D)
|
||
ADDM 0,-1(C)
|
||
JRST FIXLP
|
||
|
||
FIXED: SUB P,C%11
|
||
POPJ P,
|
||
|
||
; ROUTINE TO READ A WORD FROM BUFFER
|
||
|
||
WRDIN: PUSH P,A
|
||
PUSH P,B
|
||
SOSG -3(P) ; COUNT IT DOWN
|
||
JRST WRDIN1
|
||
AOS -2(P) ; SKIP RETURN
|
||
MOVE B,5(TB) ; CHANNEL
|
||
HRRZ A,4(TB) ; READ/READB SW
|
||
MOVEI E,5
|
||
SKIPE A
|
||
MOVEI E,1
|
||
ADDM E,ACCESS(B)
|
||
MOVE A,(TP) ; BUFFER
|
||
MOVE E,(A)
|
||
AOBJP A,WRDIN2 ; NEED NEW BUFFER
|
||
MOVEM A,(TP)
|
||
WRDIN1: POP P,B
|
||
POP P,A
|
||
POPJ P,
|
||
|
||
WRDIN2: MOVE B,-3(P) ; IS THIS LAST WORD?
|
||
SOJLE B,WRDIN1 ; YES, DONT RE-IOT
|
||
SUB A,[BUFLNT,,BUFLNT]
|
||
MOVEM A,(TP)
|
||
MOVSI B,TUVEC
|
||
MOVE PVP,PVSTOR+1
|
||
MOVEM B,ASTO(PVP)
|
||
MOVE B,5(TB)
|
||
PUSHJ P,DOIOTI
|
||
MOVE PVP,PVSTOR+1
|
||
SETZM ASTO(PVP)
|
||
JRST WRDIN1
|
||
|
||
; READ IN NEXT HALF WORD
|
||
|
||
HWRDIN: JUMPN E,NOIOT ; USE EXISTING WORD
|
||
PUSH P,-3(P) ; FAKE OUT WRDIN IF NEC.
|
||
PUSHJ P,WRDIN
|
||
JRST BRSUBR
|
||
POP P,-4(P) ; RESET COUNTER
|
||
HLRZ C,E ; RET LH
|
||
POPJ P,
|
||
|
||
NOIOT: HRRZ C,E
|
||
MOVEI E,0
|
||
POPJ P,
|
||
|
||
TYPFIX: PUSH TP,$TATOM
|
||
PUSH TP,EQUOTE BAD-TYPE-NAME
|
||
PUSH TP,$TATOM
|
||
PUSH TP,B
|
||
PUSH TP,$TATOM
|
||
PUSH TP,EQUOTE ERRET-TYPE-NAME-DESIRED
|
||
MCALL 3,ERROR
|
||
JRST TYFIXE
|
||
|
||
BRSUBR: ERRUUO EQUOTE RSUBR-IN-BAD-FORMAT
|
||
|
||
|
||
|
||
;TABLE OF BYTE POINTERS FOR GETTING CHARS
|
||
|
||
BYTPNT": 350700,,CHTBL(A)
|
||
260700,,CHTBL(A)
|
||
170700,,CHTBL(A)
|
||
100700,,CHTBL(A)
|
||
010700,,CHTBL(A)
|
||
|
||
;HERE ARE THE TABLES OF CHXRACTERS (NOTE EVERYTHING NOT SPECIFIED IS
|
||
;IN THE NUMBER LETTER CATAGORY)
|
||
|
||
CHROFF==0 ; USED FOR ! HACKS
|
||
SETCHR NUMCOD,[0123456789]
|
||
|
||
SETCHR PLUCOD,[+]
|
||
|
||
SETCHR NEGCOD,[-]
|
||
|
||
SETCHR ASTCOD,[*]
|
||
|
||
SETCHR DOTTYP,[.]
|
||
|
||
SETCHR ETYPE,[Ee]
|
||
|
||
SETCOD SPATYP,[0,15,12,11,14,40,33] ;ALL ARE TYPE 2 (SPACING - FF,TAB,SPACE,ALT-MODE)
|
||
|
||
INCRCH LPATYP,[()[]'%"\#<>] ;GIVE THESE INCREASRNG CODES FROM 3
|
||
|
||
SETCOD EOFTYP,[3] ;^C - EOF CHARACTER
|
||
|
||
SETCOD SPATYP,[32] ;^Z - TENEX/TOPS-20 EOF (SET IN BOTH TO BE CONSISTENT)
|
||
|
||
INCRCH COMTYP,[;,{}!] ;COMMENT AND GLOBAL VALUE AND SPECIAL
|
||
|
||
CHROFF==200 ; CODED AS HAVING 200 ADDED
|
||
|
||
INCRCH EXCEXC,[!.[]'"<>,-\]
|
||
|
||
SETCOD MANYT,[33]
|
||
|
||
CHTBL:
|
||
OUTTBL ;OUTPUT THE TABLE RIGHT HERE
|
||
|
||
|
||
; THIS CODE FLUSHES WANDERING COMMENTS
|
||
|
||
COMNT: PUSHJ P,IREAD
|
||
JRST COMNT2
|
||
JRST BDLP
|
||
|
||
COMNT2: SKIPL A,5(TB) ; RESTORE CHANNEL
|
||
MOVEI A,5(TB)-LSTCH ;NO CHANNEL, POINT AT SLOT
|
||
HRRM B,LSTCH(A) ; CLOBBER IN CHAR
|
||
PUSHJ P,ERRPAR
|
||
JRST BDLP
|
||
|
||
|
||
;HERE TO SET UP FOR .FOO ..FOO OR.<ABC>
|
||
|
||
DOTSTR: PUSHJ P,NXTCH1 ; GOBBLE A NEW CHARACTER
|
||
MOVEI FF,FRSDOT+DOTSEN+NUMWIN ; SET FLAG IN CASE
|
||
CAIN B,NUMCOD ; SKIP IF NOT NUMERIC
|
||
JRST DOTST1 ; NUMERIC, COULD BE FLONUM
|
||
|
||
; CODE TO HANDLE ALL IMPLICIT CALLS I.E. QUOTE, LVAL, GVAL
|
||
|
||
TRZ FF,NUMWIN ; WE ARE NOT A NUMBER
|
||
MOVSI B,TFORM ; LVAL
|
||
MOVE A,IMQUOTE LVAL
|
||
JRST IMPCA1
|
||
|
||
GLOSEG: SKIPA B,$TSEG ;SEG CALL TO GVAL
|
||
GLOVAL: MOVSI B,TFORM ;FORM CALL TO SAME
|
||
MOVE A,IMQUOTE GVAL
|
||
JRST IMPCAL
|
||
|
||
QUOSEG: SKIPA B,$TSEG ;SEG CALL TO QUOTE
|
||
QUOTIT: MOVSI B,TFORM
|
||
MOVE A,IMQUOTE QUOTE
|
||
JRST IMPCAL
|
||
|
||
SEGDOT: MOVSI B,TSEG ;SEG CALL TO LVAL
|
||
MOVE A,IMQUOTE LVAL
|
||
IMPCAL: PUSHJ P,LSTCHR ;FLUSH LAST CHAR EXCEPT
|
||
IMPCA1: PUSH TP,$TATOM ;FOR .FOO FLAVOR
|
||
PUSH TP,A ;PUSH ARGS
|
||
PUSH P,B ;SAVE TYPE
|
||
PUSHJ P,IREAD1 ;READ
|
||
JRST USENIL ; IF NO ARG, USE NIL
|
||
IMPCA2: PUSH TP,C
|
||
PUSH TP,D
|
||
MOVE C,A ; GET READ THING
|
||
MOVE D,B
|
||
PUSHJ P,INCONS ; CONS TO NIL
|
||
MOVEI E,(B) ; PREPARE TON CONS ON
|
||
POPARE: POP TP,D ; GET ATOM BACK
|
||
POP TP,C
|
||
EXCH C,-1(TP) ; SAVE THAT COMMENT
|
||
EXCH D,(TP)
|
||
PUSHJ P,ICONS
|
||
POP P,A ;GET FINAL TYPE
|
||
JRST RET13 ;AND RETURN
|
||
|
||
|
||
USENIL: PUSH TP,C
|
||
PUSH TP,D
|
||
SKIPL A,5(TB) ; RESTOR LAST CHR
|
||
MOVEI A,5(TB)-LSTCH ;NO CHANNEL, POINT AT SLOT
|
||
HRRM B,LSTCH(A)
|
||
MOVEI E,0
|
||
JRST POPARE
|
||
|
||
;HERE AFTER READING ATOM TO CALL VALUE
|
||
|
||
.SET: PUSH P,$TFORM ;GET WINNING TYPE
|
||
MOVE E,(P)
|
||
PUSHJ P,RETC ; CHECK FOR POSSIBLE COMMENT
|
||
PUSH TP,$TATOM
|
||
PUSH TP,IMQUOTE LVAL
|
||
JRST IMPCA2 ;GO CONS LIST
|
||
|
||
LOOPA: PUSH P,FF ; SAVE FLAGS IN CASE .ATOM
|
||
LOOPAT: PUSHJ P,NXTCH ; CHECK FOR TRAILER
|
||
CAIN B,PATHTY ; PATH BEGINNER
|
||
JRST PATH0 ; YES, GO PROCESS
|
||
CAIN B,SPATYP ; SPACER?
|
||
PUSHJ P,SPACEQ ; CHECK FOR REAL SPACE
|
||
JRST PATH2
|
||
PUSHJ P,LSTCHR ; FLUSH IT AND RETRY
|
||
JRST LOOPAT
|
||
PATH0: PUSHJ P,NXTCH1 ; READ FORCED NEXT
|
||
CAIE B,SPCTYP ; DO #FALSE () HACK
|
||
CAIN B,ESCTYP
|
||
JRST PATH4
|
||
CAIL B,SPATYP ; SPACER?
|
||
JRST PATH3 ; YES, USE THE ROOT OBLIST
|
||
PATH4: PUSHJ P,NIREA1 ; READ NEXT ITEM
|
||
PUSHJ P,ERRPAR ; LOSER
|
||
CAME A,$TATOM ; ONLY ALLOW ATOMS
|
||
JRST BADPAT
|
||
|
||
PUSH TP,A
|
||
PUSH TP,B
|
||
MOVSI C,TATOM
|
||
MOVE D,IMQUOTE OBLIST
|
||
PUSHJ P,IGET ; GET THE OBLIST
|
||
; IF NOT OBLIST, MAKE ONE
|
||
JUMPN B,PATH6
|
||
MCALL 1,MOBLIS ; MAKE ONE
|
||
JRST PATH1
|
||
|
||
PATH6: SUB TP,C%22
|
||
JRST PATH1
|
||
|
||
|
||
PATH3: MOVE B,ROOT+1 ; GET ROOT OBLIST
|
||
MOVSI A,TOBLS
|
||
PATH1: POP P,FF ; FLAGS
|
||
TRNE FF,FRSDOT
|
||
JRST PATH.
|
||
PUSHJ P,RLOOKU ; AND LOOK IT UP
|
||
|
||
JRST RET
|
||
|
||
PATH.: PUSHJ P,RLOOKU
|
||
JRST .SET ; CONS AN LVAL FORM
|
||
|
||
SPACEQ: ANDI A,-1
|
||
CAIE A,33
|
||
CAIN A,400033
|
||
POPJ P,
|
||
CAIE A,3
|
||
AOS (P)
|
||
POPJ P,
|
||
|
||
|
||
PATH2: MOVE B,IMQUOTE OBLIST
|
||
PUSHJ P,IDVAL
|
||
JRST PATH1
|
||
|
||
BADPAT: ERRUUO EQUOTE NON-ATOMIC-OBLIST-NAME
|
||
|
||
|
||
|
||
; HERE TO READ ONE CHARACTER FOR USER.
|
||
|
||
CREDC1: SUBM M,(P)
|
||
PUSH TP,A
|
||
PUSH TP,B
|
||
PUSHJ P,IREADC
|
||
JRST CRDEO1
|
||
JRST RMPOPJ
|
||
|
||
CNXTC1: SUBM M,(P)
|
||
PUSH TP,A
|
||
PUSH TP,B
|
||
PUSHJ P,INXTRD
|
||
JRST CRDEO1
|
||
JRST RMPOPJ
|
||
|
||
CRDEO1: MOVE B,(TP)
|
||
PUSH TP,EOFCND-1(B)
|
||
PUSH TP,EOFCND(B)
|
||
PUSH TP,$TCHAN
|
||
PUSH TP,B
|
||
MCALL 1,FCLOSE
|
||
MCALL 1,EVAL
|
||
JRST RMPOPJ
|
||
|
||
|
||
CREADC: SUBM M,(P)
|
||
PUSH TP,A
|
||
PUSH TP,B
|
||
PUSHJ P,IREADC
|
||
JRST CRDEOF
|
||
SOS (P)
|
||
JRST RMPOPJ
|
||
|
||
CNXTCH: SUBM M,(P)
|
||
PUSH TP,A
|
||
PUSH TP,B
|
||
PUSHJ P,INXTRD
|
||
JRST CRDEOF
|
||
SOS (P)
|
||
RMPOPJ: SUB TP,C%22
|
||
JRST MPOPJ
|
||
|
||
CRDEOF: .MCALL 1,FCLOSE
|
||
MOVSI A,TCHRS
|
||
HRROI B,3
|
||
JRST MPOPJ
|
||
|
||
INXTRD: TDZA E,E
|
||
IREADC: MOVEI E,1
|
||
MOVE B,(TP) ; CHANNEL
|
||
HRRZ A,-2(B) ; GET BLESS BITS
|
||
TRNE A,C.BIN
|
||
TRNE A,C.BUF
|
||
JRST .+3
|
||
PUSHJ P,GRB
|
||
HRRZ A,-2(B)
|
||
TRC A,C.OPN+C.READ
|
||
TRNE A,C.OPN+C.READ
|
||
JRST BADCHN
|
||
SKIPN A,LSTCH(B)
|
||
PUSHJ P,RXCT
|
||
TLO A,200000
|
||
MOVEM A,LSTCH(B) ; SAVE CHAR
|
||
CAMN A,C%M1 ; [-1] ; SPECIAL PSEUDO TTY HACK?
|
||
JRST PSEUDO ; YES, RET AS FIX
|
||
; ANDI A,-1
|
||
TLZ A,200000
|
||
TRZN A,400000 ; UNDO ! HACK
|
||
JRST NOEXCL
|
||
SKIPE E
|
||
MOVEM A,LSTCH(B)
|
||
MOVEI A,"! ; RETURN AN !
|
||
NOEXC1: SKIPGE B,A ; CHECK EOF
|
||
SOS (P) ; DO EOF RETURN
|
||
MOVE B,A ; CHAR TO B
|
||
MOVSI A,TCHRS
|
||
PSEUD1: AOS (P)
|
||
POPJ P,
|
||
|
||
PSEUDO: MOVE F,B
|
||
SKIPE E
|
||
PUSHJ P,LSTCH2
|
||
MOVE B,A
|
||
MOVSI A,TFIX
|
||
JRST PSEUD1
|
||
|
||
NOEXCL: JUMPE E,NOEXC1
|
||
MOVE F,B
|
||
PUSHJ P,LSTCH2
|
||
JRST NOEXC1
|
||
|
||
; READER ERRORS COME HERE
|
||
|
||
ERRPAR: PUSH TP,$TCHRS ;DO THE OFFENDER
|
||
PUSH TP,B
|
||
PUSH TP,$TCHRS
|
||
PUSH TP,[40] ;SPACE
|
||
PUSH TP,$TCHSTR
|
||
PUSH TP,CHQUOT UNEXPECTED
|
||
JRST MISMA1
|
||
|
||
;COMPLAIN ABOUT MISMATCHED CLOSINGS
|
||
|
||
MISMAB: SKIPA A,["]]
|
||
MISMAT: MOVE A,-1(P) ;GOBBLE THE DESIRED CHARACTER
|
||
JUMPE B,CPOPJ ;IGNORE UNIVERSAL CLOSE
|
||
PUSH TP,$TCHRS
|
||
PUSH TP,B
|
||
PUSH TP,$TCHSTR
|
||
PUSH TP,CHQUOT [ INSTEAD-OF ]
|
||
PUSH TP,$TCHRS
|
||
PUSH TP,A
|
||
MISMA1: MCALL 3,STRING
|
||
PUSH TP,$TATOM
|
||
PUSH TP,EQUOTE READER-SYNTAX-ERROR-ERRET-ANYTHING-TO-GO-ON
|
||
PUSH TP,A
|
||
PUSH TP,B
|
||
PUSH TP,$TATOM
|
||
PUSH TP,MQUOTE READ
|
||
MCALL 3,ERROR
|
||
CPOPJ: POPJ P,
|
||
|
||
; HERE ON BAD INPUT CHARACTER
|
||
|
||
BADCHR: ERRUUO EQUOTE BAD-ASCII-CHARACTER
|
||
|
||
; HERE ON YUCKY PARSE TABLE
|
||
|
||
BADPTB: ERRUUO EQUOTE BAD-MACRO-TABLE
|
||
|
||
BDPSTR: ERRUUO EQUOTE BAD-PARSE-STRING
|
||
|
||
ILLSQG: PUSHJ P,LSTCHR ; DON'T MESS WITH IT AGAIN
|
||
ERRUUO EQUOTE BAD-USE-OF-SQUIGGLY-BRACKETS
|
||
|
||
|
||
;FLOATING POINT NUMBER TOO LARGE OR SMALL
|
||
FOOR: ERRUUO EQUOTE NUMBER-OUT-OF-RANGE
|
||
|
||
|
||
NILSXP: 0,,0
|
||
|
||
LSTCHR: SKIPL F,5(TB) ;GET CHANNEL
|
||
JRST LSTCH1 ;NO CHANNEL, POINT AT SLOT
|
||
|
||
LSTCH2: SKIPE LSTCH(F) ;ARE WE REALLY FLUSHING A REUSE CHARACTER ?
|
||
PUSHJ P,CNTACX
|
||
SETZM LSTCH(F)
|
||
POPJ P,
|
||
|
||
LSTCH1: SETZM 5(TB) ;ZERO THE LETTER AND RETURN
|
||
POPJ P,
|
||
|
||
CNTACC: MOVE F,B
|
||
CNTACX: HRRZ G,-2(F) ; GET BITS
|
||
TRNE G,C.BIN
|
||
JRST CNTBIN
|
||
AOS ACCESS(F)
|
||
CNTDON: POPJ P,
|
||
|
||
CNTBIN: AOS G,ACCESS-1(F)
|
||
CAMN G,[TFIX,,1]
|
||
AOS ACCESS(F)
|
||
CAMN G,[TFIX,,5]
|
||
HLLZS ACCESS-1(F)
|
||
POPJ P,
|
||
|
||
|
||
;TABLE OF NAMES OF ARGS AND ALLOWED TYPES
|
||
|
||
ARGS:
|
||
IRP A,,[[[CAIN C,TUNBOU]],[[CAIE C,TCHAN],INCHAN],[[PUSHJ P,CHOBL],OBLIST]]
|
||
IRP B,C,[A]
|
||
B
|
||
IFSN [C],IMQUOTE C
|
||
.ISTOP
|
||
TERMIN
|
||
TERMIN
|
||
|
||
CHOBL: CAIE C,TLIST ;A LIST OR AN OBLIST
|
||
CAIN C,TOBLS
|
||
AOS (P)
|
||
POPJ P,
|
||
|
||
END
|
||
|
||
|