mirror of
https://github.com/PDP-10/its.git
synced 2026-03-31 03:32:04 +00:00
a209c97ec1
This source was reconstructed to match MUDSAV; TS MUD54 from 1977-07-02, using a combination of all the surviving Muddle source files. The memory layout and pure code is the same. No AGC MUD54 has survived, so the AGC code was adjusted to match the TOPS-20 agc.mud104 from Chicago that Rich Alderson provided (the only ITS conditional is the page size). There's a one-instruction difference in the symbol positions, which I've converted into a patch at the end of the code to maintain the original layout on ITS. The INITM code, which doesn't appear in the final executable, is a best guess but it's probably fairly close, since it generates objects in the right order and locations, and the symbol locations match the original. The 1977 executable has a very large number of patches, which I've replicated in MUD54 INIT. The code that the patches were replacing -- marked with "XXX patched" in the source -- is also a best guess. I haven't checked that the TOPS-20 code is correct; it could be adjusted to match mdl104.exe in the future. It would need STENEX, which could be linked from MUDSYS;.
2204 lines
47 KiB
Plaintext
2204 lines
47 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 SHOULD BE REMOVED (MUDDLE 54 ONLY)
|
||
|
||
.INSRT MUDDLE >
|
||
|
||
.GLOBAL CONS,VECTOR,NXTCHR,RLOOKU,CRADIX,SPTIME,QUOTE,TENTAB,CHMAK,FLUSCH,ITENTB
|
||
.GLOBAL SETDEV,OPNCHN,ILVAL,RADX,IDVAL,LSTCH,EVECTOR,EUVECTOR,CHUNW
|
||
.GLOBAL CHRWRD,EOFCND,DIRECT,ACCESS,IOINS,ROOT,DIRECT,DOIOTI,DOACCS,IGVAL,BYTDOP
|
||
.GLOBAL ICONS,INCONS,IEVECT,IEUVEC,BUFSTR,TYPFND,SQUTOA,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
|
||
|
||
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
|
||
IFN FRMSIN,[
|
||
FRSDOT==1000 ;. CAME FIRST
|
||
USEAGN==2000 ;SPECIAL DOT HACK
|
||
]
|
||
OCTWIN==4000
|
||
OCTSTR==10000
|
||
OVFLEW==40000
|
||
|
||
;TEMPORARY OFFSETS
|
||
|
||
VCNT==0 ;NUMBER OF ELEMENTS IN CURRENT VECTOR
|
||
ONUM==1 ;CURRENT NUMBER IN OCTAL
|
||
DNUM==3 ;CURRENT NUMBER IN DECIMAL
|
||
FNUM==5 ;CURRENTLY UNUSED
|
||
CNUM==7 ;IN CURRENT RADIX
|
||
NDIGS==11 ;NUMBER OF DIGITS
|
||
ENUM==13 ;EXPONENT
|
||
|
||
|
||
; 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,[-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,[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,[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,[IREAD1] ;WHERE TO GO AFTER BINDING
|
||
READ0: PUSH TP,$TTP ;SLOT FOR LAST THING READ (TYPE IS UNREADABLE)
|
||
PUSH TP,[0]
|
||
PUSH TP,$TFIX ;SLOT FOR RADIX
|
||
PUSH TP,[0]
|
||
PUSH TP,$TCHAN ;AND SLOT FOR CHANNEL
|
||
PUSH TP,[0]
|
||
PUSH TP,[0] ; USER DISP SLOT
|
||
PUSH TP,[0]
|
||
PUSH TP,$TSPLICE
|
||
PUSH TP,[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,[0] ;DUMMY
|
||
PUSH TP,[0]
|
||
MOVE B,1(AB) ;GET CHANNEL POINTER
|
||
ADD AB,[2,,2] ;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,[2,,2]
|
||
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,[0] ;DUMMY
|
||
PUSH TP,[0]
|
||
ADD AB,[2,,2] ;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,[0]
|
||
PUSH TP,[0]
|
||
ADD AB,[2,,2] ; BUMP TO NEXT ARG
|
||
JUMPL AB,TMA ;MORE ?, ERROR
|
||
BINDEM: PUSHJ P,SPECBIND
|
||
JRST READ1
|
||
|
||
MFUNCTION RREADC,SUBR,READCHR
|
||
|
||
ENTRY
|
||
PUSH P,[IREADC]
|
||
JRST READC0 ;GO BIND VARIABLES
|
||
|
||
MFUNCTION NXTRDC,SUBR,NEXTCHR
|
||
|
||
ENTRY
|
||
|
||
PUSH P,[INXTRD]
|
||
READC0: CAMGE AB,[-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,[-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,[0]
|
||
PUSH TP,$TFIX
|
||
PUSH TP,[10.]
|
||
PUSH TP,$TFIX
|
||
PUSH TP,[0] ; LETTER SAVE
|
||
PUSH TP,[0]
|
||
PUSH TP,[0] ; PARSE TABLE MAYBE?
|
||
PUSH TP,$TSPLICE
|
||
PUSH TP,[0] ;SEGMENT FOR SPLICING MACROS
|
||
PUSH TP,[0] ;SLOT FOR LOCATIVE TO STRING
|
||
PUSH TP,[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,[0]
|
||
PUSH TP,[0]
|
||
PUSHJ P,SPECBIND
|
||
ADD AB,[2,,2]
|
||
JUMPGE AB,USPSTR
|
||
GETYP 0,(AB)
|
||
CAIE 0,TFIX
|
||
JRST WTYP2
|
||
MOVE 0,1(AB)
|
||
MOVEM 0,3(TB)
|
||
ADD AB,[2,,2]
|
||
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,[0]
|
||
PUSH TP,[0]
|
||
PUSHJ P,SPECBIND
|
||
ADD AB,[2,,2]
|
||
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,[0]
|
||
PUSH TP,[0]
|
||
PUSHJ P,SPECBIND
|
||
ADD AB,[2,,2]
|
||
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,[2,,2]
|
||
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,[0] ; HERE WE ARE MAKE PLACE TO SAVE GOODIES
|
||
PUSH TP,$TLIST
|
||
PUSH TP,[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,[1,,1] ;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,MQUOTE 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,MQUOTE 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,[-1] ; DONT GOBBLE COMMENTS
|
||
JRST IREAD2
|
||
|
||
IREAD:
|
||
PUSHJ P,LSTCHR ;DON'T REREAD LAST CHARACTER
|
||
IREAD1: PUSH P,[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: NUMLET ;HERE IF NUMBER OR LETTER
|
||
NUMLET ;NUMBER
|
||
NUMCOD==.-DTBL
|
||
NUMLET ;+-
|
||
PLUMIN==.-DTBL
|
||
NUMLET ;.
|
||
DOTTYP==.-DTBL
|
||
NUMLET ;E
|
||
NONSPC==.-DTBL ;NUMBER OF NON-SPECIAL CHARACTERS
|
||
SPACE ;SPACING CHAR CR,LF,SP,TAB ETC.
|
||
SPATYP==.-DTBL ;TYPE FOR SPACE CHARS
|
||
|
||
|
||
;THE FOLLOWING ENTRIES ARE VARIOUS PUNCTUATION CROCKS
|
||
|
||
LPAREN ;( - BEGIN LIST
|
||
RPAREN ;) - END CURRENT LEVEL OF INPUT
|
||
LBRACK ;[ -BEGIN ARRAY
|
||
LBRTYP==.-DTBL
|
||
RBRACK ;] - END OF ARRAY
|
||
QUOTIT ;' - QUOTE THE FOLLOWING GOODIE
|
||
QUOTYP==.-DTBL
|
||
|
||
MACCAL ;% - INVOKE A READ TIME MACRO
|
||
MACTYP==.-DTBL
|
||
CSTRING ;" - CHARACTER STRING
|
||
CSTYP==.-DTBL
|
||
NUMLET ;\ - ESCAPE,BEGIN ATOM
|
||
|
||
ESCTYP==.-DTBL ;TYPE OF ESCAPE CHARACTER
|
||
|
||
SPECTY ;# - SPECIAL TYPE TO BE READ
|
||
SPCTYP==.-DTBL
|
||
OPNANG ;< - BEGIN ELEMENT CALL
|
||
|
||
SLMNT==.-DTBL ;TYPE OF START OF SEGMENT
|
||
|
||
CLSANG ;> - END ELEMENT CALL
|
||
|
||
|
||
EOFCHR ;^C - END OF FILE
|
||
|
||
COMNT ;; - BEGIN COMMENT
|
||
COMTYP==.-DTBL ;TYPE OF START OF COMMENT
|
||
|
||
GLOVAL ;, - GET GLOBAL VALUE
|
||
GLMNT==.-DTBL
|
||
ILLSQG ;{ - START TEMPLATE STRUCTURE
|
||
TMPTYP==.-DTBL
|
||
CLSBRA ;} - END TEMPLATE STRUCTURE
|
||
|
||
NTYPES==.-DTBL
|
||
|
||
|
||
|
||
; EXTENDED TABLE FOR ! HACKS
|
||
|
||
NUMLET ; !! FAKE OUT
|
||
SEGDOT ;!. - CALL TO LVAL (SEG)
|
||
DOTEXT==.-DTBL
|
||
UVECIN ;![ - INPUT UNIFORM VECTOR ]
|
||
LBREXT==.-DTBL
|
||
QUOSEG ;!' - SEG CALL TO QUOTE
|
||
QUOEXT==.-DTBL
|
||
SINCHR ;!" - INPUT ONE CHARACTER
|
||
CSEXT==.-DTBL
|
||
SEGIN ;!< - SEG CALL
|
||
SLMEXT==.-DTBL
|
||
GLOSEG ;!, - SEG CALL TO GVAL
|
||
GLMEXT==.-DTBL
|
||
LOSPATH ;!- - PATH NAME SEPARATOR
|
||
PATHTY==.-DTBL
|
||
TERM ;!$ - (EXCAL-ALT MODE) PUT ALL CLOSES
|
||
MANYT==.-DTBL
|
||
USRDS1 ; DISPATCH FOR USER TABLE (NO !)
|
||
USTYP1==.-DTBL
|
||
USRDS2 ; " " " " (WITH !)
|
||
USTYP2==.-DTBL
|
||
ENTYPE==.-DTBL
|
||
|
||
|
||
|
||
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,[2,,2] ; 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
|
||
|
||
NUMLET: PUSHJ P,GOBBLE ;READ IN THE ATOM AND PUT PNTR ON ARG PDL
|
||
JRST RET ;NO SKIP RETURN I.E. NON NIL
|
||
|
||
;HERE TO START BUILDING A CHARACTER STRING GOODIE
|
||
|
||
CSTRING: PUSHJ P,GOBBL1 ;READ IN STRING
|
||
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,[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,MQUOTE 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, [1,,1]
|
||
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,[IEUVECTOR] ;PUSH NAME OF U VECT HACKER
|
||
JRST LBRAK2 ;AND GO
|
||
|
||
LBRACK: PUSH P,[135] ; SAVE TERMINATE
|
||
PUSH P,[IEVECTOR] ;PUSH GEN VECTOR HACKER
|
||
LBRAK2: PUSHJ P,LSTCHR ;FORCE READING NEW CHAR
|
||
PUSH P,[0] ; COUNT ELEMENTS
|
||
PUSH TP,$TLIST ; AND SLOT FOR GOODIES
|
||
PUSH TP,[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,[3,,3]
|
||
|
||
; 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,MQUOTE COMMENT
|
||
PUSHJ P,IPUT
|
||
JRST VECCOM
|
||
|
||
TMPCOM: MOVSI A,(A)
|
||
ADD B,A
|
||
MOVSI A,TTMPLT
|
||
JRST TMPCO1
|
||
|
||
RETVEC: SUB P,[1,,1]
|
||
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,[1,,1]
|
||
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
|
||
|
||
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
|
||
JRST RETYPE ;GO HACK SPECIALLY
|
||
GETCTP: CAILE A,177 ; CHECK RANGE
|
||
JRST BADCHR
|
||
PUSH P,A ;AND SAVE FROM DIVISION
|
||
ANDI A,177
|
||
IDIVI A,CHRWD ;YIELDS WORD AND CHAR NUMBER
|
||
LDB B,BYTPNT(B) ;GOBBLE TYPE CODE
|
||
POP P,A
|
||
POPJ P,
|
||
|
||
NXTPRS: SKIPE A,5(TB) ;GET OLD CHARACTER IF ONE EXISTS
|
||
JRST PRSRET
|
||
NXTPR1: MOVEI A,400033
|
||
PUSH P,C
|
||
MOVE C,11.(TB)
|
||
HRRZ B,(C) ;GET THE STRING
|
||
SOJL B,NXTPR3
|
||
HRRM B,(C)
|
||
ILDB A,1(C) ;GET THE CHARACTER FROM THE STRING
|
||
NXTPR2: MOVEM A,5(TB) ;SAVE IT
|
||
POP P,C
|
||
JRST PRSRET ;CONTINUE
|
||
NXTPR3: SETZM 8.(TB)
|
||
SETZM 9.(TB) ;CLEAR OUT LOCATIVE, AT END OF STRING
|
||
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
|
||
CAIGE B,NTYPES+1 ;IF 1 > THAN MAX, MUST BE SPECIAL
|
||
JRST CHKUS1 ; CHECK FOR USER DISPATCH
|
||
|
||
CAIN B,NTYPES+1 ;FOR OBSCURE BUG FOUND BY MSG
|
||
PUSHJ P,NXTC1 ;READ NEXT ONE
|
||
HLLOS 2(TB) ;FLAG FOR TWO CHAR LOOK AHEAD
|
||
|
||
RETYP1: CAIN A,". ;!.
|
||
MOVEI B,DOTEXT ;YES, GET EXTENDED TYPE
|
||
CAIN A,"[
|
||
MOVEI B,LBREXT
|
||
CAIN A,"'
|
||
MOVEI B,QUOEXT
|
||
CAIN A,"\
|
||
MOVEI B,CSEXT
|
||
CAIN A,""
|
||
MOVEI B,CSEXT
|
||
CAIN A,"-
|
||
MOVEI B,PATHTY
|
||
CAIN A,"<
|
||
MOVEI B,SLMEXT
|
||
CAIN A,",
|
||
MOVEI B,GLMEXT
|
||
CAIN A,33
|
||
MOVEI B,MANYT ;! ALTMODE
|
||
|
||
CRMLST: ADDI 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)
|
||
SUBI A,400000 ;DECREASE CHAR
|
||
POP P,B
|
||
|
||
CHKUS2: SKIPN 7(TB) ; SKIP IF USER TABLE
|
||
JRST UPLO
|
||
PUSH P,A
|
||
ADDI A,200
|
||
ASH A,1 ; POINT TO SLOT
|
||
HRLS A
|
||
ADD A,7(TB)
|
||
SKIPL A ;IS THERE VECTOR ENOUGH?
|
||
JRST CHKUS4
|
||
SKIPN 1(A) ; NON-ZERO==>USER FCN EXISTS
|
||
JRST CHKUS4 ; HOPE HE APPRECIATES THIS
|
||
MOVEI B,USTYP2
|
||
CHKRDO: PUSH P,0 ; CHECK FOR REDOING IF CHAR IN TABLE
|
||
GETYP 0,(A)
|
||
CAIE 0,TCHRS
|
||
JRST CHKUS5
|
||
POP P,0 ;WE ARE TRANSMOGRIFYING
|
||
POP P,(P) ;FLUSH OLD CHAR
|
||
MOVE A,1(A) ;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: CAIE 0,TLIST
|
||
JRST .+4 ; SPECIAL NON-BREAK TYPE HACK
|
||
MOVNS -1(P) ; INDICATE BY NEGATIVE
|
||
MOVE A,1(A) ; 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(A) ; 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,0
|
||
POP P,A
|
||
MOVMS A ; FIX UP A POSITIVE CHARACTER
|
||
POPJ P,
|
||
|
||
CHKUS4: POP P,A
|
||
JRST UPLO
|
||
|
||
CHKUS1: SKIPN 7(TB) ; USER CHECK FOR NOT ! CASE
|
||
POPJ P,
|
||
PUSH P,A
|
||
ASH A,1
|
||
HRLS A
|
||
ADD A,7(TB)
|
||
SKIPL A
|
||
JRST CHKUS3
|
||
SKIPN 1(A)
|
||
JRST CHKUS3
|
||
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
|
||
|
||
RETYPE: PUSHJ P,GETCTP ;GET TYPE OF CHAR
|
||
JRST RETYP1
|
||
|
||
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
|
||
MOVE C,@BUFSTR(B) ; SEE IF FLAG SAYS START OF RSUBR
|
||
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,[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,[1,,1]
|
||
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,[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,[0]
|
||
|
||
; FOUND OUT IF FIXUPS STAY
|
||
|
||
MOVE B,MQUOTE 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,[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,[1,,1] ; 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,[0]
|
||
PUSH P,[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,MQUOTE 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
|
||
|
||
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,MQUOTE RSUBR
|
||
PUSHJ P,IPUT ; DO THE ASSOCIATION
|
||
|
||
RSUB6: MOVE B,-2(TP) ; GET RSUBR
|
||
MOVSI A,TRSUBR
|
||
SUB P,[4,,4] ; 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 RSUB3
|
||
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) ; XXX patched
|
||
MOVEM E,-1(A) ; XXX patched
|
||
JRST .+3
|
||
NOOPV:
|
||
]
|
||
PUSHJ P,SQUTOA ; LOOK IT UP
|
||
JRST BRSUBR
|
||
MOVEI D,(E) ; FOR FIXCOD
|
||
PUSHJ P,FIXCOD ; FIX 'EM UP
|
||
JRST FIXUPL
|
||
|
||
; 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,[1,,1]
|
||
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)
|
||
|
||
SETCHR 2,[0123456789]
|
||
|
||
SETCHR 3,[+-]
|
||
|
||
SETCHR 4,[.]
|
||
|
||
SETCHR 5,[Ee]
|
||
|
||
SETCOD 6,[0,15,12,11,14,40,33] ;ALL ARE TYPE 2 (SPACING - FF,TAB,SPACE,ALT-MODE)
|
||
|
||
INCRCH 7,[()[]'%"\#<>] ;GIVE THESE INCREASRNG CODES FROM 3
|
||
|
||
SETCOD 22,[3] ;^C - EOF CHARACTER
|
||
|
||
INCRCH 23,[;,{}!] ;COMMENT AND GLOBAL VALUE AND SPECIAL
|
||
|
||
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
|
||
|
||
;SUBROUTINE TO READ CHARS ONTO STACK
|
||
|
||
GOBBL1: MOVEI FF,0 ;KILL ALL FLAGS
|
||
PUSHJ P,LSTCHR ;DON'T REREAD "
|
||
TROA FF,NOTNUM+INSTRN ;SURPRESS NUMBER CONVERSION
|
||
GOBBLE: MOVEI FF,0 ;FLAGS CONCERRNING CURRENT GOODIE IN HERE
|
||
MOVE A,TP ;GOBBLE CURRENT TP TO BE PUSHED
|
||
MOVEI C,6 ;NOW PUSH 6 0'S ON TO STACK
|
||
PUSH TP,$TFIX ;TYPE IS FIXED
|
||
PUSH TP,FF ;AND VALUE IS 0
|
||
SOJG C,.-2 ;FOUR OF THEM
|
||
PUSH TP,$TTP ;NOW SAVE OLD TP
|
||
ADD A,[1,,1] ;MAKE IT LOOK LIKE A TB
|
||
PUSH TP,A
|
||
MOVEI D,0 ;ZERO OUT CHARACTER COUNT
|
||
GOB1: MOVSI C,(<440700,,(P)>) ;SET UP FIRST WORD OF CHARS
|
||
PUSH P,[0] ;BYTE POINTER
|
||
GOB2: PUSH P,FF ;SAVE FLAG REGISTER
|
||
INTGO ; IN CASE P OVERFLOWS
|
||
MOVEI A,NXTCH
|
||
TRNE FF,INSTRN
|
||
MOVEI A,NXTCS ; HACK TO GET MAYBE NEW TYPE WITHOUT CHANGE
|
||
PUSHJ P,(A)
|
||
POP P,FF ;AND RESTORE FLAG REGISTER
|
||
CAIN B,ESCTYP ;IS IT A CHARACTER TO BE ESCAPED
|
||
JRST ESCHK ;GOBBLE THE ESCAPED CHARACTER
|
||
TRNE FF,INSTRN ;ARE WE BUILDING A CHAR STRING
|
||
JRST ADSTRN ;YES, GO READ IN
|
||
CAILE B,NONSPC ;IS IT SPECIAL
|
||
JRST DONEG ;YES, RAP THIS UP
|
||
|
||
TRNE FF,NOTNUM+OCTWIN ;IS NUMERIC STILL WINNING
|
||
JRST SYMB ;NO, ONLY DO CHARACTER HACKING
|
||
CAIL A,60 ;CHECK FOR DIGIT
|
||
CAILE A,71
|
||
JRST SYMB1 ;NOT A DIGIT
|
||
JRST CNV ;GO CONVERT TO NUMBER
|
||
CNV:
|
||
|
||
;ARRIVE HERE IF STILL BUILDING A NUMBER
|
||
CNV: MOVE B,(TP) ;GOBBLE POINTER TO TEMPS
|
||
TRO FF,NUMWIN ;SAY DIGITSSEEN
|
||
SUBI A,60 ;CONVERT TO A NUMBER
|
||
TRNE FF,EFLG ;HAS E BEEN SEEN
|
||
JRST ECNV ;YES, CONVERT EXPONENT
|
||
TRNE FF,DOTSEN ;HAS A DOT BEEN SEEN
|
||
|
||
JRST DECNV ;YES, THIS IS A FLOATING NUMBER
|
||
|
||
MOVE E,ONUM(B) ; OCTAL CONVERT
|
||
LSH E,3
|
||
ADDI E,(A)
|
||
MOVEM E,ONUM(B)
|
||
TRNE FF,OCTSTR ; SKIP OTHER CONVERSIONS IF OCTAL FORCE
|
||
JRST CNV1
|
||
|
||
JFCL 17,.+1 ;KILL ALL FLAGS
|
||
MOVE E,CNUM(B) ;COMPUTE CURRENT RADIX
|
||
IMUL E,3(TB)
|
||
ADD E,A ;ADD IN CURRENT DIGIT
|
||
JFCL 10,.+3
|
||
MOVEM E,CNUM(B)
|
||
JRST DECNV1
|
||
MOVE E,3(TB) ; SEE IF CURRENT RADIX DECIMAL
|
||
CAIE E,10.
|
||
JRST DECNV ; YES, FORCE FLOAT
|
||
TROA FF,OVFLEW
|
||
|
||
DECNV: TRO FF,FLONUM ;SET FLOATING FLAG
|
||
DECNV1: JFCL 17,.+1 ;CLEAR ALL FLAGS
|
||
MOVE E,DNUM(B) ;GET DECIMAL NUMBER
|
||
IMULI E,10.
|
||
JFCL 10,CNV2 ;JUMP IF OVERFLOW
|
||
ADD E,A ;ADD IN DIGIT
|
||
MOVEM E,DNUM(B)
|
||
TRNE FF,FLONUM ;IS THIS FRACTION?
|
||
SOS NDIGS(B) ;YES, DECREASE EXPONENT BY ONE
|
||
|
||
CNV1: PUSHJ P,NXTCH ;RE-GOBBLE CHARACTER
|
||
JRST SYMB2 ;ALSO DEPOSIT INTO SYMBOL BEING MADE
|
||
CNV2: ;OVERFLOW IN DECIMAL NUMBER
|
||
TRNE FF,DOTSEN ;IS THIS FRACTION PART?
|
||
JRST CNV1 ;YES,IGNORE DIGIT
|
||
AOS NDIGS(B) ;NO, INCREASE IMPLICIT EXPONENT BY ONE
|
||
TRO FF,FLONUM ;SET FLOATING FLAG BUT
|
||
JRST CNV1 ;DO NOT FORCE DECIMAL(DECFRC)
|
||
|
||
ECNV: ;CONVERT A DECIMAL EXPONENT
|
||
HRRZ E,ENUM(B) ;GET EXPONENT
|
||
IMULI E,10.
|
||
ADD E,A ;ADD IN DIGIT
|
||
TLNN E,777777 ;IF OVERFLOW INTO LEFT HALF
|
||
HRRM E,ENUM(B) ;DO NOT STORE(CATCH ERROR LATER)
|
||
JRST CNV1
|
||
JRST SYMB2 ;ALSO DEPOSIT INTO SYMBOL BEING MADE
|
||
|
||
|
||
;HERE TO PUT INTO IDENTIFIER BEING BUILT
|
||
|
||
ESCHK: PUSHJ P,NXTC1 ;GOBBLE NEXT CHAR
|
||
SYMB: MOVE B,(TP) ;GET BACK TEM POINTER
|
||
TRZE FF,EFLG ;IF E FLAG SET
|
||
HLRZ FF,ENUM(B) ;RESTORE SAVED FLAGS
|
||
TRO FF,NOTNUM ;SET NOT NUMBER FLAG
|
||
SYMB2: TRO FF,NFIRST ;NOT FIRST IN WORLD
|
||
SYMB3: IDPB A,C ;INSERT IT
|
||
PUSHJ P,LSTCHR ;READ NEW CHARACTER
|
||
TLNE C,760000 ;WORD FULL?
|
||
AOJA D,GOB2 ;NO, KEEP TRYING
|
||
AOJA D,GOB1 ;COUNT WORD AND GO
|
||
|
||
;HERE TO CHECK FOR +,-,. IN NUMBER
|
||
|
||
SYMB1: TRNE FF,NFIRST ;IS THIS THE FIRST CHARACTER
|
||
JRST CHECK. ;NO, ONLY LOOK AT DOT
|
||
CAIE A,"- ;IS IT MINUS
|
||
JRST .+3 ;NO CHECK PLUS
|
||
TRO FF,NEGF ;YES, NEGATE AT THE END
|
||
JRST SYMB2
|
||
CAIN A,"+ ;IS IT +
|
||
JRST SYMB2 ;ESSENTIALLY IGNORE IT
|
||
CAIE A,"* ; FUNNY OCTAL CROCK?
|
||
JRST CHECK.
|
||
|
||
TRO FF,OCTSTR
|
||
JRST SYMB2
|
||
|
||
;COULD BE .
|
||
|
||
CHECK.: PUSHJ P,LSTCHR ;FLUSH LAST CHARACTER
|
||
MOVEI E,0
|
||
TRNN FF,DOTSEN+EFLG ;IF ONE ALREADY SEEN
|
||
CAIE A,".
|
||
JRST CHECKE ;GO LOOK FOR E
|
||
|
||
IFN FRMSIN,[
|
||
TRNN FF,NFIRST ;IS IT THE FIRST
|
||
JRST DOT1 ;YES, COULD MEAN EVALUATE A VARIABLE
|
||
]
|
||
|
||
CHCK.1: TRO FF,DECFRC+DOTSEN ;FORCE DECIMAL
|
||
IFN FRMSIN, TRNN FF,FRSDOT ;IF NOT FIRST ., PUT IN CHAR STRING
|
||
JRST SYMB2 ;ENTER INTO SYMBOL
|
||
IFN FRMSIN, JRST GOB2 ;IGNORE THE "."
|
||
|
||
|
||
|
||
IFN FRMSIN,[
|
||
|
||
;HERE TO SET UP FOR .FOO ..FOO OR.<ABC>
|
||
|
||
DOT1: PUSH P,FF ;SAVE FLAGS
|
||
PUSHJ P,NXTCH1 ;GOBBLE A NEW CHARACTER
|
||
POP P,FF ;RESTORE FLAGS
|
||
TRO FF,FRSDOT ;SET FLAG IN CASE
|
||
CAIN B,NUMCOD ;SKIP IF NOT NUMERIC
|
||
JRST CHCK.1 ;NUMERIC, COULD BE FLONUM
|
||
|
||
; CODE TO HANDLE ALL IMPLICIT CALLS I.E. QUOTE, LVAL, GVAL
|
||
|
||
MOVSI B,TFORM ;LVAL
|
||
MOVE A,MQUOTE LVAL
|
||
SUB P,[2,,2] ;POP OFF BYTE POINTER AND GOBBLE CALL
|
||
POP TP,TP
|
||
SUB TP,[1,,1] ;REMOVE TP JUNK
|
||
JRST IMPCA1
|
||
|
||
GLOSEG: SKIPA B,$TSEG ;SEG CALL TO GVAL
|
||
GLOVAL: MOVSI B,TFORM ;FORM CALL TO SAME
|
||
MOVE A,MQUOTE GVAL
|
||
JRST IMPCAL
|
||
|
||
QUOSEG: SKIPA B,$TSEG ;SEG CALL TO QUOTE
|
||
QUOTIT: MOVSI B,TFORM
|
||
MOVE A,MQUOTE QUOTE
|
||
JRST IMPCAL
|
||
|
||
SEGDOT: MOVSI B,TSEG ;SEG CALL TO LVAL
|
||
MOVE A,MQUOTE 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: SUB P,[1,,1] ;FLUSH GOBBLE CALL
|
||
PUSH P,$TFORM ;GET WINNING TYPE
|
||
MOVE E,(P)
|
||
PUSHJ P,RETC ; CHECK FOR POSSIBLE COMMENT
|
||
PUSH TP,$TATOM
|
||
PUSH TP,MQUOTE LVAL
|
||
JRST IMPCA2 ;GO CONS LIST
|
||
|
||
]
|
||
|
||
;HERE TO CHECK FOR "E" FLAVOR OF EXPONENT
|
||
|
||
CHECKE: CAIN A,"* ; CHECK FOR FINAL *
|
||
JRST SYMB4
|
||
TRNN FF,EFLG ;HAS ONE BEEN SEEN
|
||
CAIE B,NONSPC ;IF NOT, IS THIS ONE
|
||
JRST SYMB ;NO, ENTER AS SYMBOL KILL NUMERIC WIN
|
||
|
||
TRNN FF,NUMWIN ;HAVE DIGITS BEEN SEEN?
|
||
JRST SYMB ;NO, NOT A NUMBER
|
||
MOVE B,(TP) ;GET POINTER TO TEMPS
|
||
HRLM FF,ENUM(B) ;SAVE FLAGS
|
||
HRRI FF,DECFRC+DOTSEN+EFLG ;SET NEW FLAGS
|
||
JRST SYMB3 ;ENTER SYMBOL
|
||
|
||
|
||
SYMB4: TRNE FF,NUMWIN ; IF NO DIGITS YET, THIS IS AN ATOM
|
||
TRZN FF,OCTSTR
|
||
JRST SYMB
|
||
TRZN FF,OCTWIN ; ALREADY WON?
|
||
TROA FF,OCTWIN ; IF NOT DO IT NOW
|
||
JRST SYMB
|
||
JRST SYMB2
|
||
|
||
;HERE ON READING CHARACTER STRING
|
||
|
||
ADSTRN: SKIPL A ; EOF?
|
||
CAIN B,MANYT ;TERMINATE?
|
||
JRST DONEG ;YES
|
||
CAIE B,CSTYP
|
||
JRST SYMB2 ;NO JUST INSERT IT
|
||
ADSTN1: PUSHJ P,LSTCHR ;DON'T REREAD """
|
||
|
||
|
||
;HERE TO FINISH THIS CROCK
|
||
|
||
DONEG: TRNN FF,OCTSTR ; IF START OCTAL BUT NOT FINISH..
|
||
TRNN FF,NUMWIN ;HAVE DIGITS BEEN SEEN?
|
||
TRO FF,NOTNUM ;NO,SET NOT NUMBER FLAG
|
||
SKIPGE C ; SKIP IF STUFF IN TOP WORD
|
||
SUB P,[1,,1]
|
||
PUSH P,D
|
||
TRNN FF,NOTNUM ;NUMERIC?
|
||
JRST NUMHAK ;IS NUMERIC, GO TO IT
|
||
|
||
IFN FRMSIN,[
|
||
MOVE A,(TP) ;GET POINTER TO TEMPS
|
||
MOVEM FF,NDIGS(A) ;USE TO HOLD FLAGS
|
||
]
|
||
TRNE FF,INSTRN ;ARE WE BUILDING A STRING
|
||
JRST MAKSTR ;YES, GO COMPLETE SAME
|
||
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
|
||
PUSH TP,A
|
||
PUSH TP,B
|
||
PUSH TP,$TATOM
|
||
PUSH TP,IMQUOTE OBLIST
|
||
MCALL 2,GET ; GET THE OBLIST
|
||
CAMN A,$TOBLS ; IF NOT OBLIST, MAKE ONE
|
||
JRST PATH6
|
||
MCALL 1,MOBLIS ; MAKE ONE
|
||
JRST PATH1
|
||
|
||
PATH6: SUB TP,[2,,2]
|
||
JRST PATH1
|
||
|
||
|
||
PATH3: MOVE B,ROOT+1 ; GET ROOT OBLIST
|
||
MOVSI A,TOBLS
|
||
PATH1: PUSHJ P,RLOOKU ; AND LOOK IT UP
|
||
|
||
IFN FRMSIN,[
|
||
MOVE C,(TP) ;SET TO REGOBBLE FLAGS
|
||
MOVE FF,NDIGS(C)
|
||
]
|
||
JRST FINID
|
||
|
||
|
||
SPACEQ: ANDI A,-1
|
||
CAIE A,33
|
||
CAIN A,400033
|
||
POPJ P,
|
||
CAIE A,3
|
||
AOS (P)
|
||
POPJ P,
|
||
|
||
;HERE TO RAP UP CHAR STRING ITEM
|
||
|
||
MAKSTR: MOVE C,D ;SETUP TO CALL CHMAK
|
||
PUSHJ P,CHMAK ;GO MAKE SAME
|
||
JRST FINID
|
||
|
||
|
||
NUMHAK: MOVE C,(TP) ;REGOBBLETEMP POINTER
|
||
POP P,D ;POP OFF STACK TOP
|
||
ADDI D,4
|
||
IDIVI D,5
|
||
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(C)
|
||
TRNE FF,DECFRC
|
||
MOVE B,DNUM(C) ;GRAB FIXED GOODIE
|
||
TRNE FF,OCTWIN ; SKIP IF NOT OCTAL
|
||
MOVE B,ONUM(C) ; USE OCTAL VALUE
|
||
FINID2: MOVSI A,TFIX ;SAY FIXED POINT
|
||
FINID1: TRNE FF,NEGF ;NEGATE
|
||
MOVNS B ;YES
|
||
FINID: POP TP,TP ;RESTORE OLD TP
|
||
SUB TP,[1,,1] ;FINISH HACK
|
||
IFN FRMSIN,[
|
||
TRNE FF,FRSDOT ;DID . START IT
|
||
JRST .SET ;YES, GO HACK
|
||
]
|
||
POPJ P, ;AND RETURN
|
||
|
||
|
||
|
||
|
||
PATH2: MOVE B,IMQUOTE OBLIST
|
||
PUSHJ P,IDVAL
|
||
JRST PATH1
|
||
|
||
BADPAT: ERRUUO EQUOTE NON-ATOMIC-OBLIST-NAME
|
||
|
||
|
||
FLOATIT:<3A> JFCL 17,.+1 ;CLEAR ALL ARITHMETIC FLAGS
|
||
|
||
TRNE FF,EFLG ;"E" SEEN?
|
||
JRST EXPDO ;YES, DO EXPONENT
|
||
MOVE D,NDIGS(C) ;GET IMPLICIT EXPONENT
|
||
|
||
FLOATE: MOVE A,DNUM(C) ;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)
|
||
CAIG A,38. ;HOW BIG?
|
||
JRST .+3 ;TOO BIG-FLOATING OUT OF RANGE
|
||
MOVE E,[10.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 10,FOOR ;FLOATING OUT OF RANGE ON OVERFLOW
|
||
MOVSI A,TFLOAT
|
||
IFN FRMSIN, TRZ FF,FRSDOT ;FLOATING NUMBER NOT VALUE
|
||
JRST FINID1
|
||
|
||
EXPDO:
|
||
HRRZ D,ENUM(C) ;GET EXPONENT
|
||
TRNE FF,NEGF ;IS EXPONENT NEGATIVE?
|
||
MOVNS D ;YES
|
||
ADD D,NDIGS(C) ;ADD IMPLICIT EXPONENT
|
||
HLR FF,ENUM(C) ;RESTORE FLAGS
|
||
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(C) ;
|
||
IMUL B,ITENTB(D)
|
||
JFCL 10,FLOATE ;IF OVERFLOW, MAKE FLOATING
|
||
JRST FINID2 ;GO MAKE FIXED NUMBER
|
||
|
||
; 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,[2,,2]
|
||
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,[-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: SKIPE E
|
||
PUSHJ P,LSTCH2
|
||
MOVE B,A
|
||
MOVSI A,TFIX
|
||
JRST PSEUD1
|
||
|
||
NOEXCL: SKIPE E
|
||
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: PUSH P,B
|
||
SKIPL B,5(TB) ;GET CHANNEL
|
||
JRST LSTCH1 ;NO CHANNEL, POINT AT SLOT
|
||
PUSHJ P,LSTCH2
|
||
POP P,B
|
||
POPJ P,
|
||
|
||
LSTCH2: SKIPE LSTCH(B) ;ARE WE REALLY FLUSHING A REUSE CHARACTER ?
|
||
PUSHJ P,CNTACC
|
||
SETZM LSTCH(B)
|
||
POPJ P,
|
||
|
||
LSTCH1: SETZM 5(TB) ;ZERO THE LETTER AND RETURN
|
||
POP P,B
|
||
POPJ P,
|
||
|
||
CNTACC: PUSH P,A
|
||
HRRZ A,-2(B) ; GET BITS
|
||
TRNE A,C.BIN
|
||
JRST CNTBIN
|
||
AOS ACCESS(B)
|
||
CNTDON: POP P,A
|
||
POPJ P,
|
||
|
||
CNTBIN: AOS A,ACCESS-1(B)
|
||
CAMN A,[TFIX,,1]
|
||
AOS ACCESS(B)
|
||
CAMN A,[TFIX,,5]
|
||
HLLZS ACCESS-1(B)
|
||
JRST CNTDON
|
||
|
||
|
||
;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
|
||
|
||
|