899 lines
No EOL
16 KiB
Text
899 lines
No EOL
16 KiB
Text
.STITLE READ -
|
||
VERN==VERN+%FNAM2
|
||
|
||
READ: PUSH A
|
||
SPUSH B
|
||
SPUSH C
|
||
SPUSH D
|
||
SPUSH E
|
||
SPUSH F
|
||
CLR RDFLAG
|
||
MOV @S,GNCN
|
||
BIC #170000,GNCN
|
||
CLR F
|
||
READA: JSR PC,RDWRD
|
||
BR READB
|
||
BIS #SEPF,RDFLAG
|
||
JSR PC,CKDOTF
|
||
READC: JSR PC,LISTB
|
||
BIT #SEPF,RDFLAG
|
||
BEQ READA
|
||
READB: BIC #SEPF,RDFLAG ;CHECK SPECIAL CHAR IN D
|
||
JSR PC,CKDOTF ;FIRST CHECK FOR PENDING ":"
|
||
CMP #15,D
|
||
BEQ READR ;C-R
|
||
CMP #'",D
|
||
BEQ READS ;STRING
|
||
CMP #'[,D
|
||
BEQ READL ;LIST
|
||
CMP #'],D
|
||
BNE .+4
|
||
ERROR+COP ;CHAR (]) OUT OF PLACE
|
||
CMP #':,D
|
||
BEQ READD ;DOTS
|
||
BITB #OPERF,DTBL(D) ;IS CHAR AN OPERATOR
|
||
BEQ READA ;NO
|
||
MOVB DTBL2(D),A
|
||
ASL A
|
||
MOV SOBLSU(A),B
|
||
;SET TYPE TO SFUN OR INFIX
|
||
MOV @B,A ;THIS HACK WORKS BECAUSE #SFUN=0
|
||
BIC #-INFIX-1,A ; AND #INFIX=10000
|
||
BR READC
|
||
READR: POPS A
|
||
MOV A,@S
|
||
CLR TOPS
|
||
JMP RETF
|
||
READS: JSR PC,GNC
|
||
JSR PC,RDST
|
||
BR .+2 ;RDST ALWAYS SKIPS
|
||
BIS #SEPF,RDFLAG
|
||
BR READC
|
||
READL: JSR PC,RDLST
|
||
POPS TOPS
|
||
BIC #SEPF,RDFLAG
|
||
BR READC
|
||
READD: BIS #DOTF,RDFLAG
|
||
BR READA
|
||
.STITLE READ - READ WORD
|
||
;READ CHARS UP THRU NEXT SEPARATOR CHAR. IF JUST A SEP,
|
||
;RETURN WITH IT IN D. OTHERWISE NUMBERIFY OR INTERN CHAR STRING,
|
||
;SKIP RETURN WITH TOKEN IN A,,B
|
||
RDWRD: CLRB RDFLAG
|
||
JSR PC,BLSTI
|
||
RDWA: JSR PC,GNC
|
||
MOVB DTBL(D),A ;GET FLAGS IN A
|
||
BIT #SEPF,A ;IS THIS CHAR A SEPARATOR?
|
||
BNE RDWB ;YES
|
||
BISB A,RDFLAG
|
||
JSR PC,BLST
|
||
BR RDWA
|
||
RDWB: JSR PC,BLSTF ;FINISH OFF STRING
|
||
RTS PC ;NO CHARS SEEN BEFORE SEP
|
||
BIT #NNUMF,RDFLAG
|
||
BNE RDWC ;NOT A POSSIBLE NUMBER
|
||
MOV TOPS,B
|
||
MOV #LNUM,A
|
||
JSR PC,CONVER ;TRY MAKING A #
|
||
SKPRET ;LOST SO LEAVE AS LSTR
|
||
SKPRET ;OK
|
||
RDWC: MOV #UFUN,A ;TRY TO INTERN STRING IN TOPS AS A SYSTEM OR USER FUNCTION
|
||
BIT #DOTF,RDFLAG ; UNLESS DOTF ON, THEN AS USER VARIABLE
|
||
BEQ RDWD
|
||
MOV #UVAR,A
|
||
BIC #DOTF,RDFLAG
|
||
RDWD: JSR PC,.INTRN ;RDSTR COMES HERE ALSO
|
||
BR RDWE
|
||
JSR PC,FRELST
|
||
RDWE: BIS A,B
|
||
SKPRET
|
||
.STITLE READ - READ STRING
|
||
;READ CHAR UP TO NEXT SPACE OR ] IF INSIDE
|
||
;A LIST. DONT ALLOW ] OR [.
|
||
;ALWAYS SKIPS
|
||
RDST: CLRB RDFLAG
|
||
JSR PC,BLSTI
|
||
BR RDSB
|
||
RDSA: JSR PC,GNC
|
||
RDSB: MOVB DTBL(D),A
|
||
BIT #SEPF,A
|
||
BEQ RDSE
|
||
CMP #' ,D
|
||
BEQ RDSX
|
||
CMP #'],D
|
||
BEQ RDSC
|
||
CMP #'[,D
|
||
BEQ RDSX
|
||
CMP #15,D
|
||
BEQ RDSX
|
||
RDSE: BIS A,RDFLAG
|
||
JSR PC,BLST
|
||
BR RDSA
|
||
RDSC: TST LISTBD ;ARE WE IN LIST
|
||
BNE RDSX ;YES
|
||
RDSD: ERROR+COP ;CHAR (D) OUT OF PLACE
|
||
RDSX: MOV #LSTR,A
|
||
MOV #LSTR, B
|
||
JSR PC,BLSTF
|
||
RDSR: RTS PC ;EMPTY STRING
|
||
MOV #LSTR,A
|
||
MOV TOPS,B
|
||
BIT #NNUMF,RDFLAG
|
||
BEQ RDSR ;IT IS A POSSIBLE NUMBER
|
||
BIT #SEPF,RDFLAG
|
||
BNE RDSR ;IT HAS A SEP CHAR IN IT
|
||
MOV #ATOM,A
|
||
JMP RDWD ; INTERN IT
|
||
.STITL READ - READ LIST
|
||
;READ THRU MATCHING ] MAKING A LIST AS U GO
|
||
RDLST: CLRB RDFLAG
|
||
JSR PC,SLISTB
|
||
RDLA: JSR PC,GNC
|
||
CMP #' ,D
|
||
BEQ RDLA ;SKIP OVER SPACES
|
||
CMP #'[,D
|
||
BEQ RDLB ;READ A LIST
|
||
CMP #'],D
|
||
BEQ RDLY ;DONE
|
||
JSR PC,RDST ;READ A STRING
|
||
BR .+2 ;RDST ALWAYS SKIPS
|
||
RDLX: JSR PC,LISTB ;ADD THIS NODE TO LIST
|
||
CMP #'[,D
|
||
BEQ RDLB
|
||
CMP #'],D ;AT END?
|
||
BNE RDLA ;NO, GET NEXT ELEMENT
|
||
RDLY: JSR PC,FLISTB
|
||
RTS PC
|
||
RDLB: JSR PC,RDLST
|
||
POPS TOPS
|
||
CLR D
|
||
BR RDLX
|
||
.STITLE READ - MISC
|
||
CKDOTF: BIT #DOTF,RDFLAG
|
||
BEQ LISTBR
|
||
BIC #DOTF,RDFLAG
|
||
PUSH A
|
||
SPUSH B
|
||
MOV #SFUN,A
|
||
MOV #$DOTS,B
|
||
JSR PC,LISTB
|
||
JMP RETB
|
||
LISTB: MOV F,C ;BUILD A LIST, ADD NODE IN A,,B TO
|
||
JSR PC,GRBAD1 ;LIST WHOSE LAST NODE PTR IS IN F
|
||
TST F
|
||
BNE LISTB1
|
||
PUSHS C
|
||
BIS #LIST,@S
|
||
LISTB1: MOV C,F
|
||
LISTBR: RTS PC
|
||
SLISTB: MOV @P,A ;START LISTB SAVE RETURN
|
||
MOV F,@P ;SAVE CURRENT LAST NODE PTR
|
||
CLR F
|
||
INC LISTBD
|
||
JMP @A
|
||
FLISTB: POP C ;SAVE RETURN
|
||
TST F
|
||
BNE FLSB1
|
||
PUSHS #LIST
|
||
FLSB1: POP F ;RESTORE OLD CURRENT NODE PTR
|
||
MOV #LIST,A
|
||
MOV @S,B
|
||
JMP @C
|
||
BLSTI: CLR NCHR
|
||
CLR E
|
||
CLR TOPS
|
||
BLSTI1: BIS #100000,E
|
||
RTS PC
|
||
BLST: ;BUILD STRING - CHAR IN D, USES E
|
||
;DESTROYS A,B,C
|
||
PUSH A
|
||
SPUSH B
|
||
SPUSH C
|
||
BIT #200,D ;CHECK IF IGNORE BIT ON
|
||
BNE BLSTRT
|
||
BIT #177,D ;CHECK IF NULL
|
||
BEQ BLSTRT
|
||
INC NCHR ;WE HAVE A CHAR
|
||
ADD #40000,E
|
||
BGE BLST2 ;IS IT THE SECOND
|
||
MOVB D,TEMP ;NO, 1ST
|
||
BLSTRT: JMP RETC
|
||
BLST2: MOVB D,TEMP+1 ;IT IS THE SECOND CHAR
|
||
MOV TEMP,B
|
||
;STORE THE CHARACTERS
|
||
BLST3: JSR PC,BSAN
|
||
BIS #100000,E
|
||
BR BLSTRT
|
||
BLSTF: ;FINISH BUILDING STRING, PUT PTR IN TOPS.
|
||
; DONT SKIP IF EMPTY STRING (TOPS=0)
|
||
TST NCHR
|
||
BEQ BSANR ;EMPTY STRING
|
||
ADD #40000,E
|
||
BGE .+4 ;IS LAST NODE USED
|
||
SKPRET
|
||
PUSH A
|
||
SPUSH B
|
||
SPUSH C
|
||
MOVB TEMP,B ;YES
|
||
JSR PC,BSAN
|
||
BLSTF1: JMP SRETC
|
||
BSAN: MOV E,C
|
||
MOV #SSTR,A
|
||
JSR PC,GRBAD1
|
||
TST E
|
||
BNE BSAN1
|
||
MOV C,TOPS ;SAVE NEW STRING PTR ON S
|
||
BIS #LSTR,TOPS
|
||
BSAN1: MOV C,E
|
||
BSANR: RTS PC
|
||
.STITL GNC - GET NEXT CHAR
|
||
GNC: PUSH A ;GET NEXT CHAR INTO D
|
||
SPUSH B ;INITIALIZE BY MOVING LSTR PTR INTO GNCN
|
||
GNC4: MOVB GNCN+2,D ; AND CLEARING TYPE FIELD (#170000)
|
||
MOV GNCN,B ;SKIPS UNLESS NO MORE CHAR
|
||
BLT GNC1 ;JUST GOT 2ND CHAR
|
||
BNE GNC3
|
||
MOV #15,D
|
||
JMP RETB ;NONE LEFT
|
||
GNC3: JSR PC,.LOAD ;GET NEXT NODE
|
||
BIS #100000,A ;SET "STILL ANOTHER CHAR" BIT
|
||
MOV A,GNCN
|
||
MOVB B,D ;FOR OUTPUT
|
||
SWAB B
|
||
MOVB B,GNCN+2
|
||
GNC2: TST D
|
||
BEQ GNC4 ;IGNORE NULL CHARS
|
||
JMP RETB
|
||
GNC1: BIC #170000,GNCN ;CLEAR "STILL ..." BIT
|
||
BR GNC2
|
||
.STITL ERRORS AND HANDLER
|
||
EMTBK: MOV #SRET,@P ;FAKE IT OUT
|
||
RTI
|
||
ERRBK: PUSH A
|
||
MOV 2(P),A ;GET LOC OF ERROR
|
||
MOV #TYO,PCHR
|
||
JSR PC,PRONL ;PRINT ADDR WHERE ERROR OCCURED
|
||
SPACE
|
||
MOV -2(A),A ;GET ERROR #
|
||
BIC #177400,A
|
||
ASL A
|
||
MOV ERTAB(A),A ;POINTS TO LIST FOR THIS ERROR
|
||
JMP @A ;XFER TO LIST
|
||
ERRRT: POP A
|
||
RTI
|
||
|
||
ERTAS: SPUSH A
|
||
MOV 2(P),A ;TYPE ASCIZ STRING, STRING FOLLOWS CALL
|
||
JSR PC,PRAS
|
||
BIT A,#1 ;IF STRING STOPPED ON ODD ADDR
|
||
BEQ .+4
|
||
INC A ;MAKE IT EVEN
|
||
MOV A,2(P)
|
||
SPOP A
|
||
RTS PC
|
||
PRLO: PUSH A ;PRINT LAST OPERATOR
|
||
SPUSH B
|
||
MOV LO,A
|
||
BEQ EMPTY
|
||
MOV LO+2,B
|
||
BR PRCO1
|
||
PRCO: PUSH A, ;PRINT CURRENT OPERATOR
|
||
SPUSH B
|
||
MOV CO,A
|
||
MOV CO+2,B
|
||
BEQ EMPTY
|
||
PRCO1: SPUSH D
|
||
JSR PC,PROAB
|
||
SPOP D
|
||
JMP RETB
|
||
PROAB: CMP A,#UFUN ;PRINT OPERATOR IN A,B
|
||
BLO PRCO2
|
||
JMP PPNAME ;PRINT PNAME
|
||
PRCO2: MOV B,A ;SYSTEM FUNCTION
|
||
ADD #4,A
|
||
JMP PRAS ;PRINT ASCIZ PNAME
|
||
EMPTY: PRTXT ^\ EMPTY \
|
||
JMP RETB
|
||
ERTAP: MOV @(P),A ;TYPE ASCIZ STRING, POINTER FOLLOWS CALL
|
||
INC @P
|
||
INC @P
|
||
PRAS: SPUSH D ;PRINT ASCIZ STRING POINTED TO BY A
|
||
PRAS1: MOVB (A)+,D
|
||
BEQ PRASR
|
||
JSR PC,@PCHR
|
||
BR PRAS1
|
||
PRASR: SPOP D
|
||
RTS PC
|
||
PRON: BIC #TF2,TFLAGS ;PRINT OCTAL NO., NO. IN A
|
||
BR PRON1 ;CALL- JSR PC,PRON
|
||
PRONL: BIS #TF2,TFLAGS
|
||
PRON1: PUSH A ;PRON DOESN'T PRINT LEADING ZEROS, PRONL DOES
|
||
SPUSH D
|
||
CLR D
|
||
SEC
|
||
ROL A ;TO TELL WHEN WE ARE DONE
|
||
BR PRON2
|
||
PRON3: CLR D
|
||
ASL A
|
||
BEQ PRON5
|
||
ROL D
|
||
ASL A
|
||
ROL D
|
||
ASL A
|
||
PRON2: ROL D
|
||
BNE PRON4
|
||
BIT #TF2,TFLAGS
|
||
BEQ PRON3
|
||
PRON4: BIS #TF2,TFLAGS
|
||
BIS #60,D
|
||
JSR PC,@PCHR
|
||
|
||
BR PRON3
|
||
PRON5: BIS #60,D
|
||
BIT #TF2,TFLAGS
|
||
BNE .+6 ;IF NOTHING HAS BEEN TYPED, TYPE A ZERO
|
||
JSR PC,@PCHR
|
||
SPOP D
|
||
SPOP A
|
||
RTS PC
|
||
PRDNL: BIS #TF1,TFLAGS
|
||
BR .+10
|
||
PRDN: BIC #TF1,TFLAGS ;PRINT DECIMAL NO. IN A
|
||
PUSH B
|
||
SPUSH D
|
||
MOV #10,B
|
||
MOV A,MQ
|
||
BGE PRDN1
|
||
NEG MQ ;ITS NEGATIVE
|
||
MOV #'-,D
|
||
JSR PC,@PCHR
|
||
PRDN1: MOV DTOTB(B),DIVIDE
|
||
BIT #TF1,TFLAGS
|
||
BNE PRDN2
|
||
BITB #MQZ,EAESR ;> ZERO?
|
||
BNE PRDN3 ;NO
|
||
BIS #TF1,TFLAGS
|
||
PRDN2: MOV MQ,D
|
||
ADD #'0,D
|
||
JSR PC,@PCHR
|
||
PRDN3: MOV AC,MQ
|
||
SUB #2,B
|
||
BNE PRDN1
|
||
MOV MQ,D
|
||
ADD #'0,D
|
||
JSR PC,@PCHR
|
||
POP D
|
||
SPOP B
|
||
RTS PC
|
||
DTOTB: 1.
|
||
10.
|
||
100.
|
||
1000.
|
||
10000.
|
||
EMPTY1: JMP EMPTY
|
||
PRS1: PUSH A ;PRINT TOP ELEMENT OF SS
|
||
SPUSH B
|
||
MOV CSPDLP,A
|
||
ADD SPRBAO,A
|
||
CMP A,S
|
||
BLOS EMPTY1
|
||
MOV @S,B
|
||
SPUSH D
|
||
JSR PC,PNODAB
|
||
SPOP D
|
||
JMP RETB
|
||
PNODAB: MOV B,A
|
||
BIC #7777,A
|
||
CMP #SSTR,A
|
||
BEQ PRS11
|
||
CMP #ATOM,A
|
||
BLOS PRS11
|
||
ERROR+INVN ;INVALID NODE
|
||
PRS11: JSR PC,PRDATA
|
||
RTS PC
|
||
PRCT: PUSH A ;PRINT CURRENT TOKEN
|
||
SPUSH B
|
||
SPUSH D
|
||
MOV CT,A
|
||
MOV CT+2,B
|
||
JSR PC,PRTAB
|
||
SPOP D
|
||
JMP RETB
|
||
PRTAB: BIC #7777,A ;PRINT TOKEN IN A,B
|
||
CMP A,#UVAR
|
||
BHIS .+6
|
||
JMP PROAB
|
||
CMP A,#UVAR
|
||
BEQ PRUV
|
||
BR PRDATA
|
||
PRATM: BIS #PQF,FLAGS2 ;PRINT ATOM IN A,B
|
||
BR PRUV1
|
||
PRUV: MOVB #':,D ;PRINT USER VARIABLE IN A,B
|
||
JSR PC,@PCHR
|
||
PPNAME: BIC #PQF,FLAGS2 ;PRINT PNAME - UOE PTR IN B
|
||
PRUV1: JSR PC,.LOAD
|
||
JMP PRLSTR ;PRINT PNAME
|
||
PRDATA: CMP #LNUM,A ;PRINT DATA IN A,B. 7777 FIELD OF A IS 0000
|
||
BEQ PRNUM ;NUMBER
|
||
CMP #SNUM,A
|
||
BEQ PRNUM
|
||
BIS #PQF,FLAGS2 ;SET PRINT QUOTE FLAG
|
||
CMP #ATOM,A
|
||
BEQ PRUV1
|
||
CMP #LSTR,A
|
||
BEQ PRLSTR ;LONG STRING
|
||
CMP #SSTR,A
|
||
BEQ PRSSTR ;SHORT STRING
|
||
BIC #PQF,FLAGS2
|
||
CMP #LIST,A
|
||
BEQ PRLST
|
||
ERROR+CPS ;CANT PRINT A SNAP
|
||
PRLSTR: JSR PC,.LOAD ;PRINT LONG STRING
|
||
PRSSTR: JSR PC,PRQQ ;PRINT SHORT STRING
|
||
PRSTR2: MOVB B,D
|
||
BLE PRSTR3 ;NULL CHAR
|
||
JSR PC,@PCHR
|
||
PRSTR3: SWAB B
|
||
MOVB B,D
|
||
BLE PRSTR4 ;NULL CHARACTER
|
||
JSR PC,@PCHR
|
||
PRSTR4: MOV A,B
|
||
BIC #170000,B
|
||
BEQ PRSRET
|
||
JSR PC,.LOAD
|
||
BR PRSTR2
|
||
PRSRET: RTS PC
|
||
PRQQ: BIT #PQF,FLAGS2 ;PRINT ' " ' IF PQF=1
|
||
BEQ PRSRET
|
||
BIT #DPQF,FLAGS2
|
||
BNE PRSRET
|
||
MOVB #'",D
|
||
JMP @PCHR
|
||
PRNUM: CLR TEMP
|
||
BIC #7777,A
|
||
CMP #SNUM,A
|
||
BEQ PRNUM2
|
||
PRNUM1: JSR PC,.LOAD ;GET FIRST NODE
|
||
BIT #7777,A ;ONLY PRINT SNUM S FOR NOW
|
||
BEQ PRNUM2
|
||
ERROR+NTB ;# TOO BIG
|
||
PRNUM2: MOV B,A
|
||
JSR PC,PRDN
|
||
RTS PC
|
||
PRLST: PUSH A ;PRINT LIST, PTR IN B
|
||
SPUSH B
|
||
SPUSH C
|
||
TST NBKTS
|
||
BEQ PRL4
|
||
MOV #'[,D
|
||
JSR PC,@PCHR
|
||
PRL4: INC NBKTS
|
||
MOV B,C
|
||
PRL1: BIT #7777,C ;EMPTY LIST
|
||
BEQ PRL2 ;YES, DONE
|
||
BIS #DPQF,FLAGS2 ;DONT PRINT QUOTE BEFORE STRINGS
|
||
BR PRL3
|
||
PRL6: SPACE
|
||
PRL3: JSR PC,.LOADC ;GET THIS NODE
|
||
MOV A,C ;SAVE PTR TO NEXT
|
||
BIC #7777,A
|
||
JSR PC,PRTAB
|
||
BIT #7777,C
|
||
BNE PRL6
|
||
PRL2: DEC NBKTS
|
||
BEQ PRL5
|
||
MOV #'],D
|
||
JSR PC,@PCHR
|
||
PRL5: JMP RETC
|
||
PRNODE: PUSH A ;PRINT NODE POINTED TO BY B
|
||
SPUSH B
|
||
SPUSH D
|
||
JSR PC,.LOAD
|
||
JSR PC,PRON
|
||
SPACE
|
||
MOV B,A
|
||
JSR PC,PRON
|
||
SPOP D
|
||
JMP RETB
|
||
SEX1: JSR PC,PRNODE ;FOR FOO$X COMMAND IN 11SIM
|
||
HALT
|
||
SEX: JSR PC,PRNODE ;FOR RUG
|
||
JMP RUG
|
||
ERTLN: ;ERR RETURN TO LEVEL N
|
||
ERTL0: ;ERR RETURN TO LEVEL 0
|
||
MOV FUNLEV,A
|
||
BEQ ERTL1
|
||
PRTXT ^\LEVEL \
|
||
JSR PC,PRDN
|
||
PRTXT ^\ LINE \
|
||
MOV CLN,A
|
||
JSR PC,PRDN
|
||
PRTXT ^\ IN \
|
||
MOV CPP,B
|
||
JSR PC,PPNAME
|
||
PRCR
|
||
ERTL1: MOV USER,U
|
||
MOV #DBITTB,A
|
||
ADD U,A
|
||
MOV #1,(A)+
|
||
CLR (A)+
|
||
CLR (A)+
|
||
CLR (A)+
|
||
CLR (A)+ ;THAT SHOULD BE ENOUGH
|
||
MOV UDSKAD(U),UNXTDB(U)
|
||
MOV #PDLINK-SLOT1,A
|
||
ADD BASEUS,A
|
||
CLR @A
|
||
CLR 2(A)
|
||
MOV A,P
|
||
MOV A,PRBAO
|
||
MOV A,PPOPL
|
||
SUB #524,A
|
||
MOV A,PPUSHL
|
||
MOV #SDLINK-SLOT1,A
|
||
ADD BASEUS,A
|
||
CLR 2(A)
|
||
CLR @A
|
||
MOV A,S
|
||
MOV A,SPRBAO
|
||
MOV A,SPOPL
|
||
SUB #524,A
|
||
MOV A,SPUSHL
|
||
MOV #TOPS,A
|
||
MOV #<NCHR-TOPS>/2,B
|
||
CLR (A)+
|
||
DEC B
|
||
BGE .-4
|
||
CLR BRAKE
|
||
JMP MLOOP
|
||
SHOW: JSR PC,GUOEB ;SHOW "FOO"
|
||
BR SHOW5
|
||
MOV B,E
|
||
JSR PC,.BINDF
|
||
SHOW5: ERROR+PNH ;PROCEDURE NOT HERE
|
||
MOV B,F
|
||
PRCR
|
||
PRTXT ^\TO \
|
||
MOV E,B
|
||
JSR PC,PPNAME
|
||
MOV F,C
|
||
JSR PC,.LOADC
|
||
MOV A,F ;SAVE PTR TO NEXT NODE
|
||
JSR PC,.LOAD ;#ARGS IN B
|
||
TST B
|
||
BEQ SHOW2
|
||
MOV A,C
|
||
SHOW1: SPACE
|
||
JSR PC,.LOADC ;NEXT ARG
|
||
MOV A,C
|
||
JSR PC,PRUV ;PRINT ITS PNAME
|
||
BIT #7777,C
|
||
BNE SHOW1
|
||
SHOW2: PRCR
|
||
BIT #7777,F
|
||
BEQ SHOW4
|
||
MOV F,C
|
||
SHOW3: JSR PC,.LOADC
|
||
MOV A,C
|
||
MOV B,@S
|
||
JSR PC,PRLN
|
||
BIT #7777,C
|
||
BNE SHOW3
|
||
SHOW4: PRTXT ^\END\
|
||
PRCR
|
||
JMP NORT
|
||
PRLN: PUSH A ;PRINT TOKENS IN LIST ON S
|
||
SPUSH B
|
||
SPUSH C
|
||
SPUSH D
|
||
BIC #DPQF,FLAGS2 ;DO PRINT QUOTE BEFORE STRINGS
|
||
MOV @S,C
|
||
BR PRLN2
|
||
PRLN1: SPACE
|
||
PRLN2: JSR PC,.LOADC
|
||
MOV A,C
|
||
JSR PC,PRTAB
|
||
BIT #7777,C ;DONE?
|
||
BNE PRLN1 ;NO
|
||
PRCR
|
||
JMP RETD
|
||
STRACE: BIT #TRACEF,FLAGS2 ;SYSTEM TRACE
|
||
BNE .+4
|
||
RTS PC
|
||
INC NBKTS
|
||
PUSH A
|
||
PRTXT ^/CT=/
|
||
BIC #DPQF,FLAGS2
|
||
JSR PC,PRCT
|
||
PRTXT ^/ CO=/
|
||
JSR PC,PRCO
|
||
PRTXT ^/ S=/
|
||
BIC #DPQF,FLAGS2
|
||
JSR PC,PRS1
|
||
PRCR
|
||
CLR NBKTS
|
||
POP A
|
||
RTS PC
|
||
ETRACE: BIC #TF6,TFLAGS
|
||
BR TRA1
|
||
TRACE: BIS #TF6,TFLAGS
|
||
TRA1: JSR PC,GUOEB
|
||
BR TRA5
|
||
JSR PC,.BNDFS
|
||
TRA5: ERROR+PNH ;PROC NOT HERE
|
||
MOV B,C ;B POINTS TO LIST OF GOODIES. FIRST IS FLAGS,,#ARGS
|
||
JSR PC,.LDP2
|
||
BIC #TPTF,A
|
||
BIT #TF6,TFLAGS
|
||
BEQ TRA2
|
||
BIS #TPTF,A
|
||
TRA2: JSR PC,.STP2
|
||
JMP NORT
|
||
SETSTF: BIS #TRACEF,FLAGS2 ;SET SYSTEM TRACE FLAG
|
||
JMP NORT
|
||
CLRSTF: BIC #TRACEF,FLAGS2
|
||
JMP NORT
|
||
FLEV: MOV FUNLEV,B ;RETURN USER PROC CALL DEPTH
|
||
JMP R1NARG
|
||
VERSN: MOV LVERNF,B
|
||
JMP R1NARG
|
||
.MACR ERMM AA
|
||
.XLIST
|
||
AA==ERMNO
|
||
ERMNO==ERMNO+1
|
||
AA'.E
|
||
.LIST
|
||
.ENDM
|
||
|
||
.MACR BEGER A
|
||
A'.E: .OFFSE 0 ;(THIS WILL BE NON-ZERO LATER)
|
||
.ENDM
|
||
|
||
.MACR ENDER
|
||
.XLIST
|
||
PRCR
|
||
JMP ERTLN
|
||
.OFFSE 0
|
||
.LIST
|
||
.ENDM
|
||
|
||
ERMNO==0
|
||
ERTAB: ERMM BSS ;BAD SS
|
||
ERMM CFL ;CANT FIND LINE #
|
||
ERMM COP ;CHAR (D) OUT OF PALCE
|
||
ERMM CPS ;CANT PRINT SNAP
|
||
ERMM CTIP ;CANT "TO" IN PROCEDURE
|
||
ERMM CTIT ;CANT "TO" IN "TO"
|
||
ERMM ERP ;EXTRA RIGHT PAREN
|
||
ERMM HNM ;... HAS NO MEANING
|
||
ERMM HNV ;... HAS NO VALUE
|
||
ERMM ILN ;..(CT).. IS AN INVALID LOGO NAME.
|
||
ERMM INF1 ;INFIX IN THE WRONG PLACE
|
||
ERMM INVN ;INVALID NODE
|
||
ERMM ITB ;INPUT TOO BIG
|
||
ERMM LCE ;LINE ... CHANGED BY EDIT
|
||
ERMM LDE ;LINE ..(B).. DOESN'T EXIST
|
||
ERMM LNTB ;LINE # TOO BIG
|
||
ERMM NDU ;NOT A DISPLAY USER
|
||
ERMM NOU ;NO OUTPUT
|
||
ERMM NSL ;NO STORAGE LEFT
|
||
ERMM NTB ;# TOO BIG
|
||
ERMM NTF ;(S) NOT "TRUE" OR "FALSE"
|
||
ERMM NTL ;NUMBER TOO LONG
|
||
ERMM NY ;NOT YET!!
|
||
ERMM OIP ;ONLY IN PROCEDURE
|
||
ERMM OOB ;OUT OF BOUNDS
|
||
ERMM OOP ;(CO) OUT OF PLACE
|
||
ERMM OOT ;OUT OF TOKENS
|
||
ERMM PAE ;PROCEDURE ..(CT).. ALREADY EXISTS
|
||
ERMM PNH ;PROCEDURE ... NOT HERE
|
||
ERMM RTB ;RESULT TOO BIG
|
||
ERMM STD ;SNAP TOO DEEP
|
||
ERMM TIP ;TOO MUCH INSIDE PARENS
|
||
ERMM TML ;TOO MANY LINES
|
||
ERMM TMS ;TOO AMNY SNAPS
|
||
ERMM UEL ;UNEXPECTED END OF LINE
|
||
ERMM WDW ;WHAT SHOULD I DO WITH ...
|
||
ERMM WIC ;YOU CAN'T WIPE WHILE IN CAMERA
|
||
ERMM WIT ;(CT) IS WRONG INPUT TO "TO"
|
||
ERMM WTA ;..(CO)..DOESN'T LIKE..(CT)..AS INPUT
|
||
ERMM WTAA ;..(CO)..DOESN'T LIKE..(A)...AS INPUT
|
||
ERMM WTAB ;..(CO)..DOESN'T LIKE..(B)...AS INPUT
|
||
ERMM YND ;YOU DON'T HAVE THE DISPLAY
|
||
ERMM YNT ;YOU DON'T HAVE THE TURTLE
|
||
ERTEND: ERMNO ;NEXT AVAILABLE ERR NO.
|
||
BEGER WTAA
|
||
PUSHS A
|
||
JSR PC,PRCO
|
||
PRTXT ^/ DOESN'T LIKE /
|
||
JSR PC,PRS1
|
||
PRTXT ^/ AS INPUT./
|
||
ENDER
|
||
|
||
BEGER WTAB
|
||
PUSHS B
|
||
JSR PC,PRCO
|
||
PRTXT ^/ DOESN'T LIKE /
|
||
JSR PC,PRS1
|
||
PRTXT ^/ AS INPUT./
|
||
ENDER
|
||
|
||
BEGER WTA
|
||
JSR PC,PRCO
|
||
PRTXT ^/ DOESN'T LIKE /
|
||
JSR PC,PRS1
|
||
PRTXT ^/ AS INPUT./
|
||
ENDER
|
||
|
||
BEGER INF1
|
||
JSR PC,PRCO
|
||
PRTXT ^/ IS IN THE WRONG PLACE./
|
||
ENDER
|
||
|
||
BEGER NOU
|
||
JSR PC,PRLO
|
||
PRTXT ^/ DIDN'T OUTPUT!/
|
||
ENDER
|
||
|
||
BEGER OOT
|
||
PRTXT ^/OUT OF TOKENS./
|
||
ENDER
|
||
|
||
BEGER BSS
|
||
PRTXT ^/BAD SS./
|
||
ENDER
|
||
|
||
BEGER NY
|
||
PRTXT ^/NOT YET!!/
|
||
ENDER
|
||
|
||
BEGER WDW
|
||
PRTXT ^/WHAT SHOULD I DO WITH /
|
||
JSR PC,PRS1
|
||
ENDER
|
||
|
||
BEGER HNV
|
||
JSR PC,PRCT
|
||
PRTXT ^/ HAS NO VALUE./
|
||
ENDER
|
||
|
||
BEGER ERP
|
||
PRTXT ^/EXTRA RIGHT PAREN./
|
||
ENDER
|
||
|
||
BEGER TIP
|
||
PRTXT ^/TOO MUCH INSIDE PARENS./
|
||
ENDER
|
||
|
||
BEGER OOP
|
||
JSR PC,PRCO
|
||
PRTXT ^/ OUT OF PLACE./
|
||
ENDER
|
||
|
||
BEGER UEL
|
||
PRTXT ^/UNEXPECTED END OF LINE./
|
||
ENDER
|
||
|
||
BEGER NSL
|
||
PRTXT ^/NO STORAGE LEFT./
|
||
ENDER
|
||
|
||
BEGER NTF
|
||
JSR PC,PRS1
|
||
PRTXT ^/ NOT "TRUE" OF "FALSE"./
|
||
ENDER
|
||
|
||
BEGER LDE
|
||
PRTXT ^\LINE \
|
||
JSR PC,PRDN ;LINE # SHOULD BE IN B
|
||
PRTXT ^\ DOESN'T EXIST.\
|
||
ENDER
|
||
|
||
BEGER LNTB
|
||
PRTXT ^\LINE NUMBER TOO BIG.\
|
||
ENDER
|
||
|
||
BEGER COP
|
||
PRTXT ^\CHAR \
|
||
JSR PC,TYO
|
||
PRTXT ^\ OUT OF PLACE.\
|
||
ENDER
|
||
|
||
BEGER CPS
|
||
PRTXT ^\CANT PRINT A SNAP\
|
||
ENDER
|
||
|
||
BEGER NTB
|
||
PRTXT ^\# TOO BIG\
|
||
ENDER
|
||
;MORE ERROR MESSAGES:
|
||
|
||
BEGER NDU
|
||
PRTXT ^/YOU DON'T HAVE A DISPLAY CONSOLE/
|
||
ENDER
|
||
|
||
BEGER NTL
|
||
PRTXT ^/NUMBER TOO LONG/
|
||
ENDER
|
||
|
||
BEGER OOB
|
||
PRTXT ^/OUT OF BOUNDS/
|
||
ENDER
|
||
|
||
BEGER TML
|
||
PRTXT ^/TOO MANY LINES/
|
||
ENDER
|
||
|
||
BEGER STD
|
||
PRTXT ^/SNAP TOO DEEP/
|
||
ENDER
|
||
|
||
BEGER TMS
|
||
PRTXT ^/TOO MANY SNAPS/
|
||
ENDER
|
||
|
||
BEGER WIC
|
||
PRTXT ^/YOU CANT WIPE WHILE IN CAMERA/
|
||
ENDER
|
||
|
||
BEGER YND
|
||
PRTXT ^/YOU DONT HAVE THE DISPLAY/
|
||
ENDER
|
||
|
||
BEGER YNT
|
||
PRTXT ^/YOU DONT HAVE THE TURTLE/
|
||
ENDER
|
||
BEGER CFL
|
||
PRTXT ^/CANT FIND LINE NO. /
|
||
ENDER
|
||
|
||
BEGER HNM
|
||
PRTXT ^/... HAS NO MEANING./
|
||
ENDER
|
||
|
||
BEGER LCE
|
||
PRTXT ^\LINE ... CHANGED BY EDIT.\
|
||
ENDER
|
||
|
||
BEGER PNH
|
||
PRTXT ^/PROCEDURE ... NOT HERE/
|
||
ENDER
|
||
|
||
BEGER PAE
|
||
CLR TOPRNM
|
||
PRTXT ^/PROCEDURE /
|
||
JSR PC,PRCT
|
||
PRTXT ^/ ALREADY EXISTS./
|
||
ENDER
|
||
|
||
BEGER ILN
|
||
JSR PC,PRCT
|
||
PRTXT ^/ IS AN INVALID LOGO NAME./
|
||
ENDER
|
||
|
||
BEGER WIT
|
||
CLR TOPRNM
|
||
JSR PC,PRCT
|
||
PRTXT ^/ CAN'T BE A DUMMY INPUT TO "TO"./
|
||
ENDER
|
||
|
||
BEGER RTB
|
||
PRTXT ^\ARITHMETIC RESULT TOO BIG.\
|
||
ENDER
|
||
|
||
BEGER ITB
|
||
PRTXT ^\ARITHMETIC INPUT TOO BIG.\
|
||
ENDER
|
||
BEGER CTIP
|
||
PRTXT ^\CANT "TO" IN A PROCEDURE.\
|
||
ENDER
|
||
BEGER CTIT
|
||
PRTXT ^\CANT "TO" IN "TO".\
|
||
ENDER
|
||
BEGER INVN
|
||
PRTXT ^\INVALID NODE.\
|
||
ENDER
|
||
BEGER OIP
|
||
PRTXT ^\ ONLY WHEN IN A PROCEDURE.\
|
||
ENDER
|
||
|