github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-04-18 17:08:05 +00:00
Code Issues Releases Wiki Activity
Files
098afca9e4d672f2bcc741316bfc2d0ecf21aafa
PDP-10.its/src/rjl/logops.70
Lars Brinkhoff 608902b647 Assemble CLOGO from version 49. 
We previously had HQM; CLOGO BIN dated 1975.  When run, it announces
itself as LOGO.44.  RJL; LOGO 49 has a timestamp from 1973, but
appears to be a later version including turtle graphics on the 340
display.
2019-02-06 10:42:37 +01:00

2392 lines
45 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
THING: MOVE A,(S)
THING2: MOVE B,VP
PUSHJ P,LOOKUP
JRST THING3 ;NOT A GLOBAL VARIABLE
JRST THING4
THING3: MOVE A,(S)
MOVEI B,MV
PUSHJ P,SYSLUK
MOVEI N,[W+WORDF\EMPTYF,,0]-1
MOVE A,1(N) ;MACHINE VARIABLES MUST BE CHECKED
JUMPL A,(A) ;THIS ONE MUST BE COMPUTED, (FLAG IS SIGN BIT)
THING4: MOVE A,1(N)
MOVEM A,(S)
POPJ P,
CCONTE: POP S,A ;COMPUTE /CONTENTS/
PUSHJ P,NEWSTR
TRZ F,TF\NWF
MOVEI C,0
MOVE D,RP
MOVNI E,1
CCNTE1: SKIPN A,(D) ;ANY MORE PROCEDURE NAMES?
JRST ENDST1 ;NO
MOVEI D,1(D)
CAMN E,(D) ;IS THIS ONE DEFINED?
AOJA D,CCNTE1 ;NO
MOVEI C,"
TRON F,TF ;FIRST ONE?
JRST .+3 ;YES
TRO F,NWF ;NOT FIRST
DPB C,B ;NO REPLACE EOM WITH SPACE
PUSHJ P,NEWSR0
PUSHJ P,COPYAB
AOJA D,CCNTE1
IFE LFLAG,[ ;SENTENCE OPERATIONs---NO LISTS
FIRST:
PUSHJ P,NEWOPS ;CHECK EMPTY,SET UP SRCBOT+NEWBOT
JRST FSTSNT ;NO, SENTENCE
ILDB C,A ;FIRST BYTE
IDPB C,B ;BOMBS HERE ON FULL WORKSPACE
MOVEI C,0 ;FILL ZEROES AND RETURN NEW ARG
JRST BTFCL1
FSTSNT: ILDB C,A ;FIRST OF SENTENCE
JUMPE C,FSTWD
CAIN C,"
JRST FSTWD
IDPB C,B ;COPY CHARACTERS TO END OF FIRST WORD
JRST FSTSNT
FSTWD: CAMN B,NEWBOT ;IS IT EMPTY?
SKIPA A,[W+WORDF\EMPTYF,,0]
HRLZI A,W+WORDF
HLLM A,0(S)
MOVEI C,0
JRST BTFCL1
BUTFIRST:
PUSHJ P,NEWOPS
JRST BTFSNT ;NOT A WORD OR EMPTY, IE SENTENCE
TRZ F,TF
IBP A ;BUTFIRST OF WORD, SKIP OVER FIRST CHAR
ILDB C,A ;THIS IS THE SECOND CHAR
JUMPN C,BTFCOP ;MORE THAN ONE CHAR, COPY TO END OF STRING
BTFEMW: SKIPA A,[W+WORDF\EMPTYF,,0]
BTFEMP: HRLZI A,W+SENTF\EMPTYF ;ONE OF THE MANY WAYS T
MOVEM A,(S) ;TO GET A POINTER TO EMPTY
POPJ P,
BTFSNT: ILDB C,A ;SKIP OVER FIRST WORD
JUMPE C,BTFEMP ;WAS ONLY WORD, RESULT IS EMPTY
CAIE C," ;END OF WORD?
JRST BTFSNT ;CONTINUE SKIPPING OVER FIRST WORD
BTFCP1: ILDB C,A
BTFCOP:
BTFCLO: JUMPE C,BTFCL1
IDPB C,B
JRST BTFCP1
BTFCL1: PUSHJ P,ENDSTR
POP S,A
HRRM A,(S) ;NEW STRING, OLD TYPE
POPJ P,
LAST:
PUSHJ P,NEWOPS
JRST LSTSNT
ILDB C,A
IDPB C,B ;COPY FIRST CHAR, BUMPING THE CHAR PTR IN B ONCE
ILDB C,A
JUMPE C,BTFCL1 ;DONE WITH THE WORD
DPB C,B ;PUT THIS CHAR ON TOP OF PREVIOUS ONE
JRST .-3
LSTSNT: MOVE E,A ;SAVE POINTER TO BEGINNING OF WORD
LSTSN2: ILDB C,A ;CONTINUE WITH THE CURRENT WORD
CAIN C,"
JRST LSTSNT ;END OF CURRENT WORD, NOT LAST ONE
JUMPN C,LSTSN2 ;NULL_END OF SENT, ELSE NOT END OF ANY WORD
MOVE A,E
JRST FSTSNT
BUTLAST:
PUSHJ P,NEWOPS
JRST BTLSNT
ILDB C,A ;BUTLAST OF WORD, COPY WORD AND CLOBBER LAST CHAR
IDPB C,B
ILDB C,A
JUMPE C,BTFEMW ;WAS A ONE CHAR WORD, MAKE AN EMPTY
IDPB C,B
ILDB C,A
JUMPN C,.-2 ;COPY REST OF WORD
BTLCLO: DPB C,B ;CLOBBER LAST CHAR
JRST BTFCL1 ;FILL TO END OF WORD
BTLSNT: MOVE E,A ;SAVE POINTER TO BEGINNING
BTLSN1: ILDB C,A ;STEP THRU FIRST WORD
JUMPE C,BTFEMW ;ALSO LAST, MAKE AN EMPTY
CAIE C,"
JRST BTLSN1 ;CONTINUE WITH FIRST WORD
BTLSN2: MOVE A,E
BTLSN9: ILDB C,A ;COPY STEPPED OVER WORD
IDPB C,B
CAIE C,"
JRST BTLSN9
MOVE E,A ;SAVE POINTER TO NEXT WORD
BTLSN4: ILDB C,A
JUMPE C,BTLCLO ;THIS IS END OF LAST WORD
CAIN C,"
JRST BTLSN2 ;END OF WORD, NOT LAST ONE, COPY IT
JRST BTLSN4 ;NOT END OF WORD, FIND IT
;END OF LFLAG=0 CONDITIONAL
]
PUSHJ P,NRMLOP
WORD:
WORDX:
HRLZI A,WORDF
TDNE A,0(S)
TDNN A,-1(S)
ERROR WRDERR ;YOU CAN'T MAKE A WORD OUT OF A SENTENCE
CONC: HRLZI C,EMPTYF
TDNN C,-1(S) ;IS FIRST ARG EMPTY?
JRST WORD0 ;NO
POP S,-1(S) ;YES, THEN SECOND ARG IS THE RESULT
POPJ P,
WORD0: TDNE C,(S)
JRST SPOPJ
PUSHJ P,NEWSTR ;SET UP B AND NEWBOT
PUSHJ P,NEWSR1 ;SET UP A TO -1(S) AND SRCBOT
ILDB C,A
JUMPE C,WORD2 ;DON'T COPY EOM FROM FIRST ARG
IDPB C,B
JRST .-3 ;COPY WHOLE FIRST ARG
WORD2: PUSHJ P,NEWSRC ;SET UP A TO 0(S) AND SRCBOT
ILDB C,A
JUMPE C,.+3
IDPB C,B
JRST WORD2+1
POP S,A ;FLUSH SECOND ARG
JRST BTFCL1 ;FILL ZEROES AND RETURN ONE ARG
PUSHJ P,NRMLOP
SENTENCE:
HRLZI E,EMPTYF
TDNE E,0(S)
TDNN E,-1(S)
JRST SENT1
HRLZI A,W+EMPTYF+SENTF
MOVEM A,-1(A)
SPOPJ: POP S,A ;BOTH EMPTY
POPJ P, ;RETURN EMPTY
SENT1: PUSHJ P,NEWSTR
PUSHJ P,NEWSR1
SENT2: ILDB C,A
JUMPE C,SENT3
IDPB C,B
JRST SENT2
SENT3: MOVEI C,"
PUSHJ P,NEWSRC
TDNN E,-1(S) ;IF FIRST ARG IS EMPTY, DON'T SPACE
SENT4: IDPB C,B
ILDB C,A
JUMPN C,SENT4
POP S,A ;FLUSH SECOND ARG
HRLZI A,W+SENTF ;CALL NEW THING A SENTENCE
HLLM A,0(S)
JRST BTFCL1
IFE LFLAG,[ ;NON-LIST OPERATIONS
COUNT: MOVE A,(S) ;THING TO COUNT
MOVEI B,0 ;COUNT INITIALLY ZERO
TLNE A,EMPTYF ;IS IT EMPTY?
JRST COUNT2 ;COUNT=0
TLNN A,WORDF ;IS IT A WORD?
AOJA B,COUNT1 ;NO, IT IS A NON-EMPTY SENTENCE
HRLI A,440700+W
MOVNI B,1
ADD B,@A ;NOW NUMBER OF WORDS -1
IMULI B,5 ;NUMBER OF CHARS IN ALL BUT LAST WORD
ADD A,@A ;NOW A POINTS AT LAST WORD
ILDB C,A ;WORD
JUMPE C,COUNT2
AOJA B,.-2
COUNT1: HRLI A,010700+W
COUNTL: ILDB C,A
JUMPE C,COUNT2
CAIN C,"
AOJA B,COUNTL ;COUNT WORDS OF SENT AT BEG OF WORD
JRST COUNTL ;MORE OF THE SAME WORD
COUNT2:
MOVE A,B ;ARG TO SNM IN A
PUSHJ P,SNM
MOVSI C,W+WORDF
HLLM C,(S)
JRST BTFCL1
RANDOM: MOVE C,[EXP 1000003]
IMULB C,RANNO
ADD C,CRTIM1
TLZ C,400000 ;MAKE IT +
MULI C,12
ADDI C,"0
JFCL 10,.+1
PUSHJ P,NEWSTR
IDPB C,B
JRST ENDSTR
] ;END OF LFLAG=0 CONDITIONAL
IFN LFLAG,[ ;LIST OPERATIONS
.INSRT LSTOPS >
]
IFN VFLAG,[ ;VECTOR OPERATIONS
.INSRT VECOPS >
]
IFN SNAPFL,[
CMSQRT: PUSHJ P,NUCONV ;LOGO COMMAND
MOVE A,E
PUSHJ P,FLOAT ;THIS IS WHAT HAPPENS WHEN PEOPLE ARE TOO LAZY TO WRITE
PUSHJ P,SQRT ;FIXED SQRT ROUTINES
PUSHJ P,FIX
JRST NUMRET
]
IFN SNAPFL+LFLAG,[
SQRT: MOVEM B,SB
MOVE B,A
SQRT1: JUMPLE B,SQ2
MOVEM C,SC
PUSH P,[FSC A,0]
ASHC B,-33
SUBI B,201
ROT B,-1
HRRM B,(P)
LSH B,-43
ASH C,-10
FSC C,177(B)
MOVEM C,A
FMP C,SQS1(B)
FAD C,SQS2(B)
MOVE B,A
FDV B,C
FAD C,B
FSC C,-1
FDV A,C
FADR A,C
SQ1: POP P,C
XCT C
SKIPA C,SC
SQ2: MOVEI A,0
MOVE B,SB
POPJ P,
]
EITHER: TROA F,TF
BOTH: TRZ F,TF
MOVE A,(S)
PUSHJ P,PREDIQ
ERROR PREDR2
MOVE A,-1(S)
PUSHJ P,PREDIQ
ERROR PREDR2
POP S,B ;SECOND ARG
MOVEI A,1 ;LENGTH OF "TRUE"
TRZN F,TF ;SKIP IF DOING EITHER
MOVEI A,2 ;LENGTH OF "FALSE"
CAMN A,@WSB ;COMPARE AGAINST LENGTH OF SECOND ARG
MOVEM B,(S) ;JAM IF EITHER AND TRUE OR BOTH AND FALSE
POPJ P,
NOT: MOVE A,(S)
PUSHJ P,PREDIQ
ERROR PREDR1
POP S,B
MOVE A,@WSB
CAIE A,1
JRST ISTRUE
JRST ISFALSE
EMPTYP: HRLZI A,EMPTYF
PREDS1: POP S,B
TDNN A,B
JRST ISFALSE
JRST ISTRUE
SENTP: HRLZI A,SENTF
JRST PREDS1
WORDP: HRLZI A,WORDF
JRST PREDS1
IS: POP S,A
POP S,B
IS1: MOVE C,@A
CAME C,@B
JRST ISFALSE
ADDI A,1
TRNE C,377
AOJA B,IS1
ISTRUE: SKIPA A,[XWD WORDF+W,TRUEV] ;POINTER TO "TRUE"
ISFALSE:MOVE A,[XWD WORDF+W,FALSEV] ;WS PTR TO "FALSE"
PUSH S,A
POPJ P,
NUMBRP: POP S,A
PUSHJ P,NUMBRQ
JRST ISFALSE
JRST ISTRUE
LESSP: MOVE A,(S)
EXCH A,-1(S)
MOVEM A,(S)
GRATRP: PUSH P,WTOP ;BOTH ARGS ARE NUMBERS, REMEMBER CURRENT TOP OF WS
PUSHJ P,DIFF ;GET THE DIFFERENCE
POP P,A ;GET THE OLD WTOP
CAIGE A,WTOP ;SKIP IF GC IN BETWEEN
MOVEM A,WTOP ;NO, FLUSH ALL GARBAGE GENERATED BY DIFF
POP S,A ;GET THE RESULT
HRLI A,010700+W
ILDB C,A ;GET THE SIGN OF THE RESULT
CAIE C,"0 ;IS IT ZERO?
CAIN C,"- ;IS IT NEGATIVE
JRST ISFALSE ;EITHER ZERO OF NEGATIVE, CANNOT BE GREATER
JRST ISTRUE
ZEROP: MOVE A,(S)
PUSHJ P,NUMBRQ
ERROR ZERERR
POP S,A
HRLI A,010700+W
ILDB C,A ;GET THE FIRST CHAR
CAIE C,"+ ;IF A SIGN, GET ANOTHER CHAR
CAIN C,"-
ZEROP1: ILDB C,A
JUMPE C,ISTRUE ;NUMBRQ WOULD FAIL ON SIGN ONLY OR EMPTY
CAIN C,"0
JRST ZEROP1
JRST ISFALSE
PUSHJ P,NRMLOP
MAXIM: PUSH S,-1(S)
PUSH S,-1(S) ;COPY OF ARGS TO BE DESTROYED BY DIFF
JRST MINMAX
PUSHJ P,NRMLOP
MINIM: PUSH S,0(S)
PUSH S,-2(S) ;OPPOSITE ORDER FROM MAX
MINMAX: PUSHJ P,DIFF
POP S,A ;RESULT OF SUBTRACTION
POP S,B ;SECOND INPUT TO MIN OR MAX
HRLI A,010700+W
ILDB C,A ;GET SIGN OF RESULT
CAIN C,"- ;IF POSITIVE, THEN FIRST IS RESULT
MOVEM B,0(S) ; ELSE SECOND ARG IS THE ANSWER
POPJ P,
DIFF: TRO F,PMF
JRST SUM+1
PUSHJ P,NRMLOP
SUM: TRZ F,PMF
MOVE A,(S)
PUSHJ P,NUMBRQ
ERROR SUMERR
MOVE A,-1(S)
PUSHJ P,NUMBRQ
ERROR SUMERR
PUSHJ P,REVERS
CAIE D,"-
TRON F,PMF ;SKIP IF SECOND ARG + AND IS SUBTRACTION
TRON F,PMF ;SKIP IF ARG2 - & DIFF OR ARG2 + & SUM
PUSHJ P,TENCOM ;CALLED WITH PMF=1_FILL 9'S
MOVE A,(S)
EXCH A,-1(S)
MOVEM A,(S)
PUSHJ P,REVERS
CAIN D,"-
PUSHJ P,TENCOM
PUSHJ P,SUMMER
TRZ F,PMF
CAIN G,"9 ;RESULT NEG IFF HIGH ORDER DIG =9
PUSHJ P,TENCOM ;CALLED WITH PMF=0_PUT A "-" AT THE END
POP S,A ;FLUSH EXTRA LEADING ZEROES
HRLI A,350700+W ;SKIPPING OVER FIRST CHAR
AOJA A,.+2
SUM8: CAIE C,"0 ;CONSECUTIVE 0?
MOVE B,A ;NO, SAVE POINTER TO HIGHEST SIGNIFICANT DIG SO FAR
ILDB C,A
JUMPE C,.+4 ;END OF STRING
CAIE C,"- ;MINUS SIGN LIKE A TERMINATOR FOR NEG STRING
JRST SUM8
IDPB C,B ;PUT TERMINATOR (IN C) ABOVE MOST SIGNIFICANT DIGIT
PUSHJ P,ENDSTR
;FALL INTO REVERB - REVERSE BACK - AND EXIT FROM SUM FROM REVERB
REVERB: TROA F,TF ;REVERSING BACK, NO MODIFICATION TO STRING
REVERS: TRZ F,TF ;FIRST REVERSE OF NUMBER, FIDDLE WITH SIGNS
PUSHJ P,NEWSTR
PUSHJ P,NEWSRC
MOVE D,@A
ADDI A,(D) ;A POINTS AT LAST WORD
MOVEI G,2(D)
MOVE C,@A
TRNE C,77400 ;IS NEXT TO LAST CHAR EOM?
TRNN F,TF ;SKIP IF BOTH PENULT NON-ZERO AND ADDING A CHAR
MOVEI G,-1(G)
HRRZI C,@WTOP
ADDI C,(G)
MOVE G,LCORE
LSH G,12
SUBI G,1
CAMLE C,G
EXPAND WS
MOVE C,@A
MOVEI G,0
JUMPE C,REVERE
ROT C,6
ROT C,-7
TRNN C,177
AOJA G,.-2
ROT G,1 ;TIMES TWO
JRST .+4(G)
REVERL: SUBI A,1
MOVE C,@A
ROT C,-1 ;FLUSH BIT 35
IDPB C,B
ROT C,-7
IDPB C,B ;D
ROT C,-7
IDPB C,B ;C
ROT C,-7
IDPB C,B ;B
ROT C,-7
IDPB C,B ;A
REVERE: SOJG D,REVERL ;MORE WORDS TO REVERSE
TRNE F,TF
JRST REVERO
MOVEI D,177
ANDI D,(C) ;SAVE STATE OF SIGN IN D
MOVEI C,"0
CAIE D,"+
CAIN D,"-
DPB C,B ;REPLACE THE SIGN WITH A "0"
IDPB C,B ;PUT A ZERO FOR UNSIGNED NUMBERS
REVERO: SETZ C, ;SO THAT REST OF WORD WILL BE WIPED
JRST BTFCL1
TENCOM:
PUSHJ P,NEWSRC
PUSHJ P,NEWSTR
TRO F,TF ;SET CARRY INTO LOW ORDER DIGIT
ILDB C,A
JUMPE C,[ERROR]
NINECM: SUBI C,"0
MOVNS C
ADDI C,"9
TRZE F,TF ;WAS THERE A CARRY INTO THIS POSITION?
ADDI C,1 ;YES
CAIG C,"9 ;IS THERE A CARRY OUT OF THIS POS?
JRST .+3 ;NO
SUBI C,12
TRO F,TF
IDPB C,B
ILDB C,A
JUMPN C,NINECM
MOVEI D,"-
TRNN F,PMF
DPB D,B
JRST ENDSTP
SUMMER: MOVE L,-1(S)
TRZ F,TF\PMF
HRLI L,010700+W
MOVEM L,LINBOT
PUSHJ P,NEWSRC
PUSHJ P,NEWSTR
SUMMRL: ILDB C,A
JUMPE C,SUMMR2
SUBI C,"0
ILDB E,L
JUMPE E,SUMMR3
ADDI C,(E)
TRZE F,TF ;CARRY?
ADDI C,1 ;YES
CAIG C,"9 ;CARRY OUT OF THIS POSITION?
JRST .+3 ;NO
SUBI C,12
TRO F,TF
IDPB C,B
MOVEI G,(C)
JRST SUMMRL
SUMMR2: MOVE C,SRCBOT
EXCH C,LINBOT
MOVEM C,SRCBOT
EXCH A,L
IBP A
SUMMR3: SUBI L,1 ;UNDEX PTR IN L
REPEAT 3,IBP L
ILDB C,L ;GET PREVIOUS CHAR, (WAS 0 OR 9)
CAIN C,"9
TRO F,PMF ;NO, IT WAS TEN'S COMPLEMENT
LDB C,A
JUMPE C,SUMMR5
SUMMR4: TRZE F,TF
ADDI C,1
TRNE F,PMF ;WAS IT NEGATIVE?
ADDI C,11 ;YES, LEADING NINES
CAIG C,"9
JRST .+3
SUBI C,12
TRO F,TF
IDPB C,B
MOVEI G,(C)
ILDB C,A
JUMPN C,SUMMR4
SUMMR5: POP S,A
SETZM LINBOT
JRST BTFCL1
;NEGATE A NUMBER
MINUS: MOVE A,(S)
PUSHJ P,NUMBRQ
ERROR MINERR
PUSHJ P,NEWSTR ;SET UP B AS DEST.
PUSHJ P,NEWSRC ;SET UP A AS SOURCE
ILDB C,A ;GET FIRST CHAR OF NUMBER
MOVEI D,"- ;SET TO STORE -
CAIN C,"- ;IS FIRST CHAR -?
JRST COREST ;YES, DROP IT AND COPY REST
IDPB D,B ;NO, # IS +, STORE A -
CAIE C,"+ ;IF FIRST CHAR IS +, DON'T STORE IT
IDPB C,B ;STORE FIRST DIGIT
COREST: ILDB C,A ;COPY REST
JUMPN C,.-2
JRST ENDSTP
PUSHJ P,NRMLOP
TIMES: TRZ F,PMF
JFCL 10,.+1 ;CLEAR OVERFLOW FLAG
MOVE A,(S)
PUSHJ P,NUMBRQ
ERROR SUMERR
PUSHJ P,MNCON
POP S,A
PUSH P,D
MOVE A,(S)
PUSHJ P,NUMBRQ
ERROR SUMERR
PUSHJ P,MNCON
POP S,A
POP P,A
TRNE F,PMF
POPJ P, ;RETURN TO QUOT1 OR REM1
IMUL D,A
JRST QT2
QUOT: TRO F,PMF
PUSHJ P,TIMES+1
QUOT1: JUMPE A,[ERROR DIVBY0]
IDIV D,A
QT2: JFCL 10,[ERROR QTOV]
JRST LNCON
REMAIN: TRO F,PMF
PUSHJ P,TIMES+1
REM1: JUMPE A,[ERROR DIVBY0]
IDIV D,A
MOVE D,E ;GET REMAINDER
JRST QT2
PUSHJ P,NRMLOP
STIMES: MOVE A,(S)
PUSHJ P,NUMBRQ
ERROR SUMERR
PUSH P,NUMCNT
PUSHJ P,REVERS
PUSH P,D
POP S,A
EXCH B,(S)
PUSH S,B
MOVE A,B
PUSHJ P,NUMBRQ
ERROR SUMMER
PUSH P,NUMCNT
PUSHJ P,REVERS
EXCH B,(S)
POP P,E
ADDM E,-1(P)
POP P,E
TRZ F,PMF
CAIN D,"-
TRC F,PMF
CAIN E,"-
TRC F,PMF
STIME2: MOVE E,(P)
HRRZI C,@WTOP
ADDI C,(E)
MOVE G,LCORE
LSH G,12
SUBI G,1
CAMGE C,G
JRST STIME1
TLZ F,GCF
EXPAND WS
JRST STIME2
STIME1: POP P,A
HRRZ B,WTOP
ADDI B,1
HRLI B,010700+W
MOVEM A,@B
ADDM A,WTOP
AOS WTOP
PUSH S,B
MOVEI G,1(B)
ADD G,W
MOVE A,-1(S)
PUSHJ P,BINIZE
MOVE A,-2(S)
PUSHJ P,BINIZE
MOVE A,-1(S)
HRLI A,010700+W
STIME3: ILDB C,A
CAIN C,177
JRST STIME5
JUMPE C,[AOJA G,STIME3]
STIME4: MOVE B,-2(S)
HRLI B,010700+W
MOVE D,G
SOJL C,[AOJA G,STIME3]
STIME6: ILDB E,B
CAIN E,177
JRST STIME4
JUMPE E,[AOJA D,STIME6]
ADDM E,(D)
AOJA D,STIME6
STIME5: MOVEI A,@(S)
MOVEI A,1(A)
MOVE D,A
ADD D,-1(A)
SUBI D,1
PUSH P,A
PUSH P,D
STIME7: MOVE E,(A)
IDIVI E,10.
MOVEM E+1,(A)
ADDM E,1(A)
CAIGE A,-1(D)
AOJA A,STIME7
JUMPN E,[ERROR]
JUMPN E+1,[ERROR]
POP P,D
POP P,A
MOVE B,-2(S)
MOVEM B,NEWBOT
HRLI B,010700+W
STIME9: MOVE E,(D)
JUMPN E,STIME8
CAIGE A,(D)
SOJA D,STIME9
MOVEI C,"0
IDPB C,B
JRST STIM10
STIME8: TRZN F,PMF
JRST STIM11
MOVEI C,"-
IDPB C,B
STIM11: ADDI E,60
IDPB E,B
SETZM (D)
SUBI D,1
MOVE E,(D)
CAIG A,(D)
JRST STIM11
STIM10: SUB S,[3,,3]
MOVEI A,@B
SETZM 1(A)
HRLI A,1(A)
ADDI A,2
BLT A,1(D)
JRST ENDSTR
BINIZE: HRLI A,010700+W
BINIZ1: ILDB C,A
JUMPE C,BINIZ2
SUBI C,60
DPB C,A
JRST BINIZ1
BINIZ2: MOVEI C,177
DPB C,A
POPJ P,
NUMRET: MOVE D,A
LNCON: MOVE A,D
PUSHJ P,SNM
JRST ENDSTR
NUCONV: MOVE A,(S) ;INPUT IS STRING ON S
PUSHJ P,NUMBRQ ;OUTPUT IS BINARY NUMBER IN E UNLESS STRING NOT NUMERIC
ERROR ZERERR
NUMVAL: EXCH D,E
PUSH P,[NUMVL1]
MNCON: PUSHJ P,NEWSRC
MOVEI D,0
TRZ F,TF ;SAW - SIGN
JFCL 10,MNCONL
JRST MNCONL
MNCON1: CAIN C,"- ;IS IT -?
TRO F,TF ;YES, NOTE
CAIL C,"0 ;IS IT DIGIT?
CAILE C,"9
JRST MNCONL ;NO, SIGN, GET NEXT
IMULI D,10. ;YES, BUILD DEC. #
ADDI D,-<"0>(C)
MNCONL: ILDB C,A ;GET DIGIT
JUMPN C,MNCON1 ;DONE?
TRNE F,TF ;SET SIGN
MOVN D,D
JFCL 10,[ERROR NUMBIG]
POPJ P, ;RESULT IN D
NUMVL1: EXCH D,E
SUB S,[1,,1] ;GET RID OF THE ARGUMENT
POPJ P,
;NUMERIC ARGUMENT.
; CALL WITH POINTER TO ARG IN A.
; IF NOT NUMERIC RETURNS.
; IF NUMERIC, SKIPS. RETURNS BINARY IN D.
POP S,A
NUMARG: PUSH P,A ;SAVE POINTER
PUSHJ P,NUMBRQ
POPJ P, ;NUMBRQ RETURNS HERE IF NOT NUMBER
SETZ D,
POP P,A ;RESTORE A
HRLI A,010700+W ;TURN INTO BYTE POINTER TO ARG.
AOS (P) ;SO RETURN WILL SKIP
JRST MNCON+1 ;CONVERT TO BINARY.
WAIT: .STATUS TYOC,A
TRNE A,2002
JRST SLEEP
MOVEI A,1
TLNE F,BREAKF
ERROR BREAK
.SLEEP A,
JRST WAIT
SLEEP: PUSHJ P,NUMVAL
SLEEP1: MOVEI A,3
SOJL E,COMEX
.SLEEP A,
TLNE F,BREAKF
ERROR BREAK
JRST SLEEP1
TIME: .RTIME G,
MOVEI C,":
PUT66: MOVE E,[440600,,G]
PUSHJ P,NEWSTR
PUT661: ILDB H,E
ADDI H,40
IDPB H,B
ILDB H,E
ADDI H,40
IDPB H,B
TLNN E,700000
JRST ENDSTR
MOVE H,C
JUMPE H,PUT661
IDPB H,B
JRST PUT661
CLOCK: .RDTIM A,
SUB A,TIMEC
IDIVI A,3
JRST NUMRET
.COMPU: .SUSET [.RRUNT,,A]
IDIVI A,250.
JRST NUMRET
RSET: .RDTIME E,
MOVEM E,TIMEC
JRST COMEX
DATE: .RDATE G,
ROT G,12.
MOVEI C,"/
JRST PUT66
LOGN: SKIPA G,UNAME
DIRN: MOVE G,TBL
MOVEI C,0
JRST PUT66
VERSN: MOVE G,VERS
JRST DIRN+1
;HERE FOLLOW THE COMMANDS
LF: MOVEI C,12
LF.1: PUSHJ P,TYO
JRST COMEX
CR: MOVEI C,15
JRST LF.1
BELL: MOVEI C,7
JRST LF.1
FRMFD: MOVEI C,14
JRST LF.1
BLNK: MOVEI C,40
JRST LF.1
QUOTX: MOVEI C,42
JRST LF.1
PUSHJ P,MULTCM ;FOR MULTIPLE INPUTS
TYPE: TRZ F,CRF ;DON'T DO CRLF AFTER TOS
JRST PRINT+1
PUSHJ P,MULTCM
PRINT: TRO F,CRF
POP S,A ;GET THE THING TO TYPE OR PRINT
PUSHJ P,PTOSS
TRZE F,CRF ;CALLED BY TYPE OR PRINT?
LISTXT: PUSHJ P,CRLF ;PRINT
JRST COMEX
ENND: TRZ F,FLUSHF ;IF PROD ALREADY DEFINED THEN WE'RE DONE FLUSHING IT
SKIPN A,TOPROD
ERROR ENDERR ;END WHAT? YOU ARE NOT DEFINING ANYTHING
TLNE F,GETF ;IN ANY CASE, IF GETTING
JRST ENND1 ;DO NOT TYPE "DEFINED"
MOVEI A,-1(A)
MOVE A,@RPA
PUSHJ P,PTOSS
MOVEI A,[ASCIZ / DEFINED/]
PUSHJ P,PTOSSM
PUSHJ P,CRLF
ENND1: SETZB A,TOPROD
PUSHJ P,MOVEMP
JRST COMEX
;COMMAND TO CHANGE CORMAX. CORMAX IS INITIALLY 15
.CORMX: POP S,A
PUSHJ P,NUMARG ;CONVERT TO BINARY
ERROR ZERERR ;RETURNS HERE IF NOT NUMBER.
MOVEM D,CORMAX ;D HAS NUMBER IN BINARY.
JRST COMEX
ABBREVIATE:
PUSHJ P,EVAL ;EVAL FIRST ARG
PUSHJ P,GNE
ERROR ERMSSG ;SOMETHING MISSING, IE SECOND ARG
SOS CPP
CAMN A,[XWD MPF,ASL+1] ;IS IT "AS"?
AOS CPP ;YES, SKIP IT
PUSHJ P,EVAL ;GET SECOND ARG
MOVE A,0(S) ;SECOND ARG, ABBREVIATION
MOVE B,UA ;USER ABBREVIATION TABLE
PUSHJ P,LOOKUP
JRST ABBRV1
POP S,A ;FOUND IT, FLUSH ABBREVIATION
POP S,1(N) ;SAVE ITS NEW VALUE
JRST COMEX
ABBRV1: MOVEI A,2(N) ;NOT FOUND, INSERT AT END OF TABLE
CAML A,UA+1 ;ROOM FOR TWO MORE WORDS AT END?
EXPAND UA ;NO, MAKE ROOM
POP S,0(N) ;ABBREVIATION FIRST
POP S,1(N) ;VALUE SECOND
SETZM 2(N) ;REPLACE END CONDITION
JRST COMEX
LOGIN: MOVEI D,H
PUSHJ P,GNE
ERROR NOTHER ;USER DIDN'T TYPE LOGIN NAME
PUSHJ P,FILGT1 ;CONVERT NAME TO SIXBIT
MOVEM H,DFILEI+1
MOVEM H,DFILEO+1
MOVEM H,TBL
MOVEM H,FILEO+1
MOVEM H,LFILEO+1
MOVEM H,UNAME
SKIPE MONITX
.VALUE VALRET
SKIPN UNAME
ERROR USEDNM
HRRZS FILEO
.SUSET [.SSNAM,,FSNAME]
.OPEN DCHN,FILEO
ERROR NOTHER
.CLOSE DCHN,
IFN 105,[
MOVE C,[[ASCIZ /LOGO/],,[ASCIZ /DUMP/]]
MOVEM C,TBL+1
MOVEI TA,TBL
PUSHJ P,READF
SKIPN A
TLO F,GETF\ERRORF
MOVEI A,NEOFIL
MOVEM A,EOFJMP
] .SUSET [.SSNAM,,DSNAME]
.OPEN CSC,DFILEI
JRST LOGIN2
.OPEN DRIBC,DFILEO
ERROR .
LOGIN1: .IOT CSC,C
SKIPL C
.IOT DRIBC,C
JUMPG C,LOGIN1
.CLOSE CSC,
SETOM DRIBX
MOVEI B,[ASCIZ \
WELCOME TO LOGO! \]
PUSHJ P,TOSS
PUSHJ P,VERSN
POP S,A
PUSHJ P,PTOSS
PUSHJ P,CRLF
PUSHJ P,TIME
POP S,A
PUSHJ P,PTOSS
PUSHJ P,CRLF
PUSHJ P,DATE
POP S,A
PUSHJ P,PTOSS
PUSHJ P,CRLF
JRST LOGIN3
LOGIN2: .CLOSE DRIBC,
SETZM DRIBX
LOGIN3: .SUSET [.SSNAM,,FSNAME] ;THESE TWO USELESS INSTRUCTIONS ARE
.OPEN DCHN,FILEO ;ARE NEEDED TO REOPEN DCHN WHICH IS
;IS CLOSED FOR SOME GOD AWFUL REASON ABOVE
ERROR NOTHER ;THIS ERROR SHOULDN'T EVER OCCUR
TLNE F,GETF
JRST LOGGET
JRST COMEX
GOODBY: SKIPN LFILEO+1
JRST GOODB1
IFN 105,[
MOVE C,[[ASCIZ /LOGO/],,[ASCIZ /DUMP/]]
MOVEM C,TBL+1
.SUSET [.SSNAM,,FSNAME]
PUSH P,[.+2]
JRST GBSAVE
]GOODB1: MOVEI B,[ASCIZ \
AND A PLEASANT DAY TO YOU!\]
PUSHJ P,TOSS
.VALUE [ASCIZ \:KILL :V \]
BUG: POP S,D ;SAVE NEW BUG MESG
PUSHJ P,LOGN ;GET LOGIN NAME
PUSHJ P,DATE
PUSHJ P,TIME
PUSHJ P,VERSN
PUSH S,[WORDF,,SKIPV(W)]
PUSH S,D
PUSH S,[WORDF,,SKIPV(W)] ;CR-LF
MOVEI N,6
PUSHJ P,SENTENCE
SOJG N,.-1
.SUSET [.SSNAM,,[SIXBIT \RJL\]]
.OPEN CSC,[SIXBIT \ DSKLOGO BUGS\]
JRST BUG1
PUSHJ P,NEWSTR
.IOT CSC,C
JUMPLE C,.+3
IDPB C,B
JRST .-3
PUSHJ P,ENDSTR
PUSHJ P,SENTENCE
BUG1: POP S,A
MOVEI A,@A
MOVN B,@A
ADDI A,1
HRL A,B
.OPEN CSC,[SIXBIT \ 'DSKLOGO BUGS\]
ERROR .
.IOT CSC,A
.CLOSE CSC,
JRST COMEX
NEWS: TRZ F,TF
PUSHJ P,PNEWS
JRST COMEX
PNEWS: .SUSET [.SSNAM,,[SIXBIT \LOGO\]]
.OPEN CSC,[SIXBIT \ DSKLOGO NEWS\]
POPJ P,
PNEW.1: .IOT CSC,C
JUMPLE C,PNEW.3 ;EOF
TRNE F,TF ;ON IF CALLED FROM LOGO
JRST PNEW.4
PNEW.5: CAIN C,14 ;^L?
JRST PNEW.2
PUSHJ P,TYO
TLNE F,BREAKF
ERROR BREAK
JRST PNEW.1
PNEW.2: .IOT CSC,C ;HAVE SEEN ^L
JUMPLE C,PNEW.3 ;WAS IT EOF?
PUSHJ P,CRLF
MOVEI B,[ASCIZ \CONTINUE?\]
PUSHJ P,TOSS
PUSHJ P,TYI ;NO, SHALL WE CONTINUE?
CAIE C,"Y
JRST PNEW.3
PUSHJ P,CRLF
JRST PNEW.1
PNEW.4: CAIE C,"% ;OUTPUT STUFF BETWEEN %'S
JRST PNEW.6
.IOT CSC,C
JUMPLE C,PNEW.3
TRC F,TISLF ;FIRST % MUST BE FIRST CHAR
PNEW.6: TRNE F,TISLF
JRST PNEW.5
PNEW.3: .CLOSE CSC,
POPJ P,
TEST: MOVE A,(S) ;DON'T POP IN CASE ERROR PREDR1
PUSHJ P,PREDIQ ;IS THE INPUT A PREDICATE?
ERROR PREDR1 ;NO
POP S,B ;NOW CAN POP
MOVEI B,0
SKIPN @A ;0 FOR "FALSE"; "TRUE" FOR "TRUE"
MOVNI B,1
MOVEM B,TRUTH
JRST COMEX
IF: PUSHJ P,GNE ;GET NEXT ELEMENT
ERROR ERMSSG
CAMN A,[XWD MPF,TRUEL+1]
JRST IFTRUE ;IF TRUE
CAME A,[XWD MPF,FALSEL+1]
JRST IFPRED
IFFALS: MOVE C,TRUTH
JUMPN C,IFX2 ;IF FALSE AND TRUTH=FALSE
IFXFLS: AOS A,CPP ;FLUSH THIS LINE
SKIPE @CSA
AOJA A,.-1
MOVEM A,CPP
JRST SCOMEX
IFTRUE: MOVE C,TRUTH
IFX1: JUMPN C,IFXFLS ;IF TRUE AND TRUTH=FALSE, FLUSH LINE
IFX2: POP P,0(P) ;DO REST OF LINE AS IF IF WASN'T THERE
JRST EXCTCM
IFPRED: SOS CPP ;BACK UP OFF PREDICATE
PUSHJ P,EVAL
MOVE A,(S) ;(SEE TEST, ABOVE)
PUSHJ P,PREDIQ
ERROR PREDR1
PUSH P,A ;SAVE RESULT OF PREDIQ
POP S,A
PUSHJ P,GNE ;LOOK AHEAD FOR "THEN"
JRST .+2 ;NO, EOL
CAME A,[MPF,,THENL+1] ;IF YES, SKIP OVER IT
SOS CPP ;NO, BACK UP
POP P,A
SKIPE @A
JRST IFX2 ;TRUE, DO REST OF LINE
PUSHJ P,GNE ;FALSE, SCAN DOWN TO "ELSE" OR EOL
JRST SCOMEX ;EOL, DO NOTHING
CAME A,[MPF,,ELSEL+1] ;IS IT ELSE?
JRST .-3 ;NO, TRY AGAIN
JRST IFX2 ;YES, DO ST OF LINE
IMAKE: SOS CPP ;INFIX MAKE
MAKE: MOVE A,-1(S)
TLNE A,EMPTYF
ERROR NMERR5 ;NAME NOT ALLOWED TO BE EMPTY
PUSHJ P,NUMBRQ
SKIPA
ERROR NMERR6
MOVE A,-1(S)
HRRZI B,MV
PUSHJ P,SYSLUK
JRST .+2
ERROR TOERR3 ;X IS USED BY LOGO
MOVE A,-1(S)
HRRZ B,VP
PUSHJ P,LOOKUP
PUSHJ P,MAKEN ;NOTA, MAKE A NEW GLOBAL
MAKE1: POP S,A
DPB A,[3600,,1(N)] ;PUT THE VALUE AWAY, DON'T CLOBBER GLOBAL BIT
POP S,A ;FLUSH THE NAME
JRST COMEX
MAKEN: MOVEI B,2(N)
CAMLE B,VP+1
EXPAND VP
MOVE A,[XWD W+WORDF\EMPTYF\GLOBLV\UNBOUN,0] ;INTIALLY
MOVEM A,1(N) ;CLOBBER(GLOBAL) VALUE TO EMPTY
MOVE A,-1(S)
MOVEM A,(N)
SETZM 2(N)
POPJ P,
LOCAL: SKIPN PRODNM
ERROR STOERR ;LOCAL CAN ONLY BE STORED
AOS CPP
LOCAL1: MOVE E,DTOP
MOVE D,DP+1
SUB D,DP ;END RELATIVE TO BEGINNING
CAIGE D,2(E) ;WILL ANOTHER ENTRY FIT
EXPAND DP ;NO
ADD E,DP ;MAKE ABSOLUTE
PUSH P,E
MOVE A,(S)
MOVEI B,MV
PUSHJ P,SYSLUK ;IS THE THING TRYING TO BE LOCALED A SYS VAR?
JRST .+2 ;NO
ERROR LCERR1
MOVE A,(S)
PUSH S,A ;FOR MAKEN
MOVE B,VP ;SEE IF ON GLOBAL LIST
PUSHJ P,LOOKUP
PUSHJ P,MAKEN ;NOT THERE, MAKE A NEW ONE
MOVE B,[XWD W+WORDF\EMPTYF\UNBOUN,0]
EXCH B,1(N) ;OLD VALUE
POP P,E
MOVEM B,1(E)
SUB N,VP
ADDI N,1
MOVEM N,(E)
SETZM 2(E) ;NEW END
MOVEI A,2
ADDM A,DTOP ;TOP OF LIST IS HIGHER
POP S,A
POP S,A
MOVE A,CPP
MOVE C,@CSA
JUMPE C,SCOMEX
TLNE C,COMMTF
JRST SCOMEX
CAME C,[XWD MPF,ANDL+1]
JRST LOCAL2
AOS A,CPP
MOVE C,@CSA
JUMPE C,[ERROR ERMSSG]
LOCAL2: PUSHJ P,INVAL
JRST LOCAL1
;HERE FOLLOWS ALL THERE IS TO USER DEFINED PROCEDURES
;DEFINING THEM, EXECUTING THEM, CHANGING TITLES AND TRACING
TITLEX: SKIPN TOPROD ;IS THERE A PROCEDURE OPEN?
ERROR NOEDIT ;NO, CANNOT RETITLE NO PROCEDURE
PUSHJ P,GNE
ERROR ERMSSG
CAME A,[XWD MPF,TOL+1] ;IS THE NEXT THING "TO"
ERROR TOERR6
TLO F,TITLEF
JRST TO0
TO: TLZ F,TITLEF
SKIPE TOPROD ;IS THERE A PROCEDURE ALREADY OPEN
ERROR TOERR4 ;YES
TO0: MOVE H,CPP
PUSHJ P,GNE ;NEXT NON-COMMENT ELEMENT
ERROR TOERR5 ;MUST HAVE A PROCEDURE NAME
TLNN A,UPRF
JRST TONG ;PROC. NAME NO GOOD, FIND OUT WHY
MOVEI E,(A)
MOVE G,@RPA
CAMN G,[EXP -1] ;IS THE PROCEDURE ALREADY DEFINED?
JRST TO1 ;NO, ALWAYS OK
TLNE F,GETF ;DOING A GET?
JRST TOGET ;YES
HRRZ B,TOPROD
TLNE F,TITLEF ;ARE WE DOING "TITLE"?
CAIE B,(A) ;YES, IS IT THIS PROCEDURE?
ERROR TOERR8 ;NO TO EITHER
TO1: SETZ M, ;COUNT OF DUMMIES ENCOUNTERED
PUSHJ P,GNE ;NEXT NON-COMMENT ELEMENT
JRST TOA ;NO DUMMIES
TO2: TLNN A,VARF ;IS IT A DUMMY?
ERROR TOERR2 ;NO
TLNE A,W
ERROR TOERR9
MOVEI M,1(M) ;YES, COUNT IT
TO3: PUSHJ P,GNE ;CHECK FOR "AND"
JRST TOA ;NOTHING, SO NO AND
CAME A,[XWD MPF,ANDL+1] ;IS IT "AND"?
JRST TO2 ;NOT AND, TRY DUMMY
PUSHJ P,GNE
ERROR ;"AND" LAST, NOT WELL FORMED
JRST TO2 ;IT MUST EXIST AND BE A VARIABLE
TONG: TLNN A,MPF
ERROR TOERR6
ERROR TOERR3
TOGET: TRO F,FLUSHF ;LOADING AN ALREADY DEFINED PROCEDURE
MOVEM A,TOPROD ;SO LET IT BE OPEN
MOVEI A,-1(A)
MOVE A,@RPA ;PROCEDURE NAME
PUSHJ P,PTOSS
MOVEI A,[ASCIZ / IS ALREADY DEFINED/]
PUSHJ P,PTOSSM
PUSHJ P,CRLF
JRST IFXFLS
TOA: TLNN F,TITLEF ;TITLE LINE NOW VALID
JRST TOB ;TO, NOT TITLE
MOVE A,TOPROD
MOVNI G,1
EXCH G,@RPA ;OLD PROCEDURE OPEN NOW UNDEFINED
HRLI G,-1(M) ;NO OF DUMMIES-1,LOC OF DIRECTORY
MOVEI A,(E)
MOVEM A,TOPROD ;NEW PROCEDURE NAME NOW OPEN
MOVEM G,@RPA ;AND DEFINED
MOVEI A,(G)
MOVEM M,@PSA ;NUMBER OF DUMMIES
MOVEI A,1(A)
PUSHJ P,TOLINH
JRST SCOMEX
TOB: MOVEM E,TOPROD ;PROCEDURE NOW OPEN
HRLZI G,-1(M)
HRR G,PTOP ;NEW DIRECTORY GOES HERE
MOVEI A,(E)
MOVEM G,@RPA ;PROCEDURE DEFINED
MOVEI A,(M)
PUSHJ P,MOVEMP
MOVEI G,(A) ;SAVE PSA PTR TO COMPILE CODE PTR
PUSHJ P,MOVEMP ;MAKE A HOLE
MOVEI A,(G) ;GET PSA PTR BACK
PUSHJ P,TOLINJ
JRST SCOMEX
MOVEMP: MOVE D,PTOP
MOVEM A,@PSD
AOS A,PTOP
MOVEI B,@PSA
CAML B,PS+1
EXPAND PS
SETZM @PSA
POPJ P,
TOFLUS: MOVE A,CBOT
MOVEM A,CTOP
POPJ P,
TOLINE: SKIPN TOPROD ;IS THERE A PROCEDURE OPEN
ERROR INERR3 ;LINE X OF WHAT PROCEDURE?
TRNE F,FLUSHF
JRST TOFLUS
MOVE A,CBOT ;POINTER TO BASE OF NEW COMPILED LINE
MOVEI H,1(A)
MOVE L,@CSA
HRLI L,010700+W
PUSHJ P,DNM
ERROR IOPERR ;I AM IN TROOUBLE
CAIL M,100000.
ERROR INERR2 ;LINE NO TOO LARGE
JUMPE M,[ERROR INERR4] ;LINE NO =0
; TLO F,TITLEF ;NOTE THAT FIRST WORD OF COMPILED LINE TO BE FLUSHED
HRRZ A,TOPROD
JSP C,SRCHL1
CAIGE B,(M)
JRST TOLING
CAIN B,(M) ;LINE NO ALREADY EXISTS?
AOJA A,TOLINH ;YES
TOLING: SETOM NXLINE ;CANNOT SAFELY ASSUME THAT THE PROCEDURE WE'RE IN
MOVEI B,2 ; HAS NOT MOVED
ADD B,PTOP
ADD B,PS
CAML B,PS+1 ;ROOM IN PS FOR ANOTHER 2 WORD ENTRY?
EXPAND PS ;NO
MOVE B,PTOP
ADD B,PS
MOVEI C,@PSA
MOVE D,(B) ;COPY EVERYTHING DOWN 2, UP TO PLACE TO INSERT
MOVEM D,2(B)
CAIE B,(C)
SOJA B,.-3
MOVEI B,2
ADDM B,PTOP
MOVEM M,(C) ;LINE NUMBER
AOJA A,TOLINJ
TOLINH: PUSHJ P,GCCS
TOLINJ:
; SETOM TLJF ;KLUDGE
AOS B,SEQNO ;PUTTING AWAY THE STEP, GIVE IT A NEW SEQUENCE NUMBER
HRL B,CDBOT ;WHAT IS THE POINTER TO THE NEW LINE
MOVSM B,@PSA ;XWD SEQNO,CBOT INTO PROCEDURE DIRECTORY
MOVE A,CTOP
MOVEI B,@CSA ;B_CTOP+CS
MOVE C,CBOT ;CBOT, BASE OF THIS LINE TO BE STORED
MOVE A,CDBOT
SUBI C,(A) ;C_CBOT-CDBOT, LENGTH OF OTHER DIRECT LINES
MOVEI A,@CSA ;A_CS+CDBOT, ABS LOC OF CDBOT
MOVEI E,(B)
ADDI E,(C) ;E_CS+CTOP+CBOT-CDBOT, END OF COPIED DIRECT LINES
CAML E,CS+1 ;IS THAT INSIDE CURRENT CS ALLOCATION
EXPAND C,CS ;NO, NEED AT LEAST ENOUGH ROOM FOR COPIED LINES
HRLZI D,(A) ;FROM BASE OF DIRECT LINES
HRRI D,(B) ;TO CURRENT END OF COMPILED CODE
BLT D,(E) ;ENDING WITH END OF ALL OTHER DIRECT LINES
MOVE D,CTOP
; TLZE F,TITLEF
; SOS D,CTOP ;IF DELETING "TITLE" OR A LINE NUMBER
; SUBI E,(D) ;CS+CBOT(+1)-CDBOT
; ADD E,CDBOT
; HRLI A,(E)
; BLT A,@CSD
; SUB D,CBOT
; ADDB D,CDBOT
SUBI D,(H)
ADDB D,CDBOT
ADDI D,(C)
MOVEM D,CTOP
ADD H,CS
HRLI A,(H)
BLT A,@CSD
MOVEM D,CBOT
MOVEI D,-1(D)
MOVEM D,CPP ;SO THAT COMEX CAN EXIT PROPERLY
POPJ P, ;R1 FROM COMPIL
HIDE: SKIPA B,[HIDEPF,,0]
TRACE: HRLZI B,TRACEF
PUSHJ P,GNE ;TRACE WHAT?
ERROR ERMSSG ;NOTHING
TLNN A,UPRF ;TRACE A USER PROCEDURE?
ERROR WHTERR ;CANNOT TRACE THAT
MOVEI A,-1(A) ;POINT AT FIRST WORD OF RP PAIR
IORM B,@RPA ;MARK THIS PROCEDURE AS TRACED
JRST COMEX
TAB==.
PTAB: MOVEI B,7
PUSHJ P,PSPACE
TDNE B,CHARNO
JRST .-2
POPJ P,
LINE: SETZM CHARNO
TLNE F,SAVEF
POPJ P, ;MAY BE REDUNDANT
PUSHJ P,CRLF ;TYPE CRLF AND SPACES USING C
INDENT: MOVE C,BCHAR
JUMPE C,CRLF
CAMN C,CHARNO
POPJ P,
MOVEI C,"
PUSHJ P,TYO
JRST INDENT
CRLF: MOVEI C,015
PUSHJ P,TYO
MOVEI C,012
PUSHJ P,TYO
MOVEI C,15
POPJ P,
REQUEST: TLO F,RQF
MOVEI B,[ASCIZ /</]
SKIPE CHARNO ;AT LEFT MARGIN?
MOVEI B,[EXP 0] ;NO, DON'T TYPE ANYTHING
PUSHJ P,TIS
JRST REQUEST
TLZ F,RQF
POPJ P,
PRETTY: PUSHJ P,NUCONV
CAMGE E,MINLNL
ERROR PRTER1
MOVEM E,LINEL
SUBI E,5
MOVEM E,LINRET
JRST COMEX
NTHCHA: PUSHJ P,NUMVAL
SUBI E,1
JUMPL E,[ERROR .]
PUSHJ P,NEWSRC
IDIVI E,5
CAML E,@A
ERROR .
MOVNS E+1
ADD A,E
JRST .+5(E+1)
REPEAT 5,ILDB C,A
POP S,A
MOVE A,C
PUSHJ P,SNM
JRST ENDSTR
LASTCH: MOVE C,LSTCH
.RESET TYIC,
JRST .+3
.TYI: TLO F,RQF
PUSHJ P,TYI
PUSHJ P,NEWSTR
IDPB C,B
TLZ F,RQF
JRST ENDSTR
TYI: TLZE F,BREAKF
ERROR BREAK
TLO F,TIF
TLNN F,GETF
JRST TYI1
TLZ F,TIF
SKIPN FILOX
JRST TYI2
PUSHJ P,READC
CAIN CH,ENDFIL
JRST @EOFJMP
POPJ P,
TYI2: .IOT TYIC,C
JUMPL C,@EOFJMP
POPJ P,
TYI1: .IOT TYIC,C
JUMPE C,TYI1
TLZ F,TIF
CAIN C,^W
POPJ P,
CAIN C,15
JRST TYI3
CAIE C,33
CAIN C,^Z
JRST TYI1
CAIN C,^_
JRST TYI1
CAIN C,177
POPJ P,
CAIL C,140
SUBI C,40
TLNN F,EDITF
JRST TYO
CAIE C,^N
CAIN C,^R
POPJ P,
JRST TYO
TYI3: PUSHJ P,CRLF
MOVEI C,15
POPJ P,
LISTE: .CALL LISCAL
MOVEI A,0
PUSHJ P,SNM
JRST ENDSTR
LISCAL: SETZ
SIXBIT /LISTEN/
[TYIC]
SETZ A(2000)
;CHARACTER OF.
CHAROF: PUSHJ P,NUMVAL
PUSHJ P,NEWSTR
IDPB E,B
TRZ F,NWF
PUSHJ P,ENDSTR
POPJ P,
.TYO: PUSHJ P,NUMVAL
MOVE C,E
PUSHJ P,TYOI
JRST COMEX
TYO: TLZE F,BREAKF
ERROR BREAK
IFE TBOX, PUSHJ P,TYOON
IFN TBOX, PUSHJ P,TTYON
TLNE F,SAVEF
JRST TYOF
CAIL C,40
JRST TYO3
CAIN C,2 ;CNTRL B
JRST TYO7 ;PRINT AS SPACE
CAIE C,7
CAIN C,12
JRST TYOI
CAIN C,^L
JRST TYOI
CAIN C,11
JRST TTAB
CAIN C,15
JRST TYO2
CAIN C,^H
JRST TYO6
CAIN C,^Z
JRST TYO8
CAIN C,^_
JRST TYO9
LSH C,10
TYOA: XORI C,<300_10>+"^
PUSHJ P,TYO3
LSH C,-10
JRST TYO3C
TYO3: PUSH P,C
MOVE C,CHARNO
SUB C,LINEL
JUMPLE C,TYO3A
CAIL C,10.
JRST TYO3B
MOVE C,(P)
CAIE C,40
JRST TYO3A
TYO3B: PUSHJ P,CRLF
TYO3A: POP P,C
TYO3C: AOSA CHARNO
TYO2: CLEARM CHARNO
TYOI: SKIPE DRIBX
.IOT DRIBC,C
TYOII: .IOT TYOC,C
TRZE C,200
ANDCMI C,100
POPJ P,
TYO6: SOS CHARNO
JRST TYOI
TTYON: PUSH P,C
MOVEI C,TTYDEV
CAMN C,TBXDEV
JRST POPCJ
MOVEM C,TBXDEV
MOVEI C,21
XCT TBXOUT
MOVEI C,TTYDEV
XCT TBXOUT
MOVEI C,22
XCT TBXOUT
POP P,C
POPJ P,
MUSTYO: PUSH P,C
MOVEI C,MUSDEV
JRST DEVSEL
PLTTYO: PUSH P,C
MOVEI C,PLTDEV
JRST DEVSEL
TURTYO: PUSH P,C
MOVEI C,TURDEV
DEVSEL: CAMN C,TBXDEV
JRST DEVSL1
MOVEM C,TBXDEV
PUSH P,C
MOVEI C,21
XCT TBXOUT
POP P,C
XCT TBXOUT
DEVSL1: POP P,C
XCT TBXOUT
POPJ P,
POPCJ: POP P,C
POPJ P,
OCTOUT: PUSH P,B
PUSH P,D
MOVE B,[110300,,D]
MOVE D,C
OCTOU1: ILDB C,B
ADDI C,60
XCT CHOUT
TLNE B,770000
JRST OCTOU1
MOVEI C,40
SOSG NOCTPR
JRST OCTOU3
OCTOU2: XCT CHOUT
MOVE C,D
POP P,D
POP P,B
POPJ P,
OCTOU3: MOVEI C,15
MOVEM C,NOCTPR
XCT CHOUT
MOVEI C,12
JRST OCTOU2
TYOON: SKIPG SILENT
POPJ P,
.IOT TYOC,TTYONC
SETOM SILENT
POPJ P,
TYO7: MOVEI C,40 ;SUBST SPACE FOR CNTRL B
PUSHJ P,TYO3
MOVEI C,2 ;RESTORE C
POPJ P,
TYO8: PUSH P,B
MOVEI B,[ASCIZ \
THING \]
TYO8A: PUSH P,C
PUSHJ P,TOSS
POP P,C
POP P,B
POPJ P,
TYO9: PUSH P,B
MOVEI B,[ASCIZ \
NAME \]
JRST TYO8A
TYOF: CAIL C,40
AOS CHARNO
CAIN C,15
CLEARM CHARNO
SKIPE FILOX
JRST WRITEC
.IOT TYOC,C
POPJ P,
TTAB: MOVEI C,40
PUSHJ P,TYO3
MOVE C,CHARNO
TRNE C,7
JRST TTAB
MOVEI C,11
POPJ P,
PTOSSM: HRLI A,440700 ;FOR MACHINE STRINGS
JRST PTOS
PTOSS: HRLI A,010700+W ;FOR GENERATED STRINGS
PTOS: PUSHJ P,PWORD
LDB C,A
JUMPN C,.-2
POPJ P,
TOSS: HRLI B,440700
TOS: ILDB C,B ;BYTE POINTER IN B USE C
JUMPE C,CPOPJ
PUSHJ P,TYO
JRST TOS
NUMBRQ: SETZM NUMCNT
TLNE A,EMPTYF ;IS IT EMPTY?
JRST CPOPJ ;YES
TRZ F,TF
HRLI A,010700+W
ILDB C,A
JUMPE C,CPOPJ ;EMPTY
AOS NUMCNT
CAIE C,"+
CAIN C,"-
NMBRQ1: ILDB C,A
JUMPE C,NMBRQ2
AOS NUMCNT
TRO F,TF ;HAVE SEEN A CHARACTER
CAIL C,"0
CAILE C,"9
POPJ P, ;NOT A DIGIT, FAIL
JRST NMBRQ1
NMBRQ2: TRZE F,TF ;ALL THE CHARS WE SAW WERE DIGITS, BUT WERE THERE ANY
AOS 0(P) ;SAW SOME DIGITS
POPJ P, ;SAW NO CHARACTERS
PREDIQ: MOVE B,@A
ADDI A,1
CAIE B,1 ;IS LENGTH OF TEXT 1?
JRST PREDQ1 ;NO, CANNOT BE "TRUE"
MOVE B,@A ;GET TEXT OF ONE WORD ELEMENT
CAME B,[ASCIZ /TRUE/]
POPJ P, ;NOT "TRUE"
JRST CPOPJ1 ;IS "TRUE"
PREDQ1: CAIE B,2 ;FALSE MUST BE TWO WORDS LONG
POPJ P, ;NOT "FALSE"
MOVE B,@A
ADDI A,1
CAMN B,[ASCII /FALSE/]
SKIPE @A ;NEXT WORD MUST BE 0 TERMINATOR FOR "FALSE"
POPJ P, ;R1, IS NOT "FALSE"
JRST CPOPJ1 ;R2
DNM: MOVEI M,0
TRZ F,PMF\NNUMF
HRLI L,010700+W ;ALL CALLS USE A COMPLETE STRING
ILDB C,L
CAIN C,"-
TRO F,PMF
CAIE C,"+
CAIN C,"-
DNM1: ILDB C,L
CAIL C,"0
CAILE C,"9
JRST DNM2
TRO F,NNUMF
IMULI M,12
ADDI M,-60(C)
JRST DNM1
DNM2: TRZE F,PMF
MOVNS M
TRNN F,NNUMF
POPJ P,
JRST CPOPJ1
DECPRT: SKIPA B,[12]
OCTPRT: MOVEI B,10
MOVEM B,CRADIX
ANYPRT: IDIV A,CRADIX
HRLM B,(P)
SKIPE A
PUSHJ P,ANYPRT
HLRZ C,(P)
ADDI C,"0
JRST TYO
SNM: TRO F,TF
SETZM SRCBOT
TRZ F,PMF
JUMPGE A,SNMA
MOVNS A
TRO F,PMF
SNMA: IDIVI A,12
HRLM B,(P)
SKIPE A
PUSHJ P,SNMA
TRZE F,TF ;ONLY SET UP B ONCE
PUSHJ P,NEWSTR
MOVEI C,"-
TRZE F,PMF
IDPB C,B
HLRZ C,(P)
ADDI C,"0
IDPB C,B
POPJ P,
COPYAB: ILDB C,A
IDPB C,B
JUMPN C,.-2
POPJ P,
;NEWOPS IS CALLED BY FIRST,LAST,BUTFIRST, AND BUTLAST
;ALL HAPPEN TO DO THE SAME THING
;NEWSTR IS USED BY ANYONE WHO GENERATES A NEW STRING
NEWOPS: MOVE A,0(S) ;GET ARG OFF S STACK WITHOUT DESTROYING IT
TLNE A,EMPTYF ;IS IT AN EMPTY STRING
ERROR EMPARG ;EMPTY ARGUMENTS ARE ILLEGAL(?)
TLNE A,WORDF
AOS 0(P) ;SKIP JUMP TO SENT IF A WORD
IFN LFLAG,[
TRZ F,TF
TLNE A,STRF ;STRING FLAG. WHEN SET,PARENS ARE TRETED AS NORMAL CHARS.
TRO F,TF
]
HRLI A,010700+W ;IN ANY CASE, MAKE A STRING PTR
MOVEM A,SRCBOT
NEWSTR: TLO F,GCF
HRRZ B,WTOP
ADD B,[010700,,1(W)] ;MUST BE EXACTLY THIS FOR TEST IN TBACK TO WORK
MOVEM B,NEWBOT
POPJ P,
;NEWSRC SETS UP A NEW SOURCE STRING FROM THE FIRST ARG ON THE PDL
;NEWSR1 DOES THE SAME FOR THE SECOND ARG BACK
NEWSR1: SKIPA A,-1(S)
NEWSRC: MOVE A,0(S)
NEWSR0: HRLI A,010700+W
MOVEM A,SRCBOT
POPJ P,
GNE: AOS A,CPP ;GET NEXT NON-COMMENT ELEMENT
MOVE A,@CSA
JUMPE A,CPOPJ ;END OF LINE, R1
TLNE A,COMMTF ;IS IT COMMENT
JRST GNE ;YES, SKIP IT
JRST CPOPJ1
ENDSTP: POP S,C ;FLUSH OLD INPUT FIRST BEFORE
ENDSTR: MOVEI C,0 ;FINISH UP THE NEW STRING
IDPB C,B
ENDST1: TLNE B,760000
JRST .-2
TLO F,GCF
MOVEM B,WTOP
SUB B,NEWBOT
HRRZM B,@NEWBOT
HRLZI B,W+WORDF
HRR B,NEWBOT
TRZE F,NWF
TLC B,WORDF\SENTF
PUSH S,B
PUSHJ P,WSCHEC
POPJ P,
GNARG: MOVE A,[W+WORDF,,DUMMYV]
CAMN A,(S)
POPJ P,
POP S,A
JRST CPOPJ1
MULTCM: PUSHJ P,REVARG
NRMLCM: MOVE A,[W+WORDF,,DUMMYV] ;NON REVERSING MULTIPLE ARG COMMAND
CAMN A,(S)
JRST MULCM1
MULCM0: PUSH P,[NRMLCM] ;ONLY REVERSE THE ARGS ONCE
JRST @-1(P)
MULCM1: POP P,A ;RETURN FROM COMMAND
POP S,A ;MARKER
JRST COMEX
MULTOP: PUSHJ P,REVARG
NRMLOP: MOVE A,[W+WORDF,,DUMMYV]
CAMN A,-1(S)
JRST MULOP1
CAMN A,(S)
ERROR .
PUSH P,[NRMLOP]
JRST @-1(P)
MULOP1: POP S,A
MOVEM A,(S)
POP P,A
POPJ P,
REVARG: MOVE A,[W+WORDF,,DUMMYV]
MOVEI B,(S)
CAME A,(B)
SOJA B,.-1
MOVEI A,(S)
REVAR1: ADDI B,1
CAIG A,(B)
POPJ P,
MOVE C,(A)
EXCH C,(B)
MOVEM C,(A)
SOJA A,REVAR1
;ANOTHER REVERSING PROGRAM
;TURNS "A B C D E F" INTO "E F C D A B"
REVPR: MOVE M,P ;SAVE P
HRLZ C,P ;TO BE USED LATER IN A BLT
MOVE D,S ;SAVE S. ALSO USED LATER IN A BLT
MOVE E,[W+WORDF,,DUMMYV] ;LOGO PUTS THIS ON STACK TO MARK BOTTOM
REVPR1: POP S,A ;FIRST OF A PAIR
CAMN E,A ;DOES IT POINT TO BOTTOM OF STACK MARKER?
JRST REVPR2 ;YES, SO ALL THE ARGS HAVE BEEN COPIED ONTO P PDL
POP S,B ;SECOND OF A PAIR
CAMN E,B ;IF THIS ONE POINTS TO END OF STACK MARKER,
ERROR NOTPAR ;THEN THE ARGS WEREN'T PAIRED.
PUSH P,B ;COPY SECOND OF PAIR ONTO P PDL
PUSH P,A ;COPY FIRST OF PAIR ONTO P PDL
JRST REVPR1 ;GET ANOTHER PAIR
;ALL THE ARGS HAVE BEEN COPIED ONTO P PDL
;NOW COPY THEM IN THE ORDER THEY ARE IN BACK ONTO THE S PDL
REVPR2: PUSH S,A ;FIRST RETURN THE BOTTOM OF STACK MARKER
HRR C,S
AOBJP C,.+1 ;PLACE WHERE P WAS (SEE REVPR+1) IS 1 BEFORE
;LOCATION WHERE THE ARGS WERE COPIED
;PLACE WHERE S IS, IS 1 BEFORE LOCATION WHERE
;THE ARGS ARE TO RECOPIED NOW. HENCE THE AOBJ.
BLT C,(D) ;TRANSFER. D POINTS TO WHERE S POINTED BEFORE THE REVERSING BEGAN
MOVE P,M ;RESTORE P
MOVE S,D ;RESTORE S
JRST MULCM0
;STUFF TO B>HTE COPIED TO UNSHARED CORE AT START OF RUN
DEFINE TT A1,A2,A3
IFSE A3,,EXP A2
IFSN A3,,XWD A3,A2
TERMIN
ALOCTB: TABLES
DEFINE MM A1,A2
XWD A2,0
TERMIN
SPFRST: POINTR ;ALL THE LH'S OF THE INDEXED POINTERS
0?1?2 ;PTOP,CTOP,DTOP, IN THAT ORDER!
XWD W,.WTOP-.WBASE-1
EXP 1 ;CDBOT INITIALIZED THE SAME AS CTOP
1 ;CBOT SAME
XWD 525252,123456 ;AN INITIAL RANDOM BITS, FIX LATER
;SO THE STARTING POINT IS ALSO RANDOM
SPLLEN==.-SPFRST
DEFINE ELM1 NAME,VAL
NAME==.-.WBASE
1?VAL
TERMIN
.WBASE=.
ELM1 EMPTYV,0
ELM1 TRUEV,ASCIZ /TRUE/
FALSEV==.-.WBASE
EXP 2
ASCIZ /FALSE/
ELM1 LINEFV,012_29.
ELM1 CARETV,015_29.
ELM1 FORMFV,014_29.
ELM1 BLANKV,040_29.
ELM1 BELLV,007_29.
ELM1 QUOTEV,042_29.
ELM1 SKIPV,064240_18. ;BYTE (7) 15,12
ELM1 DUMMYV,0
.WTOP==.
;MACHINE DEFINED PROCEDURES
DEFINE MPM NAME,GOTO,NARG,TYPE,COND
IFN COND,[
WORDF,,[ASCIZ \NAME\]
<NARG-1>\TYPE,,GOTO]
TERMIN
DEFINE PAIR A,B,COND
IFN COND,[
[ASCIZ "A"]?[ASCIZ "B"]
]
TERMIN
DEFINE MVM A,B,C
EXP [ASCIZ "A"]
IFSN C,,XWD C,B
IFSE C,,XWD W+WORDF,B
TERMIN
$R==1 ;REGULAR (ALWAYS ASSEMBLE)
$D==NOVA+DFLAG ;ASSEMBLY FOR ANY DISPLAY FLAVOR
$N==NOVA ;ASSMBLE FOR NOVA ONLY
$S==SNAPFL ;ASSEMBLE SNAPS, ONLY IF NOVA
$3==DFLAG ;ASSEMBLE FOR 340 ONLY
$P==PHY ;PHYSICS HACK STUFF
$L==LFLAG ;LIST STUFF
$V==VFLAG ;VECTOR STUFF
$VN==0
$OM==OMFLAG ;OLD MUSIC, AS OPPOSED TO TERRY WINOGRAD AND JEANNE BAMBERGER SYSTEM
IFN NOVA IFN VFLAG $VN==1
$T==TURTAS
$NX==<1-TBOX>*TURTAS ;FOR TURTLE BUT NOT TBOX
$X==TBOX ;FOR TBOX ONLY
%FC==3_17 ;FIXED ARGS, COMMAND
%VC==1_17 ;VARIABLE ARGS, COMMAND
%FO==2_17 ;FIXED ARGS, OPERATION
%VO==0_17 ;VARIABLE ARGS, OPERATION
%FCS==34_14 ;FIXED COMMAND, TAKES SNAPS
%FOS==24_14 ;FIXED OPERATION, TAKES SNAPS
ABBT:
PAIR ABB,ABBREVIATION,$R
PAIR ABBS,ABBREVIATIONS,$R
PAIR ABT,ABBREVIATE,$R
PAIR BK,BACK,$T
PAIR B,BOTH,$R
PAIR BF,BUTFIRST,$R
PAIR BL,BUTLAST,$R
PAIR CONC,CONCATENATE,$L
PAIR C,COUNT,$R
PAIR CO,CONTROLLER,$R
PAIR CR,CARRIAGERETURN,$R
PAIR DIFF,DIFFERENCE,$R
PAIR D,DISPLAY,$D
PAIR ED,EDIT,$R
PAIR EDL,EDIT LINE,$R
PAIR EDT,EDIT TITLE,$R
PAIR EI,EITHER,$R
PAIR EP,EMPTYP,$R
PAIR ER,ERASE,$R
PAIR ERL,ERASE LINE,$R
PAIR F,FIRST,$R
PAIR FD,FORWARD,$T
PAIR LF,LINEFEED,$R
PAIR GP,GREATERP,$R
PAIR GTL,GO TO LINE,$R
PAIR GB,GOODBYE,$R
PAIR HD,HEADING,$D
PAIR HT,HIDETURTLE,$D
PAIR H,HOME,$D
PAIR IFF,IFFALSE,$R
PAIR IFT,IFTRUE,$R
PAIR LA,LAST,$R
PAIR L,LIST,$R
PAIR LC,LIST CONTENTS,$R
PAIR LE,LIST ENTRY,$R
PAIR LT,LEFT,$T
PAIR FF,FORMFEED,$R
PAIR LL,LIST LINE,$R
PAIR M,MAKE,$R
PAIR MAX,MAXIMUM,$R
PAIR MIN,MINIMUM,$R
PAIR NP,NUMBERP,$R
PAIR NOCO,NOCONTROLLER,$R
PAIR OP,OUTPUT,$R
PAIR PICK,PICKELEMENT,$L
PAIR PD,PENDOWN,$T
PAIR PU,PENUP,$T
PAIR P,PRINT,$R
PAIR PROD,PRODUCT,$R
PAIR PRS,PROCEDURES,$R
PAIR QUO,QUOTIENT,$R
PAIR RQ,REQUEST,$R
PAIR RT,RIGHT,$T
PAIR SHD,SETHEAD,$D
PAIR SETT,SETTURTLE,$R
PAIR S,SENTENCE,$R
PAIR SP,SENTENCEP,$R
PAIR ST,SHOWTURTLE,$D
PAIR T,TEST,$R
PAIR VADD,VECTORADD,$V
PAIR VEC,VECTOR,$V
PAIR VP,VECTORP,$V
PAIR W,WORD,$R
PAIR WP,WORDP,$R
PAIR ZP,ZEROP,$R
0
;MACHINE DEFINED VARIABLE NAMES
MV:
EXP [ASCIZ "EMPTY"]
XWD W+WORDF\EMPTYF,EMPTYV
[ASCIZ "EMPTYW"]
W+WORDF\EMPTYF,,EMPTYV
[ASCIZ "EMPTYS"]
W+SENTF\EMPTYF,,EMPTYV
MVM LINEFEED,LINEFV
MVM CARRIAGERETURN,CARETV
MVM FORMFEED,FORMFV
MVM BLANK,BLANKV
MVM BELL,BELLV
MVM QUOTE,QUOTEV
MVM SKIP,SKIPV
MVM CONTENTS,CCONTE,COMPUT
MVM ,DUMMYV
0
CMPT:
MPM ABBREVIATE,ABBREVIATE,0,%FC,$R
ABREVL: MPM ABBREVIATION,SPECWD,0,%FC,$R
ABRVSL: MPM ABBREVIATIONS,SPECWD,0,%FC,$R
ALLL: MPM ALL,SPECWD,0,%FC,$R
ANDL: MPM AND,SPECWD,0,%FC,$R
ASL: MPM AS,SPECWD,0,%FC,$R
MPM BACK,BACK,1,%FC,$T
MPM BELL,BELL,0,%FC,$R
MPM BIGTURTLE,BIGTURTLE,0,%FC,$NX
MPM BLANK,BLNK,0,%FC,$R
MPM BOTH,BOTH,2,%FO,$R
MPM BTOUCH,BTOUCH,0,%FO,$T
MPM BUG,BUG,1,%FC,$R
MPM BUTFIRST,BUTFIRST,1,%FO,$R
MPM BUTLAST,BUTLAST,1,%FO,$R
MPM CANCEL,RETTRN,0,%FC,$R
MPM CARRIAGERETURN,CR,0,%FC,$R
MPM CHAROF,CHAROF,1,%FO,$R
MPM CLOCK,CLOCK,0,%FO,$R
MPM COMPUTE,.COMPUTE,0,%FO,$R
MPM CONCATENATE,CONCAT,2,%VO,$L
MPM CONS,CONS,2,%VO,$L
CONTNL: MPM CONTENTS,SPECWD,0,%FC,$R
MPM CONTROLLER,CO,0,%FC,$NX
MPM CORMAX,.CORMX,1,%FC,$R
MPM COUNT,COUNT,1,%FO,$R
MPM DATE,DATE,0,%FO,$R
MPM DDT,CALDDT,0,%FC,$R
MPM DELETE,FDELETE,0,%FC,$R
MPM DIFFERENCE,DIFF,2,%FO,$R
MPM DIRNAME,DIRN,0,%FO,$R
MPM DISPLAY,DISPLAY,0,%FC,$N
MPM DISPLAY,DISPLAY,1,%FC,$3
MPM DISTANCE,DIST,2,%FO,$N
MPM DO,CALLDO,1,%FC,$R
MPM DOTPRODUCT,DOTPRD,2,%FO,$V
MPM EDIT,EDIT,0,%FC,$R
MPM EITHER,EITHER,2,%FO,$R
ELSEL: MPM ELSE,SPECWD,0,%FC,$R
MPM EMPTYP,EMPTYP,1,%FO,$R
MPM END,ENND,0,%FC,$R
MPM ENDSNAP,ESNAP,0,%FC,$S
ENTRYL: MPM ENTRY,SPECWD,0,%FC,$R
MPM ERASE,ERASE,0,%FC,$R
MPM EXIT,EXIT,1,%FC,$R
FALSEL: MPM FALSE,SPECWD,0,%FC,$R
FILEL: MPM FILES,SPECWD,0,%FC,$R
MPM FIRST,FIRST,1,%FO,$R
MPM FORMFEED,FRMFD,0,%FC,$R
MPM FORWARD,FORWARD,1,%FC,$T
MPM FRAME,FRAME,0,%FO,$N
MPM FTOUCH,FTOUCH,0,%FO,$X
MPM GENVEC,GENVEC,2,%FO,$V
MPM GET,GET,0,%FC,$R
MPM GO,GOTO,0,%FC,$R
MPM GOODBYE,GOODBYE,0,%FC,$R
MPM GREATERP,GRATRP,2,%FO,$R
MPM HEADING,HEADING,0,%FC,$D
MPM HIDETURTLE,HIDETURTLE,0,%FC,$D
MPM HOME,HOME,0,%FC,$N
MPM IF,IF,0,%FC,$R
MPM IFTRUE,IFTRUE,0,%FC,$R
MPM IFFALSE,IFFALS,0,%FC,$R
MPM INTERSECTION,INTERS,2,%VO,$L
MPM IS,IS,2,%FO,$R
MPM JOIN,CONCAT,2,%VO,$L
MPM LAMPOFF,LAMPOF,0,%FC,$T
MPM LAMPON,LAMPON,0,%FC,$T
MPM LAST,LAST,1,%FO,$R
MPM LASTCHAR,LASTCH,0,%FO,$R
MPM LEFT,LEFT,1,%FC,$T
MPM LESSON,LESSON,0,%FC,$R
MPM LESSP,LESSP,2,%FO,$R
MPM LEVEL,LEVEL,1,%FO,$L
LINELL: MPM LINE,SPECWD,0,%FC,$R
MPM LINEFEED,LF,0,%FC,$R
MPM LIST,LIST,0,%FC,$R
MPM LISTEN,LISTEN,0,%FO,$R
MPM LOCAL,LOCAL,1,%FC,$R
MPM LOGIN,LOGIN,0,%FC,$R
MPM LOGNAME,LOGN,0,%FO,$R
MPM LST,LST,1,%FO,$L
MPM LTOUCH,LTOUCH,0,%FO,$X
MPM LFTOUCH,LFTOUCH,0,%FO,$X
MPM LBTOUCH,LBTOUCH,0,%FO,$X
MACHIL: MPM MACHINE,SPECWD,0,%FC,$R
400000\WORDF,,[ASCIZ /MAKE/] ;SPECIAL TO COMPIL
<2-1>\%FC,,MAKE
LMAKL: 400000\WORDF,,[ASCIZ /MAKE/] ;MUST FOLLOW REGULAR MAKE
<2-1>\%FC,,MAKE
400000\WORDF,,[ASCIZ /MAKE
NAME: /]
<2-1>\%FC,,MAKE
MAKL2: MPM ,CPOPJ,1,%FC,$R
WORDF,,[ASCIZ /
THING: /]
<2-1>\%FC,,CPOPJ
MPM LTOUCH,LTOUCH,0,%FO,$X
MPM JR,JR,0,%FO,$P
MPM JS,JS,0,%FO,$P
MPM JVX,JVX,0,%FO,$P
MPM JVY,JVY,0,%FO,$P
MPM JX,JX,0,%FO,$P
MPM JY,JY,0,%FO,$P
MPM LR,LR,0,%FO,$P
MPM LS,LS,0,%FO,$P
MPM LVX,PX1VEL,0,%FO,$P
MPM LVY,PY1VEL,0,%FO,$P
MPM LX,PX1POS,0,%FO,$P
MPM LY,PY1POS,0,%FO,$P
MPM MAXIMUM,MAXIM,2,%VO,$R
MPM MBUFCLEAR,MBCLR,0,%FC,$NX
MPM MBUFCOUNT,MBCNT,0,%FO,$NX
MPM MBUFINIT,MBINIT,0,%FC,$NX
MPM MBUFNEXT,MBNXT,1,%FC,$NX
MPM MBUFOUT,MBOUT,0,%FC,$NX
MPM MBUFPUT,MBPUT,1,%FC,$NX
MPM MBUFSTART,MBSTRT,0,%FC,$NX
MPM MCLEAR,MCLEAR,0,%FC,$X
MPM MEMBERP,MEMBER,2,%FO,$L
MPM MINIMUM,MINIM,2,%VO,$R
MPM MLEN,MLEN,0,%FO,$X
MPM MOD,REMAIN,2,%FO,$R
MPM MOTOR,MOTOR,2,%FC,$R
NAMESL: MPM NAMES,SPECWD,0,%FC,$R
MPM NEWMUSIC,NEWMUS,0,%FC,$NX
MPM NEWS,NEWS,0,%FC,$R
MPM NOCONTROLLER,NOCO,0,%FC,$NX
MPM NOPHYSICS,NOPHY,0,%FC,$P
MPM NOT,NOT,1,%FO,$R
MPM NOTURTLE,NOTURT,0,%FC,$NX
MPM NTHCHAR,NTHCHA,2,%FO,$R
MPM NUMBERP,NUMBRP,1,%FO,$R
OFL: MPM OF,SPECWD,0,%FC,$R
MPM OLDMUSIC,OLDMUS,0,%FC,$NX
MPM OUTPUT,OUTPUT,1,%FC,$R
MPM PEN,PEN,1,%FC,$N
MPM PENDOWN,PENDOWN,0,%FC,$T
MPM PENUP,PENUP,0,%FC,$T
MPM PHYSICS,PHYSICS,0,%FC,$P
MPM PICK,PICKEL,2,%FO,$L
MPM PICKELEMENT,PICKEL,2,%FO,$L
MPM PLAY,PLAY,1,%FC,$OM
MPM PCLEAR,PCLEAR,0,%FC,$X
MPM PLOT,PLOT,0,%FC,$3
MPM PLOTDOWN,PLOTDO,0,%FC,$X
MPM PLOTXY,PLOTXY,2,%FC,$X
MPM PLOTUP,PLOTUP,0,%FC,$X
MPM PM,PM,0,%FC,$X
MPM PRETTY,PRETTY,1,%FC,$R
MPM PRINT,PRINT,1,%VC,$R
PROCDL: MPM PROCEDURES,SPECWD,0,%FC,$R
MPM PRODUCT,STIMES,2,%VO,$R
MPM PSCALE,PSCALE,1,%FC,$P
MPM PUSH,PUSHXY,2,%FC,$P
MPM PUSHA,PUSHA,2,%FC,$P
MPM QUOTE,QUOTX,0,%FC,$R
MPM QUOTIENT,QUOT,2,%FO,$R
MPM RTOUCH,RTOUCH,0,%FO,$X
MPM RBTOUCH,RBTOUC,0,%FO,$X
MPM RFTOUCH,RFTOUC,0,%FO,$X
MPM RANDOM,RANDOM,0,%FO,$R
MPM READ,READ,0,%FC,$R
MPM REMAINDER,REMAIN,2,%FO,$R
MPM REMEL,REMEL,2,%FC,$L
MPM REMOVESNAP,RSNAP,1,%FC,$S
MPM RESET,RSET,0,%FC,$R
MPM RESTART,RESTART,0,%FC,$D
MPM RIGHT,RIGHT,1,%FC,$T
MPM REQUEST,REQUEST,0,%FO,$R
MPM RR,PR,0,%FO,$P
MPM RS,RS,0,%FO,$P
MPM RV,RV,0,%FO,$P
MPM RVX,PXVEL,0,%FO,$P
MPM RVY,PYVEL,0,%FO,$P
MPM RX,PXPOS,0,%FO,$P
MPM RY,PYPOS,0,%FO,$P
MPM SAVE,SAVE,0,%FC,$R
MPM SCALARMUL,SCALRM,2,%FO,$V
MPM SCALARMULTIPLY,SCALRM,2,%FO,$V
MPM SCM,SCALRM,2,%FO,$V
MPM SENTENCE,SENTENCE,2,%VO,$R
MPM SENTENCEP,SENTP,1,%FO,$R
MPM SETHEAD,SETHEAD,1,%FC,$D
MPM SETTURTLE,SETTURTLE,0,%FC,$NX
MPM SETX,SETX,1,%FC,$D
MPM SETXY,SETXY,2,%FC,$N
MPM SETY,SETY,1,%FC,$D
MPM SHOWSNAP,SSNAP,1,%FCS,$S
MPM SHOWTURTLE,SHOWTURTLE,0,%FC,$D
MPM SING,SING,2,%VC,$R
MPM SLIDE,SLIDE,1,%FC,$VN
MPM SMALLTURTLE,SMALLTURTLE,0,%FC,$NX
MPM SNAP,SNAP,1,%FC,$S
MPM SQRT,CMSQRT,1,%FO,$V
MPM STEPNT,STEPNT,2,%FO,$V
MPM STOP,ESTOP,0,%FC,$R
MPM STR,STR,1,%FO,$L
MPM SUM,SUM,2,%VO,$R
MPM TBOXDEBUG,TBOXDEBUG,0,%FC,$X
MPM TBOXOFF,TBOXOF,0,%FC,$X
MPM TBOXON,TBOXON,0,%FC,$X
MPM TEST,TEST,1,%FC,$R
THENL: MPM THEN,SPECWD,0,%FC,$R
MPM THING,THING,1,%FO,$R
MPM TIME,TIME,0,%FO,$R
TITLEL: MPM TITLE,TITLEX,0,%FC,$R
TOL: MPM TO,TO,0,%FC,$R
MPM TOOT,WHISTL,1,%FC,$NX
MPM TOOT,TOOT,1,%FC,$X
TRACEL: MPM TRACE,TRACE,0,%FC,$R
TRACSL: MPM TRACES,SPECWD,0,%FC,$R
MPM TOWARDS,TWD,2,%FO,$N
TRUEL: MPM TRUE,SPECWD,0,%FC,$R
MPM TYI,.TYI,0,%FO,$R
MPM TYO,.TYO,1,%FC,$R
MPM TYPE,TYPE,1,%VC,$R
MPM UNION,UNION,2,%VO,$L
MPM USE,USE,0,%FC,$R
MPM VECTORADD,VADD,2,%FO,$V
MPM VECTORSUB,VSUB,2,%FO,$V
MPM VECTOR,VECTOR,2,%FO,$V
MPM VSUB,VSUB,2,%FO,$V
MPM VECTORP,VECTRP,1,%FO,$V
MPM VERSION,VERSN,0,%FO,$R
MPM VOICE,VOICE,1,%FC,$X
MPM VLEN,VLEN,0,%FO,$X
MPM VOICES,VOICES,1,%FC,$NX
MPM WAIT,WAIT,1,%FC,$R
MPM WIPE,WIPE,0,%FC,$N
MPM WORD,WORD,2,%VO,$R
MPM WORDP,WORDP,1,%FO,$R
MPM WRITE,WRITE,0,%FC,$R
MPM XCOR,XCOR,0,%FC,$D
MPM YCOR,YCOR,0,%FC,$D
MPM ZEROP,ZEROP,1,%FO,$R
DONTSH: 0 ;ALL TABLE SEARCHES TERMINATE ON A 0
;THESE ARE HERE FOR EASE IN LISTING AND EDITING
LPREN: MPM (,[[ERROR .]],0,%FO,$R
RPREN: MPM ),[[ERROR .]],0,%FO,$R
INMNSL: MPM -,DIFF,2,%FO,$R;NEXT 2 ENTRIES MUST BE IN ORDER (SEE GNSMNS)
PRMNSL: MPM -,MINUS,1,%FO,$R
INPLSL: MPM +,SUM,2,%FO,$R
PRPLSL: MPM +,CPOPJ,1,%FO,$R
INTMSL: MPM *,STIMES,2,%FO,$R
INDIVL: MPM /,QUOT,2,%FO,$R
INEQL: MPM =,IS,2,%FO,$R
INGRTL: MPM >,GRATRP,2,%FO,$R
INLSTL: MPM <,LESSP,2,%FO,$R
INCNKL: MPM &,CONC,2,%FO,$R
IMAKEL: MPM _,IMAKE,2,%FC,$R

Reference in New Issue View Git Blame Copy Permalink