mirror of
https://github.com/PDP-10/its.git
synced 2026-05-23 13:56:15 +00:00
a7399d0f9a
Looking at the backup dates for files in <mdl.int>, mdl106.exe is from 20th January 1981, whereas some of the source files are from a couple of years later. Revert to the last version prior to 20th January 1981 -- in every case, this was the earliest revision that was kept in <mdl.int>. This undoes the changes that we'd previously made to these files, many of which are no longer necessary now that we're using MIDAS 73.
2201 lines
45 KiB
Plaintext
2201 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 READB
|
||
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: 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 ; 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
|
||
|
||
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
|
||
|
||
|