TITLE ASSEMBLE LISP SYSTEM ; Do :ASSLIS 259QIO to assemble MacLisp version 2259. The suffix "QIO" ; controls the system assembled for (see next comment). The terminating ; character controls various switches: ; ; Ask? CREF? Master? ; CR no no no ; ^S no no yes ; ^X no yes no ; ^C no yes yes ; ALT yes no ; ; A "_" in the command does something as well, I didn't bother to figure it ; out. -Alan 4/21/86 ;Various suffixes: ; QIO for standard ITS assembly, QIO and turn on SFA stuff ; D10 T10 M10 for TOPS-10 assemblies. DT1 sets HISEGMENT==0; DTP sets ; DT1 DTP PAGING==1, forcing HISEGMENT==0. M10 is "minimal" size ; D20 TWX TNX for TOPS-20 and TENEX assemblies ; CMU CM1 CMP for Carnegie-Mellon system - [As of 7/1/79, no longer used] ; SAI SA1 SAP for SAIL system, ;As of 25 Jan 1979, SFA is normally set 1 only for ITS assemblies ; The D20 flag will also cause it to be set ;STRANGE FORMATS FOR BYTE POINTERS .FORMAT 36,300636060000 ; BYTPOS,BYTSIZ, [ 1,7, = 010700,, ] .FORMAT 37,002230063606 ; BYTPOS,BYTSIZ,ADDRESS [ 1,7,23 = 010700,,23 ] DEFINE NMSIRP IRP NM,,[QIO,D20,TWX,TNX,DT1,DTP,T10,D10,M10,SAI,SA1,SAP,CMU,CM1,CMP] CODE TERMIN TERMIN DEFINE INFORM CRUFT1,CRUFT2,CRUFT3,CRUFT4 IF1,[PRINTC \ CRUFT1!CRUFT2!CRUFT3!CRUFT4 \ ] TERMIN DEFINE TYO X/ IRP Q,,[X] .IOT TYOC,[Q] TERMIN TERMIN DEFINE ALLOCATE ITEMS,XMIN,XMAX,LIST N!ITEMS==XMIN IRP QQQ,,[LIST] IFSE ITEMS,ACS, QQQ=N!ITEMS IFSE ITEMS,UUOS, QQQ=N!ITEMS_33 IFSN ITEMS,ACS, IFSN ITEMS,UUOS, QQQ==N!ITEMS N!ITEMS==N!ITEMS+1 TERMIN IFG N!ITEMS-XMAX, INFORM \N!ITEMS,[IS TOO MANY ITEMS (MAX = ]\XMAX,[)] TERMIN ALLOCATE ACS,1,17,[A,B,C,D,E,T,TT,UUOT,UUOTT,QUESFL,NCRFFL,JCLBP] ALLOCATE UUOS,1,37,[STRT,ASK,SHOVE,DECBP,STRTA] ALLOCATE IOCHS,1,17¬[TYIC,TYOC,CFC,DSKC] ; JUMPAI=JUMPN AIFLAG, ;JUMP IF AI ; JUMPML=JUMPE AIFLAG, ;JUMP IF MATHLAB JUMPQ=JUMPN QUESFL, ;JUMP IF WANT QUESTIONS JUMPNQ=JUMPE QUESFL, ;JUMP IF NOT WANT QUESTIONS JUMPNC=JUMPN NCRFFL, ;JUMP IF NOT WANT CREF JUMPC=JUMPE NCRFFL, ;JUMP IF WANT CREF JUMPJ=JUMPN JCLBP, ;JUMP IF HAVE JCL JUMPNJ=JUMPE JCLBP, ;JUMP IF NOT HAVE JCL FIRSTLOC: LOC 41 JSR UUOH ;TO HAIRY UUO HANDLER LOC FIRSTLOC UUOH: 0 JRST UUOH0 DDTSTF: ASCII \LSYS:TS MIDASîOTTY:,DSK:LISP;LSPTTY \ P3: BLOCK 2 ASCII \îITTY:,CLU:LISP;MIDAS \ P5: BLOCK 2 ASCII \ î\ MASCOM: BLOCK 3 ASCIZ \:EXISTS DSK:LISP;îî:GZPîJV\ ;;; THE :EXISTS...îî ;;; IS TO RESET DDT'S PRINT DEFAULTS AND THEN ;;; FLUSH THE VALUE OF THE :EXISTS CRSTUF: ASCII \,DSK: LISP; BBCREF \ P4: BLOCK 2 LSSTUF: ASCII \ , \ LCSTUF: ASCII \,,DSK: LISP; LIST \ P2: BLOCK 2 ASCII \ \ COMM: ASCII \DSK: LSPDMP; \ PC1: ASCII \ BBLISP \ P1: BLOCK 2 CRFCOM: BLOCK 6 LSTCOM: BLOCK 7 ASCII \_DSK:\ DIRNAM: ASCII \ LISP\ ASCII \; \ LSPNAM: ASCII \LISP \ ASCII \ \ P0: BLOCK 2 ASCIZ \(R)\ LSTWRD: ASCIZ \WWWXXX,,YYYZZZ\ DSKOPN: SIXBIT \ DSKLISP \ DSKFNM: BLOCK 1 DTHOPN: SIXBIT \ DSK*LISP \ DTHFNM: BLOCK 1 LOSMSG: SIXBIT \_DSK:^LISP;^LISP^\ LOSFNM: BLOCK 1 SIXBIT \^^^FILE^NOT^FOUND!\ CLOOPN: SIXBIT \ !CLOMIDAS \ CLOFNM: BLOCK 1 CLUOPN: SIXBIT \ CLUMIDAS \ CLUFNM: BLOCK 1 CLXOPN: SIXBIT \ !CLUMIDAS \ CLXFNM: BLOCK 1 ASSMSG: SIXBIT \_VERSION^\ ASSFNM: BLOCK 1 SIXBIT \^^^ALREADY^BEING^ASSEMBLED!\ IRP FILNAM,,[LSPTTY,BBLISP,BBCREF,CREF,LIST]NM,,[LTY,BBL,BBC,CRF,LST]F,,[T,B,C,K,L] NM!FIL: SIXBIT \ DSK!FILNAM\ NM!FNM: BLOCK 1 0 ;FOR .FDELE 0 F!LOSMS: SIXBIT \_DSK:^LISP;^FILNAM^\ F!LOSFN: BLOCK 1 SIXBIT \^^^FILE^ALREADY^PRESENT!\ TERMIN 3LSNER: BLOCK 1 SIXBIT \^^^3-LETTER^SUB-NAME^NOT^RECOGNIZED^M!\ RDBK: 0 ;SAVED BREAK CHAR FROM READ TTYDSP: 0 ;NON-ZERO => DISPLAY TTY PATCH: BLOCK 100 ;MOBY PATCH AREA JCLBF: ;JCLBF SAME AS CFCBF CFCBF: BLOCK 2000-. ;MOBY BUFFER FOR REDEFINITIONS ECFCBF: INFORM [LENGTH OF REDEFINITIONS BUFFER = ]\ECFCBF-CFCBF LOC 2000 ;SEPARATE PAGE FOR PURE CODE GO: MOVEI T,401001 .CBLK T, ;PURIFY TOP PAGE (FOR PROTECTION ONLY) .VALUE SETZB JCLBP,QUESFL .SUSET [.ROPTION,,T] TLZN T,%OPCMD ;SKIP IF JCL JRST NOJCL .BREAK 12,[5,,JCLBF] .BREAK 12,[400005,,[0]] .SUSET [.SOPTION,,T] MOVE JCLBP,[1,7,JCLBF-1] NOJCL: .SUSET [.SSNAM,,[SIXBIT \LISP\]] ; .CALL MUMBLE ; .VALUE ; CAME AIFLAG,[SIXBIT \AI\] ; TDZA AIFLAG,AIFLAG ; MOVEI AIFLAG,1 .OPEN TYIC,[0,,SIXBIT \ TTYASSLISINPUT \] .VALUE .OPEN TYOC,[21,,SIXBIT \ TTYASSLISOUTPUT\] .VALUE .CALL GETTTY .VALUE REINIT: JUMPJ RDJCL ; JUMPML MLHI ; STRT [SIXBIT \_AI!\] ; JRST .+2 ;MLHI: STRT [SIXBIT \_ML!\] STRT [SIXBIT \_ASSLISP.!\] STRT [<.FNAM2&-100>+'!] RDFNAM: SETZ JCLBP, SETO QUESFL, ;DEFAULT IS WANT QUESTIONS, NO CREF RDFNM1: STRT [SIXBIT \_*!\] RDJCL: SETO NCRFFL, JSP E,READ JUMPE TT,RDFNM1 MOVE E,[ASCII \ BBLI\] ;INITIALIZE SOME LOCATIONS MOVEM E,PC1 MOVE E,[ASCII \SP \] MOVEM E,PC1+1 MOVE E,[SIXBIT \BBLISP\] MOVEM E,BBLFIL+1 MOVEM E,BLOSMS+2 IRP NM,,[LTY,BBL,BBC,CRF,LST,CLU,CLX,CLO]F,,[T,B,C,K,L,-,-,-] MOVEM TT,NM!FNM IFSN F,-, MOVEM TT,F!LOSFN TERMIN IRPC X,,[12345] MOVEM C,P!X MOVEM D,P!X+1 TERMIN HLLZ A,TT HRRZ B,TT JUMPE B,JONL1 CAIN B,'QIO JRST JONL1 NMSIRP {CAIN B,'NM JRST JONL0} MOVEM TT,3LSNER STRT 3LSNER JRST RDFNAM JONL0: HRLI B,'REL ;FOR THE VARIOUS DEC10 VERSIONS, NAME MOVEM B,BBLFIL+1 ;THE OUTPUT "RELSAI XXX" OR WHATEVER MOVEM B,BLOSMS+2 ;INSTEAD OF "BBLISP XXXD10" MOVEM A,BBLFNM MOVEM A,BLOSFN MOVEI A,77777 ;TRANSFER ASCII FOR THE 3 DIGITS TO T ANDCA A,C IORI A,20100 ;ASCII FOR THE TWO SPACES MOVEM A,P1 MOVE A,[ASCII \ \] MOVEM A,P1+1 MOVE A,C ANDI A,77777 IOR A,[ASCII \REL\] MOVEM A,PC1 MOVEM D,PC1+1 JONL1: .OPEN CFC,CLUOPN JRST .+2 JRST CFDEL .OPEN CFC,CLXOPN JRST CFOPEN .CLOSE CFC, JRST CLULOS CFDEL: .CLOSE CFC, ;MUST CLOSE IN ORDER TO .FDELE CLUOPN ; FLUSH RANDOM CLU FILE JRST CLULOS CFOPEN: .OPEN CFC,CLOOPN .VALUE MOVE A,RDBK CAIN A,"_ JRST 2NAMES TRZ TT,-1 ;USE ONLY 3 CHARS TRZ C,77777 ;CLEAR 15. BITS, LEAVING 21. TRO C,77777& ;INSERT SPACES MOVE D,SPACES JRST 1NAME 2NAMES: JSP E,READ JUMPE TT,DIR2 1NAME: MOVEM TT,DSKFNM MOVEM C,P0 MOVEM D,P0+1 MOVE E,[ASCII \LISP \] MOVEM E,LSPNAM MOVE E,[ASCII \ LISP\] MOVEM E,DIRNAM .OPEN DSKC,DSKOPN JRST DSKLOS DSKWIN: MOVE T,[[ASCII \0/-1î.MASTEX \],,MASCOM] CAIE A,^M ;CR OR ^S OR ^C OR ^X MEANS NO QUESTIONS CAIN A,^S SETZ QUESFL, CAIE A,^C ;^C AND ^X ADDITIONALLY MEAN CREF CAIN A,^X SETZB QUESFL,NCRFFL CAIE A,^M ;CARRIAGE RETURN CAIN A,33 ; OR ALTMODE HRLI T,SPACES CAIN A,^X ; OR ^X HRLI T,SPACES ; MEANS NO MASTER MODE BLT T,MASCOM+2 MOVEI E,37 IRP %,,[LTY,BBL,BBC,CRF,LST]$,,[T,B,C,K,L] .OPEN DSKC,%!FIL TRZA E,1_.IRPCNT STRT $!LOSMS TERMIN JUMPE E,NODLOS DELP: ASK A,[SIXBIT \_DELETE^AND^CONTINUE?:^!\] .BREAK 16,40000 CAIE A,"Y CAIN A,171 ;SMALL Y JRST DELDEL STRT [SIXBIT \_>>>^Y=YES,^N=NO!\] JRST DELP DELDEL: IRP %,,[LTY,BBL,BBC,CRF,LST] TRNN E,1_.IRPCNT JRST .+3 .FDELE %!FIL .VALUE TERMIN NODLOS: MOVEI T,1 JUMPC GLSCRF ;MAYBE CREF ALREADY SPECIFIED SETZ T, JUMPNQ GLSCR ;MAYBE DON'T WANT CREF QUESTION JRST CRFASK WISGUY: STRT [SIXBIT \_>>>^C=CREF,^L=LIST,^N=NEITHER,^B=BOTH!\] CRFASK: ASK A,[SIXBIT \_CREF/LIST?:^!\] ;ASK IF CREF OR LIST IS WANTED JRST GLSCR IRP X,,[0,40] IRPC Q,,[CLB] CAIN A,X+"Q MOVEI T,1+.IRPCNT TERMIN TERMIN JUMPE T,WISGUY ;SOME WISE GUY IS GIVING BAD REPLIES! JRST GLSCR GLSCRF: STRT [SIXBIT \_;CREF!\] GLSCR: MOVE A,CRFTBL(T) MOVE B,LSTTBL(T) BLT A,CRFCOM+5 BLT B,LSTCOM+6 SHOVE COMM ;TRANSFER MIDAS COMMAND STRING TO CORE LINK FILE .IOT CFC,[^M] ;CARRIAGE RETURN TRNN T,2 ;SKIP IF WE WANT A LISTING JRST MLP SETZB C,E ;E HOLDS CONDITION BITS MOVEI D,FOOTBL ;D HAS TABLE POINTER FOOASK: ASK A,@(D) ;INQUIRE ABOUT A GIVEN SECTION JRST FOONO ;DON'T WANT IT CAIE A,"Y CAIN A,171 ;SMALL Y JRST FOOYES ;WANT IT HLRZ B,2(D) ;DOES IT HAVE SUBSECTIONS? CAILE B,(C) JRST FOOSP ;YES STRT [SIXBIT \_>>>^Y=YES,^N=NO!\] JRST FOOASK ;ELSE GO TRY AGAIN FOOSP: CAIE A,"S CAIN A,163 ;SMALL S JRST FOOSEL ;WANT SELECTION STRT [SIXBIT \_>>>^Y=YES,^N=NO,^S=SELECT!\] JRST FOOASK ;ILLEGAL ANSWER, TRY AGAIN FOOSEL: ADDI C,1000 ;INCREMENT LEVEL OF INQUIRY ADDI D,2 ;INCREMENT TABLE POINTER JRST FOOASK FOONO: ADDI D,2 ;INCREMENT TABLE POINTER HLRZ B,(D) CAILE B,(C) ;SKIP IF AT END OF SUBBLOCK JRST FOONO MOVEI C,(B) ;POP LEVEL BACK JUMPN B,FOOASK ;GO BACK IF ANY MORE JRST FOOCNV ;ELSE GO DO HAIRY STUFF FOOYS0: IOR E,1(D) ;OR IN BIT FOR THIS SECTION FOOYES: ADDI D,2 ;INCREMENT TABLE POINTER HLRZ B,(D) CAILE B,(C) ;SKIP IF AT END OF SUBBLOCK JRST FOOYS0 MOVEI C,(B) ;POP LEVEL BACK JUMPN B,FOOASK ;GO BACK IF ANY MORE FOOCNV: MOVEI A,14 MOVE B,[440700,,LSTWRD] FOOCN1: SETZ D, ;CONVERT BITS TO 12.-DIGIT OCTAL LSHC D,3 ADDI D,"0 IDPB D,B CAIE A,7 JRST FOOCN2 MOVEI D,", ;OUTPUT TWO COMMAS BETWEEN HALFWORDS IDPB D,B IDPB D,B FOOCN2: SOJG A,FOOCN1 SHOVE LSTW1 ;SHOVE OUT GARBAGE SHOVE LSTWRD SHOVE LSTW2 SHOVE LSTWRD SHOVE LSTW3 MLP: ; (These days, it is always Mathlab) ; JUMPAI GLS1 ; SHOVE MLSTUF ;IF THIS IS MATHLAB, WE MUST TELL MIDAS GLS1: HRRZ T,LTYFNM ;CHECK OUT SECOND FILE NAME JUMPN T,GLS0 MOVEI T,'QIO JRST GLS0 ; MLSTUF: ASCIZ  ; PRINTC ML==1 ;  ; ML==1 ;  DEFINE MKFRM NM,FLST CAIE T,'NM JRST XXX!NM STRTA NM!STR SHOVE PC0STF SHOVE NM!STR SHOVE PC1STF SHOVE NM!STR JRST XXXGLS NM!STR: ASCIZ  FLST  XXX!NM: TERMIN PC0STF: ASCIZ \ PRINTC \ ;FLAG STRING WILL BE "SHOVED" HERE PC1STF: ASCIZ \ \ ;FLAG STRING WILL BE "SHOVED" AGAIN HERE GLS0: IRP ARG,,[[ITS,[ITS==1]] [QIO,[ITS==1?SFA==1]] [D20,[TOPS20==1?SFA==1]] [TWX,[TOPS20==1]] [TNX,[TENEX==1]] [D10,[TOPS10==1]] [T10,[TOPS10==1]] [M10,[TOPS10==1?USELESS==0?BIGNUM==0?HNKLOG==0?OBTSIZ==377?SFA==0]] [DT1,[TOPS10==1?HISEGMENT==0]] [DTP,[TOPS10==1?PAGING==1]] [SAI,[SAIL==1?SFA==1]] [SAP,[SAIL==1?PAGING==1?SFA==1]] [SA1,[SAIL==1?HISEGMENT==0?SFA==1]] [CMU,[CMU==1]] [CM1,[CMU==1?HISEGMENT==0]] [CMP,[CMU==1?PAGING==1]] ] MKFRM ARG TERMIN XXXGLS: JUMPNQ NORDF ;MAYBE DON'T WANT REDEF QUESTION RDFMSG: STRT [SIXBIT \_REDEFINITIONS:_!\] SETZM CFCBF ;ALLOW INPUT OF OTHER REDEFINITIONS MOVE T,[CFCBF,,CFCBF+1] ; FOR MIDAS .INSRT TTY: BLT T,ECFCBF-1 MOVE T,[1,7,CFCBF-1] GLS2: JSP E,GETCHR ;READ FIRST CHAR OF LINE CAIN A,^M ;CR MEANS A NEW LINE AGAIN ALREADY JRST GLS2 CAIE A,^C JRST GLS2 MOVEI A,0 ;ERASE ^C WITH A NULL DPB A,T SHOVE CFCBF ;MOVE STUFF OUT TO CORE LINK DEVICE SHOVE [ASCIZ \PRINTC \] SHOVE CFCBF ;ONCE MORE, SO IT APPEARS ON THE LSPTTY FILE SHOVE [ASCIZ \ \] NORDF: .IOT CFC,[^C] ;OUTPUT CONTROL C .CLOSE CFC, STRT [SIXBIT \_!\] .VALUE DDTSTF ;VALRET STRING TO DDT TO GET MIDAS RUNNING SPACES: REPEAT 7, ASCII \ \ ;FIVE SPACES LSTW1: ASCIZ \ PRINTC / $LIST$==<\ LSTW2: ASCIZ \> ;LISTING CONTROL / $LIST$==<\ LSTW3: ASCIZ \> \ CRFTBL: SPACES,,CRFCOM ;N CRSTUF,,CRFCOM ;C SPACES,,CRFCOM ;L CRSTUF,,CRFCOM ;B LSTTBL: SPACES,,LSTCOM ;N SPACES,,LSTCOM ;C LSSTUF,,LSTCOM ;L LCSTUF,,LSTCOM ;B ; MUMBLE: SETZ ; SIXBIT \SSTATU\ ; REPEAT 5, 2000,,AIFLAG ; 402000,,AIFLAG GETTTY: SETZ SIXBIT \TTYGET\ 1000,,TYIC REPEAT 4, 2000,,A 402000,,TTYDSP DIR: .OPEN DSKC,[0,,SIXBIT \ DSK.FILE.(DIR) \] .VALUE JSP A,CLRTTY ;CLEAR TTY SCREEN DIR1: .IOT DSKC,A ;PRINT LISP DIRECTORY CAIN A,^L JRST DIR2 .IOT TYOC,A JRST DIR1 DIR2: TYO ^G JRST RDFNAM DSKLOS: MOVE E,[ASCII \*LISP\] MOVEM E,LSPNAM MOVE E,[ASCII \ L\] MOVEM E,DIRNAM MOVEM TT,DTHFNM .SUSET [.SSNAM,,[SIXBIT \L\]] .OPEN DSKC,DTHOPN JRST DTHLOS STRT [SIXBIT \_[*LISP]!\] JRST DSKWIN DTHLOS: MOVEM TT,LOSFNM ;DISK FILE NONEXISTENT - CAN'T ASSEMBLE A PHANTOM PHILE STRT LOSMSG JRST RDFNAM CLULOS: MOVEM TT,ASSFNM ;APPARENTLY SOMEBODY'S ASSEMBLING STRT ASSMSG ; THIS VERSION ALREADY JRST RDFNAM CLRTTY: TYO ^M,^J CLRTT1: SKIPN TTYDSP ;ALTERNATE ENTRY JRST (A) ;CAN'T CLEAR SCREEN IF PRINTING TTY TYO ^P,"C JRST (A) READ: MOVE C,SPACES ;READ FILE NAME: MOVE D,SPACES ; LEAVE ASCII IN C AND D SETZ TT, ; LEAVE SIXBIT IN TT MOVE T,[0,6,TT-1] ; LEAVE EXTRA CHAR IN A MOVE B,[0,7,C-1] ; USES B AND T JRST READ1 ; RETURNS THROUGH E READ0: CAMN T,[0,6,TT] JRST READ1 IDPB A,B SUBI A,40 ;SIXBITify IDPB A,T READ1: JUMPJ READ9 .IOT TYIC,A JUMPE A,.-1 CAIN A,^G JRST REINIT CAIN A,^F JRST DIR READ1A: CAIG A,40+"Z CAIGE A,40+"A JRST READ2 SUBI A,40 ;Uppercasify if necessary JRST READ0 READ9: ILDB A,JCLBP JUMPN A,READ1A MOVEI A,^M JRST READ1A READ2: CAIG A,"^ CAIGE A,"! JRST READ4 CAIN A,"! JRST READ6 CAIN A,"# JRST READ6 CAIE A,"^ JRST READ0 READ6: TYO "?,"?,^G JRST RDFNAM READ4: MOVEM A,RDBK CAIE A,177 ; JRST READ5 ; CAMN T,[0,6,TT-1] ;SKIP UNLESS ENTIRE NAME RUBBED OUT JRST RDFNAM ;START FROM SCRATCH BACKUP: LDB A,B ;ECHO RUBBED-OUT CHARACTER .IOT TYOC,A MOVEI A,40 ;REPLACE BY SPACE IN BUFFER DPB A,B SETZ A, DPB A,T DECBP B ;BACK UP BYTE POINTERS DECBP T JRST READ1 READ5: CAME T,[22,6,TT] JRST (E) ;EXIT, UNLESS EXACTLY 3 CHARS TRZ TT,777777 IORI TT,'QIO TRZ C,077777 TRO C,<"QI>_1 TLZ D,177_11. TLO D,<"O>_11. JRST (E) GETCH0: CAMN T,[1,7,CFCBF-1] ;SKIP UNLESS ENTIRE BUFFER HAS BEEN RUBBED OUT JRST GLS1 ;GO RE-PROMPT LOSER LDB A,T ;GET CHARACTER RUBBED OUT .IOT TYOC,A ; AND ECHO BACK AT LOSER SETZ A, DPB A,T ;ZERO CHAR JUST ECHOED DECBP T ;BACK UP POINTER GETCHR: .IOT TYIC,A ;INPUT A CHAR JUMPE A,.-1 ;IGNORE NULL CHARS CAIN A,^\ ;^\ LOSES BECAUSE OF PRINTC OUTPUT JRST GETCH1 GETCH2: CAIE A,^Q ;QUOTE CHARACTER JRST GETCH3 .IOT TYIC,A JUMPE A,.-1 ;IGNORE NULLS CAIN A,^\ ;^\ LOSES JRST GETCH1 CAIE A,^C ;SO DOES ^C JRST GETCH5 GETCH1: .IOT TYOC,A ;ECHO IT BACK, PLUS A BELL TYO ^G JRST GETCHR GETCH3: CAIE A,^K ;SOFT FORM FEED CAIN A,^L ;LOUD FORM FEED JRST GETCH7 CAIN A,^F JRST FLAGS CAIE A,^G ;QUIT SIGNAL JRST GETCH4 CAMN T,[1,7,CFCBF-1] ;KIND OF QUIT DEPENDS ON WHERE WE ARE JRST REINIT JRST GLS1 ;MY APOLOGIES TO DIJKSTRA GETCH4: CAIN A,177 ;SKIP UNLESS RUBOUT JRST GETCH0 GETCH5: IDPB A,T ;DEPOSIT CHARACTER IN BUFFER MOVEI D,^J CAIN A,^M ;CARRIAGE RETURNS CAUSE INSERTION IDPB D,T ; OF FOLLOWING LINE FEED JRST (E) ;RETURN CHARACTER IN A GETCH7: CAIN A,^L JSP A,CLRTT1 GETCH8: STRT @RDFMSG SKIPA D,[1,7,CFCBF-1] GETCH9: .IOT TYOC,A ;ECHO BACK TOTAL CONTENTS OF BUFFER ILDB A,D JUMPN A,GETCH9 JRST GETCHR FLAGS: JSP A,CLRTTY ;CLEAR TTY SCREEN .OPEN DSKC,DSKOPN ;OPEN LISP SOURCE FILE SKIPA JRST .+3 .OPEN DSKC,DTHOPN .VALUE MOVEI D,3 ;FLAGS-PER-LINE COUNTER FLAGS1: .IOT DSKC,A ;SEARCH FOR INITIAL " CAIE A,"" JRST FLAGS1 FLAGS2: .IOT DSKC,A ;SEARCH FOR LINE FEED OR FINAL " CAIN A,"" JRST FLAGS5 CAIE A,^J JRST FLAGS2 .IOT DSKC,A ;NEW LINE FOUND CAIG A,40 ;DON'T WANT IT IF IT BEGINS WITH JRST FLAGS2 ; A SPACE OR CTRL CHAR CAIN A,"; ;DON'T WANT COMMENT LINES JRST FLAGS2 FLAGS4: .IOT TYOC,A ;ECHO LINE UNTIL SPACE OR CTRL CHAR .IOT DSKC,A CAILE A,40 JRST FLAGS4 SOJE D,FLAGS3 ;PRINT FLAGS THREE PER LINE TYO 40,40,40,^I JRST FLAGS2 FLAGS3: TYO ^M,^J MOVEI D,3 ;RESET COUNTER JRST FLAGS2 FLAGS5: CAIN D,3 ;ALL DONE - MAYBE NEED CR/LF JRST FLAGS6 TYO ^M,^J FLAGS6: ; (These days, it is always Mathlab) ; JUMPAI FLAGS8 ;TWO MORE FLAGS FOR MATHLAB ; STRT [SIXBIT \ML==1_MOBIOF==0_!\] ;FLAGS8: HRRZ D,LTYFNM ;FIGURE OUT OTHER FLAGS SKIPN D MOVEI D,'ITS NMSIRP {CAIN D,'NM STRT NM!STR} JRST GETCH8 UUOH0: LDB UUOT,[27.,9.,40] ;HAIRY UUO HANDLER CAILE UUOT,NUUOS ;WE ONLY KNOW ABOUT FLAVORS OF UUO .VALUE ;ANY OTHERS LOSE JRST @UUOTBL-1(UUOT) ;MINI-MOBY DISPATCH UUORET=JRST 2,@UUOH ;THIS IS HOW TO RETURN FROM MINI-MOBY DISPATCH UUOTBL: %STRT ;STRING TYPEOUT - SIXBIT %ASK ;ASK QUESTION, SKIP ON YES ANSWER %SHOVE ;SHOVE OUT ASCII FOR MIDAS %DECBP ;DECREMENT BYTE POINTER %STRTA ;STRING TYPEOUT - ASCII %STRT: %ASK: HRRZ UUOTT,40 HRLI UUOTT,(36.,6,) ;TYPEOUT OF A SIXBIT STRING 6TYP: ILDB UUOT,UUOTT JUMPE UUOT,6TYP ;IGNORE SPACES CAIN UUOT,'^ ;^ PRINTS AS SPACE JRST 6TYPSP CAIN UUOT,'# ;# QUOTES NEXT CHARACTER JRST 6TYP0 CAIN UUOT,'! ;! ENDS TYPEOUT JRST ASKP CAIE UUOT,'_ ;_ OUTPUTS CR,LF JRST 6TYP1 TYO ^M,^J JRST 6TYP 6TYPSP: TDZA UUOT,UUOT 6TYP0: ILDB UUOT,UUOTT 6TYP1: ADDI UUOT,40 .IOT TYOC,UUOT JRST 6TYP ASKP: LDB UUOT,[27.,9.,40] ;IS THIS ASK OR STRT? CAIE UUOT,ASK_-33 UUOXIT: UUORET ;STRT .IOT TYIC,UUOTT ;ASK JUMPE UUOTT,.-1 CAIE UUOTT,"N ;CAPITAL N CAIN UUOTT,156 ;SMALL N JRST .+2 AOS UUOH ;SKIP RETURN IF NOT N LDB UUOT,[23.,4,40] ;IF THE AC FIELD OF ASK IS NON-ZERO, JUMPE UUOT,.+2 ; PLACE THE CHARACTER READ IN THAT AC MOVEM UUOTT,(UUOT) MOVEI UUOT,REINIT ;CONTROL G FORCES RESTART RETURN CAIN UUOTT,^G HRRM UUOT,UUOH UUORET %SHOVE: HRRZ UUOTT,40 ;SHOVE ASCII OUT TO CORE LINK DEVICE HRLI UUOTT,(44,7,) 7.CFC: ILDB UUOT,UUOTT JUMPE UUOT,UUOXIT ;NULL CHAR TERMINATES .IOT CFC,UUOT JRST 7.CFC %DECBP: LDB UUOT,[24.,6,@40] ;DECREMENT BYTE POINTER MOVE UUOTT,UUOT ;BYTE SIZE ROT UUOT,-6 ADDB UUOT,@40 ;BACK UP POINTER BY PROPER NUMBER OF BITS LSH UUOT,-36 CAIGE UUOT,44 ;SKIP ON WORD BOUNDARY UNDERFLOW UUORET MOVE UUOT,DECTBL-6(UUOTT) EXCH UUOT,@40 SUBM UUOT,@40 UUORET DECTBL: 44,0,1 ;6 BIT BYTES 43,0,1 ;7 BIT BYTES %STRTA: HRRZ UUOTT,40 HRLI UUOTT,(36.,7,) ;TYPEOUT OF A ASCII STRING 7TYP: ILDB UUOT,UUOTT JUMPE UUOT,UUOXIT .IOT TYOC,UUOT JRST 7TYP DEFINE FOO LEVEL,BITNO,MSG LEVEL_11,,[SIXBIT \_MSG?:^!\] ZZ==0 IFNB BITNO,[ IRPNC 0,2,-1,X,,[BITNO] ZZ==11*ZZ+X-1 TERMIN 1_ZZ ] .ELSE 0 TERMIN ;;; THIS TABLE MUST CORRESPOND TO THE MOBY IRP ;;; IN LISP WHERE $LIST$ IS DEFINED FOOTBL: ;GRIDIRON DATA FOO 0,---,TOTAL^LISTING FOO 1,---,^^SYSTEM^CODE FOO 2,4.9,^^^^LOW^IMPURE FOO 2,4.8,^^^^ERROR^PAGE FOO 2,4.7,^^^^BAKTRACE/FRAME FOO 2,4.6,^^^^MOBYIO FOO 2,2.2,^^^^SORT^ROUTINES FOO 2,4.5,^^^^PRINT/UTAPE FOO 2,4.4,^^^^USEFUL^SUBRS FOO 2,4.3,^^^^ARITHMETIC FOO 2,4.2,^^^^BIGNUM FOO 2,4.1,^^^^EVAL/APPLY FOO 2,3.9,^^^^GC/READTABLE FOO 2,3.8,^^^^READER/INTERN FOO 2,3.7,^^^^STATUS/EDITOR FOO 2,---,^^^^ARRAYS/LAP FOO 3,3.6,^^^^^^ARRAYS FOO 3,2.6,^^^^^^LAP FOO 3,2.5,^^^^^^OP-DECODER FOO 2,3.5,^^^^FASLOAD FOO 2,3.4,^^^^COMMON/INT/UUO FOO 1,---,^^LIST^STRUCTURE FOO 2,3.3,^^^^MACROS FOO 2,3.2,^^^^INITIAL^ATOMS FOO 2,3.1,^^^^FREE^STORAGE FOO 2,2.9,^^^^NUMBER^AREAS FOO 1,---,^^BIBOP^TABLES FOO 2,2.8,^^^^SEGMENT^TABLE FOO 2,2.4,^^^^GC^SEGMENT^TABLE FOO 2,2.3,^^^^PURE^PAGE^TABLE FOO 1,2.7,^^INIT/ALLOCATOR 0 ;END OF GRIDIRON DATA BCONSTANTS: CONSTANTS INFORM [LENGTH OF PURE CODE = ]\.-2000 END GO