From ac2e3fe1e72c5d5e98d5e77224e5800123e489aa Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Tue, 18 Sep 2018 10:11:12 +0200 Subject: [PATCH] BBN Logo from 1970. Preserved by Arthur Krevat. > In my personal PPN from around 1987, I found LOGO.MAC: > LOGO MAC 294 <177> 21-Mar-84 DSKB: [565,20] > I suspect I found it somewhere on one of the university computers I > used to hack. Probably Stevens or some other place that maybe had a > telenet connection. --- Makefile | 2 +- doc/programs.md | 1 + src/bbn/logo.mac | 7814 ++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 7816 insertions(+), 1 deletion(-) create mode 100644 src/bbn/logo.mac diff --git a/Makefile b/Makefile index 5f8ccdba..8fa561f7 100644 --- a/Makefile +++ b/Makefile @@ -25,7 +25,7 @@ SRC = syseng sysen1 sysen2 sysen3 sysnet kshack dragon channa \ tensor transl wgd zz graphs lmlib pratt quux scheme gsb ejs mudsys \ draw wl taa tj6 budd sharem ucode rvb kldcp math as imsrc gls demo \ macsym lmcons dmcg hack hibou agb gt40 rug maeda ms kle aap common \ - fonts zork 11logo kmp info aplogo bkph + fonts zork 11logo kmp info aplogo bkph bbn DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc \ chprog sail draw wl pc tj6 share _glpr_ _xgpr_ inquir mudman system \ xfont maxout ucode moon acount alan channa fonts games graphs humor \ diff --git a/doc/programs.md b/doc/programs.md index 766e1474..16fc1a87 100644 --- a/doc/programs.md +++ b/doc/programs.md @@ -136,6 +136,7 @@ - LIVE, PALX Game of Life. - LOADP, displays system load. - LOCK, shut down system. +- LOGO, BBN Logo. - LOOKUP, looks up user info in INQUIR database. - LOSS (device). - LSPEED, set TTY line parameters. diff --git a/src/bbn/logo.mac b/src/bbn/logo.mac new file mode 100644 index 00000000..c2b4af78 --- /dev/null +++ b/src/bbn/logo.mac @@ -0,0 +1,7814 @@ +TITLE LOGO +; TM +;(C) COPYRIGHT,1970,BOLT BERANEK AND NEWMAN INC., CAMBRIDGE, MASS. +;MODIFIED AT NATIONAL RESEARCH COUNCIL (ISS/REED), OTTAWA, CANADA BY A.G.SMITH +;AND R.A. ORCHARD +; NRC MODIFICATIONS INCLUDE NRCTUR AND MUSIC SYSTEM IMPLEMENTATION +; FOR NRCTUR EITHER THE TEKTRONIX 4010 (TEKTUR) OR THE PLASMA +; PANEL (PLSTUR) ARE AVAILABLE. + +MLON +SALL +TWOSEG + +;CONFIGURATION PARAMETERS + + +IFNDEF CONFIG,> + +DEFINE OPTIONS,< +MAYBE TEN50 +MAYBE TENEX +MAYBE BBN50 +MAYBE TURTLE +MAYBE SAVBRK; ;IF ON, SAVEUP THE STATE OF LOGO SO THAT "GO" PROCEEDS +MAYBE LEVELC +MAYBE DRIBBLE +MAYBE MOCKTURTLE +MAYBE COMPTK +MAYBE MITREI +MAYBE NRCTUR +MAYBE PLSTUR +MAYBE TEKTUR +MAYBE MUSIC +MAYBE TENKI +> + +DEFINE MAYBE (A), +< A==%V + %V==%V+%V> +%V==1 + +OPTIONS +DEFINE MAYBE (A), + +OPTIONS + +;TO MAKE CONFIGURATION DEPENDENT STUFF READ LIKE ENGLISH + +SYN IFN,FOR +SYN IFE,NOTFOR + +FOR TEN50,< +BBNVER==2 ;BBN VERSION NUMBER +NRCVER==6 ;NRC MODIFICATION LEVEL +OTHVER==0 ;OTHER MODIFICATION LEVEL +EDITVR==44 ;EDIT NUMBER, INCREMENTED AT EVERY EDITING SESSION + + .JBVER==137 + LOC .JBVER + BYTE (3)OTHVER(9)BBNVER(6)NRCVER(18)EDITVR +> + +ERPDLL==20 ;LENGTH OF ERROR PDL, NEEDS TO BE LONG ENOUGH TO + ; AVOID PDL OVERFLOW TRAP +SUBTTL STORAGE ALLOCATION AND FLAG ASSIGNMENT + +;ACCUMULATOR ASSIGNMENTS +F=0 ;FLAGS AND BITS +A=1 +B=2 +C=3 +D=4 +E=5 +G=7 +H=10 +R=11 +L=12 +M=13 +N=14 +W=15 +S=16 ;ARGUMENT PUSHDOWN STACK +P=17 ;CONTROL PUSHDOWN STACK + +;FLAGS FOR THE LH OF F + +LDONF==1 ;LINE DONE FLAG FOR EDIT MODE +EDITF==2 +UPFF==4 ;COMEXR CALLED FROM RETURN CODE, NOT FROM COMEX +TIF==10 +BREAKF==20 +TOF==40 ;TYPE OR PRINT IN PROGRESS +GOF==100 ;USER TYPED DIRECT GO +RQF==200 ;A REQUEST IN PROGRESS +COMF==400 ;1 IF USER PROCEDURE BEING LEFT SHOULD BE TREATED LIKE COMMAND +GCF==1000 ;1 IF THIS K HAS NOT BEEN GARBAGE COLLECTED YET +TITLEF==2000 ;DOING TITLE DURING A TO +BROKE==4000 ;ERROR WAS NON-TYI BREAK KEY +GETF==10000 ;GET IN PROGRESS +SAVEF==20000 ;SAVE IN PROGRESS, FOR ALTERNATE FORMS OF TYPEOUT + ;UNASSIGNED +NOBREAK==100000 ;TO TEMPORARILY INHIBIT BREAK KEY +FCHARF==200000 ;FOR COMPUTING THE TIME BETWEEN _ AND CHAR 1 +GCCSF==400000 ;PROGRAM EDIT DONE, CODE PTRS ON STACK MAY BE INVALID + + +;FLAGS FOR THE RIGHT HALF OF F + +TF==1 ;A TEMPORARY FLAG FOR MANY ROUTINES +PMF==2 ;+- SIGN +NWF==4 ;NOT WORD INPUT +CRF==10 +FSYMF==20 ;0 IF FIRST ELEMENT OF LINE BEING COMPILED,USED W NNUMF +NNUMF==40 ;NON-NUMERIC INPUT +GRAPHF==100 ;TERMINAL IS IN GRAPHICS MODE +PREFIX==200 ;FOR PWORD +SUFFIX==400 ;ALSO FOR PWORD +MAKEF==1000 ;COMPIL CALLED WITH THIS=1 MEANS CALLED FROM MAKE +STORED==2000 +FLUSHF==4000 ;GETTING AN ALREADY DEFINED PROCEDURE +EABBRF==10000 ;DOING LIST ENTRY ABBREVIATIONS +ECONTF==20000 ; " " " CONTENTS +EENTRF==40000 ; " " " ENTRY +ENAMEF==100000 ; " " " NAMES +EELSEF==200000 ; 1_ELSE IS OK LINE TERMINATOR +ESCHF==400000 ;SEEN A NON-PRINTING CHAR IN PRODNM + + +;FLAG DEFINITIONS FOR LH OF STRING POINTER + +IMMEDIATE==400000 ;POINTER IS NOT A POINTER, BUT IS DATA +COMPOUND==200000 ; ELEMENT POINTED TO IS A LIST OF POINTERS +WORDF==100 ;STRING IS A WORD +SENTF==200 ;SENTENCE +EMPTYF==400 ;EMPTY +UNBOUN==40000 ;FOUND IN VP AND DP, 1_NOT EXPLICITLY SET +GLOBLF==100000 ; " " " " " , 1_TOPMOST BINDING, DONE BY MAKE + +;FLAG DEFINITIONS FOR LH OF COMPILED ELEMENT + +MPF==100000 +UPRF==40000 +VARF==20000 +LITF==10000 +INFOP==4000 ;IS AN INFIX OPERATOR +MVARF==2000 ; LIKE VARF, BUT TABLE APPEARS IN CODE +COMMTF==1000 ;IS A COMMENT +ANDF==400 ;USED IN TO LINES, IMPLIES THIS DUMMY PRECEDED BY AND +SCHF==20000 ;USED IN USER PROCEDURE NAMES, 1_NOT PROPER FORM +MAKESC==40 ;MEANS 2 LINE MAKE AND END OF NAME: +;ALSO IN THE LEFT HALF OF COMPILED ELEMENT CAN BE STRING BITS + + +;FLAG DEFINITIONS FOR LEFT HALF OF FIRST WORD OF RP PAIR + +TRACEF==100000 ;THIS PROCEDURE IS BEING TRACED + +;FLAG DEFINITION FOR LH OF 2ND WORD OF MACHINE NAME PAIR + +COMPUT==400000 ;IF ONE, THIS NAME MUST BE COMPUTED, ADDR IN RH + + +;UUO DEFINITIONS + +OPDEF ERROR [1B8] +OPDEF EXPAND [2B8] +OPDEF GARBAGE [3B8] +OPDEF SQUEZE [4B8] +OPDEF PJRST [254B8] + FOR PLSTUR,< +;CHARACTERS FOR SCREEN CONTROL FOR THE PLASMA PANEL TERMINAL + +GRFON==16 ;TURN ON GRAPHIC MODE + +DEFINE NEWPAG, ;SHIFT OUT OF GRAPHICS AND CLEAR SCREEN +GRFOFF==17 ;TURN OFF GRAPHIC MODE + +;PARAMETERS OF THE TERMINAL + +CNTRLB==2 ;OCTAL FOR CONTROL B +PCHAR==120 ;OCTAL FOR CHARACTER "P" +HIXOFS==60 ;OFFSET FOR HIGH ORDER X COORDINATE +LOXOFS==120 ;OFFSET FOR LOW " " " +HIYOFS==60 ;ALSO FOR Y COORDINATE +LOYOFS==120 ; +HILIMX==^D511 ;UPPER AND LOWER SCREEN LIMITS FOR X +LOLIMX==0 ; +HILIMY==^D511 ;UPPER AND LOWER SCREEN LIMITS FOR Y +LOLIMY==0 ; + +; SOME PARAMETERS RELATING TO THIS IMPLEMENTATION + +TURSSC==1.0 ;FLOATING POINT SCREEN SCALE FACTOR +TURHMX==256.0 ;FLOATING POINT HOME POSITION FOR X AND Y +TURHMY==256.0 ; +;HOME POSITION IS CENTER OF SCREEN (256,256) FOR PLASMA TERMINAL +DEFINE TURHOM, +;FIRST 4 BYTES OF TURHOM ARE THE HOME VALUES TURNYH,TURNYL,TURNXH,TURNXL +;LAST BYTE IS HOME VALUE OF ORIENT (90 DEGREES,I.E. STRAIGHT UP) +> + +FOR TEKTUR,< +;CHARACTERS FOR SCREEN CONTROL FOR TEKTRONIX 4010 TERMINAL + +GRFON==35 ;TURN ON GRAPHIC OUTPUT MODE +GRFOFF==37 ;TURN OFF GRAPHIC OUTPUT MODE +DEFINE NEWPAG, ;CLEAR SCREEN + +;PARAMETERS OF THIS TERMINAL + +HIXOFS==40 ;CHARACTER CODE OFFSET FOR HIGH ORDER X COORDINATE +LOXOFS==100 ;FOR LOW ORDER X COORDINATE +HIYOFS==40 ;FOR HIGH ORDER Y COORDINATE +LOYOFS==140 ;FOR LOW ORDER Y COORDINATE +HILIMX==^D1023 ;UPPER LIMIT FOR X ON SCREEN +LOLIMX==0 ;LOWER LIMIT FOR X ON SCREEN +HILIMY==^D780 ;UPPER LIMIT FOR Y ON SCREEN +LOLIMY==0 ;LOWER LIMIT FOR Y ON SCREEN + +;PARAMETERS RELATING TO THIS IMPLEMENTATION + +TURSSC==1.024 ;FLOATING POINT SCREEN SCALE FACTOR +TURHMX==500.0 ;FLOATING POINT HOME POSITION - X +TURHMY==381.3 ;FLOATING POINT HOME POSITION - Y + +;HOME POSITION IS CENTER OF SCREEN (512,390) FOR THIS TERMINAL +DEFINE TURHOM, +;FIRST FOUR BYTES OF TURHOM ARE THE HOME VALUES OF TURNYH,TURNYL,TURNXH,TURNXL +;LAST BYTE IS HOME VALUE OF ORIENT (90 DEGREES, I.E. STRAIGHT UP) +> + ;STORAGE ALLOCATION TABLE DEFINITIONS + +DEFINE TABLES +;ANY CHANGE TO THE ORDER OF THESE TABLES MUST BE REFLECTED AT CMPRSS: + ;THESE THREE MAY BE IN ANY ORDER + TT VP,40,<[EXP VPA,0]> + TT UA,40 + TT PS,200,<[EXP PSA,PSD,PSM,0]> ;THESE TWO MUST BE IN THIS ORDER + TT DP,200,<[EXP DPC,0]> + TT SP,40,<[EXP UUOACS+S,0]> ;THESE TWO MUST OCCUR IN THE SAME ORDER AS IN ACS + TT PP,200,<[EXP UUOACS+P,0]> +FOR TENEX,< TT WS,2000,<[EXP W,WSA,WSM,WSB,WSD,UUOACS+W,0]>> +FOR TEN50,> +;THIS ONE MUST ALWAYS BE LAST SO MEM TRAP CAN BE USED AS END TEST +> +DEFINE POINTR + + +DEFINE U(A1) +DEFINE UU(A1,A2)< +A1: BLOCK A2 > + +DEFINE UNDEX (AC) +< ADD AC,[XWD 070000,0] + CAIG AC,0 + SUB AC,[XWD 430000,1]> + +RELOC 0 + +;UNSHARED AREA, NON-ZERO STUFF FIRST + +FOR MOCKTURTLE, ; SET BY OTHER PROCESS AND NEVER CLEARED BY LOGO +FURST==. ;IN CASE DIFFERENT SYSTEMS PUT DATA IN DIFFERENT PLACES +UU UUOTRP,2; ;Z + ;JRST DOUUO +DEFINE MM (A1,A2) + +POINTR +U PTOP; ;ORDER OF THE NEXT TWO IS EXTREMELY IMPORTANT, MUST BE +U DTOP; +U WTOP; +U RANNO; ;STUFF TO COMPUTE PSEUDO-RANDOM DIGIT + +FOR TENEX,< UU JFNTAB,10; ;FOR OPENNING FILES + UU CHNTAB,^D23> ;PSEUDO-INTERRUPT CHANNEL DISPATCHES + +;OTHER GOOD FILE STUFF + +U CHIN; ;INSTRUCTION TO EXECUTE TO READ A CHARACTER +U CHOUT; ;INSTRUCTION TO EXECUTE TO WRITE A CHARACTER +U INFILE; +U FPTRL0; ;ADDRESS OF BYTE POINTER FOR LOGICAL BUFFER 0 +U FPTRL1; ;ADDRESS OF BYTE POINTER FOR LOGICAL BUFFER 1 +U CCOUNT; ;COUNT OF CHARS REMAINING UNUSED IN LBUF+1 +U TANDD; ;TIME AND DATE OF STARTUP +U FILEAD; ;FIRST BLOCK OF ENTRY BEING WRITTEN +U FILECT; ;COUNT OF BLOCKS USED IN WRITING THIS FILE +U LABS; ;WHERE PTR TO TOP OF FREE SPACE IS STORED DURING OPERATION + ;I.E. NUMBER OF FIRST FREE LOGICAL BLOCK OF A FILE +U LDIRNO; ;BLOCK NUMBER OF PREVIOUS DIRECTORY +U LDIRL; ;NUMBER OF ENTRIES IN LDIRNO +U FILSIZ; ;SIZE IN DISC BLOCKS OF FILE +UU DMPLST,2 + ;DATA FOR EACH PHYSICAL BUFFER + +UU BUFLOC,2; ;LOCATION IN CORE +UU PBLOCK,2; ;LOGICAL BLOCK NUMBER IN THE BUFFER +UU CHANGE,2; ;0 IF NOT ALTERED +UU FPTR,2; ;BYTE PTR INTO A BUFFER + +;DATA FOR EACH LOGICAL BUFFER + +UU LBLOCK,2; ;LOGICAL BLOCK NUMBER IN THIS LOGICAL BUFFER +UU LBUF,2; ;PHYSICAL BUFFER USED BY LOG BUFFER (0 OR 1) + +FOR TEN50,< +UU OPNPAR,3; ;THIS MUST PRECEDE LUKDAT FOR COPY TO CLEAR! +UU LUKDAT,4 +UU BUFADR,2; ;STRING POINTER LOCATIONS OF FILE BUFFERS +> +FOR DRIBBLE,< +U DRIBFL; ;FILE NUMBER OF DRIBBLE FILE +U DRIBTM; ;TIME OF TYPING _ FOR THE TIME STAMP +> + +;DATA FOR NRC SCREEN TURTLE + +FOR NRCTUR,< + +U TURNYH; ;CHARACTER CODE FOR CURRENT HIGH-ORDER Y +U TURNYL; ; " " " LOW-ORDER Y +U TURNXH; ; " " " HIGH-ORDER X +U TURNXL; ; " " " LOW-ORDER X +U TURNFX; ;CURRENT X POSITION IN FLOATING POINT +U TURNFY; ; Y " " " + +U TUROYH; ;CHARACTER CODE FOR PREVIOUS HIGH-ORDER Y +U TUROYL; ; " " " LOW-ORDER Y +U TUROXH; ; " " " HIGH-ORDER X +U TUROXL; ; " " " LOW-ORDER X +U TUROFX; ;PREVIOUS X POSITION IN FLOATING POINT +U TUROFY; ; Y " " " + + +U ORIENT; ;TURTLE'S CURRENT ORIENTATION (FIXED POINT - IN DEGREES) + +U PENST; ;STATE (RAISED OR LOWERED) OF PEN +U OFFSCR; ;ON-SCREEN/OFF-SCREEN STATUS OF PEN +> +FOR MUSIC,< ;DATA FOR LOGO MUSIC BOX + +U BXTYPE; ;HOLDS TYPE OF MUSIC BOX IN USE +U MBUFP +U MBMAX +U MBPOS +U NVOICE +U STCATO +> + + +DEFINE TT(A1,A2,A3) +<.'A1==.-BASETB +U A1> +BASETB: +TABLES +U CHARNO; ;THESE FOR INPUT SECTION +U BCHAR +U TRACEM; ;LIKE BCHAR BUT ONLY FOR TRACE OUTPUT +U SCOUNT +U LINENO +U PRODNM; ;NAME OF PROCEDURE IN PROGRESS +U TRUTH +U CBOT; ;BASE OF LINE PTED TO BY CPP +U CSTOCT; ;COUNT OF ROOM LEFT IN LINE BEING COMPILED +U CPP; ;POINTER INTO COMPILED LINE +U SPP; ;CONTENTS OF S AND P AT START OF LINE +U LINBOT +U SRCBOT +U NEWBOT +U NXLINE; ;PTR TO NEXT LINE IN CURRENT PROCEDURE +U THISPR; ;MACHINE PROCEDURE LAST IN, PTR TO 2ND ENTRY IN CMPT +U TOPROD; ;NAME OF PROCEDURE BEING DEFINED +U BRKTEM; ;TEM STORAGE FOR BREAKY ROUTINE +FOR TENEX, ;MORE TEM FOR BREAK KEY +U GODEPT; ;THE NUMBER OF GO'S IN THE STACK +U TOFDAY; ;TIME OF STARTUP IN SECS SINCE MIDNIGHT OR RESET CLOCK +U BSP; ;SPP ASSOCIATED WITH GODEPTH, STACKS AT LAST SAVED BREAK +U GCTEM; ;TEM STORAGE FOR GC AND ALLOCATOR +U SAV.A +U SAV.B +U SAV.D +U SAVEIT +UU UUOACS,20 +UU ERRPDL,ERPDLL; ;FIXED PUSHDOWN FOR ERROR HANDLER +FOR TENEX,< UU LEVLTB,3> ;FOR PSI SYSTEM +U GETDST; ;STUFF FOR COPY +U SAVSRC +FOR TENEX, +FOR TEN50,< +U FPTR2 +U CCNT2 +U BUFLC2; ;ABS ADDR OF COPY BUFFER +U BUFAD2;> ;WS ADDR OF COPY BUFFER +FOR MOCKTURTLE,< +U CURX +U CURY +U CURA +U PENPOS; ;0_DOWN, -1_UP +U TURX +U TURY +U TURXO +U TURYO; ; OLD TURX AND TURY FOR CHECKING FOR LONG MOVES +> +BLAST==.-1 + +SUBTTL INITIALIZATION + +JOB41=.JB41## +JOBSA=.JBSA## +JOBREL=.JBREL## +JOBUUO=.JBUUO## + +FOR TEN50,< +JOBREN=.JBREN## +JOBAPR=.JBAPR## +JOBOPC=.JBOPC## +JOBDDT=.JBDDT## +JOBFF=.JBFF## +JOBCNI=.JBCNI## +JOBTPC=.JBTPC## + + RELOC 400000 +> +FOR TENEX,< + SEARCH STENEX + RELOC> ;PAGE 0 WILL BE WRITABLE,1-LOGEND NOT + +LOGO: MOVEI F,0 ;CLEAR FLAGS, MAY BE SKIPPED ON CERTAIN RESTARTS +FOR TEN50,< + CALLI 0 ;RESET + MOVEI A,BREAKY + MOVEM A,JOBREN ;FOR BREAK KEY + MOVEI A,ALLOC + MOVEM A,JOBAPR ;FOR ILLEGAL MEMORY REFS + HLRZ A,JOBSA ;INITIALIZE THE LOW SEG + HRLI A,(A) + ADDI A,1 + HRRZ B,JOBREL ;TOP OF HIGHEST K ASSIGNED + SETZM -1(A) + BLT A,(B) > ;CLEAR FROM JOBFF TO TOP OF ASSIGNED CORE + +FOR TENEX,< + RESET + MOVE A,[SIXBIT /LOGO/] + SETNM ;SET UP NAME FOR SYSTAT + MOVE A,[XWD 30000,30001] + SETZM 30000 + BLT A,31777 > +FOR TEN50,< + MOVE 1,[SIXBIT /LOGO/] + SETNAM 1, > + + MOVE A,[JSR UUOTRP] + MOVEM A,JOB41 ;FOR UUOS + + MOVE A,[XWD FURST,FURST+1] + SETZM FURST + BLT A,BLAST ;CLEAR FROM START OF CORE TO EITHER DDT OR JOBFF + + MOVE A,[XWD SPFRST,FURST] + BLT A,FURST+SPLLEN-1 ;SET UP NON-ZERO PART OF UNSHARED CORE + +FOR TEN50,< HLRZ B,JOBSA> ;ALWAYS THE FIRST FREE LOCATION +FOR TENEX,< MOVEI B,30000> ;ENOUGH ROOM FOR CODE AND SYMBOLS + HRLZI A,-.WS-1 +INILU: HLRZ C,ALOCTB(A) ;POINTER TO LIST OF CELLS TO BE SET UP + HRRZM B,BASETB(A) ;RP ETC. + JUMPE C,INILUR ;NO SUBSIDIARY LIST + +INILU1: SKIPN E,(C) + JRST INILUR ;END OF SUBSIDIARY LIST + HRRM B,(E) ;NO, RPA ETC. + AOJA C,INILU1 ;NEXT IN THIS LIST + +INILUR: ADD B,ALOCTB(A) ;HOW MUCH TO GIVE TO THIS SPACE + AOBJN A,INILU ;MORE SPACES TO GO + + MOVEI A,0 + JSP C,SETPDL + +FOR TEN50,< + HRRZ A,JOBREL + CAIGE A,@WTOP ;IS WTOP INSIDE CURRENT ALLOCATION? + EXPAND WS ;NO, GET A K SO WS WILL FIT + PUSHJ P,SETTTM ;SET TELETYPE MODE TO BBN'S TELCOMP MODE + MOVEI A,220000 + APRENB A, ;REQUEST PDL AND ILL MEM REF TRAPS +> + +FOR TENEX,< + MOVEI A,30000-1 + MOVEM A,JOBREL + JSP G,NEWMEM + ERROR . > + + HRRZI A,(W) + HRLI A,.WBASE + BLT A,.WTOP-.WBASE-1(W) + HRRZI A,FLUSHM + HRRM A,JOBSA ;DON'T REDO THE INITIAL STORAGE ALLOCATION + + PUSHJ P,TIMDAY ;IN SECONDS SINCE MIDNIGHT + TRNN F,TF + MOVEM C,TOFDAY ;TIME OF LAST RESET CLOCK + MOVEI B,[ASCIZ / +LOGO + +/] + TRNN F,TF ;1 IF CALLED BY ERASE ALL + PUSHJ P,TOSS + + +RESET: SETZM TRACEM ;TRACE MARGIN + +FOR NRCTUR, ;RESET SCREEN PARAMETERS + +FOR TEN50,< PUSHJ P,SETTTM ;ENTER TELCOMP MODE + MOVEI A,220000 + CALLI A,16> ;APR ENABLE + +FOR TENEX,< + CIS ;CLEAR PSI SYSTEM + MOVEI A,400000 ;DENOTE THIS FORK + MOVE B,[XWD LEVTAB,CHNTAB] + SIR ;SET UP PSI SYSTEM + MOVEI A,0 ;BREAK TO CHANNEL 0 + ATI ;ASSIGN TERMINAL INTERRUPT + MOVEI A,400000 ;THIS FORK + MOVE B,[1B0+1B9+1B10+1B11+1B22] ; + AIC ;ACTIVATE THESE CHANNELS + EIR ;ENABLE THE SYSTEM + MOVEI A,101 + MOVE B,[EXP 525252525252] + MOVE C,B + SFCOC ;SET ALL CONTROL CHAR TYPEOUTS TO BE THEMSELVES + MOVEI A,100 + RFMOD ;READ THE TERMINAL INPUT MODES + ANDCMI B,770000 ;ZERO OUT THE WAKEUP SET + IORI B,140000 ;SET THE WAKEUP SET TO ALL CONTROLS + SFMOD > ;SET THEM + + + SQUEZE ;TAKE OUT ANY EXTRA ALLOCATION + + TRZE F,TF ;1 IF CALLED BY ERASE ALL + JRST MAINL +FOR DRIBBLE,< ;INITIALIZE THE DRIBBLE FILE +FOR TENEX,< + TLO F,NOBREAK ;DO NOT ALLOW BREAK KEY HERE + MOVEI B,[ASCIZ /INITIALS PLEASE: /] + PUSHJ P,TIS ;REQUEST INITIALS + JRST .-2 ;RUBOUT + MOVEI A,[ASCIZ /DRB/] + MOVEM A,JFNTAB+5 + MOVE B,0(S) + MOVEI A,10 + CAMGE A,@WSB + ERROR FILER9 + ADDI B,1(W) + HRRZM B,JFNTAB+4 + MOVE A,[ASCIZ /NMI/] + CAMN A,(B) ;TO OVERRIDE DRIBBLE CAPABILITY? + JRST DRIBEND ;YES +;FIX UP THE INPUT NAME + MOVEI A,1 + MOVEM A,JFNTAB + MOVEI A,JFNTAB + SETZ B, + GTJFN + ERROR IOPERR + MOVE B,[XWD 070000,020000] ;FOR APPENDING + OPENF + ERROR IOPERR + MOVEM A,DRIBFL + + MOVEI B,";" + BOUT + SETO B, + SETZ C, + ODTIM + MOVEI B," " + BOUT + MOVE D,0(S) + HRLI D,(POINT 7,(W),34) + ILDB B,D + BOUT ;MAYBE? + JUMPN B,.-2 + MOVEI B,37 + BOUT +DRIBEND: POP S,A + TLZ F,NOBREAK +>> + SUBTTL MAIN PROCESSOR LOOP + +MAINL: MOVEI B,[ASCIZ /_/] + SKIPE TOPROD ;ARE WE DEFINING A PROCEDURE NOW? + MOVEI B,[ASCIZ />/] ;YES, READY CHAR IS > + PUSHJ P,TIS + JRST MAINL +MAINL1: PUSHJ P,COMPIL + JRST MAINL ;GOT A STORED LINE + PUSHJ P,EXECUT + JRST MAINL + +;UUO TRAP HANDLER + +DOUUO: MOVEM 17,UUOACS+17 + HRRZI 17,UUOACS + BLT 17,UUOACS+16 + MOVE 17,UUOACS+17 + HLRZ A,JOBUUO + ASH A,-11 ;FLUSH AC, IF ONE + CAILE A,4 ;SQUEZE IS THE HIGHEST KNOWN UUO + JRST ILLUUO + JRST @.(A) ;ZERO CAUGHT BY MONITOR + ERRORR + ALLOCATOR + CALGAR + CMPRSS +CALGAR: MOVE B,WTOP + EXCH B,UUOACS+B + MOVEM B,SAV.B + JSP P,GARCOL ;NO PUSHES OR POPS IN GC + MOVE B,SAV.B + MOVEM B,UUOACS+B ; GARCOL NEEDS MAX REF FOR DE-ALLOC + JRST UUORET + +FOR TEN50,< +CALDDT: +FOR BBN50, + HRRZ A,JOBDDT + JUMPE A,[ERROR .] + PUSHJ P,(A) ;SO DEBUGGER MAY POPJ P,$X TO RETURN + PUSHJ P,SETTTM + JRST COMEX + +SETTTM: +FOR BBN50,< MOVEI A,20000 + TTCALL 6,A + TLO A,600000 + TTCALL 7,A > + POPJ P, + +BREAKY: TTCALL 11, + TTCALL 12, + TLNE F,NOBREAK ;IGNORE BREAK KEY? + JRST .+3 ;YES + TLNE F,TIF ;LEAVE IT SET FOR BRAKER ROUTINE + ERROR BREAK ;BREAK IMMEDIATELY IF TYPE IN HUNG + TLO F,BREAKF ;OTHERWISE, JUST FLAG IT FOR LATER + JRST 2,@JOBOPC > + +FOR TENEX,< +BREAKY: MOVEM A,BRKTEM + MOVEM B,BRKTEB + HRLZI A,400000 ;DENOTE THIS FORK + MOVE B,A ;DENOTE INTERRUPT CHANNEL 0 + DIC ;DEACTIVATE BREAK KEY + MOVE B,BRKTEB + MOVEI A,100 + CFIBF ;CLEAR THE INPUT BUFFER + MOVEI A,101 + CFOBF ;OUTPUT BUFFER TOO + MOVE A,BRKTEM + TLNE F,NOBREAK ;IGNORE BREAK? + JRST .+3 ;YES + TLNE F,TIF + ERROR BREAK + TLO F,BREAKF + DEBRK ;RETURN TO STOPPED PROCESS + +CALDDT: PUSHJ P,770000 ;FOR NOW, ASSUME RESIDENT DDT + JRST COMEX > + SUBTTL COMPILE A LINE OF INPUT + +COMPIL: TRZ F,STORED + MOVEI A,10 + MOVEM A,CSTOCT + PUSHJ P,MAKELM + TLO B,COMPOUND + MOVEM B,CBOT + MOVEM B,CPP ;MAKE AN ELEMENT TO PUT COMPILED LINE IN +CMCOMP: TRZ F,FSYMF ;ENTER HERE FROM CMAKE + POP S,L + MOVE M,UA ;IF THE DEPTH OF ABBREVIATION EXPANSION + SUB M,UA+1 ;IS GREATER THAN THE NUMBER OF ABBS + LSH M,-1 ;THEN THERE IS A LOOP IN ABB DEFINITION + HRLZI M,-2(M) ;-MAX NO OF ABBREVIATIONS,,0 +COMPAB: HRLI L,(POINT 7,(W),34) + + MOVEM L,LINBOT + IBP L +GNS: TRZ F,NNUMF!ESCHF + SETZB N,SCOUNT ;CLEAR TYPE OF SYMBOL (N) AND CHAR COUNT + PUSHJ P,NEWSTR +GNS1: JSP E,LCH ;PICK UP PREV TERMINATR, MAY BE RELEVANT + JRST .+2 + ILDB C,L ; NEXT CHAR FROM INPUT STRING + CAIN C," " + JRST .-2 + JRST GNS2 ; HAVE FIRST NON-SPACE CHAR OF SYMBOL + +GNSLET: CAIN C,"_" ; IS IT ASSIGNMENT OPERATOR? + JRST GNSMAK ; YES +GNSABC: TRO F,NNUMF ; NON-NUMERIC CHAR SEEN +GNSB: IDPB C,B ;STORE CHAR IN SYMBOL + AOS SCOUNT ; UPDATE LENGTH OF SYMBOL + ILDB C,L ; NEXT CHAR OF INPUT +GNS2: JUMPE C,GNSEND ; POSSIBLE END OF INPUT STRING + CAIL C,77 ; NOT, ? AND ABOVE ARE ALL PRINTING + JRST GNSLET ; CHARS AND LEGAL SYMBOL CONSTITUENTS + CAIL C,40 ; BELOW 40 ARE ALL CONTROL CHARS + JRST GNSSCH ; NOT, THE REST TAKE SPECIAL CARE + CAIN C,24 ; IS A CONTROL, IS IT CONTROL-T? + JRST [ MOVEI D,GNSLIT ; YES, THEN IT IS THE QUOTE FOR FILES + JRST GNSCH1 ] +GNODCH: TRO F,ESCHF ; THE REST THAT GOT THRU ARE SYMBOL + JRST GNSABC ; CONSTITUENTS BUT NOT FOR PROCEDURE NAM + + +GNSSCH: MOVE D,INFCTB-40(C) ; TABLE ENTRY FOR THE CHAR + TLNN D,TERM ; IS IT A TERMINATOR FOR PREVIOUS SYMBOL + JRST (D) ; NO, THEN DISPATCH ON ITS TYPE +GNSCH1: SKIPE SCOUNT ; IS THERE A PREVIOUS SYMBOL? + JRST GNSEND ; YES, THEN FIND OUT WHAT KIND IT IS + TLNN D,FOP ; IS IT AN INFIX OPERATOR? + JRST (D) ; NO, THEN IT HAS A SPECIAL HANDLER + IBP L ; YES, LETS NOT SEE THIS ONE AGAIN + HRR N,D ; YES, RH IS PTR INTO PRINTNAME TABLE + HRLI N,INFOP!IMMEDI ; LH OF COMPILED ELEMENT SAYS INFIX OP + JRST CMPLA ; AND WE STORE IT IN THE COMPILED CODE + +GNSMAK: IBP L + MOVE N,[XWD INFOP!IMMEDI,IMAKEL+1] + JRST CMPLA + +GNSEND: SKIPN SCOUNT ;NEW SYMBOL EMPTY? + JRST CMPLA ; YES, AT END OF WHOLE INPUT STRING + PUSHJ P,ENDSTR ;GOT A SYMBOL, FINISH IT + POP S,A ;THIS IS IT + TRNN F,NNUMF ;MIGHT IT BE A NUMBER, IE A LITERAL + JRST GNSN ;IT IS A POSSIBLE LINE NUMBER + + +;CHECK ELEMENT TO SEEE IF IT IS AN ABBREVIATION + +ABBA: + HRRZ B,UA ;USER DEFINED ABBREVIATIONS FIRST + PUSHJ P,LOOKY + JRST NOABBS + MOVE C,1(N) + JUMPE C,GNSP3 ;A DELETED SYSTEM ABBREV, MUST BE A UPROC + AOJE C,NOABBS ;A DELETED ABBREVIATION + PUSH S,LINBOT + SUB L,LINBOT + PUSH P,L ;SAVE RELATIVE POINTER INTO SOURCE STRING + HRRZ L,1(N) ;USE THE VALUE OF THE ABBREV AS THE NEW SOURCE + AOBJN M,COMPAB ;WE ARE NOW ONE LEVEL DEEPER IN ABBREVS + ERROR ABBER1 ;LOOP IN ABBREVIATION DEFINITION + + +LCH: LDB C,L + JUMPN C,(E) + TRNN M,-1 ;TOP LEVEL ABBREVIATION? + JRST (E) ; YES, DONE WITH WHOLE INPUT STRING + POP S,LINBOT ;NOT TOP LEVEL + POP P,L + ADD L,LINBOT + SUB M,[XWD 1,1] ;UP ONE LEVEL + JRST LCH + +DEFINE XOP (RH,LH) + +TERM==1 +FOP==2 + +INFCTB: +XOP GNSEND,TERM ;SPACE +XOP GNSABC ; ! +XOP GNSLIT,TERM ; " +XOP GNODCH ; # ,NOT LEGAL IN PNAME BECAUSE IT ECHOES AS SP +REPEAT 4, ; $%&' +XOP GNSLP,TERM ; ( +XOP GNSRP,TERM ; ) +XOP ITIMES+1,TERM+FOP ; * +XOP IPLUS+1,TERM+FOP ; + +XOP GNSABC ; , +XOP IMINUS+1,TERM+FOP ; - +XOP GNSABC ; . +XOP IQUOT+1,TERM+FOP ; / +REPEAT 12, ; DIGITS 0-9 +XOP GNSVAR,TERM ; : +XOP GNSCOM,TERM ; ; +XOP ILTHAN+1,TERM+FOP ; LEFT ANGLE BRACKET +XOP IEQUAL+1,TERM+FOP ; = +XOP IGRTR+1,TERM+FOP ; RIGHT ANGLE BRACKET + +;TO RESTORE LOGO TO A PREFIX ONLY LANGUAGE, ALL "TERM+FOP"S +; SHOULD BE CHANGED TO GNSABC, IE LEGAL SYMBOL CONSTITUENTS + + +GNSLP: SKIPA N,[LPREN] +GNSRP: MOVEI N,RPREN + IBP L +CMPLMP: TLO N,MPF!IMMEDIATE + HRLZI C,200000 + TDNE C,1(N) ;IS THIS MACHINE PROCEURE "MAKE"? + JRST CMAKE ;YES + ADDI N,1 ;NO, STORE MACHINE PROCEDURE CALL +CMPLA: PUSHJ P,CSTORE + TRO F,FSYMF ;NO LONGER FIRST ELEMENT + JUMPN N,GNS +CMPEND: TRNE F,MAKEF + POPJ P, + AOS A,CPP ;MAKE CPP POINT TO ONE BEYOND ELEMENT + MOVE B,CBOT + SUBI A,(B) ;GET LENGTH OF ELEMENT + MOVEI A,-1(A) ;STORED LENGTH IS ONE LESS THAN TOTAL LENGTH + EXCH A,@WSB ;SHORTEN THE ELEMENT + SUB A,@WSB ;SUBTRACT NEW LENGTH FROM OLD LENGTH + SOSL A ;FILL IN DUMMY ELEMENT FOR GARBAGE COLLECTOR + MOVEM A,@CPP + MOVEM B,CPP ;AND MAKE CPP POINT AT BEG OF LINE + TRZE F,STORED + JRST TOLINE + JRST CPOPJ1 + + + +GNSN: HRLZI N,LITF!WORDF + HRR N,NEWBOT + TRNN F,FSYMF!MAKEF ;IS IT FIRST ELEMENT AND NOT IN 2 LINE MAKE? + TRO F,STORED ;YES, NUMBER+FIRST_STORED LINE + JRST CMPLA + +;NOT AN ABBREVIATION, CHECK FOR EXISTING PROCEDURE NAMES + +NOABBS: MOVE A,NEWBOT + PUSHJ P,SYSLKP + JRST GNSP3 + SKIPL 1(N) ;IS IT AN ABBREVIATION + JRST CMPLMP ;NO, A MACHINE PROCEDURE NAME + PUSH S,LINBOT + SUB L,LINBOT + PUSH P,L + HRRZ L,1(N) + HRLI L,350700 + SETZM LINBOT + AOBJN M,GNS + ERROR IOPERR ;SYSTEM ABB MUST TERMINATE THE LOOP + + +GNSP3: MOVE A,NEWBOT + HRRZ B,RP + PUSHJ P,LOOKY + JRST .+2 + JRST GNSP1 ;AND CALL THIS A USER PROCEDURE + + MOVEI E,2(N) ;SPACE FOR THE NEW ENTRY IN TABLE + CAML E,RP+1 ;IS IT THERE ALREADY? + EXPAND RP + MOVE A,NEWBOT + MOVEM A,(N) ;NAME OF NEW PROCEDURE + SETOM 1(N) ;NOT YET TO'D + SETZM 2(N) ;NEW END OF TABLE +GNSP1: SUB N,RP + TLO N,UPRF!IMMEDIATE + TRZE F,ESCHF + TLO N,SCHF + AOJA N,CMPLA + +;COMMENTS, LITERALS, AND VARIABLE NAMES GET COPIED AND EXTRA SPACES FLUSHED + +GNSLIT: TLO N,LITF + JRST WEFA +GNSCOM: TLOA N,COMMTF +GNSVAR: TLO N,VARF +WEFA: MOVEI D,(C) ;SAVE THE PROPER TERMINATOR + PUSHJ P,WEFS + IBP L +WEFAB: TLNE N,VARF ;STARTED BY : ? + JRST VAREND ; ENDING A VERIABLE IS SPECIAL + POP S,B + IOR N,B + JRST CMPLA + +WEFS: TRZ F,TF!NWF ;MAKE A WELL-FORMED STRING, + ; I.E. NO LEADING SPACES, NO TRAILING, + ; AND AT MOST ONE IN THE MIDDLE + ILDB C,L + CAIN C," " + JRST .-2 +WEFC: CAIN C,(D) ;DONE YET? + JRST WEFB + JUMPE C,WEFD ;NO SECOND " / OR ; + TRO F,TF ;HAVE SEEN A REAL CHAR + IDPB C,B + ILDB C,L + CAIE C," " + JRST WEFC + ILDB C,L + CAIN C," " + JRST .-2 ;SAD SPC + CAIN C,(D) + JRST WEFB + JUMPE C,WEFD + MOVEI C," " + IDPB C,B + JSP E,LCH ;GET FIRST CHAR OF NEXT WORD AGAIN + TRO F,NWF ;GOT MORE THAN ONE WORD + JRST WEFC + +WEFD: TLNN N,COMMTF ;IF A COMMENT, EOL IS OK + ERROR INERR1 ;BUT NOT LITS OR VARS +WEFB: TRNE F,TF ;IS THIS THING EMPTY? + JRST ENDSTR ;NO, FINISH THE STRING NORMALLY + PUSH S,[XWD WORDF!SENTF!EMPTYF,] ;EMPTY + POPJ P, + +VAREND: MOVE A,(S) ; GOT A VARIABLE NAME + TLNE A,EMPTYF ; IS IT EMPTY? + ERROR NMERR5 ; YES, :: NOT PERMITTED + MOVEI B,MV + PUSHJ P,SYSLUK ; IS IT ONE OF THE BUILT IN NAMES? + JRST VAREN2 ; NO + POP S,A ; FLUSH THE GENERATED SYMBOL + TLO N,MVARF!IMMEDI ; CALL IT A MACHINE VARIABLE + AOJA N,CMPLA ; AND STORE ABS PTR TO VALUE WD IN MV + +VAREN2: MOVE A,(S) + MOVE B,VP ; SEE IF IT EXISTS IN OBLIST + PUSH S,[XWD WORDF!SENTF!EMPTYF!UNBOUN!GLOBLF,0] + PUSHJ P,LOOKY + PUSHJ P,MAKEN ; NOT ALREADY THERE, ADD IT, VALUE AS ABOVE + POP S,A + POP S,A + SUB N,VP ; COMPILED ELEM IS PTR REL TO VP + TLO N,VARF!IMMEDI ; AND IS FLAGGED AS A VARIABLE + AOJA N,CMPLA + +CMAKE: TRNE F,MAKEF ;ALREADY IN A 2 LINE MAKE? + AOJA N,CMPLA ;YES + JSP E,LCH + JUMPE C,CMAKE2 + MOVE A,L + ILDB C,L + CAIN C," " + JRST .-2 ;SAD SPC + CAIE C,";" ;MAKE-COMMENT-CR + AOJA N,[MOVE L,A ;THIS IS ALSO A BUG, EVEN MORE OBSCURE! + JRST CMPLA ] + PUSHJ P,NEWSTR + PUSH S,[XWD COMMTF,0] + PUSHJ P,BTFCP1 + ADD N,[XWD MAKESC,1] + PUSHJ P,CSTORE + POP S,N + JRST CMAKE3 +CMAKE2: ADD N,[XWD MAKESC,1] +CMAKE3: TRO F,MAKEF + PUSHJ P,CSTORE + MOVEI B,[ASCIZ / NAME: /] + PUSHJ P,TIS ;ASK FOJ IT + JRST .-2 + PUSHJ P,CMCOMP + SOS A,CPP + AOS CSTOCT + MOVSI B,MAKESC + IORM B,@WSA + MOVEI B,[ASCIZ / THING: /] ;CONTINUE TO ASK + PUSHJ P,TIS + JRST .-2 + PUSHJ P,CMCOMP + TRZ F,MAKEF + JRST CMPEND + + +CSTORE: AOS A,CPP + MOVEM N,@WSA + SOSE CSTOCT + POPJ P, + MOVEI A,10 ;ADD THIS MUCH ROOM TO LINE ELEMENT + MOVEM A,CSTOCT + MOVE B,CBOT + PUSHJ P,COPYUP + TLO B,COMPOUND + MOVEM B,CBOT ;LOCATION OF NEW ELEMENT + MOVEM A,CPP ;NEW PTR TO OLD END + POPJ P, + SUBTTL EXECUTE--SUPERVISOR + +EXECUTE:TRZ F,EELSEF ; 1_LEGAL TO END COMMAND LINE WITH ELSE + TLZE F,BREAKF + ERROR BREAK + PUSH P,[EXP [EXP [ERROR NOCMD]]] +EXECU1: AOS A,CPP + SKIPN A,@WSA ;IS IT EOL? + PUSHJ P,SCOMEX ;YES, CALL THE EXIT + TLNN A,COMMTF ;IS IT A COMMENT? + JRST EXCTL1 ;NO, GO TO IT + JRST EXECU1 ;IGNORE COMMENT + +EVAL: PUSH P,[EXP [EXP APOPJ]] + SKIPA A,CPP +EXCTLL: AOS A,CPP ;POINT TO NEXT ELEMENT + MOVE A,@WSA +EXCTL1: TLZ A,IMMEDIATE!COMPOUND ;IRRELEVANT BITS IN PTR + JFFO A,.+2 + ERROR ERMSG1 ;END OF LINE, SOMETHING MISSING + JRST @.-1(B) + EXCTMP + EXCTUP + EXCTV + EXCTL + EXCTIF ;INFIX OP IN PREFIX POSITION,MUST BE UNARY +- + EXCTMV ; MACHINE VARIABLE, ABS PTR TO VALUE WORD + EXCTLL ;COMMENT, TREATED JUST LIKE IT DOESN'T EXIST + + +EXCTP4: POP P,THISPR + MOVE B,(A) ;FETCH ADDRESS OF ROUTINE + TLNN B,STRINF ; DOES THE FUNCTION TAKE ONLY STRING ARG + JRST EXCTP5 ; NO + HLRE E,-1(A) ; HOW MANY DOES IT TAKE? + JUMPL E,EXCTP5 ; NEEDS NO ARGS + MOVE G,S ; SO STACK PTR CAN BE CLOBBERED +EXCTP8: MOVE A,(G) + TLNN A,WORDF!SENTF!EMPTYF ; IS IT A STRING? + JRST [.] ; NO, CONVERT IT + SUBI G,1 + SOJGE E,EXCTP8 ; E STARTED WITH N-1 +EXCTP5: PUSHJ P,(B) ;CALL PROCEDURE + +OPEX: AOS A,CPP ;LETS LOOK AT THE NEXT ELEMENT + MOVE A,@WSA ;TO SEE IF IT IS AN INFIX OP + TLNE A,COMMTF + JRST OPEX ; IGNORING COMMENTS + TLNE A,INFOP ; IS IT INFIX + JRST INFNXT ; YES, CHECK PRECEDENCE TO SEE WHO GETS INPUT + MOVE B,[XWD MPF!IMMEDI,ANDL+1] ;AND BETWEEN TWO PREFIX INPUTS IS OPTIONAL +OPEX1: SOS CPP ; NO, PRECEDING OPERATOR GETS FIRST CRACK + HRLZI A,-1 + ADDB A,0(P) + JRST EXCTP2 + +EXCTMP: HLL A,-1(A) ;FETCH NUMBER OF ARGUMENTS +EXCTP1: PUSH P,A + MOVE B,[XWD MPF!IMMEDI,OFL+1] ;TEST FOR OPTIONAL OF +EXCTP2: JUMPL A,EXCTP4 ;NEED NO ARGS +EXCTP3: AOS A,CPP + MOVE A,@WSA + CAMN B,A ;OF OR AND + JRST EXCTLL ;IS OF + JRST EXCTL1 ;NOT OF + +EXCTUP: HLL A,@RPA ;FETCH NO ARGS-1 + PUSH P,A + HRRI A,UPRODL+1 ;ENTRY IN PRINTNAME TABLE FOR GENERIC PROCEDURE + JRST EXCTP1 + +EXCTMV: SKIPGE B,(A) ; FETCH VAL AND IS IT COMPUTATIONAL? + JRST EXCTP5 ; YES, GO COMPUTE + PUSH S,B ; NO, HAVE A VALUE + JRST OPEX + +EXCTV: MOVE A,@VPA ; FETCH THE VALUE + TLZ A,GLOBLF!UNBOUN ; UNBOUN SHOULD BE CHECKED, NOT FLUSHED +EXCTL: PUSH S,A + JRST OPEX + +EXCTLP: PUSHJ P,GNE + ERROR PRNER2 + MOVEI B,[EXPARR] + MOVEM B,0(P) ;KEEPING A TRANSPARENT + JRST EXCTL1 +EXCTRP: POP P,A + POP P,A + CAIE A,[EXP EXPARR] ; I.E. ONE INPUT,,EXPARR + ERROR PRNER1 ;MATCHING (? + PUSH S,MV+1 ; WAS (), AN EMPTY EXPRESSION + JRST OPEX + +EXPARR: PUSHJ P,GNE + SKIPA + CAME A,[XWD MPF!IMMEDI,RPREN+1] + ERROR PRNER2 ;MISSING )? + POPJ P, ;PRENS MATCH + +SPECWD: ERROR EVER5 +EXIT: ERROR XITERR ;USER DEFINED ERROR MESSAGE. + ; USEFUL IN HOARDED PROCEDURES + + +EXCTIF: MOVEI A,(A) ;FLUSH BITS IN LH + CAIN A,IPLUS+1 ; UNARY PLUS? + JRST [ PUSH P,[INFUPL+1] + JRST EXCTLL ] ;INFIX OP WITH HIGHER PRECEDENCE + CAIE A,IMINUS+1 ; UNARY MINUS? + ERROR INFERR ;A NONO + PUSH P,[INFUMN+1] ; INFIX OP WITH A HIGHER PRECEDENCE + JRST EXCTLL + +INFNXT: HLRZ B,(A) ; GET PRECEDENCE OF NEW OPERATOR + ANDI B,17 ; ONLY NEED 4 BITS + MOVE C,0(P) ; FETCH PREVIOUS OPERATOR + HLRZ C,(C) ; AND GET ITS PRECEDENCE + ANDI C,17 + + CAIG B,(C) ; NEW : OLD + JRST OPEX1 ; NEW LE OLD, IE INPUT GOES WITH LH ONE + HLL A,-1(A) ; GOES WITH THIS ONE, GET # OF ARGS + PUSH P,A ; PUT OP ON STACK + JRST EXCTLL ; AND BACK FOR MORE + +CALLDO: JSP D,COMEXR ;CHECK IF AT BEG OF LINE, IF NOT DON'T RETURN + PUSHJ P,COMPIL + POPJ P, ;STORED THE LINE, NO NEED TO EXECUTE + JRST EXECUTE + +SCOMEX: SOS CPP +COMEX: JSP D,COMEXR + POPJ P, + +COMEXU: TLOA F,UPFF ;DENOTE CALLED BY USER COMMAND +COMEXR: TLZ F,UPFF ;DENOTE ROUTINE CALLED BY MACHINE COMMAND + POP P,A ;THE RETURN TO OPEX + POP P,A + CAIE A,[[ERROR NOCMD]] + ERROR COMERR + PUSHJ P,GNE ;NEXT ELEMENT + JRST COMXRD ;NO MORE + TRZE F,EELSEF + CAME A,[XWD MPF!IMMEDI,ELSEL+1] + ERROR ERXTRA + +COMXRD: SETZM CBOT ;DONE WITH THIS LINE + JRST (D) + + +;TABLE ADDRESS IN B +;SYMBOL POINTER IN A +;INDEX FOR ENTRIES IN TABLE B IN LH OF C IF NECESSARY + + + +SYSLKP: HRLZI B,(POINT 7,(W),34) + HRRI B,(A) + ILDB C,B ;FIRST CHAR OF THIS ELEM + CAIL C,"A" + CAILE C,"Z" + POPJ P, ;NOT IN RANGE FOR RESERVED NAME + MOVE B,MNPT-"A"(C) ;THE NAME TABLE FOR THAT LETTER +SYSLUK: MOVEI C,0 + JRST LOOK0 + +LOOKY: HRLZI C,W +LOOK0: MOVEI E,2 + MOVEI N,(B) ;USE N FOR STEPPING THRU TABLE + + ADDI A,(W) ;MAKE A ABSOLUTE + MOVN B,(A) ;GET THE LENGTH OF THE WS ELEMENT + HRLI A,-1(B) ;PUT -L-1 OF WS ELEMENT IN LH OF A + TLNN C,W + AOBJN A,.+1 + +LOOKL: MOVE B,A ;USE B FOR CHANGING A + HRR C,(N) ;GET THE NAME OF THIS ENTRY IN THIS TABLE + TRNN C,-1 ;0 AT END OF TABLE + POPJ P, + + MOVE D,@C ;GET A WORD OF THIS ENTRY + CAME D,(B) ;IS IT THE SAME AS THIS WORD OF NEW ELEMENT + JRST LOOKN ;NO, NOT A MATCH FOR THIS SYMBOL + ADDI C,1 ;POINT AT NEXT WORD OF THIS ENTRY + AOBJN B,.-4 ;IF NOT DONE WITH THIS ELEMENT, GO BACK + JRST CPOPJ1 ;DONE WITH THIS SYMBOL, COMPLETE MATCH + +LOOKN: ADD N,E + JRST LOOKL ;NEXT ENTRY + SUBTTL OPERATIONS + +THING: MOVE A,(S) +THING1: MOVE B,VP + PUSHJ P,LOOKY + JRST THING3 ;NOT A GLOBAL VARIABLE + JRST THING4 + +THING3: MOVE A,(S) + MOVEI B,MV + PUSHJ P,SYSLUK + MOVEI N,MV ;FIRST MACHINE VAR IS EMPTY + MOVE A,1(N) ;MACHINE VARIABLES MUST BE CHECKED + JUMPGE A,THING4 + POP S,B ;THIS ONE MUST BE COMPUTED, (FLAG IS SIGN BIT) + JRST (A) +THING4: MOVE A,1(N) + MOVEM A,(S) + POPJ P, + + +CCONTE: PUSHJ P,NEWSTR + TRZ F,TF + TRO F,NWF ; :CONTENTS: ALWAYS A SENTENCE + MOVEI C,0 + MOVE D,RP + MOVNI E,1 +CCNTE1: SKIPN A,(D) ;ANY MORE PROCEDURE NAMES? + JRST [ TRNE F,TF ;NO MORE PROCEDURES, WERE THERE ANY? + JRST ENDST1 ; YES + PUSH S,MV+1 ; NO, RETURN EMPTY + POPJ P, ] + MOVEI D,1(D) + CAMN E,(D) ;IS THIS ONE DEFINED? + AOJA D,CCNTE1 ;NO + MOVEI C," " + TROE F,TF ;FIRST ONE? + DPB C,B ;NO REPLACE EOM WITH SPACE + PUSHJ P,NEWSR0 + PUSHJ P,COPYAB + AOJA D,CCNTE1 + +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 BTFCLO + +FSTSNT: ILDB C,A ;FIRST OF SENTENCE + IDPB C,B ;COPY CHARACTERS TO END OF FIRST WORD + CAIE C," " ;IS IT THE END OF A WORD + JUMPN C,FSTSNT ;JUMP IF NOT THE ONE WORD SENTENCE + + MOVEI C,0 ;CLEAR " " OR 177 + DPB C,B ;CLOBBER OTHER TERMINATOR + + HRLZI A,WORDF + HLLM A,0(S) + JRST BTFCL1 + + +BUTFIRST: + PUSHJ P,NEWOPS + JRST BTFSNT ;NOT A WORD OR EMPTY, IE SENTENCE + + 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 + +BTFEMP: HRLZI A,WORDF!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: IDPB C,B + JUMPN C,.-2 ;COPY THRU END OF ARG + +BTFCL1: PUSHJ P,ENDST1 + POP S,A + HRRM A,(S) ;NEW STRING, OLD TYPE + POPJ P, + ;THE NEXT TWO PROCEDURES, FSEG AND BUTFSEG ACT SOMEWHAT LIKE +;FIRST AND BUTFIRST EXCEPT THAT THEY OUTPUT FROM A GIVEN STRING +;ALL OF THAT STRING ON EITHER SIDE OF A GIVEN BREAK WORD. THEY HAVE +;2 INPUTS --- THE FIRST IS THE SENTENCE (OR WORD ) TO BE BROKEN UP +;AND THE SECOND INPUT IS THE WORD TO BE USED AS THE WORD TO BREAK ON +; +; E.G. BREAKD "SET" "A TEST SET OF WORDS" +; +; WILL OUTPUT THE SENTENCE "A TEST" + +FSEG: MOVE D,-1(S) ;GET PNTR TO WORD TO BREAK ON + TLNE D,EMPTYF ;EMPTY WORD? + JRST BTFEMP ;YES, OUTPUT THE EMPTY STRING + HRLI D,(POINT 7,(W),34) ;NO, FINISH MAKING THE PNTR AND + MOVEM D,SAV.D ;SAVE IT + MOVE A,0(S) ;GET PNTR TO SENTENCE TO BE BROKEN + POP S,-1(S) ;MAKE IT ALONE ON TOP OF STACK + TLNE A,EMPTYF ;EMPTY WORD? + JRST BTFEMP ;YES, OUTPUT EMPTY WORD + HRLI A,(POINT 7,(W),34) ;NO, FINISH POINTER + MOVEM A,SAV.A ;SAVE PNTR TO BEG OF SENTENCE + MOVEM A,SAVEIT ;SAVE PNTR TO END OF LAST NON-MATCH WORD + PUSHJ P,NEWSTR ;GET A NEW STRING FOR OUTPUT--ITS + ;PNTR IS IN B AND NEWBOT + +BRK2: ILDB C,A ;GET CHAR OF SENTENCE + ILDB E,D ;GET CHAR OF BREAK WORD + JUMPE C,BRKCP2 ;IF OUT OF SENTENCE COPY ALL OF THE SENTENCE + ;(PROVIDED WE HAVEN'T JUST COMPLETED A MATCH) + + CAIE C," " ;AT END OF A WORD IN THE SENTENCE? + JRST BRK1 ;NO + CAIE E," " ;YES, ALSO AT END OF BREAK WORD? + JUMPN E,BRK3 ;NO, NO MATCH POSSIBLE FOR THIS WORD + +BRKCP1: MOVE A,SAV.A ;YES, FOUND A MATCH WORD--COPY ALL TO THIS POINT + CAMN A,SAVEIT ;IF = THEN THE BREAK WORD WAS THE + JRST BTFEMP ;FIRST WORD OF THE SENTENCE--OUTPUT EMPTY + + ILDB C,A ;COPY TILL FINISHED + CAMN A,SAVEIT ;FINISHED? + JRST .+3 ;YES + IDPB C,B ;NO + JRST .-4 ;GET NEXT CHAR + MOVEI C,0 ;WRAP IT UP + JRST BTFCLO + +BRK1: JUMPE E,BRK3 ;IF AT END OF BREAK WORD -- NO MATCH + CAIN E," " ; + JRST BRK3 + CAIN E,(C) ;ARE THE CHARS EQUAL? + JRST BRK2 ;YES, STILL HOPE FOR A MATCH + +BRK3: ILDB C,A ;SKIP REST OF THIS WORD + JUMPE C,BRKCPY ;IF HIT END OF SENTENCE COPY IT ALL + CAIE C," " ;AT END OF WORD YET? + JRST BRK3 ;NO, KEEP LOOKING + MOVEM A,SAVEIT ;YES, SAVE LAST NON-MATCH WORD PNTR + MOVE D,SAV.D ;RESTORE PNTR TO BREAK WORD + JRST BRK2 ;TRY NEXT WORD FOR A MATCH + +BRKCP2: CAIE E," " ;HAVE WE JUST COMPLETED A MATCH? + SKIPN E + JRST BRKCP1 ;YES WE HAVE--OUTPUT UP TO HERE +BRKCPY: MOVE A,SAV.A ;COPY THE ENTIRE SENTENCE + JRST BTFCP1 + + +BUTFSEG: + MOVE D,-1(S) ;GET BREAK WORD + MOVE A,0(S) ;GET PNTR TO SENTENCE TO BE SCANNED + POP S,-1(S) + TLNE A,EMPTYF ;EMPTY? + JRST BTFEMP ;YES -- OUTPUT IS EMPTY + HRLI A,(POINT 7,(W),34) ;NO, FINISH MAKING PNTR + PUSHJ P,NEWSTR ;GET A NEW STRING ALLOC'N FOR OUTPUT + ;PNTR TO AREA IS IN AC B + TLNE D,EMPTYF ;EMPTY BREAK WORD? + JRST BTFCP1 ;YES --ALWAYS A MATCH SO OUTPUT ENTIRE SENT. + HRLI D,(POINT 7,(W),34) ;FINISH MAKING PNTR TO WORD + MOVEM D,SAV.D ;SAVE IT + +BBRK2: ILDB C,A ;GET CHAR FROM SENTENCE + ILDB E,D ;AND CHAR FROM BREAK WORD + JUMPE C,BTFEMP ;IF AT END OF SENTENCE NOTHING LEFT + ;TO OUTPUT + + CAIE C," " ;AT END OF A WORD OF THE SENTENCE? + JRST BBRK1 ;NO, MAYBE AT END OF BREAK WORD + CAIE E," " ;YES, AT END OF BREAK WORD ALSO? + JUMPN E,BBRK3 ;NO + ILDB C,A ;YES, THEN FOUND A MATCH FOR BREAK WORD + CAIN C," " ;COPY THE REST OF THE SENTENCE FOR OUTPUT + JRST .-2 ;AFTER GETTING RID OF ANY BLANKS + JUMPE C,BTFEMP ;IF AT END OF SENTENCE OUTPUT EMPTY WORD + JRST BTFCLO ;GO OUTPUT REST OF SENTENCE + +BBRK1: JUMPE E,BBRK3 ;IF AT END OF BREAK WORD THERE CANNOT + CAIN E," " ;BE A MATCH AT THIS POINT + JRST BBRK3 + CAIN E,(C) ;OTHERWISE A MATCH IS STILL POSSIBLE + JRST BBRK2 ;IF CHARS ARE EQUAL + +BBRK3: ILDB C,A ;SKIP TO NEXT WORD IN SENTENCE + JUMPE C,BTFEMP + CAIE C," " + JRST .-3 + MOVE D,SAV.D + JRST BBRK2 + + +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,BTFCLO ;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,BTFEMP ;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,BTFEMP ;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 + +WORD: + HRLZI A,WORDF + TDNE A,0(S) + TDNN A,-1(S) + ERROR WRDERR ;YOU CAN'T MAKE A WORD OUT OF A SENTENCE + + 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 + IDPB C,B ;COPY SECOND ARG, INCLUDING EOM + JUMPN C,.-2 + POP S,A ;FLUSH SECOND ARG + JRST BTFCL1 ;FILL ZEROES AND RETURN ONE ARG + +SENTENCE: + HRLZI E,EMPTYF + TDNE E,0(S) + TDNN E,-1(S) + JRST SENT1 + +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 + TDNE E,0(S) ;OR IF SECOND IS + SKIPA ;IN EITHER CASE, DON'T SPACE + +SENT4: IDPB C,B + ILDB C,A + JUMPN C,SENT4 + + POP S,A ;FLUSH SECOND ARG + HRLZI A,SENTF ;CALL NEW THING A SENTENCE + HLLM A,0(S) + JRST BTFCLO + +SENTCS: SKIPA A,[SENTCL+1] +WORDS: MOVEI A,WORDL+1 + PUSH P,A ; ROUTINE TO CALL GOES ON STACK + PUSH S,MV+1 +WORDS1: PUSHJ P,GNE ; NEXT INPUT TO SS OR WS + JRST WORDS2 ; END OF LINE + CAME A,[XWD MPF!IMMEDI,ELSEL+1] ; IN THEN, ELSE TERMINA + CAMN A,[XWD MPF!IMMEDI,RPREN+1] + JRST WORDS2 ; OR ) TERMINATE INPUTS TO SS + PUSHJ P,EVAL ; NEXT INPUT + MOVE A,(P) + MOVEM A,THISPR + MOVE A,(A) + PUSHJ P,(A) ; CALL WORD OR S, PR NAME SET UP FOR ERR + JRST WORDS1 ; GO BACK FOR MORE + +WORDS2: SOS CPP ; DON'T WANT TO EAT UP THE TERMINATOR + JRST APOPJ ; GET RID OF ROUTINE NAME AND EXIT + + +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 + + PUSHJ P,COUNTW + JRST COUNT2 + +COUNT1: HRLI A,(POINT 7,(W),34) +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 M,B ;ARG TO SNM IN M + PUSHJ P,SNM + MOVSI C,WORDF + HLLM C,(S) + JRST BTFCL1 + +COUNTW: 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,CPOPJ + AOJA B,.-2 + + +RANDOM: MOVE C,[EXP 1000003] + IMULB C,RANNO + TLZ C,400000 ;MAKE IT POSITIVE + MULI C,12 + ADDI C,"0" + PUSHJ P,NEWSTR + IDPB C,B + JRST ENDSTR + + +EITHER: PUSHJ P,GNE ;GOT 1 INPUT SO FAR, NOW DO NOISE WORD CHECK + ERROR ERMSSG + CAME A,[XWD MPF!IMMEDI,ANDL+1] + CAMN A,[XWD MPF!IMMEDI,ORL+1] + AOS CPP ;SKIP THE NOISE WORD + PUSHJ P,EVAL ;AND GET THE SECOND INPUT + 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, + +;THE FOLLOWING IS A PREDICATE USED TO TEST AND DETERMINE IF A WORD +;IS A MEMBER OF A LIST OF WORDS OR NOT + +MEMBRP: POP S,B ;GET PNTR TO LIST OF WORDS + POP S,A ;GET PNTR TO WORD WERE LOOKING FOR + TLNE A,EMPTYF ;IS IT THE EMPTY WORD? + JRST ISTRUE ;YES, ALWAYS TRUE + TLNE B,EMPTYF ;IS IT EMPTY? + JRST ISFALSE ;YES, ALWAYS FALSE + HRLI A,(POINT 7,(W),34) ;CHAR PNTR TO WORD + MOVEM A,SAV.A ;SAVE IT + HRLI B,(POINT 7,(W),34) ;CHAR PNTR TO LIST +WRDOF1: MOVE A,SAV.A ;REFRESH PNTR TO WORD +WRDOF2: ILDB C,A ;GET A CHAR FROM BOTH STRINGS + ILDB D,B + CAIE C," " ;AT END OF WORD WE'RE LOOKING FOR? + JUMPN C,WRDOF3 ; + CAIE D," " ;YES, ALSO AT END OF A WORD IN LIST? + JUMPN D,NXTWRD + JRST ISTRUE ;YES, WE'VE GOT A MATCH!! +WRDOF3: CAIN D," " ;AT END OF WORD IN LIST (AND MORE LEFT)? + JRST WRDOF1 ;YES, CAN'T BE A MATCH--TRY NEXT WORD OF LIST + JUMPE D,ISFALSE ;IF OFF END OF LIST NO MATCH + CAMN C,D ;CHARACTERS EQUAL? + JRST WRDOF2 ;YES, STILL HOPE FOR A MATCH +NXTWRD: ILDB D,B ;NO, TRY NEXT WORD IN LIST + JUMPE D,ISFALSE ;THERE IS NO NEXT WORD IN LIST + CAIN D," " ;FIND END OF WORD? + JRST WRDOF1 ;YES, SO TRY NEXT WORD IN LIST + JRST NXTWRD ;KEEP LOOKING FOR END OF WORD + +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 + +ISPROC: MOVE M,UA ;GET COUNT OF NO. OF ABBREVIATIONS IN + SUB M,UA+1 ;CASE DEPTH OF ABBR. EXPANSION GETS > THAN + LSH M,-1 ;NO. OF ABBREVIATIONS -- THIS IMPLIES AN + HRLZI M,-2(M) ;LOOP IN ABBR. DEFINITIONS IS DETECTED + POP S,A ;GET POINTER TO INPUT STRING +ISPR1: MOVEM A,SAV.A + HRRZ B,UA ;CHECK FOR A USER DEFINED ABBR. + PUSHJ P,LOOKY ;FIRST + JRST NOTUAB ;NOT A USER ABBR. + MOVE C,1(N) ;GET 2ND DESCRIPTOR WRD FOR ABBR + JUMPE C,TRYUPR ;A DELETED SYSTEM ABBR, MUST BE A USER PROC + AOJE C,NOTUAB ;A DELETED ABBR + HRRZ A,1(N) ;GET POINTER TO STRING THAT THIS IS ABBR FOR + AOBJN M,ISPR1 ;AND TRY AGAIN--TILL GET A NON-ABBR + ERROR ABBER1 ;LOOP IN ABBR. DEFINITION + +NOTUAB: MOVE A,SAV.A ;RESTORE PNTR TO STRING + PUSHJ P,SYSLKP ;AN EXISTING BUILT-IN PROC OR ABBR? + JRST TRYUPR ;NO, TRY USER PROCEDURE + HRRZ C,1(N) ;GET 2ND WORD OF DESCRIPTOR + CAIE C,SPECWD ;A SPECIAL WORD? + JRST ISTRUE ;NO, A PROC OR BUILT-IN ABBR + JRST ISFALSE ;YES, SO NOT A PROCEDURE + +TRYUPR: MOVE A,SAV.A ;RESTORE POINTER TO STRING + HRRZ B,RP ; + PUSHJ P,LOOKY ;A USER PROCEDURE? + JRST ISFALSE ;NO + MOVE C,1(N) ;MAYBE---GET 2ND WORD OF DESCRIPTOR + AOJE C,ISFALSE ;IF -1 THEN NOT YET TO'D OR ERASED + JRST ISTRUE ;YES, GIVE TRUE RETURN + +IS: POP S,A + POP S,B +IS1: MOVE C,@WSA + CAME C,@WSB + JRST ISFALSE + ADDI A,1 + TRNE C,377 + AOJA B,IS1 + +ISTRUE: PUSH S,[XWD WORDF,TRUEV] ;POINTER TO "TRUE" + POPJ P, +ISFALSE:PUSH S,[XWD WORDF,FALSEV] ;WS PTR TO "FALSE" + POPJ P, + +NUMBRP: POP S,A + PUSHJ P,NUMBRQ + JRST ISFALSE + JRST ISTRUE + +NOT: MOVE A,(S) ;GET BOOL, LEAVING IT ON STACK FOR ERROR + PUSHJ P,PREDIQ ;MAKE SURE IT IS A BOOL + ERROR PREDR1 + POP S,B ;FLUSH IT NOW + SKIPE @WSA ;A IS THE REL PTR TO THE WORD CONTAINING THE EOM + JRST ISFALSE ; THE SECOND WORD OF THE STRING + JRST ISTRUE + +FINDN: TRZ F,PMF + HRLI A,(POINT 7,(W),34) +FINDNA: ILDB C,A + CAIN C,"0" + SOJA B,FINDNA + CAIN C,"+" + SOJA B,FINDNA + CAIE C,"-" + POPJ P, + TRO F,PMF ;NUMBER IS NEG + SOJA B,FINDNA +; +; +; +; SPECIAL ASCII FUNCTION +; BY HAL LAMSTER WITH INSTRUCTION FROM ALAN BELL +; +ASCIIX: POP S,L + PUSHJ P,NUMARG + OUTCHR D + JRST COMEX +; +NUMARG: TLNE L,EMPTYF + JRST CPOPJ + HRLI L,010700+W + TRO F,PMF + PUSHJ P,DNM + ERROR ZERERR + ERROR ZERERR + MOVE D,M + POPJ P, +; +; +; +; +; + +;THIS GRATRP DOES NOT GENERATE ANY NEW STRINGS, DOES NOT PERFORM AN +;ADDITION, AND SHOULD END QUICKLY ON NUMBERS WHICH HAVE +;DIFFERENT ORDERS OF MAGNITUDE OR ARE OF DIFFERENT SIGN + +LESSP: PUSHJ P,NUMRQS ;TEST INPUTS BEFORE REVERSING THEM + PUSHJ P,SWITCH ; EXCH 0(S) AND -1(S) + JRST .+2 +GRATRP: PUSHJ P,NUMRQS ;ARE THE INPUTS NUMBERS? + MOVE A,(S) + PUSHJ P,COUNTW + POP S,A + PUSHJ P,FINDN ;SUBTRACT OFF SIGNS AND LEADING ZEROES + MOVE E,A ;PTR TO FIRST SIGNIFICANT DIGIT + MOVEI D,(B) ;COUNT OF SIGNIFICANT DIGITS + MOVE H,F ;STATE OF PMF + + MOVE A,(S) + PUSHJ P,COUNTW + POP S,A + PUSHJ P,FINDN + XOR H,F + TRNE H,PMF ;SIGNS THE SAME? + JRST GRATRA ;NO, CAN QUIT NOW + + SUB B,D ;SAME NUMBER OF SIGNIF DIGITS? + JUMPN B,GRATRD ;NO, QUIT NOW + LDB B,A ; + LDB C,E +GRATRC: JUMPE B,GRATRB ;END OF ONE NUMBER + SUB B,C + JUMPN B,GRATRD ;SIGN IS MEANINGFUL + ILDB B,A + ILDB C,E + JRST GRATRC + +GRATRD: CAIGE B,0 + TRC F,PMF +GRATRF: TRZE F,PMF + JRST ISFALSE + JRST ISTRUE ; +GRATRA: LDB C,A + JUMPN C,GRATRF + LDB C,E +GRATRB: JUMPE C,ISFALSE + JRST GRATRF + +EQUALP: PUSHJ P,DIFF ;EQUALP IS ZEROP OF DIFF OF +ZEROP: MOVE A,(S) + PUSHJ P,NUMBRQ + ERROR ZERERR + POP S,A + HRLI A,(POINT 7,(W),34) + 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 + + +MINIM: SKIPA A,[LESSP] +MAXIM: MOVEI A,GRATRP + PUSH P,A ; WHICH WAY THE TEST GOES + PUSH S,-1(S) + PUSH S,-1(S) ; EXTRA COPY FOR THE ONES THAT PRED EATS + PUSHJ P,@0(P) ; CALL THE APPROPRIATE PREDICATE + POP P,A ; FLUSH THE PARAM + POP S,B ; THE OUTPUT FROM PRED + MOVEI A,1 ; LENGTH OF "TRUE" + POP S,C ; SECOND INPUT TO MAX OR MIN + CAME A,@WSB ; MAX AND FIRST .GTR. SECOND? + MOVEM C,0(S) ; NO, THEN SECOND IS THE ANSWER + POPJ P, + +COMPLM: MOVE A,(S) + PUSHJ P,NUMBRQ + ERROR ZERERR + POP S,A + PUSHJ P,NEWSR0 + PUSHJ P,NEWSTR + MOVEI D,"-" + ILDB C,A + CAIE C,"-" ;IS THE OLD STRING NEG? + IDPB D,B ;NO, MAKE NEW ONE NEG + CAIE C,"+" ;SKIP EXPLICIT + + CAIN C,"-" ; OR - + SKIPA + IDPB C,B ;OTHERWISE STORE FIRST CHAR OF NUM + PUSHJ P,COPYAB ;COPY REST OF STRING + PJRST ENDST1 ;AND FINISH IT OFF + +UNPLUS: MOVE A,(S) + PUSHJ P,NUMBRQ + ERROR ZERERR + POPJ P, + +DIFF: TROA F,PMF +SUM: TRZ F,PMF + PUSHJ P,NUMRQS + 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 + + PUSHJ P,SWITCH + + PUSHJ P,REVERS + CAIN D,"-" + PUSHJ P,TENCOM + + PUSHJ P,SUMMER + TRZ F,PMF + CAIE G,"8" ;WHEN 9+9 AND NO CARRY INTO + 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 +SUM7: 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 +REVERA: PUSHJ P,NEWSRC + MOVE D,@A + ADDI A,(D) ;A POINTS AT LAST WORD + MOVEI G,0 +REVERY: MOVE C,@A + JUMPE C,REVERZ + 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,"-" + SKIPA ;SIGNED, OVERWRITE THE SIGN + IBP B ;UNSIGNED, ADD A LEADING 0 DIGIT + DPB C,B ;REPLACE THE SIGN WITH A "0" + +REVERO: MOVEI C,0 + JRST BTFCLO + +REVERZ: SUBI A,1 + SOJG D,REVERY + ERROR IOPERR ;INPUT WAS NOT A NUMBER + + +TENCOM: + PUSHJ P,NEWSRC + TRO F,TF ;SET CARRY INTO LOW ORDER DIGIT + ILDB C,A + JUMPE C,[ERROR] +NINECM: MOVNS C + ADDI C,"9"+"0" + 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 + DPB C,A + ILDB C,A + JUMPN C,NINECM + + TRNE F,PMF ;NEGATIVE RESULT? + POPJ P, ;NO + MOVEI D,"-" + DPB D,A + MOVE B,A + PJRST ENDSTP ;LENGTH OF THE STRING MAY HAVE CHANGED + +SUMMER: MOVE L,-1(S) + TRZ F,TF!PMF + HRLI L,(POINT 7,(W),34) + 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: UNDEX L + LDB 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 BTFCLO + +PRODUCT: + PUSHJ P,NUMRQS + MOVE A,(S) ;LENGTH OF ONE INPUT + MOVE A,@WSA + MOVE B,-1(S) + CAMLE A,@WSB ;.GTR. THAN OTHER INPUT? + PUSHJ P,SWITCH ; NOW FIRST ARG (-1(S)), .GE. SECOND + PUSHJ P,REVERS ;REVERSE SHORTER STRING + CAIE D,"-" ;SIGN OF IT + TRZA F,PMF ;IS + + TRO F,PMF ;IS - + PUSHJ P,PRDCVI ; CONVERT STRING TO NUMBER BASE 100000 + PUSHJ P,SWITCH + PUSHJ P,REVERS ;REVERSE THE LONGER INPUT + CAIN D,"-" ;SIGN OF OTHER + TRC F,PMF ;IF - COMPLEMENT SIGN OF RESULT + PUSHJ P,PRDCVI ; CONVERT THIS ONE TOO + MOVE B,-1(S) ;THE SHORTER ONE + MOVE A,(S) ; LONGER ONE BECOMES MULTIPLICAND + + MOVE A,@WSA ; LENGTH OF MULTIPLICAND + ADD A,@WSB ; + LENGTH OF MULTIPLIER + PUSHJ P,MAKELM ; IS THE MAXIMUM LENGTH OF RESULT + MOVE G,A + MOVEI B,@WSB ; ADDR OF RESULT + MOVE A,-1(S) + MOVEI L,@WSA ; ADDR OF MULTIPLIER + MOVN C,(L) ; -LENGTH OF MULTIPLIER + HRLI L,(C) + MOVEI B,1(B) ; POINT AT LOW ORDER DIGIT + ADDI L,1 ; POINT AT NEXT GIGIT + +MULTND: SKIPN E,(L) ; IS THE CURRENT GIGIT 0? + JRST MULR + SETZ D, ; INITIALLY, NO CARRY + MOVE A,(S) + MOVEI A,@WSA + MOVN C,(A) + HRLI A,(C) + ADDI A,1 + HRRZI B,(L) + ADD B,NEWBOT + SUB B,-1(S) +MULTL: MOVE C,E + IMUL C,(A) + ADD C,D ; OVERFLOW FROM PREVIOUS GIGIT +MULTC: ADD C,(B) ; PREVIOUS PARTIAL RESULT + IDIVI C,^D100000 ; MODULO 100000. + MOVEM D,(B) ; IS NEW PARTIAL RESULT FOR THIS PLACE + MOVE D,C ; CARRY TO NEXT PLACE + ADDI B,1 ; NEXT PLACE IN RESULT + AOBJN A,MULTL ; NEXT GIGIT IN MULTIPLICAND + JUMPN D,MULTC ; PROPAGATE CARRY +MULR: AOBJN L,MULTND ; NEXT GIGIT OF MULTIPLIER + +; CONVERT THE RESULT FROM GIGITS TO DIGITS, REVERSE IT AND OUTPUT + + SETZ B, + MOVE A,NEWBOT ; 010700+W,,HEADER WORD +PRDCVB: ADD A,[XWD 430000,1] ; MAKE IT POINT 7,HEADER+1,0 + MOVE C,@A + MOVNI E,5 + SETZM @A +PRDCVC: IDIVI C,^D10 + ADDI D,"0" + IDPB D,A + CAIE D,"0" + MOVE B,A ; MOST SIGNIFICANT NON-ZERO DIGIT + AOJL E,PRDCVC + SOJG G,PRDCVB + + JUMPN B,NOTZR + MOVE B,NEWBOT + IBP B ; SKIP OVER ONE "0" + JRST PDZERO +NOTZR: MOVEI C,"-" ; INSERT "-" IF RESULT IS NEGATIVE + TRZE F,PMF + IDPB C,B ; JUST ABOVE MOST SIGNIF DIG +PDZERO: POP S,A + MOVEI A,@WSB + MOVEI C,@WTOP + HRLI A,1(A) + ADDI A,2 + CAIL C,-2(A) + JRST [ SETZM -1(A) + CAIL C,(A) + BLT A,(C) + JRST .+1 ] + PUSHJ P,ENDSTP + JRST REVERB + +PRDCVI: MOVE A,(S) ; CONVERT TO BASE 100000. (5 DIGITS PER GIGIT) + HRLI A,10700+W +PRDCVJ: MOVNI E,5 + SETZ N, +PRDCVK: ILDB C,A + JUMPE C,PRDCVR + SUBI C,"0" + IMUL C,PRDCVT+5(E) + ADDI N,(C) + AOJL E,PRDCVK + MOVEM N,@A + JRST PRDCVJ +PRDCVR: MOVEM N,@A + POPJ P, + +PRDCVT: ^D1 + ^D10 + ^D100 + ^D1000 + ^D10000 + +QUOTIENT: + PUSHJ P,QUOT + POP S,-1(S) ;FLUSH REMAINDER + POPJ P, + +REMAINDER: + PUSHJ P,DIVREM ;GET QUOTIENT, REMAINDER + POP S,-1(S) ;AND FLUSH THE QUOTIENT + POPJ P, + +DIVISION: + PUSHJ P,DIVREM ;GET QUOTIENT, REMAINDER + PJRST SENTENCE ;AND MAKE A SENTENCE OUT OF THEM + +DIVREM: PUSHJ P,QUOT + PUSHJ P,SWITCH + + HRLZI L,(POINT 7,(W),34) + HRRI L,(A) ;SWITCH USES A + JSP D,NUMDIG + SKIPA + JRST .+4 + MOVE B,(S) + MOVEI B,1(B) + HRLI B,350700+W + IDPB C,B + TLNE B,760000 + JRST .-2 + TRO F,TF ;FOR REVERSING BACK + PUSHJ P,NEWSTR + PJRST REVERA ;REVERSE BACK + + +NUMDIG: MOVE A,L ; COUNT SIGNIF DIGS IN L STRING + MOVE B,L ; SPARE COPIES OF PTR TO A AND B + ILDB C,A ; FIND MOST SIGNIFICANT DIGIT + JUMPE C,.+4 ; B NOW HAS PTR TO MOST SIGNIF DIGIT + CAIE C,"0" + MOVE B,A ; THIS ONE IS MORE SIGNIFICANT + JRST .-4 + + SKIPA A,[0] ; NOW COUNT IN A HOW MANY + IBP L + CAME B,L ; REACHED THE END? + AOJA A,.-2 ; NO, IS SIGNIF + JUMPE A,(D) + JRST 1(D) + +QUOT: PUSHJ P,NUMRQS + PUSHJ P,SWITCH + + PUSHJ P,REVERS ;DIVIDEND + CAIE D,"-" + TRZA H,PMF ;+ + TRO H,PMF ;- + + PUSHJ P,SWITCH + PUSHJ P,REVERS ;DIVISOR + CAIN D,"-" + TRC H,PMF ;- + + PUSHJ P,NEWSRC + PUSHJ P,NEWSTR + PUSHJ P,COPYAB + PUSHJ P,ENDST1 + TRO F,PMF + PUSHJ P,TENCOM ;+DIVD,+DIVSR,-DIVSR ON PDL + + PUSHJ P,NEWSR1 + MOVE L,A + JSP D,NUMDIG + ERROR DIVERR + MOVE E,A ;NUMBER OF NON-ZERO DIGITS IN DIVISOR + MOVE L,-2(S) + HRLI L,(POINT 7,(W),34) + MOVEM L,LINBOT + JSP D,NUMDIG + JRST QUOTZR + SUB A,E ;DIGS IN DIVD- DIGS IN DIVSR + JUMPL A,QUOTZR ;DIVISOR .GTR. DIVIDEND + IDIVI A,5 + ADD A,LINBOT + JUMPE B,.+3 + IBP A + SOJG B,.-1 ;WHERE TO START SUBTRACTION PTR IN A + + TRZ F,NWF!PMF ;NO SUCCESSFUL SUBTRACTIONS DONE YET + PUSHJ P,NEWSTR ;QUOTIENT APPEARS HIGH DIG TO LOW + MOVEI C,"-" + TRNE H,PMF ;IS RESULT NEG? + IDPB C,B ;YES, STORE A - + + MOVE L,A +QUOTLP: MOVEI C,"0" + IDPB C,B ;START OF NEXT DIGIT +ADDR: MOVE E,(S) +ADDR0: MOVE A,L + HRLI E,(POINT 7,(W),34) + TRZ F,TF ;CARRY +ADDR1: ILDB C,A + JUMPE C,ADDR2 ;END OF LONGER ONE GETS PROPER CARRY + SUBI C,"0" + ILDB D,E + ADDI C,(D) + TRZE F,TF + ADDI C,1 + CAIG C,"9" + JRST .+3 + SUBI C,12 + TRO F,TF + DPB C,A + JRST ADDR1 + +ADDR2: TRNE F,PMF + TRC F,TF ;INVERT SENSE OF CARRY + TRZN F,TF ;IF NO CARRY + JRST ADDR3 ;THEN WE'RE DONE WITH THIS SIGNIF DIGIT + LDB C,B + MOVEI C,1(C) + DPB C,B ;BUMP THIS DIGIT + TRO F,NWF ;NON-ZERO RESULT + JRST ADDR ;REPEAT THE SUBTRACTION + +ADDR3: MOVE E,-1(S) + TRCN F,PMF ;ARE THE DIVISORS + - ? + JRST ADDR0 ;NO, ADD BACK IN + CAMN L,LINBOT + JRST QUDONE + UNDEX A + DPB C,A ;C IS 0, SHORTEN THE DIVIDEND + UNDEX L + TRNE F,NWF ;JUST DONE A LEADING 0? + JRST QUOTLP ;NO, NEXT DIGIT OF QUOTIENT + JRST ADDR ;YES, DO THIS ONE OVER + +QUDONE: TRZE F,NWF ;ANY SUCCESSFUL SUBTRACTION? + JRST .+4 ;YES +QUOTZR: MOVE B,NEWBOT + MOVEI C,"0" + IDPB C,B + POP S,C ;FLUSH THE TWO DIVISORS + PJRST ENDSTP ;EXIT WITH REV(REM) AND QUOT ON S STACK + +TODATE: +FOR TENEX, +FOR TEN50,< DATE G, + IDIVI G,^D31 ;DAY TO H + MOVEI D,(G) + IDIVI D,^D12 ;MON TO E + ADDI D,^D1964 ;YR TO D +> + MOVEI M,1(E) ;IT WAS MON-1 + PUSHJ P,SNM + MOVEI E,"/" + IDPB E,B + MOVEI M,1(H) ;IT WAS DAY-1 + PUSHJ P,SNM0 ;DON'T MAKE A NEW STRING + IDPB E,B + MOVEI M,(D) ;YEAR + PUSHJ P,SNM0 + PJRST ENDSTR + + +TIME: PUSHJ P,TIMDAY + IDIVI C,^D3600 ;SECONDS PER HOUR + MOVE M,C ;HOUR TO M + TRZ F,PMF ;AM OR PM + CAIGE M,^D12 + JRST .+3 + SUBI M,^D12 + TRO F,PMF ;PM + SKIPN M + MOVEI M,^D12 ;MIDNIGHT AND NOON ARE 12 + PUSHJ P,SNM + MOVEI C,":" + IDPB C,B + + IDIVI D,^D60 ;CONVERT SECONDS TO MINUTES + MOVE M,D + PUSHJ P,SNM0 + MOVEI A,[ASCIZ / AM/] + TRZE F,PMF + MOVEI A,[ASCIZ / PM/] + HRLI A,440700 + PUSHJ P,COPYAB + PJRST ENDSTR + +TIMDAY: +FOR TENEX, ;D HAD HIGH BITS SET +FOR TEN50,< MSTIME C, + IDIVI C,^D1000 > ;INDEPENDENT OF LINE FREQUENCY + POPJ P, + + +CLOCK: PUSHJ P,TIMDAY + SUB C,TOFDAY + CAIGE C,0 + ADDI C,^D24*^D3600 ;WENT PAST MIDNIGHT + MOVE M,C + PUSHJ P,SNM + PJRST ENDSTR + +RESETC: PUSHJ P,TIMDAY + MOVEM C,TOFDAY + JRST COMEX + +;TEXT - AN OPERATION ON TWO INPUTS +; 1) NAME OF A PROCEDURE +; 2) A LINE NUMBER IN THAT PROCEDURE +;IF EITHER INPUT LIES, THE OUTPUT IS EMPTY + +TEXT: POP S,L ;SECOND INPUT, A LINE NUMBER + PUSHJ P,DNM + JRST BTFEMP ;NOT A NUMBER, RETURN EMPTY + JRST BTFEMP ; NUMBER TOO BIG, ALSO RETURN EMPTY + MOVE A,(S) + MOVE B,RP + PUSHJ P,LOOKY ;FIRST INPUT, A PROCEDURE NAME + JRST BTFEMP ;NOT A PROCEDURE + HRRZ A,1(N) + CAIN A,-1 ;IS IT DEFINED? + JRST BTFEMP ;NO + JUMPE M,TEXT1 ;IS IT LINE 0, IE TITLE + JSP C,SRCHLL ;FIND THE LINE + CAIE B,(M) + JRST BTFEMP ;NOT FOUND, RETURN EMPTY + POP S,B + PJRST LINGEN ;RETURN THE TEXT OF THE LINE + +TEXT1: POP S,B + MOVEI D,1(A) + MOVE M,@PSD + PUSHJ P,NEWSTR + MOVEI D,TITLEL+1 + PUSHJ P,LNGMP ;COPY IN BUILT-IN COMMAND NAME + PJRST LINGE0 ;REST OF THE LINE + +;LINES - A PROCEDURE OF ONE INPUT, A PROCEDURE NAME +;IF DEFINED, RETURNS THE SENTENCE OF ALL LINE NUMBERS, ELSE EMPTY + +LINES: MOVE A,(S) + MOVE B,RP + PUSHJ P,LOOKY + JRST BTFEMP ;PROCEDURE NOT EXTANT + HRRZ A,1(N) + CAIN A,-1 + JRST BTFEMP ;NOT DEFINED + MOVEI A,2(A) ;SKIP OVER TITLE + SKIPN M,@PSA ;ANY LINES? + JRST BTFEMP ;NONE + POP S,B + PUSHJ P,SNM ;FIRST LINE NUMBER + TRO F,NWF ;SP OF LINES OF "X" IS ALWAYS "TRUE" +LINES1: MOVEI A,2(A) + SKIPN M,@PSA ;ANY MORE LINES? + PJRST ENDSTR ;NO + PUSHJ P,DSPACE + PUSHJ P,SNM0 ;ADDITIONAL LINE NUMBERS + JRST LINES1 + SUBTTL COMMANDS + +;HERE FOLLOW THE COMMANDS + +TYPE: TRZA F,CRF ;DON'T DO CRLF AFTER TOS +PRINT: TRO F,CRF + TLO F,TOF ;DENOTE TYPEOUT FOR BREAKY ERROR + SETZM BCHAR + 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 + TLZ F,TOF ;NO LONGER TYPING OUT + JRST COMEX + +ENND: SKIPN A,TOPROD + ERROR NOPERR ;END WHAT? YOU ARE NOT DEFINING ANYTHING + SKIPN PRODNM ;IF THE "END" WAS STORED, OR + TLNE F,GETF ;IN ANY CASE, IF GETTING + JRST ENND1 ;DO NOT TYPE "DEFINED" + JSP H,ETUP + MOVEI A,[ASCIZ / DEFINED/] + PUSHJ P,PTOSSM + PUSHJ P,CRLF +ENND1: SETZB A,TOPROD + TRZN F,FLUSHF ;IF FLUSHING IT, NOT REALLY OPEN + PUSHJ P,MOVEMP + JRST COMEX + + +ABBREVIATE: + AOS CPP + PUSHJ P,EVAL ;EVAL FIRST ARG + PUSHJ P,GNE + ERROR ERMSSG ;SOMETHING MISSING, IE SECOND ARG + CAMN A,[XWD MPF!IMMEDI,ASL+1] ;IS IT "AS"? + AOS CPP ;YES, SKIP IT + PUSHJ P,EVAL ;GET SECOND ARG + +ABBRV0: MOVE A,0(S) ;SECOND ARG, ABBREVIATION + TLNE A,EMPTYF ;IS IT EMPTY + ERROR ABBER2 ;DON'T USE THE EMPTY THING AS AN ABB + MOVE B,UA ;USER ABBREVIATION TABLE + PUSHJ P,LOOKY + 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 + +TEST: MOVE A,(S) ;LEAVE ARG ON STACK FOR ERROR + PUSHJ P,PREDIQ ;IS THE INPUT A PREDICATE? + ERROR PREDR1 ;NO + POP S,B ; OK TO FLUSH NOW + MOVEI B,0 + SKIPN @WSA ;0 FOR "FALSE"; "TRUE" FOR "TRUE" + MOVNI B,1 + MOVEM B,TRUTH + JRST COMEX + +IF: MOVE A,(S) + PUSHJ P,PREDIQ ;IS INPUT TO IF A PREDICATE? + ERROR PREDR1 ;NO, INPUT MUST BE A PREDICATE + POP S,B ;FLUSH IT + TRO F,EELSEF ;DENOTE THAT AN ELSE MAY APPEAR + SKIPE @WSA ;IS IT FALSE + JRST IF2 ;NO, TRUE + AOS A,CPP + SKIPN B,@WSA ;HOOK FOR A TRAILING ELSE + JRST IFXFS2 ;DIDN'T FIND ONE + CAME B,[XWD MPF!IMMEDI,ELSEL+1] + JRST .-4 ; NOT ELSE, GO BACK FOR NEXT ELEM + JRST IFX2 ;FOUND ELSE, USE THE REST +IF2: POP P,0(P) ;FLUSH PTR TO OPEX + MOVE B,[XWD MPF!IMMEDI,THENL+1] ; OPTIONAL THEN + AOS A,CPP + CAME B,@WSA + SOS CPP + JRST EXECU1 + +IFFALSE: SKIPE TRUTH + JRST IFX2 ; IF FALSE, AND IN FACT TRUTH IS FALSE +IFXFLS: MOVE A,CBOT + ADD A,@WSA +IFXFS2: SUBI A,1 + MOVEM A,CPP + JRST COMEX + +IFTRUE: SKIPE TRUTH + JRST IFXFLS ; IF TRUE, AND TRUTH=FALSE +IFX2: TLZ F,COMF + POP P,0(P) + MOVEI A,[[ERROR NOCMD]] + CAME A,(P) + ERROR COMERR + JRST EXECU1 + + +GOODBYE: JSP D,COMEXR ;MAKE SURE LINE IS OK FIRST, THEN +FOR TENEX,< MOVEI A,100 ;PRIMARY INPUT FILE + CFIBF ;FLUSH ANY OTHER JUNK + MOVE C,[ASCII /LOGO +/] + MOVNI D,5 + SETZ B, + ROTC B,7 + STI ;SIMULATE TERMINAL INPUT TO EXEC + AOJL D,.-3 + HALTF > ;AND RETURN TO EXEC +FOR TEN50,< CALL [SIXBIT /EXIT/]> + +TYPEIN: PUSHJ P,REQUEST ;PUSH SECOND ARG TO MAKE +MAKE: MOVE A,-1(S) + TLNE A,EMPTYF + ERROR NMERR5 ;NAME NOT ALLOWED TO BE EMPTY + HRRZI B,MV + PUSHJ P,SYSLUK + JRST .+2 + ERROR NMERR3 ;X IS USED BY LOGO + MOVE A,-1(S) + HRRZ B,VP + PUSHJ P,LOOKY + PUSHJ P,MAKEN ;NOTA, MAKE A NEW GLOBAL +MAKE1: POP S,A ; GET THE VALUE + DPB A,[XWD 004100,1(N)] ;PUT IT AWAY, NOT CHANGING STATE OF GLOB +IGNORE: POP S,A ;FLUSH ONE INPUT, THE NAME IF MAKE + JRST COMEX + +MAKEN: MOVEI B,2(N) + CAML B,VP+1 + EXPAND VP + MOVE A,-1(S) + MOVEM A,(N) + MOVE A,[XWD WORDF!SENTF!EMPTYF!GLOBLF!UNBOUN,0] + MOVEM A,1(N) + SETZM 2(N) + POPJ P, + + + +LOCAL: SKIPN PRODNM + ERROR STOERR ;LOCAL CAN ONLY BE STORED + MOVSI A,EMPTYF + TDNE A,0(S) ;IS THE LOCAL NAME EMPTY + ERROR NMERR5 ; NAMES CANNOT BE EMPTY + MOVE A,(S) + MOVEI B,MV + PUSHJ P,SYSLUK ; IS IT A BUILT IN + JRST .+2 + ERROR LCLERR ; CAN'T USE MV AS LOCAL NAME + MOVE A,(S) + PUSH S,A ; SO MAKEN CAN USE "-1(S)" FOR NAME + MOVE B,VP + PUSHJ P,LOOKY ; DOES THE NAME ALREADY EXIST? + PUSHJ P,MAKEN ; NO, GO DO IT + POP S,A + POP S,A ; GET RID OF JUNK + + MOVE E,DTOP + MOVE D,DP+1 + SUB D,DP ;END RELATIVE TO BEGINNING + CAIG D,2(E) ;WILL ANOTHER ENTRY FIT + EXPAND DP ;NO + ADD E,DP ;MAKE ABSOLUTE + MOVE B,[XWD WORDF!EMPTYF!SENTF!UNBOUN,0] + EXCH B,1(N) ; TOP LEVEL BINDING NOT SET, ONLY DECLARED + SUB N,VP + ADDI N,1 + MOVEM N,(E) ; NAME PTR IN DP IS REL PTR TO VP + MOVEM B,1(E) ; AND VALUE IS THE ONE IN VP PREVIOSLY + MOVEI A,2 + ADDM A,DTOP ;TOP OF LIST IS HIGHER + JRST COMEX ;ONLY ALLOW ONE INPUT + SUBTTL COMMANDS--USER DEFINED PROCEDURES + +;HERE FOLLOWS ALL THERE IS TO USER DEFINED PROCEDURES +;DEFINING THEM, EXECUTING THEM, CHANGING TITLES AND TRACING + +TITLE: SKIPN TOPROD ;IS THERE A PROCEDURE OPEN? + ERROR NOPERR ;NO, CANNOT RETITLE NO PROCEDURE + PUSHJ P,GNE + ERROR ERMSSG + CAME A,[XWD MPF!IMMEDI,TOL+1] ;IS THE NEXT THING "TO" + ERROR TITER2 ;WORD AFTER TITLE MUST BE TO + TLO F,TITLEF + JRST TO0 +TO: TLZ F,TITLEF + SKIPE TOPROD ;IS THERE A PROCEDURE ALREADY OPEN + ERROR TOERR4 ;YES +TO0: MOVE H,CPP ;WHERE TO START SAVING THE CODE OF TITLE LINE + SUB H,CBOT ;ALWAYS RELATIVE TO BEG OF LINE!! + PUSHJ P,GNE ;NEXT NON-COMMENT ELEMENT + ERROR ERMSSG ;MUST HAVE A PROCEDURE NAME + TLNN A,UPRF + ERROR TOERR5 ;CANNOT BE USED AS A PROCEDURE NAME + TLNE A,SCHF ; DOES IT HAVE NON-PRINTING CHARS + ERROR TOERR7 ; YES, NOT A LEGAL NAME + 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 TOERR6 ;NO TO EITHER, THE PROCEDURE IS ALREADY DEFINED +TO1: SETZ M, ;COUNT OF DUMMIES ENCOUNTERED + PUSHJ P,GNE ;NEXT NON-COMMENT ELEMENT + JRST TOA ;NO DUMMIES +TO2: TLNE A,MVARF ; IS THE FORMAL NAME RESERVED? + ERROR TOERR3 ; NOT PERMITTED + TLNN A,VARF ;IS IT A DUMMY? + ERROR TOERR2 ;NO + MOVEI M,1(M) ;YES, COUNT IT +TO3: PUSHJ P,GNE ;CHECK FOR "AND" + JRST TOA ;NOTHING, SO NO AND + CAME A,[XWD MPF!IMMEDI,ANDL+1] ;IS IT "AND"? + JRST TO2 ;NOT AND, TRY DUMMY + PUSHJ P,GNE + ERROR ERMSSG ;"AND" LAST, NOT WELL FORMED + JRST TO2 ;IT MUST EXIST AND BE A VARIABLE + + +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,TOLINJ + 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: SETZM CBOT + POPJ P, + +TOLINE: SKIPN TOPROD ;IS THERE A PROCEDURE OPEN + ERROR INERR3 ;LINE X OF WHAT PROCEDURE? + TRNE F,FLUSHF + JRST TOFLUS + MOVEI H,2 ;SAVE THE LINE BUT NOT THE LINE NUMBER + MOVE A,CBOT + MOVEI A,1(A) ; POINT PAST OVERHEAD WORD + MOVE L,@WSA + PUSHJ P,DNM + ERROR IOPERR ;I AM IN TROOUBLE + ERROR INERR2 ; OVERFLOW, LINE NO TOO LARGE + CAIL M,^D100000 + ERROR INERR2 ;LINE NO TOO LARGE + JUMPE M,[ERROR INERR4] ;LINE NO =0 + + HRRZ A,TOPROD + JSP C,SRCHL1 + CAIGE B,(M) + JRST TOLING + + CAIN B,(M) ;LINE NO ALREADY EXISTS? + AOJA A,TOLINJ ;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 + + +TOLINJ: TLO F,GCCSF ; WRONG PLACE FOR THIS FLAG + MOVE B,CBOT ; PTR TO OLD LENGTH + CAIN H,1 ; ALL OF THE LINE BEING SAVED? + JRST TOLINQ ; YES + PUSH P,A ; PTR INTO PROCEDURE DIRECTORY + MOVE A,@WSB ; GET THE OLD LENGTH + SUBI A,-1(H) ; NEW LENGTH + PUSHJ P,MAKELM + MOVE A,CBOT + ADDI A,-1(H) + HRLZI C,@WSA + HRRI C,@WSB + MOVEI A,(C) + AOBJN C,.+1 + ADD A,(A) + BLT C,(A) + POP P,A + TLO B,COMPOUND ; NEW ELEMENT IS COMPOUND +TOLINQ: MOVEM B,@PSA + POPJ P, ;R1 FROM COMPIL + + +TRACE: PUSHJ P,GNE ;TRACE WHAT? + ERROR ERMSSG ;NOTHING + TLNN A,UPRF ;TRACE A USER PROCEDURE? + ERROR WHATER ;CANNOT TRACE THAT + MOVEI A,-1(A) ;POINT AT FIRST WORD OF RP PAIR + HRLZI B,TRACEF + IORM B,@RPA ;MARK THIS PROCEDURE AS TRACED + JRST COMEX + +UPROD: MOVE A,-1(P) + POP P,-1(P) + MOVNI B,1 + CAMN B,@RPA ;IS THE PROCEDURE DEFINED? + ERROR EVER3 ;NO, X NEEDS A MEANING + MOVEI B,(A) + CAMN B,TOPROD ;IS THIS THE ONE BEING DEFINED? + ERROR EVER4 ;YES, X HAS NOT BEEN COMPLETELY DEFINED + + JSP D,SAVEUP ;PUSH ALL THE GOOD STUFF + HRRZM A,PRODNM + + MOVE B,DP ;LOC OF DUMMY ARG TABLE + HLRE C,A ; + NO OF ARGS AT SCAN TIME -1 + ADDI C,1 + MOVEI E,(C) + ADDI E,1(C) + ADD B,DTOP ;PART OF TABLE ALREADY USED + ADDI B,(E) ;AMT FOR DUMMY NAMES + CAML B,DP+1 ;ALL FIT IN DP? + EXPAND E,DP ;EXPAND THE TABLE AT LEAST THIS MUCH + + ADDM C,DTOP + ADDM C,DTOP ;UPDATE AMT USED + + + + TLO F,NOBREAK ;INHIBIT BREAK FOR DURATION OF TRACE + HRRZ D,@RPA + PUSH P,BCHAR ;SAVE CURRENT STATE OF MARGIN + MOVE E,TRACEM ;MARGIN FOR TRACE + ANDI E,17 ;INDENT AT MOST 14 SPACES + MOVEM E,BCHAR + TRZ F,TF ;IF SET WILL DENOTE THAT THIS PROC IS TRACED + MOVEI A,-1(A) + MOVE A,@RPA ;FETCH NAME OF PROCEDURE + TLNE A,TRACEF ; AND SKIP IF NOT TRACED + TRO F,TF + PUSH P,C + TRNE F,TF + SKIPN CHARNO + SKIPA ;NOT TRACING OR AT MARGIN + PUSHJ P,CRLF ;NOT AT MARGIN, GET THERE + TRNE F,TF + PUSHJ P,INDENT + POP P,C + TRNE F,TF + PUSHJ P,CALPTS ;TRACED, TYPE OUT THE NAME + + MOVEI D,1(D) ;POINT TO PTR TO TO LINE + MOVE D,@PSD ;FETCH PTR TO TO LINE + MOVN E,C ;-N + MOVEI C,1(S) ;STACK LOCATION + ADD C,E ;LOCATION IN STACK OF FIRST DUMMY + HRL C,E ;-COUNT OF DUMMIES + HRRZ G,DP + ADD G,-3(P) ;OLD VALUE OF DTOP + ;BEWARE OF THIS INSTRUCTION WHEN CHANGING SAVEUP + JUMPGE C,UPDVCR ;NO DUMMIES, GET FIRST LINE + + MOVE A,[POINT 7,[ASCIZ / OF /]] +UPDVCL: TRNE F,TF + PUSHJ P,CLPTS1 ;IF TRACED, TYPE "OF" OR " AND " + MOVEI E,042 ;TO QUOTE INPUTS IF TRACING + MOVE A,@WSD ;LOOP TO COPY INTO DP, GET DUMMY NAME + TLNN A,VARF ;IS IT A DUMMY NAME + AOJA D,.-2 ;NO, TRY NEXT ELEMENT + MOVEM A,(G) ;INTO DUMMY VAR TABLE + MOVE B,(C) ; NEW BINDING + EXCH B,@VPA ; GOES INTO VP, OLD BINDING + MOVEM B,1(G) ; GOES INTO DP + MOVE A,(C) ; NEW BINDING AGAIN, FOR TRACING + TRNE F,TF ;TRACING? + PUSHJ P,CLPTS0 ;YES, TYPE INPUT QUOTED + MOVEI G,2(G) + POP S,0(S) ;POP 1 THING OFF S STACK WITHOUT CLOBBERING + MOVEI D,1(D) + MOVE A,[POINT 7,[ASCIZ / AND /]] + AOBJN C,UPDVCL ;UPROD DUMMY VAR COPY LOOP +UPDVCR: TRNE F,TF ;BUT BEFORE EXECUTING + PUSHJ P,CRLF ;NEATEN UP + MOVEI A,2 + TRZE F,TF ;TRACING? ALSO, FLAG NO LONGER NEEDED + ADDM A,TRACEM ;NEXT TRACE CALL INDENTED TWO MORE SPACES + + +UPFRST: PUSH S,CBOT + POP P,BCHAR ;RESTORE OLD MARGIN +UPNEXT: JSP C,SRCHLN + CAMG B,LINENO + JRST OUTPTA + MOVEM A,NXLINE +UPNXT1: MOVEM B,LINENO ;FOUND A LINE NO .GTR. PREVIOUS LINE + TLZ F,NOBREAK ;SAFE TO ALLOW BREAK AGAIN + AOS A,NXLINE + MOVE A,@PSA ;GET COMPILE PTR & CHANGE NO + MOVEM A,CBOT + MOVEM A,CPP + + PUSHJ P,EXECUTE + + AOS A,NXLINE ;DONE WITH THE LINE, GET NEXT ONE + JUMPE A,UPNEXT ;DO IT THE LONG WAY IF ANY PROCEDURES CHANGED + MOVE B,@PSA ;FETCH THE LINE NO + JUMPN B,UPNXT1 ;LINE NO .NE. 0_MORE TO DO + JRST OUTPTA ;NO MORE LINES, DONE WITH PROCEDURE + +CLPTS0: TRO F,PREFIX!SUFFIX +CALPTS: HRLI A,(POINT 7,(W),34) ;WORKSPACE ELEMENT +CLPTS1: PUSH P,B + PUSH P,C + PUSH P,D + PUSHJ P,PTOS ;FINALLY! + POP P,D + POP P,C + POP P,B + POPJ P, + +OUTPTA: TLZ F,NOBREAK ;REMEMBER TO PERMIT BREAK + TLO F,COMF ;DENOTE THAT THERE IS NO OUTPUT + JRST RETA + +FOR SAVBRK,< +GO: SKIPE PRODNM + ERROR DIRERR ;"GO" ALONE CAN ONLY BE DIRECT + SKIPG GODEPTH + ERROR GOERR9 ;NOPLACE TO GO + JSP H,GORE + POPJ P, + +CANCEL: SKIPE PRODNM + ERROR DIRERR ;DIRECT ONLY ERROR BEFORE NOTHING TO CANCEL + SKIPG GODEPTH + ERROR CANER1 ;NOTHING TO CANCEL + JSP H,GORE + JRST FLUSHM ;FLUSH TO BSP + +GORE: SOS GODEPTH ;TEST ABOVE SO IT DOESN'T GO NEGATIVE + MOVE A,BSP + JSP C,SETPDL + JSP D,RESTOR + POP P,BSP + JRST (H) > + +ESTOP: TLOA F,COMF +OUTPUT: POP S,GCTEM ;SAVE OUTPUT VALUE FOR A MOMENT (GC IMPOSSIBLE) + SKIPN PRODNM + ERROR STOERR ;OUTPUT AND STOP MUST BOTH BE STORED + JSP D,COMEXR ;DO THE END OF LINE CHECKS + POP P,0(P) +RETA: JSP E,RESTOA ;RESTORE ALL BUT PRODNM + TLNN F,COMF ;IS THIS OUTPUT? + PUSH S,GCTEM ;YES RESTORE VALUE TO S STACK + TLNE F,GOF ;IS THIS RETURN UNTRACEABLE? + JRST RETD ;YES IT IS, SKIP TRACE STUFF + + + + MOVE A,PRODNM + MOVEI A,-1(A) ;DON'T CHANGE PRODNM, COMERU MAY NEED IT + MOVE A,@RPA ;ENDING A TRACED PROCEDURE? + TLNN A,TRACEF + JRST RETD ;NO + MOVNI B,2 + ADDB B,TRACEM + PUSH P,BCHAR + ANDI B,17 + MOVEM B,BCHAR + PUSHJ P,INDENT + PUSHJ P,PTOSS ;TYPE PROCEDURE NAME + MOVEI A,[ASCIZ / OUTPUTS /] + TLNE F,COMF ;DID IT OUTPUT? + MOVEI A,[ASCIZ / STOPS/] ;NO, IT STOPPED + PUSHJ P,PTOSSM + +RETB: TLNE F,COMF + JRST RETC ;NO NEED TO TYPE WHAT IT OUTPUTTED, IT STOPPED + TRO F,PREFIX!SUFFIX + MOVEI E,042 + MOVE A,(S) + PUSHJ P,PTOSS +RETC: POP P,BCHAR + PUSHJ P,CRLF + + +RETD: POP P,E ;OLD PRODNM INTO E + ANDI E,377777 ;TRUTH BIT IS PACKED IN THIS HALFWORD + EXCH E,PRODNM ;SAVE NAME OF PR BEING EXITED IN E + TLZE F,COMF ;DID THE PROCEDURE OUTPUT? + JSP D,COMEXU ;NO, TREAT IT LIKE A COMMAND + POPJ P, + +SRCHLN: HRRZ A,PRODNM ;THIS IS THE PROCEDURE TO SEARCH +SRCHL1: HRRZ A,@RPA ;GET RELATIVE PTR INTO PS SPACE + CAIN A,-1 ;ERASED? + ERROR NOPROD ;THERE IS NO PROCEDURE X + +SRCHLL: MOVEI A,2(A) ;POINT TO NEXT LINE NO + HRRZ B,@PSA ;GET THE LINE NO + JUMPE B,1(C) ;R1, FOUND END BEFORE THE LINE + XCT (C) ;ARG TO ROUTINE IS THE COMPARE + JRST SRCHLL ;CONTINUE ON NO COMPARE + JRST 2,2(C) ;GOOD COMPARE, R2 + + +GOTOLINE: + SKIPN PRODNM ;IS THE COMMAND STORED? + ERROR STOERR ; NO, IS AN ERROR + + PUSHJ P,GTL1 + + JSP C,SRCHLN ;IS THERE THAT LINE IN THIS PROCEDURE + CAIE B,(M) + ERROR GOERR3 ;THERE IS NO LINE X + MOVEI A,-1(A) + MOVEM A,NXLINE ;SO STEP TO NEXT LINE WILL FIND THIS ONE WITHOUT SEARCHING + JRST COMEX + +NUMEVL: AOS A,CPP + MOVE L,@WSA ;FETCH LINE NUMBER + TLNE L,LITF ;IF THIS, DOES NOT NEED TO BE EVALED + JRST GOTO1 ;IS A LITERAL, COULD BE A NUMBER + PUSHJ P,EVAL ;NOT A LITERAL, MUST EVALUATE +GTL1: POP S,L ;VALUE RETURNED +GOTO1: MOVEI D,(L) ;SAVE POINTER FOR ERROR COMMENT + TLNN L,SENTF ; CANNOT BE A NUMBER IF IT IS A SENTENCE + PUSHJ P,DNM + ERROR GOERR2 ;IS NOT A LINE NUMBER + ERROR GOERR2 ; TOO BIG + POPJ P, + +SAVEUP: HRLZ B,LINENO ;A MUST BE LEFT ALONE + HRR B,PRODNM + MOVE C,TRUTH + ANDI C,400000 + ORI B,(C) ;PRODNM .LT. 2^17 BECAUSE THERE MUST BE A + ; NAME FOR EACH ONE + PUSH P,B ;LINENO,,TRUTH+PRODNM + PUSH P,DTOP + MOVE B,CPP + SUB B,CBOT + TLZE F,GCCSF ;CODE PTRS PUSHED FROM HERE ON ARE VALID + TLO B,200000 ;BUT IF SET, THOSE ABOVE ARE NOT + TRNE F,EELSEF ;ON A LINE STARTING WITH IF? + TLO B,100000 ; YES, PUSH THAT FACT + PUSH P,B + PUSH P,SPP + + SETZM TRUTH + SETZM LINENO + SETZM PRODNM + HRRZI B,(S) ;WHEN SAVEUP IS CALLED IS THE ONLY TIME + SUB B,SP ;THE DEPTH OF THE PUSHDOWN LISTS CHANGE + HRLZM B,SPP + HRRZI B,1(P) + SUB B,PP + HRRM B,SPP + JRST (D) + +RESTOR: JSP E,RESTOA ;RESTORE ALL BUT PRODNM + HRRZM A,PRODNM + POP P,A ;FIX UP PDL + JRST (D) + +RESTOA: POP S,CBOT + POP P,SPP + TLNN F,GCCSF ; HAS THERE BEEN A POSSIBLE LINE EDIT? + JRST RESTOC ; NO, NO NEED TO CHECK FOR ALTERATIONS + HRRZ A,-2(P) ;PRODNM BEING RETURNED TO + ANDI A,377777 ;REMOVE TRUTH FLAG + JUMPE A,RESTOC ; SKIP TEST IF DIRECT LINE + HLRZ M,-2(P) ;LINE NO + JSP C,SRCHL1 ;FIND THE LINE AGAIN + CAIE B,(M) + ERROR LNDERR ;LINE DELETED WHILE IN IT + MOVEI A,1(A) + MOVE A,@PSA ;SEQNO,,CODEPTR +RESTOC: POP P,A ; BITS,,CPP REL CBOT + TLZE A,200000 ;WAS GCCSF SET AT THIS LEVEL GOING DOWN + TLO F,GCCSF ;THEN IT MUST BE SET ON WAY UP + TLZE A,100000 ; LINE BEING POPPED STARTED WITH IF? + TRO F,EELSEF ; YES, THEN IT CAN END WITH ELSE + ADD A,CBOT + MOVEM A,CPP + MOVE C,DTOP ;FLUSH LOCAL BINDINGS THIS LEVEL + POP P,DTOP ; HAVING REMEMBERED OLD VALUE +RESTB1: CAMN C,DTOP ; ARE THERE ANY MORE BINDINGS? + JRST RESTB2 ; NO + MOVEI C,-1(C) ; REL PTR TO VALUE + MOVE B,@DPC ; PICK UP VALUE + MOVEI C,-1(C) ; REL PTR TO REL PTR TO VP + MOVE A,@DPC + MOVEM B,@VPA ; STORE VALUE IN OBLIST + JRST RESTB1 +RESTB2: MOVE A,(P) ;LINENO,,TRUTH+PRODNM + MOVEI B,0 + TRZE A,400000 + HRROI B,-1 ;TRUTH=FALSE + MOVEM B,TRUTH + HLRZM A,LINENO + SETOM NXLINE + JRST (E) + +WAIT: MOVE L,(S) + HRLI L,(POINT 7,(W),34) + PUSHJ P,DNM + ERROR ZERERR + ERROR . ; TOO LONG A TIME TO WAIT + POP S,L +FOR TENEX,< MOVEI 1,^D1000 + IMUL 1,M + DISMS > +FOR TEN50,< MOVEI A,^D3600 + IMULI M,^D60 + CAIG M,(A) + JRST .+4 + SLEEP A, + SUBI M,(A) + JRST .-4 + IDIVI M,^D60 + SLEEP M, > + JRST COMEX + +LINEFEED: + SKIPA C,[012] +BELL: MOVEI C,007 + JRST COMCHR + +FORMFEED: + SKIPA C,[014] +CRETUN: MOVEI C,015 +COMCHR: PUSHJ P,TYO + JRST COMEX + +SKIP: PUSHJ P,CRLF + JRST COMEX + SUBTTL SUBROUTINES + +;TYPE IN STRING +;CHECK FOR CONTROL CHARACTERS,EDIT CHARS, ILLEGAL CHARS +;EDITF=1_EDIT MODE, THEN A CONTAINS BYTE POINTER TO BEGINNING OF STRING +;BYTE POINTER TO OUTPUT STRING IN B +;RETURN STRING POINTER TO INPUT ON S-LIST +;R1_FAILURE, TRY AGAIN, R2_SUCCESS. + +TIS: MOVEI C,2 ;SET CONTINUATION TO SPACE TWO CHARACTERS + MOVEM C,BCHAR + TLZ F,LDONF!FCHARF ;CLEAR LINE DONE FLAG FOR EDIT MODE + TLNN F,EDITF!GETF ;DON'T TYPE WEDGE OR _ IF EDITING + PUSHJ P,TOSS ;PRINT OUT COMMENT FROM B +FOR DRIBBLE,< +FOR TENEX,< + PUSH P,A + SKIPN A,DRIBFL ;IS THERE A DRIBBLE OPEN? + JRST TISAZ ;NO + SETO B, + SETZ D, + ODCNV + HRRZM D,DRIBTM +TISAZ: POP P,A >> + PUSHJ P,NEWSTR + TLNN F,EDITF ;ARE WE IN EDIT MODE? + JRST TISB ;NO + PUSHJ P,NEWSRC + MOVEM A,LINBOT ;FOR PURPOSES OF GARBAGE COLLECTION + PUSHJ P,TEDIT ;AND COPY IT TO THE INPUT STRING +TISB: PUSHJ P,TYI ;GET NEXT CHARACTER INTO C +FOR DRIBBLE,< +FOR TENEX,< + PUSH P,A + SKIPN A,DRIBFL + JRST TISB01 + TLOE F,FCHARF ;FIRST CHAR ON LINE? + JRST TISB0 ;NO + MOVE H,B ;TIME STAMP THE LINE + MOVE G,C + SETO B, + SETZ D, + ODCNV + HRRZI D,(D) + SUB D,DRIBTM + CAIGE D,0 + ADDI D,^D24*^D3600 + HRLZI E,400001 + ODTNC + MOVEI B," " + BOUT + MOVE B,H + MOVE C,G +TISB0: EXCH C,B + BOUT + EXCH C,B +TISB01: POP P,A >> + +TISB1: CAIGE C,40 ;CONTROL CHAR? + JRST TISC ;YES + CAIN C,177 ;RUBOUT? + JRST TISO ;YES + AOS CHARNO ;PRINT CHARACTER SO COUNT + CAIN C,134 ;BACKSLASH + JRST TISN ;YES +TISF: TLNE F,EDITF + PUSHJ P,TYO ;IN EDIT MODE THERE IS NO OTHER ECHOING + IDPB C,B + JRST TISB + +TISC: MOVEI E,(C) ;SAVE CHAR IN C + ROT E,-1 + HRRZ D,ITAB(E) + JUMPL E,.+2 + HLRZ D,ITAB(E) + JUMPN D,(D) ;DISPATCH IF IT IS A LEGAL CONTROL CHAR + JRST TISF ;NOT A SPECIAL CONTROL CHAR + + +DEFINE CC (A,B,C,D) + + +ITAB: +CC 0,0,0,0 ;NUL ABC +CC 0,0,0,TISF ;DEFG +CC 0,0,TISI,0 ;H TAB LF K +CC 0,TISJ,TISK,0 ;L CR NO +NOTFOR TURTLE, ;TEN50 USES DC3 AS TERMINATOR IN FILES +FOR TURTLE, +CC TISLIT,0,0,TISM ;TUVW +NOTFOR TURTLE, ;XYZ ALTMODE +FOR TURTLE, +FOR TEN50, +FOR TENEX, ;END OF LINE IS 37, LF ALREADY FLUSHED + + +TISDC3: TLNE F,GETF ;COMING FROM A FILE? + JRST TISEOL ;YES, OK + JRST TISF +TISD: +FOR TEN50,< TTCALL 11,> ;FLUSH ALL INPUT +FOR TENEX,< MOVEI A,100 + CFIBF> + MOVEI B,[ASCIZ " +MEANINGLESS CHARACTER"] +TISA: PUSHJ P,TOSS + PUSHJ P,CRLF +TISR1: + TLZE F,EDITF + POP S,A ;CLEAN UP THE PUSH-DOWN LISTS + POPJ P, ;GIVE R1 + +TISG: MOVEI C," " ;CONTROL B + TLNN F,GETF ;NO ECHO IF FROM FILE + PUSHJ P,TYO ;TYPE BACK A SPACE + MOVEI C,002 ;AND PUT CONTROL B IN BUFFER + JRST TISF + +TISH: TLNN F,GETF + PUSHJ P,PTAB ;IF NOT IN A FILE, ECHO SPACES + MOVEI C,011 + JRST TISF + + +TISLIT: TLNN F,GETF ;DOING A GET? + JRST TISF ;NO, ^T NOT LEGAL FROM TERMINAL +TISLT1: IDPB C,B ;COPY TEXT BETWEEN ^T'S LITERALLY, NO INTERP + PUSHJ P,TYI +FOR DRIBBLE, + CAIE C,024 ;LOOKING FOR MATCHING ^T + JRST TISLT1 ;NOT FOUND + JRST TISF ;BACK TO NORMAL READING + TISI: TLNE F,GETF + JRST TISF ;COMING FROM FILE, LET IT THRU + TLNE F,EDITF + PUSHJ P,TYO + PUSH P,B + MOVEI B,[BYTE (7) 15,40,40,0] + PUSHJ P,TOSS + POP P,B + MOVEI C," " ;AND TREAT LIKE A SPACE + JRST TISF + +TISZ: PUSHJ P,CRLF + JRST TISEOL +TISJ: SETZM CHARNO + TLNE F,EDITF ;WE MUST ECHO THE CR IF EDITING + PUSHJ P,TYO + PUSHJ P,TYI + CAIE C,12 ;LINEFEED FOLLOWING CR? + JRST TISCR ;NO + TLNE F,EDITF ;EDITING? + PUSHJ P,TYO ;YES, ECHO IT TOO +TISEOL: SETZB C,CHARNO + IDPB C,B ;FINISH THIS STRING + HRLZI L,(POINT 7,(W),34) + HRR L,NEWBOT + MOVEM L,LINBOT + MOVE B,L ;SAME SRC AND DEST FOR WELL-FORMING + +TISEL2: ILDB C,B + JUMPE C,TISEL3 + CAIL C,40 + JRST .-3 + CAIE C,15 + CAIN C,12 + JRST TISEL2 ; CR AND LF CAN OCCUR IN LITERALS + CAIE C,"G"-100 + CAIN C,"I"-100 + JRST TISEL2 + CAIN C,"L"-100 + JRST TISEL2 + CAIN C,"T"-100 + TLNN F,GETF + JRST TISD + JRST TISEL2 + +TISEL3: MOVE B,L + SETZB D,M ; TERMINATE ON EOL, ABBREVIATION LEVEL 0 + PUSHJ P,WEFS ;REMOVE EXTRA SPACES + TLZN F,EDITF ;CLEAR PDL+EDIT FLAG + JRST CPOPJ1 + POP S,-1(S) + MOVNI A,1 + GETLCH A + TLZ A,(1B15) ;TURN ECHOING BACK ON UNLESS LOCAL COPY + SETLCH A + MOVE A,TERMIO + EXCH A,CHIN ;RESTORE LINE-AT-A-TIME INPUT + CAME A,[INCHRW C] ;IF IT HAS BEEN CHANGED TO THIS + MOVEM A,CHIN ;OTHERWISE QUIT +CPOPJ1: AOS 0(P) +CPOPJ: POPJ P, + + +TISCR: MOVEI A,15 ;CR + IDPB A,B ;PUT IT INTO THE TEXT + JRST TISB1 ;TREAT THE CHAR AFTER CR FOR WHAT IT IS + +TISK: TLNN F,EDITF ;TYPE NEXT WORD IN EDIT MODE + JRST TISF ;NOT IN EDIT MODE + PUSHJ P,TEDIT ;COPY NEXT WORD TO TT AND BUFFER + JRST TISB + +TISL: TLNN F,EDITF ;TYPE REST OF LINE IN EDIT MODE + JRST TISF ;NOT IN EDIT MODE + PUSHJ P,TEDIT + TLNN F,LDONF + JRST .-2 + JRST TISB + +TEDIT: TLNE F,LDONF ;IF LINE DONE JUST EXIT + POPJ P, + PUSH P,A ;SAVE POINTERS + PUSH P,B ;NO GARBAGE COLLECTION POSSIBLE + PUSHJ P,PWORD ;PRINT WORD + POP P,B + POP P,L +TEDITA: CAMN A,L ;HAVE WE CAUGHT UP? + POPJ P, + ILDB C,L ;COPY THE NEXT CHAR INTO THE INPUT STRING + JUMPE C,TEDITB ;IS IT A NULL + IDPB C,B + JRST TEDITA + +TEDITB: TLO F,LDONF ;SET LINE DONE FLAG + POPJ P, ;AND EXIT +TBACK: CAMN B,NEWBOT ;ARE WE AT BEGINNING + JRST TISB ;OFF BEGINNING OF STRING + UNDEX B + JRST 2,@D + +TISO: MOVEI C,134 + PUSHJ P,TYO + +TISN: JSP D,TBACK ;BACK UP ONE CHARACTER + JRST TISB + +TISMA: JSP D,TBACK ;REMOVE ONE MORE CHARACTER + MOVEI C,134 ;TYPE BACKSLASH + PUSHJ P,TYO +TISM: CAMN B,NEWBOT ;IS THERE A PREVIOUS CHAR + JRST TISB ;NO-SO QUIT + LDB C,B ;YES-REMOVE LEADINGS SPACES + CAIN C," " + JRST TISMA +TISMB: CAMN B,NEWBOT ;REMOVE NON-SPACES TIL A SPACE + JRST TISB ;OFF BEGINNING OF LINE SO QUIT + LDB C,B + CAIN C," " + JRST TISB + JSP D,TBACK + MOVEI C,134 ;TYPE A BACKSLASH WHEN CHARACTERS REMOVED + PUSHJ P,TYO + JRST TISMB + +;PRINT WORD +;ENTER WITH BYTE POINTER TO WORK-SPACE IN A +;PRINT WORD AND FOLLOWING SPACE IF EXISTS +;TYO UPDATES CHARNO AND TAKES INPUT IN C + +PWORDH: PUSHJ P,TYO ;JUST THE CR, NO LF +PWORD: MOVEI D,0 ;INITIALIZE COUNT OF PRINTING CHARACTERS + MOVE B,A ;COPY POINTER + TRNE F,PREFIX ;MUST WE PREFIX " OR / TO THIS WORD? + MOVEI D,1 ;YES, COUNT THE EXTRA CHAR +PWORDB: ILDB C,B ;COUNT PRINTING CHARACTERS + CAIE C,002 ;CONTROL-B IS A SPACING CHARACTER + CAILE C," " + AOJA D,PWORDB + CAIE C,015 ;STOP IF CR + CAIN C," " ;OR END OF WORD + JRST PWORDA + JUMPN C,PWORDB ;CONTINUE ON NOT NULL + TRNE F,SUFFIX ;MUST WE SUFFIX " OR / TO END OF THIS STRING? + MOVEI D,1(D) ;YES, COUNT THE EXTRA CHAR AT END +PWORDA: TLNE F,SAVEF ;WHEN SAVING + JRST PWORDS ;THE WORD ALWAYS FITS ON A LINE + MOVEI C,^D72 + SUBI C,(D) + CAMGE C,BCHAR + JRST PWORDC ;YES + CAMGE C,CHARNO ;COUNT+CHARNO .GTR. 72.? + PUSHJ P,LINE ;YES-CRLF AND SPACE TO BCHAR +PWORDS: MOVEI C,(E) ;PUT PREFIX IN C + TRZE F,PREFIX ;SHOULD WE TYPE A PREFIX? +PWORDE: PUSHJ P,TYO ;YES + ILDB C,A ;OTHERWISE PRINT WORD + CAME A,B ;HAVE WE CAUGHT UP + JRST PWORDE ;NO + +PWORDF: LDB C,A ;WHAT WAS THE TERMINATING CHARACTER + JUMPE C,PWORDX + CAIN C,015 + JRST PWORDH ;CR- HANDLE REST OF WORD JUST LIKE WORD + CAIN C," " + JRST PWORDD ;SPACE + PUSHJ P,LINE ;OTHER-MEANS WE ARE AT END OF LINE BUT NOT OWRD + JRST PWORD ;AND GO PROCESS REST AS WORD + +PWORDX: MOVEI C,(E) ;AT EOM + TRZE F,SUFFIX ;MUST WE AFFIX A SUFFIX? + PUSHJ P,TYO ;YES, TYPE IT + POPJ P, + +PWORDC: MOVE D,BCHAR ;IF BCHAR .NE. CHARNO CRLF AND SPACE + CAMLE D,CHARNO + PUSHJ P,LINE + MOVEI C,(E) + TRZE F,PREFIX + PUSHJ P,TYO +PWORDG: MOVEI C,110 ;PRINT TILL CHARNO=72. + CAMN C,CHARNO + JRST PWORDF + ILDB C,A + PUSHJ P,TYO + JRST PWORDG + +PWORDD: MOVEI C,110 ;TYPE SPACE IF CHARNO .NE. 72. + CAMN C,CHARNO ;TYPE CRLF AND SPACES IF CHARNO=72. + JRST LINE + MOVEI C," " + JRST TYO + + +PTYO: MOVEI C,^D72 + CAMN C,CHARNO + PUSHJ P,LINE + MOVEI C,(B) + JRST TYO + +PSPACE: PUSH P,B + MOVEI B," " + PUSHJ P,PTYO + POP P,B + POPJ P, + +PTAB: HRRZ B,CHARNO + IDIVI B,11 ;TAB STOPS ARE NINE APART + SUBI C,11 + MOVE B,C + PUSHJ P,PSPACE + AOJL B,.-1 + POPJ P, + +LINE: + SETZM CHARNO + TLNE F,SAVEF + PJRST PSPACE + PUSHJ P,CRLF ;TYPE CRLF AND SPACES USING C +INDENT: MOVE C,BCHAR + CAMN C,CHARNO + POPJ P, + CAMG C,CHARNO + JRST INDENT-1 ;BCHAR .LT. CHARNO + MOVEI C," " + PUSHJ P,TYO + JRST INDENT + +CRLF: TLNN F,SAVEF + SETZM CHARNO + MOVEI C,015 + PUSHJ P,TYO + MOVEI C,012 + JRST TYO + +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, + +FOR TENEX,< +XBOUT: PUSH P,A + EXCH B,C + MOVEI A,101 + BOUT + EXCH B,C + POP P,A + POPJ P, + +XBIN: PUSH P,A + MOVE C,B + MOVEI A,100 + BIN + EXCH C,B + POP P,A + POPJ P, > + +FOR TENEX,< +ASK: POP S,L + PUSHJ P,DNM + ERROR ZERERR + ERROR . ; TOO LONG A TIME TO WAIT + MOVEI C,"*" + SKIPN CHARNO ;AT LEFT MARGIN? + PUSHJ P,TYO ;YES + + MOVE A,[XWD 15,1] + ATI ;CR TO CH1 FOR ASK + MOVE A,[XWD 33,2] + ATI ;ALT MODE TO CH 2 FOR ASK + MOVE A,[XWD 34,3] + ATI ;RUBOUT TO CH 3 FOR ASK + MOVEI A,100 + RFMOD + ANDCMI B,6000 + IORI B,2000 ;CHANGE ECHO MODE TO IMMEDIATE + SFMOD + HRLZI A,400000 + HRLZI B,340000 + AIC ;ACTIVATE INTERRUPT CHANNELS FOR CR,ALTMODE, AND RUBOUT + MOVEI A,^D1000 + IMULI A,(M) + DISMS ;IN MILLISECONDS + MOVEI A,100 + CFIBF ;INCOMPLETE, FLUSH ALL OF IT + +ASK1: MOVEI A,15 ;CR + DTI ;DEASSIGN TERMINAL INTERRUPT + MOVEI A,33 ;EOM + DTI + MOVEI A,34 ;RUBOUT + DTI + HRLZI A,400000 + HRLZI B,340000 + DIC ;DEACTIVATE ASK CHANNELS + MOVEI A,100 ;TERMINAL JFN + RFMOD + XORI B,6000 + SFMOD + MOVEI B,37 + STI ;EOM FOR TIS + MOVEI B,[EXP 0] + PUSHJ P,TIS + ERROR IOPERR + POPJ P, + +ASKEOL: MOVEI A,ASK1 + MOVEM A,LEVLTB+2 + DEBRK + +ASKRUB: MOVEI A,100 + CFIBF + MOVEI B,[BYTE (7) 15,177,43,0] + PUSHJ P,TOSS + PUSHJ P,CRLF + MOVEI C,"*" + PUSHJ P,TYO + DEBRK > ;CONTINUE WAITING + +TYO: +FOR NRCTUR,< +NOTFOR PLSTUR,< + TRZN F,GRAPHF ;IS TERMINAL IN GRAPHICS MODE? +> +FOR PLSTUR,< + TRNN F,GRAPHF ;is terminal in GRAPHICS MODE? +> + JRST TYO0 ;NO - PROCEED TO TYPE OUT CHARACTER + PUSH P,C ;YES, SAVE CHARACTER +FOR PLSTUR,<î + MOVEI C,CNTRLB ;RESET CURSOR TO LOWER LEFT + PUSHJ P,TYO0 ;OF THE PLASMA SCREEN + MOVEI C,PCHAR ; + PUSHJ P,TYO0 + MOVEI C,HIXOFS + PUSHJ P,TYO0 + MOVEI C,LOXOFS + PUSHJ P,TYO0 + MOVEI C,HIYOFS + PUSHJ P,TYO0 + MOVEI C,LOYOFS + PUSHJ P,TYO0 + TRZ F,GRAPHF ;TURN OFF GRAPHICS FLAG +> + MOVEI C,GRFOFF ;AND TURN OFF GRAPHICS MODE + PUSHJ P,TYO0 + POP P,C ;RESTORE ORIGINAL CHARACTER + SETZM CHARNO ;RESET HORIZONTAL POSITION (SAFEST THING TO DO) +> +TYO0: TLNE F,NOBREAK + JRST .+3 + TLZE F,BREAKF + ERROR BREAK + TLNE F,SAVEF ;GOING TO A FILE? + JRST TYO2 ;YES, LET TAB AND ^B THROUGH UNTRANSLATED + CAIE C,11 ;IS IT TAB + JRST TYO1 ;NO + PUSH P,B + PUSHJ P,PTAB + POP P,B + POPJ P, + +NOTFOR PLSTUR,< +TYO1: TLNE F,TOF ; # GET CONVERTED ONLY ON PRINT OR TYPE + CAIE C,"#" ;MULTIPLE SPACE CHAR + CAIN C,002 +TYOSPC: MOVEI C,40 ;SUBSTITUTE SPACE FOR CONTROL-B +> +FOR PLSTUR,< +TYO1: TLNN F,TOF ; # GETS CONVERTED ONLY ON PRINT OR TYPE + JRST TYO1A ; + CAIN C,"#" ;A # ? + JRST TYOSPC ;YES, INSERT A BLANK +TYO1A: CAIE C,CNTRLB ;A CONTROL-B?? + JRST TYO2 ;NO + TRNN F,GRAPHF ;YES, IS THE GRAPHICS MODE ON? +TYOSPC: MOVEI C,40 ;NO, SUBSTITUTE BLANK FOR ^B OR # +> +TYO2: TLNN F,TOF + JRST .+3 + CAIN C,015 ;IS THE CHAR CR + XCT CHOUT ;YES, TYPE TWICE, NOT THE BEST WAY TO GET TIMING ON CR ALONE + XCT CHOUT + CAIN C,177 + JRST .+3 ;RUBOUTS DON'T COUNT + CAIL C," " ;IS IT A PRINTING CHARACTER + AOS CHARNO + CAIN C,015 ;CR-CLEAR CHARNO + SETZM CHARNO + POPJ P, + +TYI: TLO F,TIF ;SET TYPEIN FLAG + TLNE F,NOBREAK + JRST .+3 + TLZE F,BREAKF + ERROR BREAK + XCT CHIN ;GET A CHARACTER + TLZ F,TIF + POPJ P, + +PTOSSM: HRLI A,440700 ;FOR MACHINE STRINGS + JRST PTOS +PTOSS: HRLI A,(POINT 7,(W),34) ;FOR GENERATED STRINGS +PTOS: PUSHJ P,PWORD + LDB C,A + JUMPN C,.-2 + POPJ P, + +TOSW: HRLI B,(POINT 7,(W),34) + JRST TOS +TOSS: HRLI B,440700 +TOS: ILDB C,B ;BYTE POINTER IN B USE C + JUMPE C,CPOPJ + PUSHJ P,TYO + JRST TOS + +NUMBRQ: TLNE A,EMPTYF ;IS IT EMPTY? + JRST CPOPJ ;YES + TRZ F,TF + HRLI A,(POINT 7,(W),34) + + ILDB C,A + JUMPE C,CPOPJ ;EMPTY + CAIE C,"+" + CAIN C,"-" +NMBRQ1: ILDB C,A + JUMPE C,NMBRQ2 + 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,@WSA + ADDI A,1 + CAIE B,1 ;IS LENGTH OF TEXT 1? + JRST PREDQ1 ;NO, CANNOT BE "TRUE" + MOVE B,@WSA ;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,@WSA + ADDI A,1 + CAMN B,[ASCII /FALSE/] + SKIPE @WSA ;NEXT WORD MUST BE 0 TERMINATOR FOR "FALSE" + POPJ P, ;R1, IS NOT "FALSE" + JRST CPOPJ1 ;R2 + + +NUMRQS: MOVE A,(S) ;NUMBERS? + PUSHJ P,NUMBRQ + ERROR SUMERR + MOVE A,-1(S) + PUSHJ P,NUMBRQ + ERROR SUMERR + POPJ P, + + +DNMO: MOVEI R,10 + JRST DNM0 +DNM: HRLI L,(POINT 7,(W),34) ;ALL CALLS USE A COMPLETE STRING + MOVEI R,12 +DNM0: MOVEI M,0 + TRZ F,NNUMF + JFCL 17,.+1 + TRNN F,PMF ;ARE + AND - PERMITTED IN THE STRING? + JRST DNM1 ; NO + ILDB C,L + CAIN C,"-" + JRST DNM1 + TRZ F,PMF + CAIN C,"+" +DNM1: ILDB C,L + CAIL C,"0" + CAILE C,"0"-1(R) + JRST DNM2 + TRO F,NNUMF + IMULI M,(R) + ADDI M,-60(C) + JRST DNM1 +DNM2: TRNN F,NNUMF + POPJ P, + TRZE F,PMF + MOVNS M + AOS (P) + JOV CPOPJ + JRST CPOPJ1 + +DECPRT: SKIPA R,[EXP 12] +OCTPRT: MOVEI R,10 +ANYPRT: IDIV A,R + HRLM B,(P) + SKIPE A + PUSHJ P,ANYPRT + HLRZ C,(P) + ADDI C,"0" + JRST TYO + +SNM: PUSHJ P,NEWSTR +SNM0: SETZM SRCBOT +SNMA: IDIVI M,12 + HRLM N,(P) + SKIPE M + PUSHJ P,SNMA + HLRZ C,(P) + ADDI C,"0" + IDPB C,B + POPJ P, + +COPYAB: ILDB C,A + IDPB C,B + JUMPN C,.-2 + POPJ P, + +SWITCH: MOVE A,(S) + EXCH A,-1(S) + MOVEM A,(S) + POPJ P, + + +;MAKE AN ARBITRARY SIZED WORKSPACE ELEMENT +; ENTER WITH LENGTH IN A +; RETURN WITH PTR TO LENGTH WORD IN B + +MAKELM: PUSHJ P,NEWSTR ; GENERATING A STRING + SETZM SRCBOT ; WITH NO SOURCE +TRPAD1: MOVEM A,@B ; SET UP LENGTH WORD + ADD B,A ; POINT B AT LAST DATA WORD +TRPAD2: MOVEM @B ; REFERENCE IT TO CAUSE ILL MEM REF + SETZM @B ; NOW MAKE IT ZERO + MOVEM B,WTOP ; GET HERE AFTER GC AND EXPAND WS + SUB B,A ; PROMISED THAT B POINT AT FIRST + POPJ P, + + +;COPY CONTENTS OF AN ELEMENT TO A NEW AND LARGER ONE +; ENTER WITH LENGTH INCREMENT IN A +; AND PTR TO OLD ELEMENT IN B +;RETURN PTR TO NEW ELEMENT IN B +; AND PTR TO OLD END IN NEW ELEMENT IN A + +COPYUP: PUSH S,B ; SAVE OLD GUY + ADD A,@WSB ; NEW LENGTH + PUSHJ P,MAKELM ; MAKE IT + POP S,A + HRLZI C,@WSA ; FROM + HRRI C,@WSB ; TO + AOBJN C,.+1 ; BUT SKIP THE WORD COUNT + MOVE A,@WSA ; OLD LENGTH + ADD A,B ; NEW BASE + BLT C,@WSA ; ENDING AT END OF OLD DATA + 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 + JRST APOPJ ;YES EXIT FROM CALLING ROUTINE + TLNE A,WORDF + AOS 0(P) ;SKIP JUMP TO SENT IF A WORD + HRLI A,(POINT 7,(W),34) ;IN ANY CASE, MAKE A STRING PTR + MOVEM A,SRCBOT +NEWSTR: HRRZ B,WTOP + ADD B,[POINT 7,1(W),34] ;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,(POINT 7,(W),34) + MOVEM A,SRCBOT + POPJ P, + + +GNE: AOS A,CPP ;GET NEXT NON-COMMENT ELEMENT + MOVE A,@WSA + 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 + MOVEM B,WTOP + SUB B,NEWBOT + HRRZM B,@NEWBOT + HRLZI B,WORDF + HRR B,NEWBOT + TRZE F,NWF + TLC B,WORDF!SENTF + PUSH S,B + POPJ P, + SUBTTL GARBAGE COLLECTOR AND STORAGE ALLOCATION ROUTINES + +;THE NEXT SECTION (10-11 PAGES) CONTAINS STORAGE ALLOCATION +;AND GARBAGE COLLECTION ROUTINES FOR THE VARIOUS SPACES + +;MOVE A PROCEDURE TO THE END OF THE PROCEDURE SPACE + +MOVEPR: SETOM NXLINE ;POINTER INTO PS NO LONGER VALID + HRRZ D,@RPA ; A CONTAINS A PRODNM + MOVEI B,(D) ;B AND D HAVE REL PTR TO BEGINNING OF DIRECTORY + + MOVEI D,2(D) ;TWO WORDS PER LINE IN PROCEDURE DIRECTORY + SKIPE @PSD ;LINE NO=0? + JRST .-2 ;NO, NEXT LINE + + MOVEI D,1(D) + HRRZ C,PTOP + CAIL D,(C) + POPJ P, ;ALREADY THE LAST ONE IN THE SPACE + + SUBI D,(B) ;D IS NOW THE LENGTH OF THE PROCEDURE + ADDI C,@PSD + CAML C,PS+1 + EXPAND D,PS + + HRRZ E,PTOP + HRRM E,@RPA + HRLI E,(B) + MOVE C,PS + HRLI C,(C) + ADDB E,C + MOVE G,E + HRLI D,(D) + ADD G,D + BLT C,-1(G) + HLR G,E + BLT G,-1(E) + + MOVEI A,0 ;SEARCH RP FOR ALL THAT POINT AFTER MOVED DIR. + MOVNI D,(D) +MPRL: SKIPN @RPA + POPJ P, ;DONE + MOVEI A,1(A) + HRRZ C,@RPA + CAIN C,-1 ;IS THIS ONE DEFINED? + AOJA A,MPRL ;NO, DON'T OFFSET IT + CAIL C,(B) ;B CONTAINS PTR TO OLD BEG OF MOVED PROC + ADDM D,@RPA ;OFFSET IT BY AMOUNT MOVED DOWN + AOJA A,MPRL + ;GARBAGE COLLECTOR PASS ONE +;SEARCH ALL LISTS AND THINGS, REPLACING START OF ALL GOOD STRINGS + +GARCOL: MOVE S,UUOACS+S + SETZM 1(S) ;ALWAYS ROOM FOR ONE ZERO AFTER S LIST, BECAUSE + ; CS ALWAYS STARTS AT ONE + TLZ F,GCF ;INDICATE THAT GC WAS DONE FOR THIS K + MOVEI N,.WTOP-.WBASE ;BOTTOM OF FLUSHABLE STRINGS + + MOVE B,VP + JSP S,GCMARK + MOVN B,DTOP + HRLZI B,(B) + HRR B,DP + ADDI B,1 + ADD B,[XWD 2,2] + JUMPGE B,.+3 + JSP L,MARKNEW + JRST .-3 + + MOVE B,SP + MOVEI B,1(B) ;STACKS SKIP THE FIRST CELL + JSP S,GCMARK + MOVE B,UA + JSP S,GCMARK ;USER ABBREVIATIONS ALSO + + HRLZI A,GCSTAB-GCSTOP ;A TABLE OF PAIRS, LIKE LINBOT,UUOACS+L +GARC01: MOVE C,GCSTAB(A) + HLRZ B,C + SKIPE B ;IF ZERO, SAME AS PREVIOUS + MOVN E,(B) ;LIKE MOVN E,LINBOT + ADDM E,(C) ;LIKE ADDM E,UUOACS+L , TO OFFSET AC + AOBJN A,GARC01 ;BACK FOR THE REST OF THE FUNNIES + + HRLZI A,GCSTAB-GCSTOP +GARC02: HLRZ B,GCSTAB(A) + JUMPE B,GARC03 ;SOMETHING ELSE TO MARK? + SKIPE (B) ;MAYBE, SEE IF NON-ZERO + JSP L,MARKNEW ;YES, MARK IT +GARC03: AOBJN A,GARC02 + + MOVE A,RP ;MARK PROCEDURES +GCMKP1: MOVE B,(A) ;PTR TO PROCEDURE NAME + JUMPE B,GCPSS2 + MOVEI B,(A) + JSP L,MARKNEW ;MARK THE NAME + + MOVEI A,1(A) ; POINT AT PTR TO DIRECTORY + MOVE M,(A) ; POSITION IN PS + CAMN M,[-1] ; IS THE PROCEDURE DEFINED? + AOJA A,GCMKP1 ; NO, NOTHING TO COLLECT + ADD M,PS ; MAKE PTR ABSOLUTE +GCMKP2: MOVEI B,1(M) ; B NOW POINTS TO HEAD OF COMPOUND + JSP L,MARKNEW + MOVEI M,2(M) ; NEXT LINE + SKIPE (M) ; IS IT END OF PROCEDURE? + JRST GCMKP2 + AOJA A,GCMKP1 ; YES, TRY NEXT PROCEDURE + + +GCMARK: SKIPN (B) + JRST (S) + JSP L,MARKNEW + AOJA B,GCMARK + + +;MARK MIXED LISTS +;B CONTAINS PTR TO HEAD +;C=0 IS THE END CONDITION + +MARKNEW: + SETZ C, +MARKN0: MOVE D,(B) ; GET POINTER TO BE CHASED + TLNN D,IMMEDIATE ; IF TRUE, IT IS NOT A POINTER + CAILE N,(D) ; OR ONE OF THE PERMANENT STRINGS + JRST MARKN1 ; DO PREVIOUS ONE IN THIS LIST + + ADDI D,(W) ; MAKE RELATIVE PTR ABSOLUTE + HLRZ E,(D) ; GET HEAD OF BACKCHAIN + HRLM B,(D) ; AND MAKE BACKCHAIN POINT AT THIS PTR + TLNE D,COMPOUND ; IS IT ALSO A MIXED LIST? + JUMPE E,MARKN2 ; AND NOT PREVIOUSLY CHASED + HRRM E,(B) ; NO TO EITHER, JUST FINISH BACKCHAIN + +MARKN1: JUMPE C,(L) ; END OF TOP LEVEL? + SUBI B,1 ; NO, DO PREVIOUS ONE ON THIS LEVEL + SOJG C,MARKN0 ; IF NOT DONE WITH THIS LEVEL + + HLRZ C,(B) ; GET HEAD OF BACKCHAIN,TAIL AT PREV LEV + MOVE B,C + MOVE C,(B) ; FETCH POSSIBLE COUNT + TLZN C,IMMEDIATE ; IS IT END OF BACKCHAIN? + JRST .-3 ; NO, TRACE CHAIN SOME MORE + + HLLZM C,(B) ; COMPLETE BACKCHAIN FOR PASS TWO + MOVEI C,(C) ; MAKE IT 0,,COUNT + JRST MARKN1 ; AND GO BACK FOR MORE ON POPPED LEVEL + +MARKN2: HLL C,D ; PUSH DOWN A LEVEL AND CHASE IT + TLO C,IMMEDIATE ; SO THE POP CAN BE UNAMBIGUOUS + MOVEM C,(B) ; THAT'S WHERE THE COUNT IS STORED + MOVE B,D ; POINT TO HEADER WORD NEXT LEVEL DOWN + HRRZ C,(B) ; GET THE COUNT FOR THIS LEV + ADD B,C ; START CHASING AT BACK END OF OBJ + JRST MARKN0 ; AND START OVER + +;GARBAGE COLLECTOR PASS TWO + +GCPSS2: MOVEI R,GCPS2R ; PASS TWO SUBR TO CHASE BACKCHAINS + JSP L,GCPS2S + MOVEI R,GCPS3R ; PASS THREE SUBR TO COMPRESS + JSP L,GCPS2S +GCPS2C: SUBI E,@WSB ;MAKE E THE AMOUNT COLLECTED + MOVNI G,(E) ;USE G TO OFFSET WTOP,ETC + HRRM B,NEWBOT ;B IS THE RELATIVE DEST FOR THE STRING + ADDM G,UUOACS+B + ADDM G,WTOP + + HRRZ D,JOBREL + SUBI D,(E) + HRLI B,(A) + ADDI B,(W) + CAMG A,JOBREL ;DON'T GET CAUGHT WITH ILL MEM REF + BLT B,(D) + +GCPS2D: MOVE A,JOBREL + SUBI A,@UUOACS+B +FOR TENEX,< CAMG A,INCREMENT > +FOR TEN50,< CAIG A,2000 > + JRST GCPSS3 + MOVEI A,@UUOACS+B +FOR TEN50,< CORE A, + HALT> +FOR TENEX,< JSP E,SETMEM> + +GCPSS3: MOVEI D,2(D) + CAMLE D,JOBREL + JRST GCPS3B ;AVOID DOING BLT ON FULL ALLOCATION + SETZM -1(D) + HRLI D,-1(D) + BLT D,@JOBREL + +GCPS3B: HRLZI A,GCSTAB-GCSTOP ;UNDO THE CRAZIES +GCPS3C: MOVE C,GCSTAB(A) + HLRZ B,C + SKIPE B + MOVE G,(B) + ADDM G,(C) + AOBJN A,GCPS3C + JRST (P) + + +GCPS2S: HRRZ E,NEWBOT + HRRZ B,WTOP + CAIG E,(B) + MOVEI E,1(B) ;WTOP .GTR. NEWBOT, I.E. NO STRING IN PROGRESS + ADDI E,(W) ;FOR END TEST, QUIT BEFORE NEW STRING + MOVEI A,.WTOP-.WBASE(W) ;SOURCE IS ABSOLUTE + MOVEI B,.WTOP-.WBASE ;DESTINATION IS RELATIVE +GCPS2A: CAIL A,(E) ;IS THE NEXT STRING THE UNFINISHED ONE? + JRST GCPS2E ;YES, ALMOST DONE WITH THIS PASS +GCPS2F: MOVE C,(A) ;GET THE LENGTH WORD + TLNE C,-1 ;DOES IT HAVE A BACK CHAIN POINTER, IE MARKED? + JSP S,(R) ; YES, CHASE OR COMPRESS +GCPS2B: ADDI A,1(C) ;NEXT SOURCE + JRST GCPS2A + +GCPS2E: CAIN A,(E) ;IS THIS THE UNFINISHED STRING? + CAMLE A,JOBREL ;IF SO ARE WE STILL WITHIN THE BOUNDS OF CORE? + JRST (L) ;NO WE'RE ALREADY DONE + CAIE R,GCPS3R ;SKIP IF THIRD PASS + JRST GCPS2F ;SECOND PASS DO BACKCHAIN STUFF IF RELEVANT + HRRZS (A) ;ON THIRD PASS CLEAR BACKCHAIN POINTER + JRST (L) + +GCPS2R: HLRZ D,C ;TRACE THE BACK CHAIN + HRRZ G,(D) + HRRM B,(D) ;REPLACE BACK CHAIN POINTER WITH NEW RELATIVE POINTER + MOVEI D,(G) ;PUT THE NEW BACK PTR IN D + JUMPN D,.-3 ;THE CHAIN CONTINUES + ADDI B,1(C) ; AND POINT TO NEXT OBJ + JRST (S) + +GCPS3R: HRRZM C,(A) ;CLEAR THE BACK CHAIN POINTER IN LENGTH WORD + HRLZI G,(A) ;BLT SOURCE + HRRI G,@WSB ;BLT DEST, MAKING IT ABSOLUTE + ADDI B,(C) ;DEST+LENGTH=END OF BLT + BLT G,@WSB ;MOVE IT + ADDI B,1 ;MAKE B POINT BEYOND END OF THIS STR, AT BEG OF NEXT + JRST (S) + +GCSTAB: XWD LINBOT,UUOACS+L + XWD SRCBOT,UUOACS+A + XWD CBOT,CPP +FOR TEN50,< + XWD BUFADR,BUFLOC + XWD 0,FPTR + XWD BUFADR+1,BUFLOC+1 + XWD 0,FPTR+1 + XWD BUFAD2,BUFLC2 + XWD 0,FPTR2 +FOR MUSIC,< + XWD MBUFP,MBMAX + XWD 0,MBPOS > +GCSTOP==. + +FOR TEN50,< +TRPPC==JOBTPC +ALLOC: MOVEM A,SAV.A + MOVE A,JOBCNI ; GET REASON FOR TRAP + TRNE A,20000 ;WAS IT AN ILL MEM REF? + JRST ALOCWS ;YES, WORKSPACE SPACE NEEDED + MOVE A,SAV.A > + +ALLOCP: JUMPG S,ALOCSP ;PDL TRAP, WAS IT ARG STACK? + JUMPL P,[ERROR .] + EXPAND PP ;NO, CONTRO STACK + HRL P,ALOCTB+.PP + TLC P,-1 + ADD P,[XWD 1,0] ;MAKE IT TWO'S COMPLEMENT + JRST ALOCAL + +ALOCSP: EXPAND SP + HRL S,ALOCTB+.SP + TLC S,-1 + ADD S,[XWD 1,0] + JRST ALOCAL + +ALOCWS: +FOR TENEX, + + MOVE A,TRPPC + TLNE A,20000 ; IS BYTE INTERRUPT ON? + JRST [ HRRZM A,SAVEIT ;SAVE ADDRESS OF BYTE INSTRUCTION + HLLZ A,(A) ;MAKE SURE IT'S A DPB OR IDPB INSTRUCTION + TLZ A,1777 ; + CAME A,[IDPB 0,0] ; + ERROR ILLTRP ;IF NOT ERROR, "IMAT" + HRRZI A,@NEWBOT ;MUST BE IN PROCESS OF CREATING + CAIG A,@WTOP ;NEW STRING (I.E. NEWBOT .GT. WTOP) + ERROR ILLTRP ;IF NOT ERROR, "IMAT" + MOVE A,@SAVEIT ;ALSO MUST HAVE BEEN ACCESSING THE + MOVE A,@A ; + MOVEI A,@A ; + SOS A ;WORD ABOVE JOBREL OR TW0 ABOVE JOBREL + SUB A,JOBREL ; + TDNE A,[-2] + ERROR ILLTRP ;IF NOT THEN ERROR, "IMAT" + JRST ALCWS1 ] ; A GOOD TRAP +FOR TENKI,< + MOVE A,TRPPC +> +NOTFOR TENKI,< + SOS A,TRPPC ; PROPER CODE HAS ONLY WRITE TRAPS +> MOVEI A,(A) + CAIE A,TRPAD1 + CAIN A,TRPAD2 + JRST ALCWS1 ; THE ONLY LEGAL PLACES FOR TRAPS + ERROR ILLTRP +ALCWS1: MOVE A,SAV.A + EXPAND WS + +FOR TEN50,< +ALOCAL: MOVEM A,JOBCNI + HRRZI A,220000 + CALLI A,16 ;REENTER TRAPPING MODE + MOVE A,JOBCNI + JRST 2,@JOBTPC > + +FOR TENEX,< +ALOCAL: DEBRK +LEVTAB: EXP LEVLTB,LEVLTB+1,LEVLTB+2 + +EOFEX: SETZ B, ; EOF, RETURN 0 BYTE + DEBRK +DATAEX: ERROR . > + +ALLOCATOR: + LDB C,[POINT 4,JOBUUO,12] ;GET THE AC NUMBER + HRRZ A,JOBUUO ;WHICH SPACE IS IT? + SUBI A,BASETB ;SUBTRACT OFFSET + HRRZ B,ALOCTB(A) ;HOW MUCH SPACE MUST WE ADD NOW? + JUMPE C,.+3 ;SKIP NEXT TWO IF NO AC SPECIFIED + CAMGE B,UUOACS(C) ;IS THE SPECIFIED AMOUNT GREATER THAN THE NORMAK AMOUNT + MOVE B,UUOACS(C) ;REQUESTED AMOUNT GREATER THAN NORMAL + MOVEM B,GCTEM + ADDI B,@WTOP + CAIN A,.WS ;IS THE REQUEST FOR MORE WORK SPACE? + JRST ALLOC0 ;YES + CAMG B,JOBREL ;DOES THE REQUESTED AMOUNT FIT + JRST ALLOC1 ;YES, DON'T ASK FOR MORE + + JSP G,NEWMEM + ERROR PUNT ;NO MORE CORE AVAILABLE, + JRST ALLOC1 ;GOT ONE + +ALLOC0: TLOE F,GCF ;YES, HAVE WE GC'ED THIS 2^N K YET? + JRST ALLC01 ;NO, GO DO IT + JSP G,NEWMEM + ERROR PUNT ;CAN'T GET MORE CORE AND CAN'T SAVE BY GC + JRST UUORET ;RETURN + +ALLC01: JSP P,GARCOL + HRRZ A,JOBUUO + CAIN A,WS ;WAS IT WORKSPACE CALL? + JRST UUORET ;YES, NOW DONE + MOVE C,GCTEM + ADDI C,@WTOP + CAMLE C,JOBREL ;DID THE GC GIVE US ENOUGH ROOM? + ERROR PUNT ;NO + +ALLOC1: HRRZ A,JOBUUO + SUBI A,BASETB ;MAKE A A AN INDEX TO SPACE POINTERS + MOVE B,GCTEM + MOVEI G,(B) + HRLI G,(G) + MOVE H,BASETB+1(A) + HRRZ C,JOBREL + HRRZI D,1(C) + SUBI D,(B) + HRLZI D,(D) + HRRI D,1(C) + JRST ALLOC3 + +ALLOC2: MOVE E,D + BLT E,(C) + SUBI C,(B) +ALLOC3: SUB D,G + CAIGE H,(D) + JRST ALLOC2 + + HRLZI D,(H) + HRRI D,1(H) + SETZM (H) + ADDI H,(B) + BLT D,-1(H) + + MOVEI A,1(A) + JSP D,RPOINT + +UUORET: MOVE 17,[XWD UUOACS+1,1] ;DON'T RESTORE 0 + BLT 17,17 + JRST 2,@UUOTRP + + +RPOINT: HLRZ C,ALOCTB(A) ;POINTER TO LIST OF WORDS TO UPDATE + ADDM B,BASETB(A) ;UPDATE THE BASE IN THE BASE TABLE + JUMPE C,ALLOC5 ;NO SECONDARY BASE POINTERS + MOVE E,(C) ;GET AN ADDRESS OF A SECONDARY BASE PTR + JUMPE E,ALLOC5 ;NO MORE IN THIS LIST + ADDM B,(E) ;UPDATE IT + AOJA C,.-3 +ALLOC5: CAIE A,.WS + AOJA A,RPOINT ;MORE TO DO IN ALOCTB + JRST (D) + +FOR TENEX,< + +INCREMENT: 10000 +BOUND: 200000 + +SETMEM: MOVE 3,INCREMENT + SUBI 3,1 + IOR 3,A + EXCH 3,JOBREL + MOVE 2,3 + ASH 2,-11 ; PAGE NO + HRLI 2,400000 ; THIS FORK + SETO 1, ; TO FLUSH IT + AOJA 2,.+3 + PMAP + SUBI 3,1000 + CAMLE 3,JOBREL + SOJA 2,.-3 + JRST (E) + +NEWMEM: MOVE C,JOBREL + ADDI C,1 + ADD C,INCREMEMT + CAML C,BOUND + JRST (G) ; TOO MUCH + MOVEI 1,400000 ; THIS FORK + MOVEI 2,1B22 ; NON- EX PAGE REF + DIC ; SO WE CAN ADD WITH IMPUNITY + SUBI C,1 + MOVEM C,JOBREL + SUB C,INCREM + SKIP 1(C) + ADDI C,1000 + CAME C,JOBREL + JRST .-3 + AIC ; TURN CHANNEL BACK ON + HRRZ A,JOBUUO + JRST 1(G) > + +FOR TEN50,< + +NEWMEM: MOVE A,JOBREL + ADDI A,1 + MOVEI B,(A) ;FIRST ADDR OF NEW K IN A AND B + CORE A, + JRST (G) ;NONE AVAILABLE, IMMEDIATE R1 + ASH B,-12 ;DECIMAL K + CAIGE B,100 ; GOT TOO MUCH? + JRST 1(G) ;NO, OK + HRRZ A,THISPR + CAIN A,SAVEL+1 ;ARE WE DOING A SAVE? + JRST 1(G) ;YES, OK TO USE LAST K + MOVE A,JOBREL + SUBI A,2000 + CORE A, + ERROR IOPERR + JRST (G) > ;MUST RESERVE LAST K FOR PANIC SAVE + +SHORTN: HRRZ B,ALOCTB(G) ;SHORTEN THIS SPACE IF IT NEEDS IT + ADDI A,(B) + CAML A,BASETB+1(G) ;MORE THAN MINIMUM ALLOC LEFT OVER? + JRST (L) ;NO + HRL A,BASETB+1(G) + HLRZ B,A ;EVEN IF A CHANGES + SUBI B,(A) ;THE TWO HALVES REMAIN RELATIVELY CONSTANT + MOVNI B,(B) ;B MUST BE NEGATIVE FOR RPOINT + ADD W,B + BLT A,@WTOP + MOVEI A,1(G) + JSP D,RPOINT + MOVE W,UUOACS+W + JRST (L) + ;COMPRESS ALL AREAS TO BE AT MOST CURRENTLY USED PLUS INITIAL ALLOCATION + +CMPRSS: HRLZI G,-3 ;THREE PAIR TABLES +CMPRS1: SKIPA A,BASETB(G) ;FETCH THE BASE OF THE TABLE + ADDI A,2 ;ADVANCE TO PAIR IF ANY + SKIPE (A) ;ANY MORE PAIRS? + JRST .-2 ;YES + JSP L,SHORTN + AOBJN G,CMPRS1 ;OTHER PAIR TABLES + + HRLI G,-2 ;TWO TABLES WITH TOP POINTERS + ;RH OF G NOW POINTS TO PS +CMPRS2: HRRZ A,PTOP-.PS(G) ;PTOP FIRST IN ORDER + ADD A,PS-.PS(G) ;TOPS ARE RELATIVE, MAKE ABSOLUTE + JSP L,SHORTN + AOBJN G,CMPRS2 ;OTHER TOP TABLE + + HRLI G,-2 ;TWO PDP'S + ;RH OF G NOW POINTS TO SP +CMPRS3: HRRZ A,UUOACS+S-.SP(G) ;GET CURRENT TOP OF STACK + ADDI A,1 ;CORRECT TO FIRST FREE WORD + JSP L,SHORTN ;PDP'S ARE ALREADY ABSOLUTE + HRRZ A,UUOACS+S-.SP(G) + ADDI A,1 + SUB A,SP+1-.SP(G) + HRLM A,UUOACS+S-.SP(G) ;FIX PDL END TEST + AOBJN G,CMPRS3 ;OTHER PDP + + HRRZ A,JOBREL + SUBI A,@WTOP ;DIFFERENCE BETWEEN LAST STRING AND TOP OF CORE +FOR TENEX,< CAMG A,INCREMENT > ; IS IT MORE THAN ALLOC AMT +FOR TEN50,< CAIG A,2000 > + JRST CMPRS4 ;NO, DON'T CONTRACT + MOVEI A,@WTOP +FOR TEN50,< + CORE A, ;GIVE UP WHAT WE DON'T NEED ANYMORE + JRST ILLUUO > ;BIG TROUBLE +FOR TENEX,< JSP E,SETMEM> + +CMPRS4: MOVEI A,@WTOP + HRLI A,(A) + SETZM (A) + ADDI A,1 + MOVE B,JOBREL + CAILE B,(A) + BLT A,(B) + JRST UUORET ;HAVE NOW TO FIT IN CORE + ;STUFF TO BE COPIED TO UNSHARED CORE AT START OF RUN + +DEFINE TT (A1,A2,A3) +, +IFNB ,> +ALOCTB: TABLES + +DEFINE MM (A1,A2) + + +SPFRST: Z + JRST DOUUO + POINTR ;ALL THE LH'S OF THE INDEXED POINTERS + EXP 0,2 ;PTOP,DTOP, IN THAT ORDER! + XWD W,.WTOP-.WBASE-1 + XWD 525252,123457 ;AN INITIAL RANDOM BITS, FIX LATER + ;SO THE STARTING POINT IS ALSO RANDOM +FOR TENEX,< Z ;BITS FOR JFNTAB + XWD 377777,377777 ;NO INPUT OR OUTPUT FILE FOR STRING + Z ;DEFAULT DEVICE IS DSK + Z + Z + [ASCIZ /LGO/] ;EXTENSION + Z + Z + XWD 1,BREAKY ;CH 0, PRIORITY ABOVE ALL OTHERS + XWD 3,ASKEOL ;CH 1 CR FOR ASK + XWD 3,ASKEOL ;CH 2 ALT-MODE FOR ASK + XWD 3,ASKRUB ;CH 3 RUBOUT FOR ASK + REPEAT 5, ;CH 4-8 UNUSED + XWD 2,ALLOCP ;CH 9, PDL TRAP + XWD 2,EOFEX ;CH 10 + XWD 2,DATAEX ;CH 11 + REPEAT ^D10, ;CH 12-21 UNUSED + XWD 2,ALOCWS ;CH 22 REF TO NON-EXISTANT PAGE +> +TERMIO: +FOR TENEX, +FOR TEN50, +SPLLEN==.-SPFRST + + + +DEFINE ELM1 (NAME,VAL) +< +NAME==.-.WBASE +EXP 1,VAL +> + +.WBASE=. +ELM1 EMPTYV,0 +ELM1 TRUEV,ASCIZ /TRUE/ +FALSEV==.-.WBASE +EXP 2 +ASCIZ /FALSE/ +ELM1 LINEFV,012B6 +ELM1 CARETV,015B6 +ELM1 FORMFV,014B6 +ELM1 BLANKV,002B6 +ELM1 BELLV,007B6 +ELM1 QUOTEV,042B6 +ELM1 SKIPV, +.WTOP==. + SUBTTL TABLES OF MACHINE-DEFINED VARIABLES AND PROCEDURES + +DEFINE MVM (A,B,C) +, + IFB ,> + + +;MACHINE DEFINED VARIABLE NAMES + +MV: +MVM EMPTY,EMPTYV,WORDF!SENTF!EMPTYF +MVM LINE FEED,LINEFV +MVM CARRIAGE RETURN,CARETV +MVM FORM FEED,FORMFV +MVM BLANK,BLANKV +MVM BELL,BELLV +MVM QUOTE,QUOTEV +MVM SKIP,SKIPV +MVM CONTENTS,CCONTE,COMPUT +0 + +PREPRC==2 ;PREFIX PRECEDENCE +STRINF==40000 + + +;MACHINE DEFINED PROCEDURES + +DEFINE MPM (NAME,GOTO,NARG,BITS) +< XWD NARG-1,[ASCIZ \NAME\] + IFB , + IFNB ,> + +;DEFAULT PRECEDENCE IN LH OF FIRST WORD IS 2 +;INTERPRETATION OF ALLOWED FORM FOR INPUTS IS AS FOLLOWS: +; STRINF=1 => STRING ONLY + + + +DEFINE PAIR (A,B) + + +DEFINE LETTAB (LET) +> + +MNPT: +LETTAB ABCDEFGHIJKLMNOPQRSTUVWXYZ + +;THE ENTRIES IN THIS TABLE NEED NOT BE IN ORDER OF DECREASING +;PROBABILITY OF OCCURANCE BECAUSE IT IS SEARCHED ONLY AT COMPILE +;TIME. AT EXECUTE TIME THE ENTRIES ARE REFERENCED ONLY BY NUMBER. +;THE ABOVE STATEMENT IS FALSE + +CMPT: +MNTA: MPM ABBREVIATE,ABBREVIATE,0 +ABREVL: MPM ABBREVIATION,SPECWD,0 +ABRVSL: MPM ABBREVIATIONS,SPECWD,0 +ALLL: MPM ALL,SPECWD,0 +ANDL: MPM AND,SPECWD,0 +ASL: MPM AS,SPECWD,0 + MPM ASCII,ASCIIX,1 +FOR TENEX,< MPM ASK,ASK,1 > ;DEMAND IN TIME + PAIR ABB,ABBREVIATION + PAIR ABBS,ABBREVIATIONS + PAIR ABT,ABBREVIATE + 0 +; +; SPECIAL ASCII FUNCTION CALL +; +MNTB: +FOR TURTLE,< MPM BACK,BACK,0 > +FOR MOCKTURTLE!NRCTUR, + MPM BELL,BELL,0 + MPM BOTH,BOTH,2 + MPM BUTFIRST,BUTFIRST,1 + MPM BUTFSEG,BUTFSEG,2 ;ADDED AT NRC (RAO -- 21 MAR 75) + MPM BUTLAST,BUTLAST,1 + PAIR B,BOTH + PAIR BF,BUTFIRST + PAIR BL,BUTLAST + 0 +MNTC: +FOR SAVBRK,< MPM CANCEL,CANCEL,0 > + MPM CLOCK,CLOCK,0 +CONTNL: MPM CONTENTS,SPECWD,0 + MPM COPY,COPY,1; ;OTHER INPUTS ARE NOEVAL + MPM COUNT,COUNT,1 + PAIR C,COUNT + 0 +MNTD: MPM DATE,TODATE,0 + MPM DDT,CALDDT,0 + MPM DIFFERENCE,DIFF,2 + MPM DIVISION,DIVISION,2 + MPM DO,CALLDO,1 + PAIR DIFF,DIFFERENCE + PAIR DIV,DIVISION + 0 + +MNTE: MPM EDIT,EDIT,0 + MPM EITHER,EITHER,1 +ELSEL: MPM ELSE,SCOMEX + MPM EMPTYP,EMPTYP,1 + MPM END,ENND,0 +ENTRYL: MPM ENTRY,SPECWD,0 + MPM EQUALP,EQUALP,2 + MPM ERASE,ERASE,0 + MPM EXIT,EXIT,1 ;THIS COMMAND IS USEFUL INSIDE HOARDED PROCEDURES + PAIR EDL,EDIT LINE + PAIR EDT,EDIT TITLE + EXP [ASCIZ /EE/] + XWD 400000,[ASCIZ /ERASE ENTRY/] ;CAN'T USE PAIR + PAIR EI,EITHER + PAIR EP,EMPTYP + PAIR ER,ERASE + PAIR ERL,ERASE LINE + 0 +MNTF: +FILEL: MPM FILE,SPECWD,0 + MPM FIRST,FIRST,1 + MPM FORMFEED,FORMFEED,0 +FOR NRCTUR,< MPM FORWARD,FORWARD,1 > +FROML: MPM FROM,SPECWD +FOR TURTLE,< MPM FRONT,FRONT,0 > +FOR MOCKTURTLE,< MPM FRONT,FRONT,1 > + MPM FSEG,FSEG,2 ;ADDED AT NRC (RAO -- 21 MAR 75) +FOR NRCTUR,< PAIR FD,FORWARD> + PAIR F,FIRST + 0 +MNTG: MPM GET,GET,0 +FOR SAVBRK,< MPM GO,GO,0 > + MPM GOTOLINE,GOTOLINE,1 + MPM GOODBYE,GOODBYE,0 + MPM GREATERP,GRATRP,2 + PAIR GB,GOODBYE + PAIR GP,GREATERP + PAIR GTL,GOTOLINE + 0 +MNTH: +FOR MOCKTURTLE,< MPM HERE,HERE,0 > +FOR MOCKTURTLE!NRCTUR,< + MPM HOME,HOME,0 > +FOR TURTLE,< MPM HORN,HORN,0 > + 0 +MNTI: MPM IF,IF,1 ;FOR IF THEN ELSE + MPM IFFALSE,IFFALSE,0 + MPM IFTRUE,IFTRUE,0 + MPM IGNORE,IGNORE,1 ;A COMMAND WHICH IGNORES ITS INPUT + MPM IS,IS,2 + MPM ISPROC,ISPROC,1 ;CHECKS TRUTH OF ARG BEING A PROCEDURE + PAIR IFF,IFFALSE + PAIR IFT,IFTRUE +MNTJ: +MNTK: 0 + +MNTL: MPM LAST,LAST,1 +FOR TURTLE,< MPM LEFT,LEFT,0 > +FOR MOCKTURTLE!NRCTUR,< MPM LEFT,LEFT,1 > + MPM LESSP,LESSP,2 +LINELL: MPM LINE,SPECWD,0 + MPM LINEFEED,LINEFEED,0 + MPM LINES,LINES,1 + MPM LIST,LIST,0 + MPM LOCAL,LOCAL,1 + PAIR L,LAST + PAIR LC,LIST CONTENTS + PAIR LE,LIST ENTRY + PAIR LL,LIST LINE + 0 + + +MNTM: MPM MAKE,MAKE,2,200000 ;SPECIAL TO COMPIL + MPM MAXIMUM,MAXIM,2 +FOR MUSIC,< + MPM MBUFCLEAR,MBCLR,0 + MPM MBUFCOUNT,MBCNT,0 + MPM MBUFINIT,MBINIT,0 + MPM MBUFNEXT,MBNXT,1 + MPM MBUFOUT,MBOUT,0 + MPM MBUFPUT,MBPUT,1 + MPM MBUFSTART,MBSTRT,0 +> + MPM MEMBERP,MEMBRP,2 ;ADDED AT NRC----R.A.O. + MPM MINIMUM,MINIM,2 +FOR MOCKTURTLE,< MPM MOVE,MOVE,1 > + PAIR MAX,MAXIMUM + PAIR MIN,MINIMUM + PAIR MP,MEMBERP + 0 +MNTN: +NAMESL: MPM NAMES,SPECWD,0 + MPM NEWMUSIC,NEWMUSIC,0 ;NEW MUSIC BOX + MPM NOT,NOT,1 + MPM NUMBERP,NUMBRP,1 + PAIR NP,NUMBERP + 0 +MNTO: +FOR NRCTUR,< MPM OFFSCREEN,TOFFSC,0 > +OFL: MPM OF,SPECWD,0 + MPM OLDMUSIC,OLDMUSIC,0 ;OLD MUSIC BOX +ORL: MPM OR,SPECWD + MPM OUTPUT,OUTPUT,1 + PAIR OP,OUTPUT + 0 +MNTP: +FOR MOCKTURTLE!NRCTUR,< + MPM PAGE,PAGE,0 + MPM PENUP,PENUP,0 + MPM PENDOWN,PENDN,0 > + MPM PRINT,PRINT,1 +PROCDL: MPM PROCEDURES,SPECWD,0 + MPM PRODUCT,PRODUCT,2 + PAIR P,PRINT + PAIR PC,PRINT :CONTENTS: + PAIR PCC,PRINT COUNT :CONTENTS: + PAIR PROD,PRODUCT + PAIR PRS,PROCEDURES + 0 +MNTQ: MPM QUOTIENT,QUOTIENT,2 + PAIR QUO,QUOTIENT + 0 +MNTR: MPM RANDOM,RANDOM,0 + MPM REMAINDER,REMAINDER,2 + MPM REQUEST,REQUEST,0 + MPM RESETCLOCK,RESETC,0 + MPM RETURN,CRETUN,0 +FOR TURTLE,< RIGHT,RIGHT,0 > +FOR MOCKTURTLE!NRCTUR,< MPM RIGHT,RIGHT,1 > + PAIR REM,REMAINDER + PAIR RQ,REQUEST + 0 + +MNTS: +SAVEL: MPM SAVE,SAVE,0 +SENTCL: MPM SENTENCE,SENTENCE,2 + MPM SENTENCES,SENTCS,0 + MPM SENTENCEP,SENTP,1 +FOR MOCKTURTLE,< + MPM SETHEADING,SETHEADING,1 +> +FOR MUSIC,< +> +FOR MOCKTURTLE,< + MPM SETTURTLE,SETTURTLE,1 + MPM SETX,SETX,1 + MPM SETXY,SETXY,1 + MPM SETY,SETY,1 +> +FOR MUSIC,< MPM SING,SING,2 > + MPM SKIP,SKIP,0 + MPM STOP,ESTOP,0 + MPM SUM,SUM,2 + PAIR S,SENTENCE + PAIR SP,SENTENCEP + PAIR SS,SENTENCES + 0 + + +MNTT: MPM TEST,TEST,1 + MPM TEXT,TEXT,2 +THENL: MPM THEN,SPECWD + MPM THING,THING,1 + MPM TIME,TIME,0 +TITLEL: MPM TITLE,TITLE,0 +TOL: MPM TO,TO,0 +FOR TURTLE,< MPM TOUCHLEFT,TOUCHLEFT,0 + MPM TOUCHRIGHT,TOUCHRIGHT,0 > +TRACEL: MPM TRACE,TRACE,0 +TRACSL: MPM TRACES,SPECWD,0 + MPM TYPE,TYPE,1 + MPM TYPEIN,TYPEIN,1 + PAIR T,TEST +MNTU: 0 + +FOR MUSIC, +NOTFOR MUSIC, +MNTW: MPM WAIT,WAIT,1 +FOR MOCKTURTLE,< MPM WIPE,WIPE,0 > +WORDL: MPM WORD,WORD,2 + MPM WORDP,WORDP,1 + MPM WORDS,WORDS,0 + PAIR W,WORD + PAIR WP,WORDP + PAIR WS,WORDS +MNTX: +MNTY: 0 +MNTZ: MPM ZEROP,ZEROP,1 + PAIR ZP,ZEROP + 0 ;ALL TABLE SEARCHES TERMINATE ON A 0 + + +;PREFIX OPERATORS FOLLOW IN ORDER OF INCREASING PRECEDENCE, +;OPERATOR WITH HIGHEST PRECEDENCE GETS FIRST CRACK AT OPERAND +;NOTE WELL!! THERE IS A TEST IN THE TWOARG ERROR CODE +;WHICH RELIES ON THE FACT THAT THIS ENTIRE TABLE RESIDES ABOVE +;THE PREFIX OPERATOR TABLES TO DISTINGUISH INFIX FROM PREFIX OPS + +RPREN: MPM ),EXCTRP,0,1 ;PARENTHESES ARE NOT INFIX OPERATORS BUT +LPREN: MPM <(>,EXCTLP,0,1 ;ARE INCLUDED HERE FOR CONVENIENCE +IMAKEL: MPM _,MAKE,1,2 +UPRODL: MPM ,UPROD,1,2 ;NO OF ARGS NEEDED IS A LIE +ILTHAN: XWD 1-1,[ASCIZ \<\] + XWD 4,LESSP +IEQUAL: MPM =,EQUALP,1,4 +IGRTR: XWD 1-1,[ASCIZ \>\] + XWD 4,GRATRP +IPLUS: MPM +,SUM,1,6 +IMINUS: MPM -,DIFF,1,6 +ITIMES: MPM *,PRODUCT,1,10 +IQUOT: MPM /,QUOTIENT,1,10 +INFUMN: MPM -,COMPLM,1,12 +INFUPL: MPM +,UNPLUS,1,12 +; MPM ^,POWER,1,14 ;FOR LATER EXPANSION + +;BINARY OPERATORS IN TH TABLE ABOVE ARE INDICATED AS NEEDING ONE FEWER +;ARGUMENTS THAN THEY ACTUALLY DO. THAT IS BECAUSE BY THE TIME +;THAT NUMBER OF ARGS NEEDED IS FETCHED FROM THE TABLE, ONE OF +;THE PROCEDURE'S INPUTS IS ALREADY ACCOUNTED FOR. + SUBTTL LOGO SYSTEM STUFF - LISTING, EDITING, AND ERASING + +LIST: TRZ F,EABBRF!ECONTF!EENTRF!ENAMEF + + PUSH P,[EXP LISTXT] ;SO ALL SUBRS CALLED MAY EXIT WITH POPJ + PUSHJ P,GNE + ERROR WHATER + TLNE A,UPRF ;IS IT A USER PROCEDURE NAME? + JRST LISTPR ;YES, GO LIST IT + TLZN A,MPF + ERROR WHATER + MOVEI A,(A) + CAIN A,ALLL+1 + JRST LALL + CAIN A,CONTNL+1 ;IS IT "CONTENTS"? + JRST LISTCT ;GO LIST CONTENTS + CAIN A,TITLEL+1 ;IS IT "TITLE"? + JRST LISTTL + CAIN A,LINELL+1 ;IS IT "LINE"? + JRST LISTLN + CAIN A,ENTRYL+1 + JRST LISTEN + CAIN A,NAMESL+1 + JRST LSTFNM + CAIN A,ABRVSL+1 + JRST LSTFAB + CAIN A,FILEL+1 + JRST LFILE + ERROR WHATER ;YOU CAN'T LIST THAT. + +LALL: PUSHJ P,GNE + JRST LALLJ + TLZN A,MPF ;IS ARG A MACHINE NAME? + ERROR LSTER2 ;NO, ALL THE REST MUST BE WELL KNOWN NAMES + MOVEI A,(A) + CAIN A,PROCDL+1 ;ALL PROCEDURES? + JRST LISTAP ;YUP + CAIN A,NAMESL+1 ;ALL NAMES? + JRST LISTAN ;YUP + CAIN A,ABRVSL+1 ;ALL ABBREVIATIONS? + JRST LISTAA + ERROR LSTER2 ;LIST ALL WHAT? + +LALLJ: PUSHJ P,LISTAP + PUSHJ P,LISTAN + PUSHJ P,LISTAA + SOS CPP + POPJ P, + + +;LIST CONTENTS AND LIST ALL PROCEDURES + +LISTCT: PUSHJ P,GNE ;IS IT LC FROM AN ENTRY? + JRST LSTCT0 + SOS CPP + TRO F,ECONTF + JRST LISTFL +LSTCT0: MOVEI A,LISTTO + SOSA CPP +LISTAP: MOVEI A,LISTPR + PUSH P,A + PUSHJ P,CRLF + MOVEI A,0 ;FOR LOOP OVER ALL PROCEDURES +LSTCT1: SKIPN @RPA ;END OF PROCEDURE NAME LIST? + JRST APOPJ + MOVEI A,1(A) ;MAKE A LOOK LIKE UPROD COMPILE PTR + MOVNI B,1 + CAMN B,@RPA + AOJA A,LSTCT1 + PUSH P,A ;SAVE IT + PUSHJ P,@-1(P) ;CALL THE RIGHT ROUTINE + JFCL ;DON'T CARE IF IT WASN'T DEFINED + POP P,A ;REMEMBER WHERE WE WERE IN LIST + AOJA A,LSTCT1 ;GO GET NEXT PROD NAME + + +LISTTO: MOVE M,@RPA ;GET POINTER TO PROCEDURE DIRECTORY + CAMN M,[EXP -1] ;IS THIS PROCED DEFINED? + POPJ P, ;NO, R1 EXIT IMMEDIATELY + MOVEI A,-1(A) + AOS 0(P) + MOVE A,@RPA ;IS THS PR TRACED? + TLNN A,TRACEF + JRST LSTLN1 ;NO + TLNE F,SAVEF ;DOING A SAVE? + JRST .+4 + + MOVEI B,[ASCIZ /(TRACED)/] + PUSHJ P,TOSS ;TYPE "(TRACED) " IF IT IS + JRST LSTLN1 + + MOVEI B,[ASCIZ /TRACE /] + PUSHJ P,TOSS ;FOR A SAVE, TYPE "TRACE PRNAME" + MOVEI B,(A) + PUSHJ P,TOSW + PUSHJ P,CRLF + JRST LSTLN1 + + + +LISTTL: MOVE A,TOPROD ;LIST TITLE + JUMPE A,[ERROR NOPERR] ;MUST HAVE A PROCEDURE OPEN + PUSHJ P,LISTTO ;LIST IT + ERROR IOPERR ;BIG TROUBLE + POPJ P, + +;LIST A PROCEDURE + +LISTPR: PUSHJ P,CRLF ;ONE EXTRA IN FRONT + PUSH P,A ;SAVE WHICH PROCEDURE + PUSHJ P,LISTTO ;DO THE "TO" LINE + ERROR EVER3 ;X NEEDS A MEANING + MOVEI M,1(M) + PUSHJ P,LSTPLN ;DO CURRENT LINE + AOJA M,.-1 ;DO NEXT LINE + POP P,A + HRRZI A,(A) + CAMN A,TOPROD ;SHOULD WE TYPE "END"? TESTING RH ONLY + TLNE F,SAVEF + SKIPA + POPJ P, ;NO, PROCEDURE IS STILL OPEN + MOVEI B,[ASCIZ /END/] + PUSHJ P,TOSS + JRST CRLF + + +LISTLN: PUSHJ P,SNMEVL + MOVEI M,(A) ;SRCHLN USES A, LSTPLN USES M + PUSHJ P,LSTPLN + POPJ P, + ERROR IOPERR + + +SNMEVL: SKIPN TOPROD + ERROR NOPERR ;MUST HAVE A PROCEDURE OPEN + PUSHJ P,NUMEVL + MOVE A,TOPROD + JSP C,SRCHL1 ;IS IT A LINE NO OF THE CURRENT PROCEDURE? + CAIE B,(M) + ERROR GOERR3 + POPJ P, + +SAVAA: SKIPA A,[EXP SAVAAR] +LISTAA: MOVEI A,LSTAAR + PUSH P,A ;SAVE NAME OF ROUTINE TO CALL + MOVEI A,2 + MOVEM A,BCHAR + PUSHJ P,CRLF + MOVE G,UA ;POINT AT FIRST ABBREV NAME +LSTAAL: SKIPN A,(G) ;ANY MORE ABBREVIATIONS? + JRST APOPJ ;NO + MOVNI C,1 + CAME C,1(G) ;IS THIS ONE DEFINED? + PUSHJ P,@(P) ;YES, OUTPUT IT + ADDI G,2 + JRST LSTAAL + +LSTAAR: PUSHJ P,PTOSS ;TYPE NAME + MOVEI B,[ASCIZ /=>/] + PUSHJ P,TOSS + PUSHJ P,PTAB + MOVE A,1(G) + PUSHJ P,PTOSS ;TYPE VALUE + PUSHJ P,CRLF ;LINE + POPJ P, + +;LIST ONE LINE OF A PROCEDURE + +LSTPLN: HRRZ A,@PSM ;GET LINE NO, M SET UP BY LISTTO + JUMPE A,CPOPJ1 ;NO MORE LINES, GIVE R2 + PUSHJ P,DECPRT ;TYPE LINE NO., MAX OF 5 CHARS +LSTLN1: MOVEI A,1 ;ENTER HERE FOR LIST TITLE, DON'T TYPE LINE NO + ADD A,CHARNO + MOVEM A,BCHAR + MOVEI M,1(M) ;POINT AT PTR TO COMPILED CODE + HRRZ D,@PSM ;GET PTR TO COMPILED LINE + MOVEI D,1(D) +LSTPLL: MOVE A,@WSD ;GET NEXT ELEMENT OF THE LINE + TLZ A,COMPOUND!IMMEDIATE + JFFO A,.+2 ;WHAT KIND OF ELEMENT? + PJRST CRLF ;EOL, TYPE CR + PUSH P,D ;REMEMBER WHERE WE ARE IN THE LINE + TLNE A,INFOP + JRST LSTIOP ;INFIX OP, MAY WANT TO SUPRESS SURROUNDING SPCS +LSTLL1: SKIPE CHARNO ;SO "TO" WON'T BE " TO" + PUSHJ P,PSPACE ;SPACE BEFORE EACH ELEMENT +LSTLL2: JRST @.-1(B) ;DISPATCH ON TYPE + EXP LSTPMP,LSTPUP,LSTPV,LSTPL,LSTPMP,LSTPMV,LSTPCM + +LSTPMP: MOVE A,-1(A) ;MACHINE PROCEDURE, GET PTR TO NAME + HRLI A,440700 ;MAKE TEXT PTR +LSTPM1: PUSHJ P,PWORD ;TYPE ELEMENT +LSTPM2: POP P,D + AOJA D,LSTPLL ;GO BACK FOR NEXT ELEMENT ON THE LINE + +LSTPUP: MOVEI A,-1(A) ;USER PROCEDURE, POINT AT NAME PTR + MOVE A,@RPA ;GET PTR TO NAME + HRLI A,(POINT 7,(W),34) ;MAKE TEXT PTR + JRST LSTPM1 + +LSTPMV: MOVE A,-1(A) + MOVEI E,":" + TRO F,PREFIX!SUFFIX + PUSHJ P,PTOSSM + JRST LSTPM2 + +LSTPV: MOVEI A,-1(A) ; POINT TO NAME WD, NOT VALUE WD + MOVE A,@VPA ; FETCH THE NAME PTR + SKIPA E,[":"] ;VARIABLE, AFFIX ":" MARKS +LSTPCM: MOVEI E,";" ;COMMENT + TRO F,PREFIX!SUFFIX +LSTPL1: PUSHJ P,PTOSS + JRST LSTPM2 + +LSTPL: PUSH S,A ;LITERAL + PUSHJ P,NUMBRQ ;SEE IF IT IS A NUMBER + TRO F,PREFIX!SUFFIX ;IF NOT, QUOTE IT + POP S,A + MOVEI E,042 + JRST LSTPL1 + +LSTIOP: MOVEI D,1(D) ;CHECK FOLLOWING ELEM FOR LIT OR VAR + JSP E,LSTIOT + MOVEI D,-2(D) ;PRECEDING ONE TOO + JSP E,LSTIOT + JSP H,ETMP ;BOTH PASS, SUPPRESS SPACE BEFORE AND AFTER + AOS D,0(P) + MOVE A,@WSD + TLZ A,COMPOUND!IMMEDIATE + JFFO A,LSTLL2 ;NEVER FALLS THROUGH! +LSTIOT: MOVE C,@WSD + TLNN C,LITF + TLNE C,VARF + JRST (E) ;CANDIDATE FOR SPACE ELIMINATION + JRST LSTLL1 + +;LIST ALL NAMES + +LISTAN: MOVEI A,2 + MOVEM A,BCHAR + PUSHJ P,CRLF + + MOVE A,VP+1 ;DUMMIES FIRST, MAKE COPY OF VP + SUB A,VP ; SO IT CAN BE CLOBBERED WITH BINDINGS + PUSHJ P,MAKELM ; RETURNS IN B WS PTR TO LENGTH WORD + HRLZ A,VP ; SET UP TO BLT, FROM VP + HRRI A,@WSB ; TO NEW ELEMENT + MOVE G,A ; REMEMBER WHERE + ADDI A,1 ; POINT BEYOND LEN WD + BLT A,@WTOP ; WHICH POINTS TO END OF ELEMENT + + HRLI G,B ; ELEM(B) + MOVE H,DP + ADD H,DTOP ; AFTER LAST ENTRY IN DP +LSTAN3: SUBI H,2 ; AT LAST ENTRY + CAMG H,DP ; NO MORE ENTRIES? + AOJA G,LSTANG ; DONE WITH DUMMIES, DO GLOBALS + + MOVE B,(H) ; PTR TO PTR TO VALUE WD IN VP + MOVEI A,@G ; ABS PTR TO NAME WD IN VP COPY + PUSHJ P,LSTANR ; LIST TOPMOST BINDING + + MOVE C,1(H) ; FETCH NEXT LEVEL BINDING + MOVEM C,1(A) ; AND MAKE IT TOP ONE IN COPY + JRST LSTAN3 ; GO BACK FOR MORE + + +SAVAN: MOVEI A,SAVANR ; SAVE LISTING ROUTINE + SKIPA G,VP ;SAVE USES REAL VP + +LSTANG: MOVEI A,LSTANR ;LISTING ROUTINE + PUSH P,A ;SAV ROUTINE TO CALL + PUSHJ P,CRLF + MOVE A,G +LSTANH: SKIPN (A) ;ANY MORE? + JRST APOPJ ;NO, DONE + PUSHJ P,@(P) ;NO, LIST THIS ONE + ADDI A,2 + JRST LSTANH ;TRY NEXT ONE + +LSTANR: MOVSI C,UNBOUN + TDNE C,1(A) ; IS THIS VALUE UNBOUND? + POPJ P, ; YES, DON'T TYPE IT + PUSH P,A ;TYPE ANY KIND OF VALUE + MOVEI E,":" ;SLASH THE NAME + TRO F,PREFIX!SUFFIX + MOVE A,(A) ;FETCH THE NAME + PUSHJ P,PTOSS + MOVEI A,[ASCIZ / IS /] + PUSHJ P,PTOSSM + MOVEI E,042 ;QUOTE THE VALUE + +LSTNR1: MOVE A,(P) + TRO F,PREFIX!SUFFIX + MOVE A,1(A) ;GET THE VALUE + PUSHJ P,PTOSS + PUSHJ P,CRLF +APOPJ: POP P,A + POPJ P, + +;LIST X ENTRY NAME WHERE X CAN BE CONTENTS,NAMES,ABBREVIATIONS,ENTRY + +LISTEN: TRO F,EENTRF + JRST LISTFL +LSTFNM: TROA F,ENAMEF +LSTFAB: TRO F,EABBRF + +LISTFL: TRZ F,TF + POP P,A ;THE RETURN TO LISTXT + JSP H,FILEGO + ERROR NOFILE + PUSHJ P,SEARCH + ERROR NOENTRY + MOVEI D,4(G) + MOVE C,@E ;== READ @E,1 + MOVEI E,1 + PUSHJ P,.READ + PUSHJ P,READC + CAIE C,176 ;SKIP OVER COPY OF NAME + JRST .-2 + MOVE A,[PUSHJ P,READC] + MOVEM A,CHIN + +;FALLS THRU + +LNLINE: PUSHJ P,TIS ;READ A LINE + ERROR ;SHOULD HAVE GOTTEN AN EOF INTERRUPT + POP S,A + TRNE F,EENTRF + JRST LISTIT ;IF LIST ENTRY, LIST EVERY LINE + PUSHJ P,NEWSTR + PUSHJ P,NEWSR0 + PUSHJ P,COPYWD + JRST MBLIST ;NOTHING ON LINE, MAYBE TYPE CRLF + POP S,B + MOVE A,SRCBOT + TRZE F,STORED + JRST LNLINE ;STORED LINES ONLY GET LISTED ON LIST ENTRY + ADDI B,1 + MOVE C,@WSB ;FIRST WORD OF FIRST SYMBOL + CAMN C,[ASCIZ /TO/] + TRNN F,ECONTF + SKIPA + JRST LISTIT ;TO LINE AND LIST CONTENETS + CAMN C,[ASCIZ /MAKE/] + TRNN F,ENAMEF + SKIPA + JRST LISTIT ;NAME AND LIST NAMES + CAME C,[ASCII /ABBRE/] + JRST LNLINE ;NOT ABBREVIATE, SO NOTA + ADDI B,1 + MOVE C,@WSB + CAME C,[ASCII /VIATE/] + JRST LNLINE ;AGAIN NOT ABBREVIATE + ADDI B,1 + SKIPN @WSB + TRNN F,EABBRF + JRST LNLINE ;AND AGAIN +LISTIT: PUSHJ P,PTOSS ;LIST THE CURRENT LINE + TROA F,TF ;DENOTE THAT A LINE WAS TYPED SINCE LAST MBLIST + +MBLIST: TRZE F,TF + PUSHJ P,CRLF + JRST LNLINE + +COPYWD: ILDB C,A + JUMPE C,CPOPJ + CAIE C,024 ;^T IS ALSO A TERMINATOR + CAIN C," " + JRST COPYW1 + IDPB C,B + JRST COPYWD +COPYW1: AOS (P) + JRST ENDSTR + + + +EDIT: PUSHJ P,GNE + ERROR EDTER1 + TLNE A,UPRF ;IS THAT WHAT A USER PROCEDURE? + JRST EDITPR ;YES + CAMN A,[XWD MPF!IMMEDIATE,LINELL+1] ;IS THAT WHAT "LINE"? + JRST EDITLN ;YES + CAMN A,[XWD MPF!IMMEDIATE,TITLEL+1] ;IS IT "TITLE"? + JRST EDITTL ;YES + ERROR EDTER1 ;YOU CANNOT EDIT THAT + +EDITPR: SKIPE TOPROD ;IS THERE A PROCEDURE OPEN? + ERROR EDTER2 ;YES, YOU ARE ALREADY EDITING X + MOVNI B,1 + CAMN B,@RPA ;IS THE PROCEDURE DEFINED? + ERROR EVER3 ;CAN EDIT DEFINED PROCEDURES ONLY + HRRZM A,TOPROD ;THE PROCEDURE IS NOW OPEN + PUSHJ P,MOVEPR ;MAKE IT LAST + SOS PTOP ;PROCEDURE NO LONGER CLOSED + JRST COMEX + +EDITLN: PUSHJ P,SNMEVL + PUSHJ P,LINGEN ;GENERATE THE TEXT OF THAT LINE FOR TIS + +EDTLN1: JSP D,COMEXR ;DO END OF LINE CHECKING + MOVNI B,1 ;FIRST READ LINE CHARACTERISTICS FOR THIS LINE + GETLCH B + TLO B,(1B15) ;THEN TURN OFF NORMAL ECHOING OF INPUT + SETLCH B + MOVE B,[INCHRW C] ;SET TO INPUT A CHARACTER AT A TIME + EXCH B,CHIN + CAME B,TERMIO ;ONLY IF, THAT IS, WE ARE READING FROM TTY + MOVEM B,CHIN ;IF NOT, THEN UNDO WHAT WE JUST DID + TLO F,EDITF ;WE ARE NOW EDITING + POPJ P, + + +EDITTL: SKIPN M,TOPROD ;CURRENTLY IN A PROCEDURE? + ERROR NOPERR + PUSHJ P,NEWSTR + + MOVEI D,TITLEL+1 ;"TITLE" + PUSHJ P,LNGMP ;COPY MACHINE PROCEDURE NAME + MOVEI A,(M) + MOVE D,@RPA + MOVEI D,1(D) + MOVE M,@PSD + PUSHJ P,LINGE0 + JRST EDTLN1 + +DSPACE: MOVEI C," " + IDPB C,B + POPJ P, + + +LINGEN: MOVEI D,1(A) ;POINTER TO POINTER TO COMPILED CODE FOR LINE + PUSHJ P,SNM ;IS THE FIRST WORD OF THE GENERATED LINE + MOVE M,@PSD +LINGE0: MOVEI M,1(M) +LINGEA: MOVE D,@WSM ;GET NEXT ELEMENT + TLZ D,IMMEDIATE!COMPOUND + JFFO D,LINGE1 ;DIPATCH ON TYPE + JRST ENDSTR ;WHICH WILL EXIT FROM LINGEN WITH POPJ + +LINGE1: TLNE D,INFOP + JRST LNGFOP +LINGE2: MOVEI C," " + IDPB C,B ;BEFORE ALL BUT FIRST ELEMENT PUT A SPACE + TRO F,NWF ; AND CALL IT A SENTENCE +LINGE3: PUSHJ P,@.(E) + AOJA M,LINGEA ;BACK FOR NEXT ELEMENT + EXP LNGMP,LNGUP,LNGV,LNGL,LNGMP,LNGMV,LNGCMT + +LNGMV: MOVEI E,":" + TRO F,PREFIX!SUFFIX +LNGMP: MOVE A,-1(D) ;FETCH POINTER TO TEXT NAME OF PROCEDURE + HRLI A,440700 +LNGALL: MOVEM A,SRCBOT + TRZE F,PREFIX + IDPB E,B ;AFFIX PREFIX IF THERE IS ONE + ILDB C,A ;COPY THE WHOLE ELEMENT + JUMPE C,LNGALE ;DONE IF EOM + IDPB C,B + JRST .-3 ;NEXT CHAR +LNGALE: TRZE F,SUFFIX + IDPB E,B ;AFFIX SUFFIX IF ONE TOO + POPJ P, ;DONE WITH THIS ELEMENT + +LNGUP: MOVEI A,-1(D) + MOVE A,@RPA ;GET NAME OUT OF TABLE +LNGUP1: HRLI A,(POINT 7,(W),34) ;IT IS A WORKSPACE ELEMENT + JRST LNGALL + +LNGV: MOVEI A,-1(D) + MOVE D,@VPA + SKIPA E,[":"] +LNGCMT: MOVEI E,";" + TRO F,PREFIX!SUFFIX +LNGL1: MOVEI A,(D) + JRST LNGUP1 + +LNGL: MOVEI A,(D) ;NUMBRQ USES A FOR ARG + PUSHJ P,NUMBRQ + TRO F,PREFIX!SUFFIX + MOVEI E,042 + JRST LNGL1 + +LNGFOP: MOVEI A,1(M) + JSP G,LNGIOT + MOVEI A,-1(M) + JSP G,LNGIOT + XCT LINGE3 + MOVEI M,1(M) + MOVE D,@WSM + TLZ D,COMPOUND!IMMEDIATE + JFFO D,LINGE3 +LNGIOT: MOVE C,@WSA + TLNN C,LITF + TLNE C,VARF + JRST (G) + JRST LINGE2 + +ERASE: PUSH P,[EXP ERASXT] + PUSHJ P,GNE + ERROR WHATER + TLNE A,UPRF ;IS IT A UPROD + JRST ERASPR ;YES, ERASE ONE PROCEDURE + TLZN A,MPF ;ALL OTHER PARAMETERS MUST BE MACHINE NAMES + ERROR WHATER + MOVEI A,(A) + CAIN A,LINELL+1 ;IS IT "LINE" + JRST ERASLN ;YES, ERASE LINE + CAIN A,ALLL+1 ;IS IT ALL? + JRST ERSALL + CAIN A,ABREVL+1 + JRST ERSABB + CAIN A,TRACEL+1 + JRST ERASTR ;ERASE TRACE + CAIN A,ENTRYL+1 + JRST ERASEN + ERROR WHATER ;NONE OF THE ABOVE + +ERASXT: SQUEZE ;SEE IF WE CAN REDUCE THE STORAGE ALLOCATION + JRST COMEX + + +ERSALL: PUSHJ P,GNE ;ALL WHAT? + JRST ERASAL ;ALL PERIOD + TLZN A,MPF ;MUST BE A MACHINE NAME + ERROR WHATER + MOVEI A,(A) + CAIN A,NAMESL+1 ;IS IT "NAMES" + JRST ERSALN + CAIN A,PROCDL+1 ;IS IT "PROCEDURES" + JRST ERSALP + CAIN A,ABRVSL+1 + JRST ERSALA ;ALL ABBREVIATIONS + CAIN A,TRACSL+1 ;"TRACES"? + JRST ERSALT + ERROR WHATER + +ERASAL: +FOR TEN50,< + HLRZ A,JOBSA ;GET FIRST FREE LOC + ADDI A,1777 ;ONE MORE K + CORE A, + ERROR IOPERR > +FOR TENEX,< + MOVEI A,30000 + JSP E,SETMEM > + MOVEI F,TF ;DON'T TYPE STARTUP MESSAGE AGAIN + JRST LOGO+2 ;OR DO THE RESET (WHICH CLOSES DRIBBLE FILE) + +ERSALA: SETZM @UA + POPJ P, + +ERSALP: SETZM @RP ;FLUSH ALL PROCEDURE NAMES + SETZM PTOP ;FLUSH ALL PROCEDURE DIRECTORIES + SETZM BSP ;CLEAR ALL SAVED BREAKS + SETZM GODEPT + JRST FLUSHM ;FLUSH PDLS AND ALL BOUND VARS + +ERSALN: MOVE A,VP + MOVE H,[XWD WORDF!SENTF!EMPTYF!GLOBLF!UNBOUN,0] +ERSAN1: SKIPN (A) + POPJ P, + PUSHJ P,FINDAG ;FIND A GLOBAL VALUE + MOVEM H,1(C) ; AND RESET IT TO UNSET + ADDI A,2 + JRST ERSAN1 + +FINDAG: MOVSI D,GLOBLF + MOVE C,A + TDNE D,1(C) ;IS GLOBAL VALUE IN VP? + POPJ P, ;YES + MOVEI B,1(C) ;ABS PTR TO VALUE WD + SUB B,VP + MOVN C,DTOP + HRLZI C,(C) + HRR C,DP +FNDAG1: ADD C,[XWD 2,2] + JUMPGE C,CPOPJ1 ;NO GLOBAL BINDING ANYWHERE + CAME B,(C) + JRST FNDAG1 + POPJ P, + + +ERSABB: AOS A,CPP + PUSHJ P,EVAL + MOVE A,(S) + MOVE B,UA + PUSHJ P,LOOKY + JRST ERSAB1 ;NOT A USER ABBREVIATION + SKIPE 1(N) ;NO CHANGE IF AN ALREADY ERASED SYSTEM ABB + SETOM 1(N) + POP S,A +NOSQZE: POP P,A + JRST COMEX + +ERSAB1: MOVE A,(S) + PUSHJ P,SYSLKP ;LOOKUP BUILTIN FN OR ABBREVIATION + ERROR WHATER + SKIPL (N) ;IS IT AN ABBREV. RATHER THAN PR NAME + ERROR WHATER ;PR NAME + PUSH S,(S) + SETZM -1(S) + POP P,A + JRST ABBRV0 ;SKIP OVER FETCHING INPUTS TO ABT + + +ERASTR: PUSHJ P,GNE ;ERASE TRACE ON WHAT PROCEDURE? + ERROR WHATER + TLNN A,UPRF ;ONLY USER DEFINED PROCEDURES ARE TRACED + ERROR WHATER + MOVEI A,-1(A) + HRLZI B,TRACEF + ANDCAM B,@RPA ;CLEAR THE APPROPRIATE BIT + JRST NOSQZE + +ERSALT: MOVE A,RP ;ERASE ALL TRACES +ERSLT1: HRLZI B,TRACEF + ANDCAB B,(A) ;CLEAR THE BIT + MOVEI A,2(A) ;POINT AT NEXT ENTRY + JUMPN B,ERSLT1 ;NAME NON-ZERO IF NOT AT END OF TABLE + JRST NOSQZE + +ERASLN: PUSHJ P,SNMEVL ;ERASE LINE, WHAT LINE? +ERSLN1: MOVEI C,@PSA + MOVE B,2(C) ;COPY ALL THE REST OF THE LINES BACK TWO + MOVEM B,(C) + MOVEI C,1(C) + JUMPN B,.-3 ;TERMINATE ON ZERO LINE NUMBER + + MOVNI B,2 + ADDM B,PTOP + POPJ P, + +ERASPR: MOVEI A,-1(A) ;CLEAR LH OF A + HRLZI B,TRACEF + ANDCAM B,@RPA ;ERASE THE TRACE ON IT IF ANY + MOVEI A,1(A) + + MOVNI B,1 ;ERASE PROCEDURE + CAMN B,@RPA ;IS THE PROCEDURE DEFINED? + JRST ERPR1 ;QUIT EARLY, NOT DEFINED + SKIPE TOPROD ;IS THERE A PROCEDURE OPEN? + AOS PTOP ;"CLOSE" IT TEMPORARILY + CAMN A,TOPROD ;IS IT THE PROCEDURE CURRENTLY BEING DEFINED + SETZM TOPROD ;YES, WHEN WE'RE DONE, NO PROCEDURE OPEN + PUSH P,TOPROD + MOVEM A,TOPROD + PUSHJ P,MOVEPR ;MAKE THIS ONE LAST TEMPORARILY + MOVE A,TOPROD + MOVE A,@RPA + + PUSHJ P,ERSLN1 ;ERASE ONE LINE + SKIPE @PSA ;ANY LEFT? + JRST .-2 ;YES, ERASE ONE MORE + + MOVE A,TOPROD + MOVNI B,1 + EXCH B,@RPA ;MARK AS UNDEFINED AND FETCH PTR TO BEGINNING + HRRM B,PTOP ; OF THE STORAGE WE JUST FREED UP + HRRZ B,-1(P) + SKIPN PRODNM ;DON'T SAY IF STORED + CAIE B,ERASXT ;OR NOT JUST ERASE PR + JRST .+5 + JSP H,ETUP ;X + MOVEI A,[ASCIZ / ERASED/] + PUSHJ P,PTOSSM + PUSHJ P,CRLF + POP P,TOPROD ;RESUME EDITING THE PROCEDURE THAT HAD BEEN + SKIPE TOPROD + SOS PTOP + POPJ P, + +ERPR1: HRRZ B,(P) + SKIPN PRODNM + CAIE B,ERASXT + POPJ P, + ERROR NOPROD + SUBTTL SYSTEM INDEPENDENT FILE CODE + + +DEFINE READ (BLOCK,BUFFER) +< MOVE C,BLOCK + MOVEI E,BUFFER + PUSHJ P,.READ > + +DEFINE FORCE (BUFFER) +< MOVEI E,BUFFER + PUSHJ P,.FORCE > + +FOR TENEX,< +DEFINE ALTERD (BUFFER,AC) +<>> ;THE SYSTEM TAKES CARE OF IT +FOR TEN50,< +DEFINE ALTERD (BUFFER,AC) +< MOVE AC,LBUF+BUFFER + SETOM CHANGE(AC) >> + + +;FILE PARAMETERS + +FOR TENEX, +FOR TEN50, +LBLKL==200 +DRENL==12 +NENTRY==/DRENL +BUFBIT==1 + +ZLABS==TF ;THIS FLAG USED TO INDICATE LABS=0 WHEN SET +PURGE TF + + +;DIRECTORY FORMAT +;OVERHEAD BLOCK - 8 WORDS +;WORD CONTENTS +; 0 - TOP OF BLOCK FREE LIST +; 1 - NUMBER OF ENTRIES IN THIS DIRECTORY BLOCK +; 2 - TOP OF ENTRY BLOCK LIST IN THIS DIRECTORY +; 3 - TOP OF ENTRY BLOCK FREE LIST +; 4 - LINK TO NEXT DIRECTORY BLOCK, OR 0 +; 5 - PASSWORD NUMBER FOR THIS FILE +; 6 - NUMBER OF BLOCKS ON THE FREELIST +; 7 - LAST REWRITE NUMBER USED IN FILE +;ENTRY BLOCK - DRENL WORDS LONG +; 0 TO 3 - FIRST 20 CHARACTERS OF THE ENTRY NAME +; 4 - LINK TO FIRST TEXT BLOCK OF ENTRY +; 5 - TIME AND DATE SAVED +; 6 - TIME AND DATE GOTTEN +; 7 - LOCKED, HOARDED, AND SIZE OF FILE IN BLOCKS +; 8 - REWRITE NUMBER FOR THIS ENTRY +; 9 - POINTER TO NEXT ENTRY BLOCK , OR 0 + ;GET HAS BEEN MODIFIED AT NRC TO OPEN A FILE FOR READING ONLY, WHERE ORIGINALLY +;FILES WERE ALWAYS OPENED IN UPDATE MODE. THIS MEANS THAT THE ACCESS TIME AND +;DATE FOR THE ENTRY WITHIN THE FILE IS NO LONGER UPDATED ON GET, BUT IT HAS +;THE ADVANTAGE OF ALLOWING THE USE OF A LIBRARY OF LOGO FILES STORED IN SOME +;SPECIAL DIRECTORY. AT NRC THIS SPECIAL DIRECTORY IS ACCESSED BY USE +;OF THE /LIB: MODIFICATION TO THE USERS' FILE STRUCTURE SEARCH LIST. +;NOTE THAT THE CHANGES ARE ONLY "FOR TEN50"--THE TENEX VERSION REMAINS UNCHANGED + +COPYGT: SKIPA A,[GETCP0] +GET: MOVEI A,GET4 + MOVEM A,GETDST ; CALLED BY GET OR BY COPY + JSP H,FILEGO ;GENERATE FILE NAME, SAVEUP, AND OPEN + ERROR NOFILE ;MAYBE FILE IN USE? + PUSHJ P,SEARCH ;LOOK FOR ENTRY + ERROR NOENTRY ;NO SUCH ENTRY +NOTFOR TEN50,< + MOVE A,TANDD ;TIME AND DATE OF PROGRAM STARTUP + MOVEI D,6(G) ;CURRENT ENTRY +6 + MOVEM A,@E ;UPDATE D-G +> + MOVEI D,4(G) ;ENTRY+4, POINTER TO DATA BLOCK + READ @E,1 ;READ THE FIRST DATA BLOCK INTO BUF1 + + PUSHJ P,READC ;SKIP OVER COPY OF THE ENTRY NAME + CAIE C,176 + JRST .-2 +NOTFOR TEN50,< + FORCE 0 ;WRITE THE MODIFIED DIRECTORY +> + JRST @GETDST ; WHAT IS THE REST TO DO + +GET4: MOVE A,[PUSHJ P,READC] ;MOST OF GET + MOVEM A,CHIN + PUSHJ P,TIS + ERROR IOPERR ;CANNOT GET A RUBOUT FROM THE FILE + MOVE A,(S) + HRLI A,(POINT 7,(W),34) + ILDB C,A + CAIE C,";" ;IS THE FIRST LINE COMMENT? + JRST MAINL1 ;NO, TREAT THE LINE NORMALLY + POP S,A + PUSHJ P,PTOSS ;TYPE THE COMMENT + PUSHJ P,CRLF + JRST MAINL ;PROCEED AS IF INPUT WERE FROM TERMINAL + ERASEN: JSP H,FILEGO + ERROR NOFILE + JSP H,FILUPD + ERROR UPDERR + PUSHJ P,SEARCH + ERROR NOENTRY + PUSHJ P,ERENRO + JSP H,CLOSUP + POP P,A ;FLUSH THE RETURN TO ERASXT + JRST COMEX + + FOR TENEX,< +GETCP0: SKIPA 1,COPJFN + PUSHJ P,READC1 +GETCP1: SOSGE CCOUNT + JRST .-2 + ILDB C,@FPTRL1 + BOUT + JUMPN C,GETCP1 + CLOSF + JFCL + JRST REDEOF ; AND CLOSE THE LOGO FILE +> + +FOR TEN50,< + PUSHJ P,READC1 +GETCP0: SOSGE CCOUNT + JRST .-2 + ILDB C,@FPTRL1 + SOSLE CCNT2 + JRST GETCP3 + PUSHJ P,GTSVUG + OUT 2,DMPLST + SKIPA + ERROR + LDB C,@FPTRL1 ; GET THE SAME CHARACTER AGAIN +GETCP3: IDPB C,FPTR2 + JUMPN C,GETCP0 + HRLZI C,440700 + HRR C,BUFLC2 + CAMN C,FPTR2 + JRST GETCP2 + PUSHJ P,GTSVUP ;LAST BUFFER IS NOT EMPTY + OUT 2,DMPLST + SKIPA + ERROR +GETCP2: CLOSE 2, + RELEAS 2, + SETZM BUFAD2 + JRST REDEOF + +GTSVUG: SKIPE CCNT2 + AOS (P) ;FIRST TIME THRU SKIP THE OUT +GTSVUP: MOVEI C,200*5 + MOVEM C,CCNT2 + HRRZ C,BUFLC2 + HRLI C,440700 + MOVEM C,FPTR2 + SUBI C,1 + HRLI C,-200 + MOVEM C,DMPLST + POPJ P, +> + +SAVER: PUSHJ P,LISTAP + PUSHJ P,SAVAN + PUSHJ P,SAVAA + + SETZ C, + XCT CHOUT ;INSERT AN END OF FILE + POPJ P, + +FOR TENEX,< +SAVCOP: MOVE 1,COPJFN + BIN + MOVE 3,2 + PUSHJ P,WRITEC + JUMPN 3,.-3 + CLOSF + JFCL + POPJ P, +> +FOR TEN50,< +SAVCOP: SOSG CCNT2 + JRST [ PUSHJ P,GTSVUP + IN 2,DMPLST + SKIPA + ERROR + JRST .+1 ] + ILDB C,FPTR2 + PUSHJ P,WRITEC + JUMPN C,SAVCOP + CLOSE 2, + RELEAS 2, + SETZM BUFAD2 + POPJ P, +> + COPYSV: SKIPA A,[SAVCOP] +SAVE: MOVEI A,SAVER + MOVEM A,SAVSRC + JSP H,FILEGO + JRST SAVNEW ;NO FILE, MAKE ONE + JSP H,FILUPD ;OPEN IN UPDATE MODE + ERROR UPDERR ;FILE EXISTS BUT CAN'T UPDATE IT + PUSHJ P,SEARCH ;LOOK FOR AN ENTRY BY THE SAME NAME + JRST SAVE0 ;NO THIS WILL BE A NEW ENTRY + TLZ F,GETF ;TURN OFF THIS FLAG WHILE WE ASK QUESTION +SAVEQ: MOVEI B,[ASCIZ /OK TO REPLACE EARLIER VERSION OF THIS ENTRY? +(YES OR NO): /] + PUSHJ P,TIS ;ASK QUESTION AND GET RESPONSE + JRST SAVEQ ;BAD INPUT OF SOME KIND. + POP S,B + AOS B ;ADVANCE POINTER TO FIRST WORD OF MESSAGE + MOVE A,@WSB ;WHAT DID HE SAY? + CAMN A,[ASCII /NO/] + JRST SAVEX + CAME A,[ASCII /YES/] + JRST SAVEQ ;WHAT WAS THAT AGAIN? + TLO F,GETF ;OK TO PROCEED, TURN THIS BACK ON +SAVE0: READ [0],0 ;READ BK 0 OF FILE, DIRECTORY INTO BUF0 + MOVE A,@FPTRL0 + MOVE A,(A) + MOVEM A,LABS ;FREE LIST IS FIRST WORD OF DIR + +SAVE1: TLO F,SAVEF ;DENOTE SAVE IN PROGRESS + MOVE A,[PUSHJ P,WRITEC] + MOVEM A,CHOUT ;WHAT TO XCT WHEN OUTPUTTING CHARS + + MOVEI A,1 + MOVEM A,FILECT + PUSHJ P,WRITC2 ;GET A NEW BLOCK + MOVE A,LBLOCK+1 ;FIRST BLOCK OF FILE + MOVEM A,FILEAD + MOVE H,(S) ;COPY ENTRY NAME INTO FILE + HRLI H,(POINT 7,(W),34) + ILDB C,H + XCT CHOUT ;WRITE A CHAR INTO FILE + JUMPN C,.-2 + + MOVEI C,176 + DPB C,@FPTRL1 ;OVERWRITE THE 0 EOM + + MOVE A,CPP ;STORE COMMENT IN FILE IF ON SAVE LINE + MOVEI A,1(A) ;POINT AT NEXT ELEMENT + SKIPE A,@WSA ;IS IT NOT THERE? + TLNN A,COMMTF ;MAKE SURE IT IS A COMMENT + JRST SAVE2 ;NOT A COMMENT + MOVEI C,";" + PUSHJ P,TYO + PUSHJ P,PTOSS + PUSHJ P,CRLF + +SAVE2: PUSHJ P,@SAVSRC ;CALL APROPRIATE ROUTINE + TLZ F,SAVEF + MOVE A,TERMIO+1 ;TERMINAL OUTPUT INSTRUCTION + MOVEM A,CHOUT + ALTERD 1,C + ;MAKE DIRECTORY ENTRY + + HRRZ E,@FPTRL0 ;WHERE DIRECTORY IS + SKIPE 3(E) + JRST SAVE4 ;LIST OF AVAIL DIR ENTRIES NOT EMPTY + + PUSHJ P,WRITC2 ;NEED ANOTHER DIRECTORY BLOCK + + HRRZ E,@FPTRL0 ;DESTROYED E AGAIN + HRLZI B,(E) ;THE OLD DIRECTORY 0 + HRRZ C,@FPTRL1 ;WHERE THE DATA IN IT WILL GO + HRRI B,(C) + BLT B,LBLKL-1(C) ;COPY THE FULL DIRECTORY + PUSHJ P,CLRDIR + HRRZ E,@FPTRL0 ;DESTROYED IT AGAIN! + MOVE B,LBLOCK+1 + MOVEM B,4(E) ;CHAIN TO FULL DIRECTORY BLOCK + ALTERD 1,D + JRST SAVE4 + +SAVNEW: JSP H,OPENW ;WRITING ONLY + ERROR IOPERR ;DISASTER + SETOM LABS + PUSHJ P,WRITC2 ;READ A NEW BLOCK INTO BUFFER 1 + MOVE A,LBUF+1 + MOVEM A,LBUF ;AND SWITCH IT INTO BUFFER 0 + MOVE A,LBLOCK+1 + MOVEM A,LBLOCK + MOVE A,FPTRL1 + MOVEM A,FPTRL0 + PUSHJ P,CLRDIR +FOR TEN50, + JRST SAVE1 + SAVE4: HRLI E,D ;NOW FILL UP A DIRECTORY ENTRY + MOVE D,3(E) ;TOP OF LADES + HRLI D,-4 ;NUMBER OF WORDS OF TEXT TO COPY MAX + MOVEI G,(D) ;EXTRA COPY OF PTR TO ENTRY + + MOVE B,(S) + MOVEI B,1(B) ;FIRST TEXT WORD IN ENTRY NAME + MOVE C,@WSB + MOVEM C,@E + TRNE C,376 ;END OF ENTRY NAME? + AOBJN D,.-4 + + MOVEI D,4(G) + MOVE C,FILEAD + MOVEM C,@E + + MOVEI D,5(G) + MOVE C,TANDD + MOVEM C,@E + + MOVEI D,6(G) + SETOM @E ;NEVER GOTTEN + + MOVEI D,7(G) ;NO BLOCKS IN FILE + MOVE C,FILECT + MOVEM C,@E + + MOVEI D,DRENL-1(G) + EXCH G,2(E) ;THIS BLOCK ONTO LUDES + EXCH G,@E ;OLD TOP OF LUDES INTO THIS BLOCK + MOVEM G,3(E) ;OLD LADES FP IN THIS BLOCK TO LADES + + AOS 1(E) ;A NEW ENTRY IS NOW COMPLETE + ALTERD 0,C + + SETOM LDIRNO ;SEARCH FOR ANOTHER ENTRY OF SAME NAME + SETOM LDIRL ;SET UP TO FALL INTO SEARCH + MOVE A,(S) + ADDI A,1(W) + MOVE G,2(E) ;LUDES + PUSHJ P,SERCH5 ;ENTER AT CONTINUE WITH NEXT ENTRY + JRST .+2 ;NO OTHER ENTRY OF SAME NAME + PUSHJ P,ERENRO ;DELETE THAT OTHER ENTRY + READ [0],0 + MOVE A,LBUF + MOVE B,LABS + MOVEM B,@BUFLOC(A) ;UPDATE LABS BEFORE CLOSING FILE + ALTERD 0,C +SAVEX: JSP H,CLOSUP + JRST COMEX + + +COPY: PUSHJ P,GNE + ERROR ERMSSG + MOVEI G,COPYGT ;NEXT ELEMENT IS TO OR FROM + CAMN A,[XWD MPF!IMMEDI,FROML+1] + JRST COPY1 + CAME A,[XWD MPF!IMMEDI,TOL+1] + ERROR + MOVEI G,COPYSV +COPY1: POP S,B ;STRING OF FILE DESIGNATOR + HRLI B,(POINT 7,(W),34) +FOR TENEX,< + MOVSI 1,400001 + CAIE G,COPYGT + MOVSI 1,1 + GTJFN + ERROR TNXERR + MOVEM A,COPJFN + MOVE 2,[XWD 70000,700000] + OPENF + ERROR TNXERR + JRST (G) +> +FOR TEN50,< + JRST COPY2 + +;CONVERT BEGINNING OF STRING POINTED TO BY B TO SIXBIT AND STORE +; RESULT IN E. TERMINATORS ARE EOM : . [ AND MAYBE ] + +R7TO6: MOVEI D,6 + MOVE A,[POINT 6,E] + SETZ E, +R7TO6L: ILDB C,B + CAIE C,"." + CAIN C,":" + POPJ P, ;LEGAL TERMINATORS + CAIE C,"[" + CAIN C,0 + POPJ P, +FOR BBN50,< + CAIN C,"]" + POPJ P, > + XORI C,40 + SOJL D,[ERROR] ;TOO MANY CHARS + IDPB C,A ;OK + JRST R7TO6L ; GET ANOTHER CHAR +> + +FOR TEN50,< +COPY2: MOVE H,[XWD OPNPAR,OPNPAR+1] + SETZM OPNPAR + BLT H,LUKDAT+3 ; CLEAR FILE DESCRIPTOR BLOCKS + MOVEI H,LUKDAT + PUSHJ P,R7TO6 ;GET DEVICE OR FILENAME + JUMPE C,FNDCD8 ; FILENAME ONLY + CAIN C,"[" ; FOO[PRJPRG] + JRST FNDCD3 + CAIN C,"." ; FILENAME + JRST FNDCD2 + CAIE C,":" ; DEVICE DESIGNATOR + ERROR ;NOTA + MOVEM E,OPNPAR+1 ; DEVICE NAME + PUSHJ P,R7TO6 ; FILENAME OR NOTHING + JUMPE C,FNDCD8 ; LAST FIELD IS FILE NAME + CAIN C,"[" ; FOO:BAR[PRJPRG] + JRST FNDCD3 + CAIE C,"." ; ONLY OTHER LEGAL TERMINATOR + ERROR +FNDCD2: MOVEM E,(H) ; FILE NAME OK + MOVEI H,LUKDAT+1 + MOVEI D,3 ; EXT CAN ONLY BE 3 CHARS LONG + PUSHJ P,R7TO6+1 + HLLM E,(H) ;MAKE SURE THE DATE FIELD NOT CHANGED + ;ONLY CHANGE THE EXT FIELD--DATE75 FIX + JUMPE C,FNDCD8+1 ; EXTENSION IS LAST--ALREADY STORED + CAIE C,"[" ; EXT CAN ONLY BE FOLLOWED BY PRJ-PRG + ERROR + SKIPA ;EXT ALREADY STORED +FNDCD3: MOVEM E,(H) ; STORE FIELD BEFORE [PRJPRG] +FOR BBN50,< + PUSHJ P,R7TO6 ; UP TO SIX CHAR IDCODE + CAIE C,"]" + ERROR ; MUST BE FOLLOWED BY RT BRK + CALL 5,[SIXBIT /SQUOZE/] > +NOTFOR BBN50,< + MOVE L,B + PUSHJ P,DNMO ;OCTAL DNM + ERROR ;NOT A NUMBER + ERROR ;NUMBER TOO BIG + CAIE C,"," ;FIRST ONE MUST END IN , + ERROR + HRLZ E,M ; FIRST IS PRJ NO + PUSHJ P,DNMO + ERROR + ERROR + CAIE C,"]" ; SECOND DELIMITED BY RT BRK + ERROR + HRR E,M ; AND IS PRG NUMBER +> + MOVEM E,LUKDAT+3 + ILDB C,L + JUMPE C,FNDCD9 ; ALL OK + ERROR ; SOMETHING EXTRA IN FILE DESIGNATOR + +FNDCD8: MOVEM E,(H) ; STORE THE LAST FIELD +FNDCD9: HRLZI 2,(SIXBIT /DSK/) + SKIPN OPNPAR+1 + MOVEM 2,OPNPAR+1 ; DEFAULT VALUE IS DSK + MOVEI 2,17 + MOVEM 2,OPNPAR ; MODE IS DUMP + OPEN 2,OPNPAR ; INIT THE DEVICE + ERROR + MOVE 1,[ENTER 2,LUKDAT] + CAIE G,COPYGT + HRLI 1,(LOOKUP 2,) + XCT 1 + ERROR + SETZM CCNT2 + MOVEI A,200 + PUSHJ P,MAKELM + MOVEM B,BUFAD2 + ADDI B,1(W) + HRRZM B,BUFLC2 + JRST (G) > + + PUSHJ P,READC1 +READC: SOSGE CCOUNT ;READ ONE CHARACTER + JRST .-2 + ILDB C,@FPTRL1 ;FETCH ONE + JUMPN C,CPOPJ ;END OF FILE? + +REDEOF: JSP H,CLOSUP + TLNN F,GETF + JRST COMEX + JRST READC + +READC1: MOVNI C,LBLKL-1 + ADD C,@FPTRL1 + SKIPN C,@C ;FORWARD PTR IS IN FIRST WORD OF BLOCK + JRST REDEOF ;FILE BROKEN + PUSH P,A + PUSH P,B + PUSH P,D + PUSH P,E ;P, USEABLE ONLY BECAUSE NO GC POSSIBLE + READ C,1 ;READ THE NEXT BLOCK + POP P,E + POP P,D + POP P,B + POP P,A + POPJ P, ;POINTER AND COUNT SET UP BY READ + + + WRITEC: SOSGE CCOUNT ;WRITE A CHARACTER INTO A FILE + JRST WRITC1 ;BUFFER FULL + IDPB C,@FPTRL1 ;PUT IT AWAY + POPJ P, + +WRITC1: PUSH P,A + PUSH P,B + PUSH P,C ;SAVE THE CHARACTER + PUSH P,D + PUSH P,E + AOS FILECT ;ANOTHER BLOCK USED FOR FILE + PUSHJ P,WRITC2 +WRTC1A: POP P,E + POP P,D + POP P,C + POP P,B + POP P,A + JRST WRITEC + +WRITC2: TRZ F,ZLABS ;WHETHER LABS=0 + SKIPLE C,LABS ;END OF LABS? + JRST WRITC3 ;NO + TRO F,ZLABS ;GENERATING MORE SPACE + +;NO MORE LABS,LABSND LENGTH OF FILE AND CALL THAT MORE LABS + + MOVE C,FILSIZ ;SET UP AT OPEN + AOS FILSIZ + IMULI C,NLOGB ;# OF PAGES IN C, MULTIPLY BY FUDGE + MOVEM C,LABS ;REMEMBER FOR A WHILE +WRITC3: MOVE B,LBUF+1 + HRRZ A,(P) ;WHO CALLED? + CAIE A,WRTC1A ;WAS IT FOR A NEW DATA BLOCK? + JRST WRITC4 ;NO + MOVE C,LBLOCK+1 ;YES, CHAIN NEW ONE TO LAST ONE + IDIVI C,NLOGB ; WHICH ONE REL TO BEG OF PBLOCK + IMULI D,LBLKL ;BUT FIND BEGINNING OF BUFFER + ADD D,BUFLOC(B) + MOVE C,LABS + MOVEM C,(D) +WRITC4: TRNN F,ZLABS ;NEED TO LENGTHEN FILE? + JRST WRITC5 ;NO + FOR TENEX,< READ C,1 ;OLD ONE GETS WRITTEN IF CHANGED + MOVE A,LBUF+1 > ;AND THE NEW ONE GETS ASSOCIATED + +FOR TEN50,< MOVE B,LBUF + XORI B,BUFBIT + MOVEM B,LBUF+1 + PUSHJ P,WRITF1 ;WRITE CONTENTS OF LOGICAL BUF 1 IF NECESSARY + + MOVE C,LABS + MOVEM C,LBLOCK+1 ;NOW ASSOCIATE NEW BLOCK WITH BUFFER + MOVE A,LBUF+1 + MOVEM C,PBLOCK(A) ;AND PHYSICAL BUFFER + MOVEI C,5* + MOVEM C,CCOUNT + MOVE B,BUFLOC(A) + HRLZI C,(B) + HRRI C,1(B) + SETZM (B) + BLT C,LBLKL-1(B) + HRLI B,010700 + MOVEM B,FPTR(A) + MOVEI B,FPTR(A) + MOVEM B,FPTRL1 +> + MOVE B,@FPTRL1 + HRLZI A,-NLOGB ;SET UP THE LABS CHAIN IN THE BUFFER + HRR A,LABS ;LOG ADDR OF THE FIRST BLOCK IN BUFFER + AOBJP A,.+4 + + HRRZM A,(B) ;THE FORWARD POINTER + ADDI B,LBLKL ;WHERE THE NEXT ONE SHOULD GO + AOBJN A,.-2 ;THE REST + + SETZM (B) ;THE LAST ONE TERMINATES THE CHAIN + JRST WRITC6 + +WRITC5: READ C,1 ;READ THIS ONE FOR ITS FORWARD PTR +WRITC6: MOVE C,@FPTRL1 + MOVE C,(C) ;GET FIRST WORD OF BLOCK + MOVEM C,LABS ;WHICH POINTS TO NEXT FREE BLOCK + MOVE C,@FPTRL1 + SETZM (C) ;THIS ONE NOW THE END OF THE DATA CHAIN + ALTERD 1,C ;NOTE THAT THIS BLOCK CHANGED (SOON) + POPJ P, + ;SEARCH FOR AN ENTRY +;ENTRY NAME AT 0(S) + +SEARCH: SETOM LDIRNO + SETOM LDIRL ;NO OF ENTRIES IN LAST DIRECTORY BLOCK + READ [0],0 ;READ BLOCK 0 INTO BUFFER 0 +SERCH1: HRRZ E,@FPTRL0 ;PHYSICAL ADDR OF DIR BLOCK TO E + MOVE A,(S) ;FETCH PTR TO ENTRY NAME + ADDI A,1(W) + SKIPN 1(E) ;POSSIBLE THAT THIS DIRECTORY BLOCK IS EMPTY + JRST SERCH6 ;YES SEE IF ANY OTHER DIRECTORY BLOCKS + MOVE G,2(E) ;TOP OF ENTRY CHAIN, THIS DIRECTORY + HRLI E,D + +SERCH2: MOVEI B,(A) ;ANOTHER POINTER TO FIRST WORD OF STRING + HRLZI D,-4 ;FOUR WORDS OF TEXT IN DIRECTORY + HRRI D,(G) ;WHERE THE ENTRY BLOCK STARTS +SERCH3: MOVE C,(B) ;A WORD OF THE ENTRY NAME + CAME C,@E ;SAME AS IN THE ENTRY BLOCK? + JRST SERCH5 ;NO, TRY THE NEXT ENTRY BLOCK + TRNN C,376 ;IS IT THE END OF THE NAME STRING? + JRST CPOPJ1 ;YES, FOUND + MOVEI B,1(B) ;NEXT WORD IN STRING + AOBJN D,SERCH3 ;NEXT WORD IN ENTRY BLOCK + + PUSH P,A ;IN CASE .READ IS CALLED + PUSH P,E + READ @E,1 ;READ FIRST DATA BLOCK INTO BUF 1 + + HRLZI H,440700 ;COMPARE FULL NAME + HRR H,-1(P) + PUSHJ P,READC + ILDB B,H + JUMPE B,SERCH4 ;END OF INPUT STRING + CAIN B,(C) + JRST .-4 ;STILL SAME, TRY ANOTHER + SETZ C, ;SO THE NEXT TEST WILL LOSE + +SERCH4: POP P,E + POP P,A + CAIN C,176 ;DID THE ENTRY NAME ALSO END? + JRST CPOPJ1 ;YES, R2 + +SERCH5: MOVEI D,DRENL-1(G) ;POINT AT DIREXTORY ENTRY CHAIN + SKIPE G,@E ;IS IT IN THIS DIRECTORY BLOCK + JRST SERCH2 ;YES +SERCH6: SKIPN A,4(E) ;IS THERE ANOTHER DIRECTORY BLOCK + POPJ P, ;NO, DIDN'T FIND THE ENTRY + MOVE B,LBLOCK + MOVEM B,LDIRNO + MOVE B,1(E) ;NUMBER OF ENTRIES TDB + MOVEM B,LDIRL + READ A,0 ;READ THE NEXT DIRECTORY BLOCK + JRST SERCH1 ;YES, PROCESS IT + ;ERASE ENTRY ROUTINE - USED BY ERASE ENTRY AND SAVE +;AFTER SEARCH E CONTAINS D,,BLOCKAD +; AND G CONTAINS OFFSET OF ENTRY INTO BLOCK + +ERENRO: MOVEI D,4(G) ;POINTER TO ADDR OF FIRST DATA BLOCK + MOVE C,@E ;GET IT + MOVEM C,FILEAD ;AND SAVE IT FOR PUTTING ON LABS + + MOVEI D,DRENL-1(G) ;POINT TO FORWARD CHAIN IN OBJECT + MOVEI C,(G) ;OFFSET OF OBJECT ENTRY + EXCH C,3(E) ;PUT IT ON TOP OF FREE CHAIN + EXCH C,@E ;AND TOP OF FREE CHAIN INTO IT + ;ENDING WITH REST OF USED LIST IN C + SKIPA D,[EXP 2] ;FIRST ENTRY IN THIS BLOCK +EREN1: MOVEI D,DRENL-1(A) ;POINT AT NEXT CHAIN ADDRESS + MOVE A,@E + CAME A,G ;DID THIS CELL POINT AT DELETED CELL + JRST EREN1 ;NO + MOVEM C,@E ;RECHAIN LUDES + ALTERD 0,D + SOSG A,1(E) ;DECREMENT NUMBER IN LUDES + JRST FLUSHTHISONE + + SKIPG B,LDIRL ;PREVIOUS DIR BLOCK? + JRST TRYAFTER ;NO + ADDI B,(A) ;TOTAL NO,TDIRL+LDIRL + CAILE B,NENTRY ;WILL FIT IN ONE BLOCK? + JRST TRYAFT ;NO, TRY TDIRL+'NDIRL' + +;COMPACT LDIR WITH TDIR, PUTTING TDIR INTO LDIR +;THIS ORDER SO THAT IF LDIR IS NO 0 RECHAIN ALWAYS WINS + + MOVE B,LBUF ;TAKE THIS DIRECTORY + MOVEM B,LBUF+1 ;AND PUT IT IN BUF1 + MOVE B,LBLOCK + MOVEM B,LBLOCK+1 + MOVE B,FPTRL0 + MOVEM B,FPTRL1 + READ LDIRNO,0 +COMPACT: + MOVE E,@FPTRL1 + HRLI E,D + MOVE H,@FPTRL0 + HRLI H,G ;AND OFFSET BY CONTENTS OF G + MOVE A,2(H) ;TOP OF LIST IN LDIR + MOVEI G,DRENL-1(A) + SKIPE A,@H + JRST .-2 ;FIND END OF PREVIOUS LIST + MOVE A,3(H) + MOVEM A,@H ;END OF OLD LIST WILL NOW POINT TO LADES + MOVE D,2(E) ;POINT AT FIRST ENTRY TO BE COPIED + ERENLP: MOVEI G,(A) + HRLZI A,@E ;FROM + HRRI A,@H ;THE TO FREELIST + MOVEI G,DRENL-2(G) + BLT A,@H ;COPY AN ENTRY + + MOVEI G,1(G) ;POINT TO POINTER TO NEXT FREE TO + MOVE A,@H ;NEXT TO BUFFER ADDRESS TO A + MOVEI D,DRENL-1(D) + SKIPE D,@E ;NEXT FREE FROM, IS IT END OF LIST + JRST ERENLP ;NO + + SETZM @H ;END OF GOOD CHAIN + MOVEM A,3(H) + ALTERD 0,D ;NOTE THAT BUF0 CHANGED + + MOVE A,LBLOCK+1 + EXCH A,LABS + MOVEM A,(E) ;PUT THE DIR BLOCK JUST FREED ON TOP OF BLOCK FREELIST + MOVE A,4(E) + MOVEM A,4(H) ;UPDATE DIRECTORY CHAIN + MOVE A,1(E) + ADDM A,1(H) ;AND COUNT OF USED ENTRIES IN DIRECTORY + + ALTERD 1,D ;NOTE THAT BUF1 CHANGED + + +ERENB: MOVE A,FILEAD ;PUT FILE BLOCKS ONTO FREELIST + +ERENR: READ A,1 + MOVE D,@FPTRL1 + SKIPE A,(D) ;FIND THE END OF THE DATA CHAIN + JRST ERENR + + MOVE B,LABS + MOVEM B,(D) ;LINK OLD BLOCK FREELIST TO END + ALTERD 1,D + + READ [0],0 + + MOVE A,@FPTRL0 + MOVE B,FILEAD + MOVEM B,(A) + MOVEM B,LABS + ALTERD 0,D + POPJ P, + TRYAFT: SKIPN A,4(E) ;IS THERE A NEXT DIRECTORY + JRST ERENB ;NO, JUST DELETE THE DATA BLOCKS + READ A,1 ;READ IT + MOVE D,@FPTRL1 + MOVE B,1(D) + ADD B,LDIRL + CAILE B,NENTRY + JRST ERENB ;TWO INTO ONE WON'T GO + JRST COMPACT + +FLUSHTHISONE: + SKIPN A,LBLOCK ;IS THIS DIRECTORY 0 + JRST FLUSH0 ;YES + EXCH A,LABS ;PUT IT ON LABS + MOVEM A,(E) + MOVE H,4(E) ;CHAIN TO NEXT DIRECTORY + READ LDIRNO,0 + MOVE A,@FPTRL0 + MOVEM H,4(A) ;CHAIN THIS ONE + ALTERD 0,D + SKIPE 1(A) ;IS THIS ONE EMPTY TOO? + JRST ERENB + MOVEI E,(A) ;IT MUST BE DIR BLOCK 0, DELETE FILE + +FLUSH0: SKIPE 4(E) ;ARE THERE ANY OTHER DIRECTORIES? + JRST ERENB ;YES, LET THIS ONE BE +FOR TENEX, +FOR TEN50,< +FOR LEVELC, + SETZM LUKDAT + RENAME 1,LUKDAT + ERROR IOPERR > + POP P,G ;RETURN LOC + MOVEI B,0 ;SINCE THE FILE HAS BEEN DELETED MARK + MOVE B,LBUF(B) ;THAT THE FILE ENTRIES HAVE NOT BEEN + SETZM CHANGE(B) ;ALTERED SO THAT THERE WILL BE NO ATTEMPT + MOVEI B,1 ;TO WRITE OUT THESE ALTERED BLOCKS--THIS + MOVE B,LBUF(B) ;HAS BEEN CAUSING BAD MESSAGES TO BE PRINTED + SETZM CHANGE(B) ;WHEN THE LAST ENTRY WAS ERASED + JRST (G) ;RETURN + CLRDIR: MOVE E,@FPTRL0 ;ADDRESS OF FIRST WORD OF BUFFER + SETZM 1(E) ;NUMBER OF DIRECTORY CELLS USED + SETZM 2(E) ;LUDES - LIST USED DIRECTRY ENTRIES + MOVEI D,10 ;REL PTR TO FIRST AVAILABLE DIR CELL + MOVEM D,3(E) ;LADES - LIST AVAIL DIR ENTRY CELLS + SETZM 4(E) ;POINTER TO CONTINUATION BLOCK OF DIRECTORY + MOVEI E,10(E) ;POINT TO FIRST CELL + MOVEI D,DRENL(D) ;REL ADDR OF NEXT CELL + MOVEM D,DRENL-1(E) ;SET FORWARD PTR OF THIS CELL TO NEXT + MOVEI E,DRENL(E) ;POINT AT NEXT CELL + CAIE D,LBLKL-DRENL + JRST .-4 + SETZM DRENL-1(E) + POPJ P, + +WRITIF: MOVE B,LBUF(B) ;WHICH PHYSICAL BUFFER? +WRITF1: SKIPE CHANGE(B) ;IS THE DATA CHANGED? + JRST WRITIT ;NEEDS WRITING + POPJ P, + +.FORCE: MOVE B,LBUF(E) ;PHYS BUF + +WRITIT: SETZM CHANGE(B) ;WILL NO LONGER NEED REWRITING +FOR TEN50,< MOVE A,PBLOCK(B) + USETO 1,1(A) + HRRZ A,BUFLOC(B) + SUB A,[XWD PBLKL,1] ;REST OF IOWD + MOVEM A,DMPLST + OUT 1,DMPLST ;DUMP MODE, CHANNEL 1, + SKIPA + ERROR IOPERR > + POPJ P, + +FOR TEN50,< +.MARK: MOVE E,LBUF(E) + SETOM CHANGE(E) + POPJ P, > + + +OPENW: +FOR TENEX, +FOR TEN50, + +CLOSIT: +FOR TEN50,< MOVEI B,0 + PUSHJ P,WRITF1 + MOVEI B,1 + PUSHJ P,WRITF1 + CLOSE 1, + RELEAS 1, + SETZM BUFLOC + SETZM BUFLOC+1 ;DEALLOCATE THE BUFFERS + SETZM BUFADR + SETZM BUFADR+1 +> +FOR TENEX,< + HRLZI E,-2 ;REMOVE THE PAGES OF BUFFER + MOVE B,BUFLOC(E) ;FROM THE MAP OF FORK + ASH B,-11 + HRLI B,400000 + SETO A, + PMAP + AOBJN E,.-5 + HRRZ A,INFILE + CLOSF + ERROR IOPERR > + POPJ P, + +;READ A BLOCK INTO A BUFFER +;CALLED WITH LOGICAL BUFFER NUMBER IN E +; AND WITH LOGICAL BLOCK NUMBER IN C + +.READ: MOVEM C,LBLOCK(E) ;THIS LOGICAL BUFFER WILL CONTAIN THIS BLOCK + HRLZI A,-2 ;# OF PHYSICAL BUFFERS + + MOVEI D,(C) ;FIRST CHECK IF LOGICAL BLOCK IS + XOR D,PBLOCK(A) ; IN ONE OF THE PHYSICAL BUFFERS + TRNN D,-NLOGB ;# OF LOGICAL BUFFERS IN ONE PHYS ONE + JRST .READ7 ;ALREADY IN A BUFFER + AOBJN A,.-4 ;TRY THE OTHER ONE + +;THE LOGICAL BLOCK IS NOT IN EITHER PHYSICAL BUFFER +;THEREFORE THE PHYSICAL BUFFER USED BY THE REQUESTED LOGICAL ONE +; IS PREFERABLE UNLESS IT IS ALSO USED BY THE OTHER LOGICAL ONE TOO + + MOVE A,LBUF ;THE PHYS BUFFER USED BY LOGICAL BUFFER 0 + XOR A,LBUF+1 + TRON A,BUFBIT ;ARE BOTH USING THE SAME PHYSICAL BUFFER? + XORM A,LBUF(E) ;YES, SWITCH THE BUF THIS ONE USES + + MOVEI B,(E) + PUSHJ P,WRITIF + + MOVE B,LBUF(E) ;NOW READ THE REQUESTED BLOCK + MOVE A,LBLOCK(E) ;WHAT PART OF FILE TO READ + +FOR TENEX,< MOVE B,BUFLOC(B) ;PHYSICAL BUFFER LOCATION + ASH A,-2 ;MUST PARAMETERIZE LOG BASE 2 OF NLOGB + ASH B,-11 ;2^9 WORDS PER PAGE + HRLI B,400000 + HRL A,INFILE + HRLZI C,140000 ;READ AND WRITE ACCESS PERMITTED + PMAP > +FOR TEN50, + + .READ3: MOVE C,LBUF(E) ;GET PHYSICAL BUFFER NUMBER + MOVEI B,FPTR(C) ;GET PHYSICAL POINTER LOCATION + MOVEM B,FPTRL0(E) ;STORE ITS ADDRESS IN LOGICAL PTR + MOVEI A,NLOGB-1 ;SET UP POINTER TO THE BLOCK + AND A,LBLOCK(E) + IMULI A,LBLKL ;NUMBER OF WORDS IN A LOGICAL BLOCK + ADD A,BUFLOC(C) + HRLI A,010700 + MOVEM A,FPTR(C) + MOVEI B,5* + MOVEM B,CCOUNT + MOVE B,LBLOCK(E) + MOVEM B,PBLOCK(C) + POPJ P, + +.READ7: HRRZM A,LBUF(E) ;MAKE THE LOGICAL BUFFER USE THAT PBUF + JRST .READ3 ;SET UP POINTERS AND EXIT + +FOR TENEX,< +FILEGO: PUSH S,CBOT + PUSHJ P,GETFLN + PUSHJ P,GETFLN +FILEGA: MOVE B,-1(S) + MOVEI A,10 ;NUMBER OF WORDS FOR TENEX + CAMGE A,@WSB ;WILL THE NAME FIT? + ERROR FILER9 ;NOT IMPLEMENTED + MOVEI B,@WSB ;COMPUTE ABS ADDR OF STRING + MOVEI B,1(B) ;FIRST WORD OF TEXT + MOVEM B,JFNTAB+4 ;FILE NAME SLOT + + MOVEI B,[ASCIZ /LGO/] + MOVEM B,JFNTAB+5 ;EXT + + MOVE A,[XWD 100000,1] + MOVEM A,JFNTAB + MOVEI A,JFNTAB + MOVEI B,0 + GTJFN + JRST (H) ;NO FILE + MOVE G,[XWD 070000,701000] +OPNRW1: JSP D,SAVEUP ;SAVE CURRENT STATE OF LOGO + PUSH P,INFILE ;SAVE NAME OF CURRENT OPEN FILE + MOVEM A,INFILE + HRLZ A,LBLOCK+1 ;LOGICAL BLOCK NUMBER OF DATA BLOCK + HRR A,CCOUNT ;NUMBER OF CHARS REMAINING IN THAT BLOCK + PUSH P,A ;A POINTER INTO THE ENTRY + PUSH P,BSP + MOVE B,SPP + MOVEM B,BSP + TLO F,GETF + MOVE A,INFILE + MOVE B,G + OPENF + JRST (H) + SIZEF + JRST (H) + MOVEM C,FILSIZ + MOVEI A,400000 + MOVEM A,BUFLOC + MOVEI A,401000 + MOVEM A,BUFLOC+1 + SETOM PBLOCK + SETOM PBLOCK+1 ;NO PAGES IN THE BUFFERS +FILUPD: JRST 1(H) ;LABEL ADDED BY A.G.SMITH--MEANS MODIFICATIONS + ;AT SAVE: AND ERASEN: HAVE NO EFFECT IN TENEX +> + +FOR TEN50,< +FILEGO: PUSH S,CBOT + PUSHJ P,GETFLN + PUSHJ P,GETFLN +FILEGA: MOVE B,-1(S) + HRLI B,(POINT 7,(W),34) + MOVE A,[POINT 6,LUKDAT] + SETZM LUKDAT + MOVEI D,6 +FILGO1: ILDB C,B + JUMPE C,FILGO2 + XORI C,40 ;7 TO 6 BIT CODE + IDPB C,A ;STORE IN LUKDAT + SOJG D,FILGO1 + ILDB C,B + JUMPN C,[ERROR FILER9] ;FILE NAME TOO LONG, TEMP ERR + +FILGO2: INIT 1,17 ;INIT IN DUMP MODE + SIXBIT /DSK/ + Z + ERROR IOPERR + + HRLZI C,(SIXBIT /LGO/) + MOVEM C,LUKDAT+1 ;EXT + SETZM LUKDAT+2 + SETZM LUKDAT+3 + + LOOKUP 1,LUKDAT + JRST (H) ;FILE BUSY OR SOMETHING + HLRE A,LUKDAT+3 ;LENGTH OF FILE + JUMPG A,.+3 ;ALREADY IN BLOCKS + ASH A,-7 + MOVNI A,(A) ;MAKE -WORDS +BLOCKS + HRRZM A,FILSIZ + SETZM LUKDAT+3 ;THIS PRJ PROG AGAIN + JRST FILGO3 ;DON'T OPEN FILE FOR WRITING IF JUST READING + +OPNRW1: ENTER 1,LUKDAT + JRST (H) + +FILGO3: JSP D,SAVEUP + PUSH P,INFILE + MOVEM A,INFILE + HRLZ A,LBLOCK+1 + HRR A,CCOUNT + + PUSH P,A + PUSH P,BSP + MOVE B,SPP + MOVEM B,BSP + TLO F,GETF + + HRLZI C,-2 ; ASSIGN 2 BUFFERS IN WS +OPNRW2: MOVEI A,LBLKL + PUSHJ P,MAKELM + MOVEM B,BUFADR(C) + MOVEI B,@WSB + MOVEI B,1(B) + MOVEM B,BUFLOC(C) + AOBJN C,OPNRW2 + + SETOM PBLOCK + SETOM PBLOCK+1 + JRST 1(H) + +;CALL HERE AFTER OPENING FILE FOR READING IF WANT TO UPDATE IT +FILUPD: ENTER 1,LUKDAT + JRST (H) + JRST 1(H) +> + +CLOSUP: PUSHJ P,CLOSIT + MOVE A,BSP + ADD A,[XWD -2,3] ;TWO OFF THE S, 3 XTRA LEFT ON P + JSP C,SETPDL + + POP P,BSP + POP P,A + HRRZM A,CCOUNT + HLRZM A,LBLOCK+1 + POP P,INFILE + JSP D,RESTOR + SKIPE INFILE ;IS THE POPPED FILE THE TERMINAL? + JRST (H) + TLZ F,GETF + MOVE A,TERMIO + MOVEM A,CHIN + JRST (H) + LFILE: POP P,A + PUSH S,CBOT + PUSHJ P,GETFLN ;ONLY ONE INPUT + PUSH S,(S) ;DUMMY UP ANOTHER + JSP H,FILEGA + ERROR NOFILE + SETZ A, +LFILE1: READ A,0 + HRRZ E,@FPTRL0 + SKIPN 1(E) ;IS THIS DIRECTORY BLOCK EMPTY? + JRST LFIL10 ;YES TRY NEXT + HRLI E,D + MOVE D,2(E) ;TOP OF LIST OF USED ENTRY SLOTS + +LFILE2: HRLZI G,440700 + HRRI G,@E ;FOR THE FIRST 20 CHARS OF ENTRY NAME + MOVNI H,^D20 + ILDB C,G + JUMPE C,LFILE9 ;EOM IS 0 IN DIRECTORY + XCT CHOUT + AOJN H,.-3 + PUSH P,E + PUSH P,D ;READ FILE FOR THE REST OF THE GOODIES + READ 1(G),1 + MOVEI A,4 + ADDM A,@FPTRL1 ;SKIP TYPING FIRST TWENTY CHARS AGAIN + MOVNI A,4*5 + ADDM A,CCOUNT + PUSHJ P,READC + CAIN C,176 + JRST .+3 + XCT CHOUT + JRST .-4 + POP P,D + POP P,E + +LFILE9: PUSHJ P,CRLF + MOVEI D,DRENL-1(D) + SKIPE D,@E + JRST LFILE2 ;NEXT ENTRY IN THIS DIRECTORY +LFIL10: SKIPE A,4(E) + JRST LFILE1 ;NEXT DIRECTORY BLOCK + JRST REDEOF + SAVANR: PUSH P,A + PUSHJ P,FINDAG + SKIPA ;R1_FOUND ONE, R2_NO GLOBAL VAL + JRST APOPJ ; DON'T SAVE IF NO GLOBAL BINDING + MOVSI A,UNBOUN + TDNE A,1(C) ; OR IF UNBOUND + JRST APOPJ + PUSH P,C + MOVEI A,[ASCIZ /MAKE /] + PUSHJ P,PTOSSM + MOVE A,-1(P) ;WHAT NAME + MOVE A,(A) ;NAME OF THING + MOVEI E,024 ;PSEUDO-QUOTE + TRO F,PREFIX!SUFFIX + PUSHJ P,PTOSS + POP P,-1(P) + PUSHJ P,PSPACE + JRST LSTNR1 + +SAVAAR: MOVEI A,[ASCIZ /ABBREVIATE /] + PUSHJ P,PTOSSM + MOVEI E,024 + TRO F,PREFIX!SUFFIX + MOVE A,1(G) + PUSHJ P,PTOSS + MOVEI A,[ASCIZ / AS /] + PUSHJ P,PTOSSM + MOVE A,(G) + TRO F,PREFIX!SUFFIX ;QUOTE THIS ONE TOO + PUSHJ P,PTOSS + JRST CRLF + + + +GETFLN: PUSHJ P,GNE + ERROR ERMSSG + TLNN A,UPRF + ERROR FILER1 + MOVEI A,-1(A) + PUSH S,@RPA + POPJ P, + + + SUBTTL TURTLES OF VARIOUS KINDS + +FOR TURTLE,< +BACK: SKIPA B,[[BYTE (7) 16,177,177,177,177,177,177,0]] +FRONT: MOVEI B,[BYTE (7) 1,177,177,177,177,177,177,0] + JRST TURTEL + +RIGHT: SKIPA B,[[BYTE (7) 10,177,177,177,177,0]] +LEFT: MOVEI B,[BYTE (7) 26,177,177,177,177,0] + JRST TURTEL + +HORN: MOVEI B,[BYTE (7) 35,177,177,0] +TURTEL: PUSHJ P,TOSS ;DO IT + JRST COMEX + +TOUCHE: MOVEI A,101 ;TERMINAL OUTPUT + DOBE ;WAIT FOR EMPTY BUFFER + + MOVEI A,100 ;TERMINAL INPUT + SIBE ;INPUT BUFFER EMPTY + JRST TOUCH1 ;NO + MOVEI A,200 ;8*16MS GTR 1 CHAR TIME + DISMS ;WAIT FOR A POSSIBLE CHAR + + MOVEI A,100 + SIBE ;DID A CHAR COME IN? + JRST .+2 ;YES + JRST ISFALSE ;DIDN'T TOUCH ANYTHING + +TOUCH1: BIN + JRST (D) + +TOUCHLEFT: + JSP D,TOUCHE ;GET A TOUCH CHAR + CAIE B,20 ;CONTROL P + JRST ISFALSE + JRST ISTRUE + +TOUCHRIGHT: + JSP D,TOUCHE + CAIE B,22 ;CONTROL-R + JRST ISFALSE + JRST ISTRUE > + FOR MOCKTURTLE,< +HOME: SETZM CURX ;REAL + SETZM CURY ;REAL + SETZM CURA ; INTEGER DEGREES + SETZM PENPOS ; 0=DOWN + PUSHJ P,SENDUP ; SEND POSITION TO DISPLAY + JRST COMEX + +PENUP: SETOM PENPOS + JRST COMEX +PENDN: SETZM PENPOS + JRST COMEX + +SETXY: PUSHJ P,SETXYR +SETXYO: PUSHJ P,SENDUP +SETXYP: POP S,A + JRST COMEX + +SETX: PUSH P,[SETXYO] +SETXR: PUSHJ P,FLOTA1 ; GET FIRST ARG + MOVE E,M ; X POS IN E + MOVE M,CURY ; Y POS IN M (SAME) + JRST SETXY1 ;SET BOTH X AND Y + +SETY: PUSH P,[SETXYO] +SETYR: PUSHJ P,FLOTA1 + MOVE E,CURX + JRST SETXY1 + +SETXYR: PUSHJ P,FLOTA1 + MOVE E,M ; GET X FIRST + PUSHJ P,FLOTARG ; THEN GET Y +SETXY1: CAMN E,CURX + CAME M,CURY + SKIPA ; AT LEAST ONE IS DIFFERENT + JRST CPOPJ1 ; R2, SKIP OVER THE PUSHJ P,SEND + MOVEM E,CURX + MOVEM M,CURY + POPJ P, ; R1, DO THE SEND + +SETTURTLE: PUSH P,[SETXYO+1] + PUSHJ P,SETXYR + SOS 0(P) ; NOT SKIP RETURN, REFLECT THIS + PUSHJ P,INTARG ; GET THIRD ARG + PUSHJ P,MOD360 + MOVEM N,CURA + POPJ P, +SETHEADING: PUSHJ P,INTAR1 +SETHE1: PUSHJ P,MOD360 + MOVEM N,CURA ; WHEN SENDING WEDGES, CHECK FOR A .NE. CURA + JRST SETXYP ; CHANGING ONLY ANGLE, NO NEED TO SEND X OR Y + +LEFT: PUSHJ P,INTAR1 + MOVNS M + SKIPA +RIGHT: PUSHJ P,INTAR1 + ADD M,CURA + JRST SETHE1 +HERE: PUSHJ P,NEWSTR + MOVE M,CURX + PUSHJ P,FIXSNM + MOVE M,CURY + PUSHJ P,FIXSNM + MOVE M,CURA + PUSHJ P,SNM0 + TRO F,NWF ; THIS IS A SENTENCE + PJRST ENDSTR + + +BACK: PUSHJ P,INTAR1 + MOVNS M + PUSHJ P,FLOAT + SKIPA +FRONT: PUSHJ P,FLOTA1 + PUSH P,M + MOVE M,CURA + PUSHJ P,FLOAT + MOVE A,M ;SAVE ANGLE IN M + PUSHJ P,SIND ;SIN WHERE ONE WOULD EXPECT COS + FMPR A,(P) ; DISTANCE ON STACK + FADR A,CURX + PUSH P,A ; NEW X ON STACK + MOVE A,M + PUSHJ P,COSD ; BECAUSE COORD SYSTEM IS MIRRORED ON X=1,Y=1 + POP P,E ; NEW X LOC + POP P,M ; FLUSH DISTANCE + FMPR M,A + FADR M,CURY + PUSH P,[MOVXYO] + JRST SETXY1 + + +MOVE: PUSHJ P,SETXYR +MOVXYO: PUSHJ P,SENDIT ; SENSITIVE TO PENPOS + POP S,A + JRST COMEX + + +FIXSNM: PUSHJ P,FIX + JUMPGE M,.+4 ; POSITIVE NUMBER + MOVNS M + MOVEI C,"-" + IDPB C,B ; SIGN AND MAGNITUDE + PUSHJ P,SNM0 + PJRST DSPACE ; SPACE AFTER FIRST TWO OF HERE + +FIX: PUSH P,M + MOVMS M + FADR M,[0.5] ; ROUND + MULI M,400 + EXCH M,N + ASH M,-243(N) + SKIPGE 0(P) + MOVNS M + POP P,N + POPJ P, +> +FOR MOCKTURTLE!NRCTUR,< + +FLOTA1: MOVSI M,10700+W + HLLM M,0(S) ; INITIALIZATION FOR FIRST CALL +FLOTAR: PUSHJ P,INTARG +FLOAT: IDIVI M,400 + SKIPE M + TLC M,243000 + TLC N,233000 + FADL M,N + POPJ P, + +INTAR1: MOVSI M,10700+W + HLLM M,0(S) +INTARG: MOVE L,(S) + TRO F,PMF ; + AND - PERMITTED IN THIS STRING + PUSHJ P,DNM+1 ; BEWARE!!! + ERROR ZERERR + ERROR MAGNER ; NUMBER MUCH TOO BIG + + MOVEM L,(S) + POPJ P, +MOD360: IDIVI M,^D360 + CAIGE N,0 + ADDI N,^D360 + POPJ P, + ;WINNING SIN, COS ROUTINES, LIFTED, MINUS COMMENTS, FROM LIB +;ARG AND VALUE IN A, DESTROYS B AND C +;AND STRIPPED OF ALL WASTE MOTION SAVING AC'S + +COSD: FADR A, [90.0] +SIND: FDVR A, [57.295779] + MOVM B,A + CAMG B, [XWD 170000,0] + POPJ P, + FDV B, [1.5707963] + CAMG B, [1.0] + JRST S2 + MULI B, 400 + LSH C, -202(B) + TLZ C, 400000 + MOVEI B, 200 + ROT C, 3 + LSHC B, 33 + FAD B, [0] + JUMPE C, S2 + TLCE C, 1000 + FSB B, [1.0] + TLCE C, 3000 + TLNN C, 3000 + MOVNS B +S2: SKIPGE A + MOVNS B + MOVEM B, A + FMPR B, B + MOVE C, [0.00015148419] + FMP C, B + FAD C, [-0.00467376557] + FMP C, B + FAD C, [0.07968967928] + FMP C, B + FAD C, [-0.64596371106] + FMP C, B + FAD C, [1.5707963] +S2B: FMPR A, C + POPJ P, +> ;END OF ROUTINES OF INTEREST FOR NRC SCREEN TURTLE +FOR MOCKTURTLE,< + +WIPE: PUSHJ P,WIPIT + JRST COMEX + +SENDUP: PUSH P,PENPOS + SETOM PENPOS + PUSHJ P,SENDIT + POP P,PENPOS + POPJ P, + +SENDIT: MOVSI E,-2 +SENDT1: MOVE M,CURX(E) + PUSHJ P,FIX + ADDI M,SCRNSZ/2 + CAIL M,0 + CAILE M,SCRNSZ + ERROR OFSCRN + MOVEM M,TURX(E) + AOBJN E,SENDT1 + PJRST SENDXY + +OPNTUR: HRROI 1,[ASCIZ / +TURTLE PORT? /] + PSOUT + MOVSI 1,460003 + MOVE 2,[XWD 100,101] + GTJFN + ERROR TNXERR + MOVE 2,[10B5+1B20] ;BINARY, OUTPUT USE + OPENF + ERROR TNXERR + MOVEM 1,TURJFN + PUSHJ P,WIPIT + PUSH P,TURX + PUSH P,TURY + SETZM TURX + SETZM TURY + PUSHJ P,SENDUP ; QUICK AND DIRTY HOME + POP P,TURY + POP P,TURX + POPJ P, + +FOR COMPTK,< +SCRNSZ==^D800 +SENDXY: SKIPN 1,TURJFN ; BEWARE THAT ER ALL DOES NOT KILL IT + PUSHJ P,OPNTUR + MOVE 2,TURY + PUSHJ P,SPLIT + SKIPE PENPOS + TRZ 2,1 + PUSHJ P,SENDON + MOVE 2,3 + PUSHJ P,SENDON + MOVE 2,TURX + PUSHJ P,SPLIT + PUSHJ P,SENDON + MOVE 2,3 +SENDON: TRNN 2,40 + TRO 2,100 + BOUT + POPJ P, + +SPLIT: IDIVI 2,20 + EXCH 2,3 + ROT 2,2 + IORI 2,3 + POPJ P, + +WIPIT: SKIPN 1,TURJFN + PUSHJ P,OPNTUR + MOVE 2,[POINT 8,WIPSTR] + SETZ 3, + SOUT + DOBE ; WAIT FOR ^L TO GET OUT + MOVEI 1,^D500 + DISMS + MOVE 1,TURJFN + POPJ P, +WIPSTR: BYTE (8) 100,100,100,100,27,6,34,137,100,100,100,100,6,14,34,0 +> + +FOR MITREI,< +SCRNSZ==^D1023 +SENDXY: SKIPN 1,TURJFN + PUSHJ P,OPNTUR + MOVEI 2,3 ; MOVE OP CODE + SKIPE PENPOS + MOVEI 2,2 ; SET PTR OP CODE + BOUT + MOVSI 4,-2 +SNDXY1: MOVE 2,TURX(4) + IDIVI 2,200 ; LOW ORDER 7 BITS IN SECOND BYTE + BOUT + MOVE 2,3 + BOUT + AOBJN 4,SNDXY1 + + SKIPE PENPOS ; YES, BUT WAS IT A MOVE? + POPJ P, ;NO + DOBE ; WAIT FOR ALL TURTLE CHARS TO GET OUT + MOVEI 1,^D350 + DISMS ; AND WAIT ONE SECOND MORE + POPJ P, + +WIPIT: SKIPN 1,TURJFN + PUSHJ P,OPNTUR + MOVEI 2,1 + BOUT + POPJ P, +> +> + FOR NRCTUR,< +BACK: PUSHJ P,FLOTA1 ;GET ONE INTEGER ARGUMENT AND FLOAT IT + MOVNS M ;BACK IS INVERSE OF FORWARD + SKIPA +FORWARD:PUSHJ P,FLOTA1 + MOVE B,[XWD TURNYH,TUROYH] + BLT B,TUROFY ;SAVE CURRENT COORDINATES AS OLD + MOVE A,ORIENT ;NOW GET TURTLE'S ORIENTATION + FSC A,233 ;FLOAT IT + PUSHJ P,COSD ;CALCULATE COSINE(ORIENTATION ANGLE) + FMPR A,M ;MULTIPLY BY COMMAND ARGUMENT (RANGE) + FADRM A,TURNFX ;ADD TO PREVIOUS X + MOVE A,ORIENT + FSC A,233 + PUSHJ P,SIND ;CALCULATE SINE(ORIENTATION ANGLE) + FMPR A,M ;MULTIPLY BY RANGE + FADRM A,TURNFY ;ADD TO PREVIOUS Y + POP S,A ;FLUSH ARGUMENT OF COMMAND + +;POSITION IS NOW UPDATED IN VIRTUAL SPACE. CALCULATE HOW MUCH, +;IF ANY, OF THE VECTOR IS VISIBLE ON THE PHYSICAL SCREEN AND DISPLAY AS MUCH. + + PUSHJ P,CALCVS ;CALCULATE VISIBLE PORTION OF VECTOR + JRST COMEX ;RETURN 1 -- POSITION WAS AND IS OFF-SCREEN + PUSHJ P,TURBYT ;CONVERT TO TERMINAL BYTES + TROE F,GRAPHF ;IS GRAPH MODE ALREADY ON? + JRST TURCON ;YES, CURSOR POSITION IS AS EXPECTED + MOVEI C,GRFON ;NO, SET GRAPHIC MODE AGAIN. + PUSHJ P,TYO0 +FOR PLSTUR,< + MOVEI C,CNTRLB ;SET FOR CURSOR POSITIONING + PUSHJ P,TYO0 ; + MOVEI C,PCHAR ; + PUSHJ P,TYO0 ; + MOVE C,TUROXH + PUSHJ P,TYO0 + MOVE C,TUROXL + PUSHJ P,TYO0 + MOVE C,TUROYH + PUSHJ P,TYO0 + MOVE C,TUROYL + PUSHJ P,TYO0 +> +FOR TEKTUR,< + HRLZI M,-4 ;SET AN INDEX FOR A LOOP OF 4 CHARACTERS +TURPP: MOVE C,TUROYH(M) ;GET BYTES FOR POSITION SPECIFICATION + PUSHJ P,TYO0 ;SEND THEM ONE AT A TIME + AOBJN M,TURPP +TURCON: MOVEI C,GRFON ;PREPARE TO SEND A "DARK" VECTOR + SKIPE PENST ;IN CASE PEN IS RAISED + PUSHJ P,TYO0 ;IT IS--MUST PRECEDE VECTOR WITH "GRFON" CH. + PUSHJ P,TURBYT ;GENERATE TERMINAL CONTROL BYTES + MOVE C,TURNYH ;NOW SEND THE NECESSARY BYTES + CAME C,TUROYH ;THERE ARE FOUR RULES: + PUSHJ P,TYO0 ;(1) BYTES MUST BE SENT IN ORDER YH,YL,XH,XL + MOVE C,TURNXH ;(2) BYTE XL MUST ALWAYS BE SENT + CAME C,TUROXH ;(3) IF XH IS SENT, YL MUST BE SENT + JRST TURXHN ;(4) SUBJECT TO ABOVE CONSTRAINTS, BYTES + MOVE C,TURNYL ; WHICH HAVE NOT CHANGED NEED NOT BE SENT + CAME C,TUROYL + PUSHJ P,TYO0 + JRST TURLAS +TURXHN: MOVE C,TURNYL + PUSHJ P,TYO0 + MOVE C,TURNXH + PUSHJ P,TYO0 +TURLAS: MOVE C,TURNXL + PUSHJ P,TYO0 + JRST COMEX ;THAT'S ALL +> + +FOR PLSTUR< +TURCON: MOVE C,PENST ;IS PEN UP? + JUMPE C,PNDOWN ;NO + MOVEI C,CNTRLB ;YES,NEXT POSITION JUST POSITIONS CURSOR + PUSHJ P,TYO0 ;SO SEND CONTROL-B + P TO INDICATE THIS + MOVEI C,PCHAR ; + PUSHJ P,TYO0 ; +PNDOWN: MOVE C,TURNXH ;SEND THE NECESSARY BYTES TO DRAW THE VECTOR + CAME C,TUROXH ;EACH (X,Y) POSITION IS TRANSMITTED AS A STRING OF + PUSHJ P,TYO0 ;2,3, OR 4 CHARACTERS IN THE SEQUENCE XH,XL,YH,YL + MOVE C,TURNXL ;SUCH THAT XL AND YL ARE SENT FOR EVERY POSITION AND + PUSHJ P,TYO0 ;XH AND/OR YH ARE SENT ONLY IF THEY HAVE CHANGED + MOVE C,TURNYH ;FROM THE PREVIOUS POSITION. + CAME C,TUROYH + PUSHJ P,TYO0 + MOVE C,TURNYL + PUSHJ P,TYO0 + JRST COMEX +> + ;SUBROUTINE TO CALCULATE THE POINTS OF INTERSECTION OF THE EDGES OF THE VISIBLE +;SCREEN WITH THE LINE FROM OLD POSITION TO NEW POSITION IN VIRTUAL SPACE. + +NXHF==1 +NXLF==2 +NYHF==4 +NYLF==10 +OXHF==20 +OXLF==40 +OYHF==100 +OYLF==200 +ALLXYF==377 ;ALL THE ABOVE FLAGS +ALLOF==360 ;THE "OLD" FLAGS + +CALCVS: TRZ C,ALLXYF ;USE REGISTER C FOR LOCAL FLAGS + MOVE M,TURNFX ;GET END-POINT OF VECTOR, X + PUSHJ P,SFIXM ;SCALE AND FIX (CONVERT TO INTEGER) + MOVE A,M ;SAVE X IN A + CAILE M,HILIMX ;TEST HIGH + TRO C,NXHF ;RIGHT OF SCREEN + CAIGE M,LOLIMX ;TEST LOW + TRO C,NXLF ;LEFT OF SCREEN + MOVE M,TURNFY ;PICK UP Y + PUSHJ P,SFIXM ;SCALE AND FIX + MOVE B,M ;SAVE Y IN B + CAILE M,HILIMY ;TEST HIGH + TRO C,NYHF ;ABOVE SCREEN + CAIGE M,LOLIMY + TRO C,NYLF ;BELOW SCREEN + MOVE M,TUROFX ;FIGURE OUT WHERE WE CAME FROM + PUSHJ P,SFIXM ;COMPARE VECTOR ORIGIN WITH SCREEN LIMITS + CAILE M,HILIMX + TRO C,OXHF + CAIGE M,LOLIMX + TRO C,OXLF + MOVE M,TUROFY + PUSHJ P,SFIXM + CAILE M,HILIMY + TRO C,OYHF + CAIGE M,LOLIMY + TRO C,OYLF + TRCN C,ALLXYF ;WERE ANY FLAGS SET? + AOSA (P) ;NO, RETURN TO RETURN 2 + TRNN C,NXHF+OXHF ;ARE NEW AND OLD X RIGHT OF SCREEN? + POPJ P, ;YES, RETURN 1 -- STILL OFFSCREEN + TRNN C,NXLF+OXLF ;ARE NEW AND OLD X LEFT OF SCREEN? + POPJ P, ;YES, AGAIN ENTIRE VECTOR IS OFF-SCREEN + TRNN C,NYHF+OYHF ;AND SO ON... + POPJ P, + TRNN C,NYLF+OYLF + POPJ P, + TRC C,ALLXYF ;RESTORE FLAGS TO THEIR SET STATE + TRNN C,ALLOF ;NOW, WAS THE PREVIOUS POINT ON-SCREEN? + JRST OXYOK ;YES, SO WE DON'T NEED TO WORRY ABOUT IT. + TRNN C,OXHF+OXLF ;NO + JRST OLDXOK ;OLD X IS WITHIN LIMITS + MOVEI A,HILIMX ;SET A TO PROPER LIMIT FOR X + TRNE C,OXLF + MOVEI A,LOLIMX + PUSHJ P,VEDGEX ;RECALCULATE CORRESPONDING Y +OLDXOK: TRNN C,OYHF+OYLF + JRST OXYSET ;OLD X AND Y ARE NOW PROPERLY SET IN A AND B + TRNN C,OXHF+OXLF ;HAS Y JUST BEEN RECALCULATED? + JRST OLDY2 ;NO, Y IS STILL TOO HIGH + CAIG B,HILIMY ;YES, MAYBE OLD Y IS OK NOW. + CAIGE B,LOLIMY + JRST OLDY2 ;NO SUCH LUCK + JRST OXYSET ;YES, OLD X AND Y ARE OK +OLDY2: MOVEI B,HILIMY ;ASSUME OLD Y WAS TOO HIGH + TRNE C,OYLF ;OR WAS IT TOO LOW? + MOVEI B,LOLIMY + PUSHJ P,VEDGEY ;RECALCULATE X ON THIS BASIS + CAIG A,HILIMX ;NOW SEE IF RECALCULATED X IS OK + CAIGE A,LOLIMX + POPJ P, ;NO, THE NEW VECTOR IS COMPLETELY OFF-SCREEN +OXYSET: PUSHJ P,TURBYT ;TIME TO CONVERT TO TERMINAL BYTES + MOVE M,[XWD TURNYH,TUROYH] + BLT M,TUROXL ;MUST MOVE BYTES TO WHERE THEY SHOULD BE + TRZ F,GRAPHF ;ALSO RESET GRAPH MODE SO CURSOR WILL + ; GET REPOSITIONED +OXYOK: SETCMM OFFSCR ;COMPLEMENT OFF-SCREEN STATE + MOVE M,TURNFX ;RE-CONVERT X AND Y + PUSHJ P,SFIXM + MOVE A,M + MOVE M,TURNFY + PUSHJ P,SFIXM + MOVE B,M + TRNN C,NXHF+NXLF ;IS NEW X WITHIN LIMITS? + JRST NEWXOK ;YES + MOVEI A,HILIMX ;NO, ASSUME IT IS TOO HIGH + TRNE C,NXLF ;UNTIL FLAG IS CHECKED + MOVEI A,LOLIMX + PUSHJ P,VEDGEX ;RECALCULATE Y +NEWXOK: TRNN C,NYHF+NYLF ;ANYTHING ELSE NEED ATTENTION? + JRST CPOPJ1 ;NO, WE'RE DONE, RETURN TO RETURN 2 + TRNN C,NXHF+NXLF ;HAS NEW Y JUST BEEN RECALCULATED? + JRST NEWY2 ;NO + CAIG B,HILIMY ;YES, IS Y OK YET? + CAIGE B,LOLIMY + JRST NEWY2 ;NO, IT IS STILL TOO FAR OUT + JRST CPOPJ1 ;YES, WE'RE DONE AFTER ALL +NEWY2: MOVEI B,HILIMY ;HIGH? + TRNE C,NYLF + MOVEI B,LOLIMY ;LOW + PUSHJ P,VEDGEY ;RECALCULATE X + JRST CPOPJ1 ;IF IT ISN'T WITHIN LIMITS, SOMETHING IS WRONG + VEDGEX: MOVE M,TURNFX + FSBR M,TUROFX ;(XN-XO) + MOVE N,A ;GET XEDGE + FSC N,233 ;FLOAT IT + FDVR N,[TURSSC] ;NORMALIZE IT + FSBR N,TUROFX ;(XEDGE-XO) + FDVR N,M ;(XEDGE-XO)/(XN-XO) TO N + MOVE M,TURNFY + FSBR M,TUROFY ;(YN-YO) TO M + FMPR M,N ;(YN-YO)*((XEDGE-XO)/(XN-XO)) + FADR M,TUROFY ;(YN-YO)*((XEDGE-XO)/(XN-XO))+YO + PUSHJ P,SFIXM ;SCALE AND FIX M + MOVE B,M ;STORE IN B + POPJ P, + +VEDGEY: MOVE M,TURNFY ;COMPUTE (XN-XO)*((YEDGE-YO)/(YN-YO))+XO + FSBR M,TUROFY + MOVE N,B ;GET YEDGE + FSC N,233 + FDVR N,[TURSSC] + FSBR N,TUROFY + FDVR N,M + MOVE M,TURNFX + FSBR M,TUROFX + FMPR M,N + FADR M,TUROFX + PUSHJ P,SFIXM + MOVE A,M + POPJ P, + +TURBYT: MOVE M,A ;GET X CO-ORDINATE (KNOWN TO BE ON-SCREEN) + IDIVI M,^D32 ;SEPARATE INTO HIGH AND LOW ORDER + ADDI M,HIXOFS ;ADD CHARACTER OFFSET + MOVEM M,TURNXH ;AND STORE + ADDI N,LOXOFS ;ADD OFFSET FOR LOW-ORDER + MOVEM N,TURNXL ;AND STORE LOW + MOVE M,B ;DO THE SAME FOR Y + IDIVI M,^D32 + ADDI M,HIYOFS + MOVEM M,TURNYH + ADDI N,LOYOFS + MOVEM N,TURNYL + POPJ P, + POPJ P, + ;COMMANDS FOR LEFT, RIGHT, HOME, PAGE, PENUP, PENDOWN, AND (TEST) OFFSCREEN + +RIGHT: PUSHJ P,INTAR1 ;GET AN INTEGER ARGUMENT + MOVNS M ;RIGHT IS INVERSE OF LEFT + SKIPA +LEFT: PUSHJ P,INTAR1 + ADD M,ORIENT ;ADD TO CURRENT ORIENTATION + PUSHJ P,MOD360 ;CORRECT IT MOD 360 + MOVEM N,ORIENT + POP S,A ;FLUSH ARGUMENT + JRST COMEX + +PENUP: SETOM PENST ;RAISE PEN + JRST COMEX +PENDN: SETZM PENST ;LOWER PEN + JRST COMEX + +HOME: PUSHJ P,TURRST + JRST COMEX + +TURRST: MOVE A,[POINT 7,[TURHOM]] + HRLZI B,-4 ;SET UP A LOOP INDEX + ILDB C,A ;PICK UP THE CHARACTERS DEFINING HOME + MOVEM C,TURNYH(B) ;STORE THE FOUR POSITION BYTES + AOBJN B,.-2 + ILDB C,A ;THEN GET THE HOME ORIENTATION + MOVEM C,ORIENT ;AND SET IT BACK + MOVE C,[TURHMX] ;SET ALSO THE BASIC POSITION LOCATIONS + MOVEM C,TURNFX + MOVE C,[TURHMY] + MOVEM C,TURNFY + SETZM PENST ;LOWER PEN + SETZM OFFSCR ;AND NOTE THAT WE ARE NOW ON-SCREEN + TRZ F,GRAPHF ;CLEAR THE GRAPHICS MODE FLAG, SO THAT + POPJ P, ;TERMINAL WILL BE SET PROPERLY. + +TOFFSC: SKIPE OFFSCR ;THIS IS A BOOLEAN FUNCTION + JRST ISTRUE ;WHICH IS TRUE IF PEN IS OFF-SCREEN + JRST ISFALSE ;AND FALSE IF PEN IS ON-SCREEN + +PAGE: MOVEI B,[NEWPAG] ;GET ADDRESS OF NEW PAGE STRING. + PUSHJ P,TOSS ;AND SEND IT OUT + JRST COMEX + SFIXM: PUSH P,M ;SAVE ARGUMENT FOR SIGN + FMPR M,[TURSSC] ;MULTIPLY BY SCREEN SCALE FACTOR + MOVM M,M ;WORK WITH ABSOLUTE VALUE + MULI M,400 ;SEPARATE FRACTION & EXPONENT + EXCH M,N ;GET MANTISSA BACK IN M + CAIL N,243 ;IS ABSOLUTE VALUE TOO HIGH? + SKIPA M,[377777777777] ;YES, SET TO MAXIMUM INTEGER + ASHC M,-243(N) ;NO, USE EXPONENT TO CALCULATE SHIFT + TLNE N,200000 ;ROUND IF NECESSARY + ADDI M,1 ; + POP P,N ;GET BACK ORIGINAL ARGUMENT + SKIPGE N ;TO CORRECT THE SIGN + MOVN M,M + POPJ P, ;AND EXIT +> + SUBTTL MUSIC SYSTEM + +FOR MUSIC,< +MBLGTH==^D300 ;ROOM FOR 1800 CHARACTERS--1 MINUTE AT 300 BAUD +MBINCR==^D300 ;SIZE OF ADDITIONAL REQUESTS + +;VOICES +VOICES: PUSHJ P,INTAR1 ;GET AN INTEGER ARGUMENT + CAIL M,1 ;MUST BE IN RANGE 1-4 + CAILE M,4 + ERROR MBVOC ;OTHERWISE ERROR MESSAGE + MOVEM M,NVOICE + JRST COMXS1 + +;MBUFCOUNT +MBCNT: HLRZ B,MBPOS ;OUTPUT THE CURRENT BUFFER COUNT + ANDI B,(77B5) ;GET JUST THE BYTE POSITION PART OF POINTER + IDIVI B,(6B5) ;CHARACTERS ARE 6 BITS LONG + HRRZI M,@MBPOS ;NOW ADD FULL-WORDS + SUBI M,@MBUFP + IMULI M,6 ;6 BYTES TO THE WORD + SUB M,B ;WORKS SINCE THERE ARE NO BYTES IN WORD 0 +NUMRET: PUSHJ P,SNM ;OUTPUT NUMERIC RESULT AS A STRING + PJRST ENDSTR + +;MBUFNEXT +;MOVE AHEAD ARG NUMBER OF PLACES IN MUSIC BUFFER +MBNXT: PUSH P,[COMXS1] ;SO THAT RETURN CAN BE VIA POPJ + PUSHJ P,INTAR1 ;NUMERIC ARGUMENT INTO M + JUMPL M,[ERROR MBFOR] ;CANNOT MOVE BACKWARD + MOVE A,M + IDIVI A,6 ;CALCULATE NUMBER OF WORD TO MOVE MBPOS + ADDM A,MBPOS ;MBPOS IS BYTE POINTER TO PLACE IN MUSIC BUFFER + AOJA B,MBNXT1 ;B IS REMAINDER FROM DIVIDE ABOVE + +MBNXTX: MOVE B,NVOICE ;NUMBER OF VOICES (SING ENTERS HERE) +MBNXT2: IBP MBPOS +MBNXT1: SOJG B,MBNXT2 + MBNXT3: HRRZI A,@MBPOS + SUBI A,@MBUFP + HRRZ B,@MBUFP ;GET CURRENT BUFFER LENGTH + CAIG A,(B) ;IS THIS BUFFER FULL? + POPJ P, ;NO EXIT + MOVEI A,MBINCR ;YES THROW IT OUT AND GET A BIGGER ONE + MOVE B,MBUFP + PUSHJ P,COPYUP + SUB B,MBUFP ;RETURNS WITH POINTER TO NEW BUFFER IN B + ADDM B,MBUFP ;SET NEW POINTER + ADDM B,MBPOS ;CORRECT MBPOS AND MBMAX TOO + ADDM B,MBMAX + ADDI A,1 ;AND A POINTS TO (COPY) OF LAST WORD OF OLD + SETZM @A ;CLEAR NEW SECTION OF BUFFER + MOVEI A,@A ;CHANGE FROM INDEXED TO ABSOLUTE ADDRESS + HRLI A,(A) + MOVEI B,MBINCR-1(A) ;END OF NEW BUFFER + ADDI A,1 + BLT A,(B) ;PROPAGATE THE ZERO + JRST MBNXT3 ;AND TEST AGAIN + +;MBUFPUT +;PUT A NOTE INTO THE MUSIC BUFFER +MBPUT: PUSH P,[COMXS1] ;SO THAT EXIT CAN BE VIA POPJ + PUSHJ P,INTAR1 +MBPUTX: SKIPL M ;(SING ENTERS HERE THE FIRST TIME) + CAILE E,^D63 ;ALLOWABLE RANGE FOR NOTES + ERROR MBNOTE ;OUT OF RANGE +MBPUTY: DPB M,MBPOS + POPJ P, + +;MBUFOUT +;OUTPUT THE BUFFER TO THE MUSIC BOX +MBOUT: + SKIPN BXTYPE ;OLD OR NEW BOX? + JRST MBNEW ;NEW + MOVE B,[POINT 7,[BYTE (7) 01,60,60,60,66]] ;SEND HEADER + ;^Q,J FOR NEW BOX--DEC 1974 + MOVEI A,5 ;TO SELECT AUXILIARY DEVICE #6 (MUSIC BOX) + ILDB C,B + PUSHJ P,TYO0 + SOJG A,.-2 + JRST MBCONT +MBNEW: MOVEI C,021 ;GET ^Q + TTCALL 15,C ;OUTPUT IN IMAGE MODE TO OMIT FILLER RUBOUT + MOVEI C,"J" ;NOW J TO SWITCH NEW BOX TO MUSIC + PUSHJ P,TYO0 +MBCONT: MOVEI C,"#" ;NOW SET CONTROL STATE REGISTER + PUSHJ P,TYO0 + MOVE C,STCATO ;GET NUMBER OF VOICES TO PLAY STACCATO + LSH C,2 ;GOES INTO BITS 4 AND 3 + MOVE A,NVOICE ;GET NO. OF VOICES + ADD C,SILENT-1(A) ;CHOOSE WHICH VOICES TO BE SILENT + SUB C,NVOICE ;AND SET NUMBER OF VOICES IN BITS 2 AND 1 + PUSHJ P,TYO0 ;BITS 3 AND 4 ZERO SILENCES ALL VOICES + PUSHJ P,UPDMAX ;UPDATE MBMAX + HRLZI B,(POINT 6,(W),35) + HRR B,MBUFP ;ADD BASE OF BUFFER RELATIVE TO W + JRST MBOUT3 + +SILENT: 124 ;VOICES 0,1,2 SILENT + 44 ;VOICES 0,1 SILENT + 64 ;NONE SILENT + 64 ;NONE SILENT + MBOUT2: TLZE F,BREAKF ;IS THERE A BREAK PENDING? + ERROR BREAK ;YES, TAKE IT NOW + ILDB C,B + ADDI C,40 ;CHANGE TO ASCII + PUSHJ P,TYO0 +MBOUT3: CAME B,MBMAX ;DONE YET? + JRST MBOUT2 ;NO, CONTINUE + SKIPE BXTYPE ;OLD OR NEW BOX?? + JRST MBOLD ;OLD + MOVEI B,[BYTE (7) 43,100,0] ;SHUT UP THE NEW TYPE OF + PUSHJ P,TOSS ;MUSIC BOX, AND TERMINATE MESSAGE PER PROTOCOL + MOVEI C,021 ;GET ^Q + TTCALL 15,C ;OUTPUT IN IMAGE MODE TO AVOID FILLER CHAR + MOVEI C,040 ;GET AND SEND SPACE + PUSHJ P,TYO0 + ;^Q,SPACE FOR NEW BOX -- DEC 1974 + JRST COMEX +MBOLD: MOVEI B,[BYTE (7) 43,100,15,36,0] ;SHUT UP OLD MUSIC BOX + PUSHJ P,TOSS ;AND TERMINATE MESS PER PROTOCAL + JRST COMEX + +; NEXT TWO PROCEDURES JUST SET THE TYPE OF MUSIC BOX THAT IS TO BE +; USED. + +NEWMUSIC: + SETZM BXTYPE ;NEW BOX + JRST COMEX +OLDMUSIC: + SETOM BXTYPE ;OLD BOX + JRST COMEX + +;MBUFINIT & +;MBUFCLEAR +MBCLR: HRRZ A,@MBUFP ;WHAT'S THE CURRENT BUFFER LENGTH + CAIG A,^D1024+MBLGTH ;COULD WE SAVE 1K OR MORE BY STARTING AFRESH? + JRST MBCLRX ;NO PROCEED WITH WHAT WE HAVE +MBINIT: MOVEI A,MBLGTH ;YES REQUEST A NEW BUFFER + PUSHJ P,MAKELM ;(OLD ONE, IF ANY, WILL BE GARBAGE COLLECTED) + MOVEM B,MBUFP +MBCLRX: HRRZ A,MBUFP + HRLI A,(POINT 6,(W),35) ;FORM A POINTER INDEXED BY W + IBP A + MOVEM A,MBPOS + MOVEM A,MBMAX + MOVEI A,@MBUFP ;GET POINTER TO ZEROTH WORD OF BUFFER + ADDI A,1 + SETZM (A) ;CLEAR FIRST WORD + HRLI A,(A) + HRRZ B,@MBUFP ;GET LENGTH INTO B + ADDI B,-1(A) ;FORM ADDRESS OF LAST DATA WORD + ADDI A,1 + BLT A,(B) ;PROPAGATE ZEROS THROUGH THE BUFFER + JRST COMEX + ;MBUFSTART +MBSTRT: PUSHJ P,UPDMAX ;UPDATE MBMAX + HRRZ A,MBUFP + HRLI A,(POINT 6,(W),35) + IBP A + MOVEM A,MBPOS + JRST COMEX + +;SING +;SING A SINGLE NOTE WITH DURATION + +SING: SKIPN MBUFP ;CHECK TO SEE THAT STARTMUSIC HAS BEEN RUN + ERROR MBNOTI ;ERROR IF NOT + PUSHJ P,INTAR1 ;GET THE DURATION INTO M + POP S,A ;FLUSH THE ARGUMENT + JUMPE M,COMXS1 ;IF 0 DURATION, DO NOTHING + SKIPG D,M ;SAVE DURATION IN D + ERROR MBDUR ;NEGATIVE DURATIONS AREN'T ALLOWED + PUSHJ P,INTAR1 ;PICK UP PITCH + ADDI M,^D28 ;0 CORRESPONDS TO ABS 28 (MIDDLE C) + PUSHJ P,MBPUTX ;PUT INTO THE MUSIC BUFFER + PUSHJ P,MBNXTX ;INCREMENT POSITION BY # OF VOICES + SOJLE D,COMXS1 ;DECREMENT DURATION. DONE IF 0 NOW. + SOJLE D,SING3 ;DECREMENT AGAIN. BRANCH IF DUR WAS 2 + CAIG M,2 ;IS THE NOTE BOOM, GRITCH OR REST? + SETZ M, ;IF SO, ONLY PLAY ONE PER NOTE +SING2: PUSHJ P,MBPUTY + PUSHJ P,MBNXTX ;STORE BYTE AND INCREMENT POSITION + SOJG D,SING2 ;LOOP BACK AS MANY TIMES AS NECESSARY +SING3: SETZ M, ;END WITH ONE TIME PERIOD OF SILENCE + PUSHJ P,MBPUTY + PUSHJ P,MBNXTX +COMXS1: POP S,A + JRST COMEX + +UPDMAX: MOVE A,MBPOS ;SEE IF MBPOS IS AHEAD OF MBMAX + HRRZ B,MBMAX + CAILE B,(A) ;FIRST COMPARE WORD ADDRESSES + POPJ P, + CAIN B,(A) ;IF NOT THE SAME, THEN MBPOS WINS + CAMG A,MBMAX ;WORD ADDRESSES MATCH, COMPARE BYTE POSITIONS + MOVEM A,MBMAX ;(BYTE POSITION COMPARES IN OPPOSITE SENSE) + POPJ P, + SUBTTL ERROR ROUTINES + +ERRORR: MOVE P,[IOWD ERPDLL,ERRPDL] + TRZ F,PREFIX!SUFFIX + MOVE A,TERMIO+1 + TLZE F,SAVEF + MOVEM A,CHOUT + SKIPE CHARNO + PUSHJ P,CRLF + HRRZ C,JOBUUO + CAIL C,MAXERR + SETZ C, + HLRZ A,ERRORS(C) ;GET TEXT MESSAGE + HRLI A,440700 + HRRZ B,ERRORS(C) ;GET DISPATCH FOR COMPUTATIONAL ERRORS + JUMPN B,(B) ;DISPATCH IF A COMPUTATIONAL ERROR +ALLERP: PUSHJ P,PTOS ;TYPE GENERAL MESSAGE +ALLERR: PUSHJ P,CRLF + SKIPN PRODNM ;WERE WE INSIDE A USER PROCEDURE? + JRST ERROUT + MOVEI A,[ASCIZ /I WAS AT LINE /] + PUSHJ P,PTOSSM + MOVE A,LINENO + PUSHJ P,DECPRT + MOVEI A,[ASCIZ / IN /] + PUSHJ P,PTOSSM + JSP N,PUNAME ;PRINT PROCEDURE NAME + PUSHJ P,CRLF + JRST ERROUT + + +NONAME: PUSHJ P,PTOS + HRRZ A,UUOTRP + SUBI A,1 + PUSHJ P,OCTPRT + JRST ALLERR + +ERROUT: TDZ F,[XWD TIF!NOBREAK,MAKEF] + MOVE P,UUOACS+P ;SAFE TO USE REGULAR PDL NOW + TLZE F,BROKE ;WAS ERROR THE BREAK KEY + SKIPN PRODNM ;AND WAS A STORED LINE INTERRUPTED? + JRST FLUSHM + + + +FOR SAVBRK,< +ERROT2: TLZ F,RQF ;WHICH WAY DO WE CALL MAINL + TLZE F,TOF ;IN A PRINT OR TYPE? + JRST ERROT4 ;YES, GO PROCEEDS WITH THE NEXT LINE + TLZN F,GETF ;IN A GET? + JRST ERROT3 ;NO, BREAK AT EXECUTE RESTARTS CURRENT LINE + + JSP H,CLOSUP + MOVE A,BSP ;GETTING, CLOSE THE FILE AND + JSP C,SETPDL ;SET UP TO REDO THE GET ON A GO + MOVE A,TERMIO + MOVEM A,CHIN + JSP D,RESTOR ;RESTORE THE LINE THAT HAD THE GET + +ERROT3: SOS LINENO ;SO UPNEXT WILL FIND THIS ONE AGAIN +ERROT4: MOVE A,SPP + ADDI A,1 + JSP C,SETPDL ;GET TO BEGINNING OF THE LINE + PUSH P,BSP + JSP D,SAVEUP ;SAVEUP FOR GO + AOS GODEPTH ;ONE MORE GO ON THE STACK + MOVE A,SPP + MOVEM A,BSP ;NEW "TOP LEVEL" +FOR TENEX,< MOVEI A,101 ;TERMINAL OUTPUT + DOBE > ;DISMISS UNTIL ERROR MESSAGE IS + ;COMPLETELY OUT +FOR DRIBBLE, ;BUT DON'T ASK FOR INITIALS + JRST RESET > ;CLEAR WATING BREAKS AND RESTART PSI + + +FLUSHM: TLZN F,GETF ;NO, BUT WERE WE GETTING FROM A FILE? + JRST ERROT1 ;NO + JSP H,CLOSUP + +ERROT1: HRRZ G,BSP + ADD G,PP +FLUSHL: MOVE A,SPP + ADDI A,1 + JSP C,SETPDL + CAIL G,(P) ;SET BACK TO BSP? + JRST FLUSHE ;YES + POP P,A ;RETURN FROM EXECUTE + JSP D,RESTOR ;ONE MORE PDL LEVEL + JRST FLUSHL + +FLUSHE: GARBAG +FOR DRIBBLE, ;DO NOT REOPEN DRIBBLE FILE + JRST RESET + +MATCHG: PUSHJ P,PTOS + MOVE C,UUOACS+D ;THE OFFENDING TERMINATOR + PUSHJ P,TYO +MATCG1: MOVEI C,"?" + PUSHJ P,TYO + JRST ALLERR + +ILLUUO: MOVEI B,[ASCIZ /HELP!!/] + PUSHJ P,TOSS + JRST ALLERR + +.INER3: PUSHJ P,PTOS + MOVE A,CBOT + ADDI A,1 + MOVE A,@WSA + PUSHJ P,PTOSS + MOVE A,[POINT 7,[ASCIZ / OF WHAT PROCEDURE?/],] + JRST ALLERP + +.NMER3: SKIPA E,-1(S) +.TOER3: MOVE E,1(S) + EXCH E,A + HRLI A,(POINT 7,(W),34) +TYPAFT: PUSHJ P,PTOS + MOVE A,E + JRST ALLERP + +CANTBS: MOVE E,A + MOVE A,(S) + JSP H,ETLIT + JRST CANTB0 +CANTBA: SKIPA E,UUOACS+A +CANTBT: MOVE E,THISPR + EXCH A,E + JSP H,ETYPIT +CANTB0: MOVEI A,[ASCIZ / CAN'T BE A /] +CANTB1: HRLI A,440700 + JRST TYPAFT + +.GOER2: MOVE E,A + MOVE A,UUOACS+D + JRST TYPAFT-1 + +.GOER3: PUSHJ P,PTOS + SKIPA A,UUOACS+D +.XITER: POP S,A +.GOER4: HRLI A,(POINT 7,(W),34) + JRST ALLERP + +.NOPRO: PUSHJ P,PTOS + SOS A,UUOACS+A + HRRZ A,@RPA + JRST .GOER4 + +.TNAME: PUSHJ P,PTOS + JSP N,TUNAME + JRST ALLERR +.PMNAM: JSP N,PMNAME + JRST ALLERP + +.COMER: TLZN F,UPFF + JRST .PMNAM ;A SYSTEM COMMAND + SKIPA E,UUOACS+E ;A USER DEFINED COMMAND +UNDFND: MOVE E,UUOACS+A + JSP N,PUNAM1 + JRST ALLERP + +TWOARG: PUSH P,A + HRRZ B,THISPR + CAIL B,RPREN ;INFIX OPS ABOVE ) + JRST .ITWOA ;TYPE "A" + "B" + JSP N,PMNAME + MOVEI B,[ASCIZ / OF /] + PUSHJ P,TOSS + MOVE A,-1(S) + JSP H,ETLIT ;ARG ONE OF TWO + MOVEI A,[ASCIZ / AND /] +TWARG9: PUSHJ P,PTOSSM +TWARG8: MOVE A,(S) ;GET SECOND ARG OF TWO OR ONLY ARG IF ONE + JSP H,ETLIT + PUSHJ P,CRLF + POP P,E + JRST TYPAFT+1 + +ONEARG: PUSH P,A + HRRZ B,THISPR + CAIL B,RPREN + JRST .IONEA + JSP N,PMNAME + MOVEI A,[ASCIZ / OF /] + JRST TWARG9 + +.ITWOA: MOVE A,-1(S) + JSP H,ETLIT + PUSHJ P,PSPACE +.IONEA: JSP N,PMNAME + PUSHJ P,PSPACE + JRST TWARG8 + +.NOCMD: PUSHJ P,PTOS + POP S,A + JSP H,ETLIT + JRST MATCG1 + + +TUNAME: SKIPA E,TOPROD +PUNAME: MOVE E,PRODNM +PUNAM1: EXCH A,E + JSP H,ETUP + MOVE A,E + JRST (N) + +PMNAME: MOVE B,THISPR + MOVE B,-1(B) + PUSHJ P,TOSS + JRST (N) + +FOR TENEX,< +.TNXER: MOVEI 1,101 + MOVE 2,[XWD 400000,-1] + SETZ 3, + ERSTR + JRST ALLERR+1 > + + +HARIKIRI: + PUSHJ P,PTOS +FOR TENEX,< HALTF > +FOR TEN50,< CALL 1,[SIXBIT /EXIT/] > + JRST ERROUT ;TRY TO CONTINUE + +.XTRER: MOVE E,A + SKIPA A,CPP ;START WITH THIS ELEMENT +.XTRR1: AOS A,CPP + MOVE A,@WSA ;NEXT ELEMENT + JSP H,ETYPIT + JUMPE A,TYPAFT+1 + PUSHJ P,PSPACE ;SEPARATE ELEMENTS WITH SPACES + JRST .XTRR1 ;BACK FOR NEXT ELEMENT + +.MISSG: PUSHJ P,PTOS ;"THERE ARE " + HRRZ H,UUOACS+P + HLRE A,(H) + ADDI A,1 + PUSHJ P,DECPRT ;N + MOVEI A,[ASCIZ / INPUTS MISSING FOR /] + PUSHJ P,PTOSSM + HRRZ A,(H) + CAIE A,UPRODL+1 + JRST .MISG2 + MOVE A,-1(H) + JSP H,ETUP + JRST .MISG9 + +.MISG1: PUSHJ P,PTOS + MOVE A,THISPR +.MISG2: JSP H,ETMP + +.MISG9: MOVEI C,"." + PUSHJ P,TYO + JRST ALLERR + + + +LNALND: MOVE E,A + MOVEI A,[ASCIZ /LINE /] + PUSHJ P,PTOSSM + MOVE A,UUOACS+M + PUSHJ P,DECPRT + MOVEI A,[ASCIZ / OF /] + PUSHJ P,PTOSSM + MOVE A,UUOACS+P + MOVE A,-2(A) + JSP H,ETUP ;TYPE USER PROCEDURE NAME + MOVEI A,[ASCIZ / WAS /] + PUSHJ P,PTOSSM + MOVE A,E + PUSHJ P,PTOS + MOVEI A,[ASCIZ / DURING EXECUTION./] + PUSHJ P,PTOSSM + JRST ALLERP + +ETYPA: MOVE E,UUOACS+A + EXCH A,E + JSP H,ETYPIT + JRST TYPAFT+1 + +BRAKER: PUSHJ P,PTOS + TLO F,BROKE + JRST ALLERR + + +SETPDL: HLRZ B,A + ADD B,SP + HRRZI S,(B) + SUB B,SP+1 + HRLI S,1(B) + + ADD A,PP + HRRZI P,-1(A) + SUB A,PP+1 + HRLI P,(A) + JRST (C) + + +ETYPIT: TLZ A,COMPOUND!IMMEDIATE + JFFO A,.+2 + JRST (H) + JRST @.+1-2(B) + EXP ETMP,ETUP,ETVAR,ETLIT,ETMP,ETMV,ETCOM + +ETMV: MOVEI E,":" + TRO F,PREFIX!SUFFIX +ETMP: HRLI A,440700 + JRST ETUP1 +ETUP: HRLI A,(POINT 7,(W),34) + ADD A,RP +ETUP1: HRR A,-1(A) + PUSHJ P,PTOS + JRST (H) + +ETCOM: MOVEI G,";" + JRST ETLIT1 +ETVAR: MOVEI A,-1(A) + MOVE A,@VPA + SKIPA G,[EXP ":"] +ETLIT: MOVEI G,042 +ETLIT1: EXCH G,E + TRO F,PREFIX!SUFFIX + PUSHJ P,PTOSS + MOVE E,G + JRST (H) + +DEFINE EE (NAME,TEXT,CODE) + + +ERRORS: +EE .BARF,ERROR ,NONAME +EE ABBER1,LOOP IN ABBREVIATION EXPANSION. +EE ABBER2,DON'T USE THE EMPTY THING AS AN ABBREVIATION. +EE CANER1,NOTHING TO CANCEL. +EE COMERR, CAN'T BE USED AS AN INPUT. IT DOES NOT OUTPUT.,.COMER +EE DIRERR, CAN ONLY BE DIRECT.,.PMNAM +EE DIVERR,DIVISION BY ZERO. +EE EDTER1,YOU CANNOT EDIT THAT. +EE EDTER2,YOU ARE ALREADY EDITING ,.TNAME +EE ERXTRA,IS EXTRA.,.XTRER +EE ERMSG1,THERE ARE ,.MISSG +EE ERMSSG,SOMETHING MISSING FOR ,.MISG1 +EE EVER3, NEEDS A MEANING.,UNDFND +EE EVER4, HAS NOT BEEN COMPLETELY DEFINED.,UNDFND +EE EVER5,PROCEDURE NAME.,CANTBT +EE FILER1,FILE NAME.,CANTBA +EE FILER9,FILE NAME TOO LONG. +EE GOERR1,GO WHERE? +EE GOERR2, IS NOT A LINE NUMBER.,.GOER2 +EE GOERR3,THERE IS NO LINE ,.GOER3 +EE GOERR9,NO PLACE TO GO. +EE ILLTRP,ILLEGAL MEMORY ALLOCATION TRAP- ALL IS LOST.,HARIKIRI +EE INERR1,MATCHING ,MATCHG +EE INERR2,LINE NUMBER IS TOO LARGE., +EE INERR3,LINE ,.INER3 +EE INERR4,YOU CAN'T HAVE A LINE 0., +EE INFERR,INFIX OPERATOR MUST BE PRECEDED BY AN INPUT +EE IOPERR,I AM IN TROUBLE. TELL YOUR TEACHER. +EE LCLERR,LOCAL NAME.,CANTBS + EE LNDERR,DELETED,LNALND +EE LSTER2,LIST ALL WHAT? + EE MAGNER,NOT SUCH A BIG NUMBER.,ONEARG +FOR MUSIC,< +EE MBDUR,A NOTE CANNOT HAVE A NEGATIVE DURATION. +EE MBFOR,MBUFNEXT CAN ONLY MOVE FORWARD. +EE MBNOTI,YOU HAVEN'T RUN STARTMUSIC YET. +EE MBNOTE,THAT NOTE IS OUTSIDE MY RANGE. +EE MBVOC,YOU MUST SPECIFY 1 TO 4 VOICES ONLY. +> +EE NMERR3, IS USED BY LOGO.,.NMER3 +EE NMERR5,DON'T USE THE EMPTY WORD FOR A NAME., +EE NOCMD,THERE IS NO COMMAND FOR ,.NOCMD +EE NOENTRY,NO SUCH ENTRY. +EE NOFILE,NO SUCH FILE. +EE NOPERR, WHAT? YOU ARE NOT DEFINING ANYTHING.,.PMNAM +EE NOPROD,THERE IS NO PROCEDURE ,.NOPRO +EE NOTWRD,FIRST INPUT TO MEMBERP MUST BE A WORD, +FOR MOCKTURTLE,< +EE OFSCRN,THAT PUTS YOU OFF THE SCREEN.> +EE PREDR1,INPUT MUST BE A PREDICATE.,ONEARG +EE PREDR2,INPUTS MUST BE PREDICATES.,TWOARG +EE PRNER1,MATCHING (? +EE PRNER2,MISSING )? +EE STOERR, CAN ONLY BE USED IN A PROCEDURE.,.PMNAM +EE SUMERR,INPUTS MUST BE NUMBERS.,TWOARG +FOR TENEX,< +EE TNXERR,,.TNXER> +EE TITER2,TITLE MUST BE FOLLOWED BY "TO". +EE TOERR1,USE "DO" WHEN "TO" IS STORED. +EE TOERR2,YOU NEED : MARKS AROUND EACH INPUT., +EE TOERR3, IS USED BY LOGO.,.TOER3 +EE TOERR4,DON'T TRY TO DEFINE ANOTHER PROCEDURE INSIDE THIS ONE., +EE TOERR5,PROCEDURE NAME.,CANTBA +EE TOERR6, IS ALREADY DEFINED.,ETYPA +EE TOERR7,ONLY PRINTING CHARACTERS IN A PROCEDURE NAME. +EE TOOFUL,NO ROOM FOR ANOTHER GET; SAVE AND ERASE FIRST. +EE UPDERR,THAT FILE CAN'T BE UPDATED BY YOU. +EE WHATER, WHAT?,.PMNAM +EE WRDERR,INPUTS TO WORD CANNOT BE SENTENCES.,TWOARG +EE XITERR,,.XITER ;NO SYSTEM ERROR MESSAGE, ONLY THAT SUPPLIED BY USER +EE ZERERR,INPUT MUST BE A NUMBER.,ONEARG +EE BREAK,BREAK,BRAKER +EE PUNT,STORAGE FULL +BLOCK 5 ;FOR PATCHING THIS LIST +MAXERR==.-ERRORS + XLIST ;WOULD ANYONE LIKE TO SEE 14 PAGES OF LITERALS? + LIT + LIST +FOO: +LOGEND: END LOGO + +