1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189 |
- %%<PROG (C)
- <CRLF ,OUTCHAN>
- <PRINC "Is this assembly for Tenex? ">
- <COND (<MEMQ <TYI ,INCHAN> "YyTt">
- <SETG 10X T>)
- (<SETG 10X <>>)>
- <CRLF ,OUTCHAN>>
- %%<AND ,10X <USE "JSYS"> <CRLF ,OUTCHAN>>
- %%<OR <GASSIGNED? IFN10X>
- <DEFINE IFN10X ('10X 'ITS)
- <COND (,10X <CHTYPE .10X SPLICE>) (<CHTYPE .ITS SPLICE>)>>>
- <SETG RUBOUT? <>>
- <SETG RUVEC <IUVECTOR 4>>
- <SETG NO-TELL 0>
- <SETG IN-TELL 0>
- <SETG TELL-VEC <IUVECTOR 7>>
- ;"Print some strings to ,OUTCHAN"
- <TITLE TELL>
- <DECLARE ("VALUE" ATOM <PRIMTYPE STRING> "OPTIONAL" FIX
- <OR STRING FALSE> <OR STRING FALSE>)>
- <MOVE A* AB>
- LOOP <PUSH TP* (AB)>
- <PUSH TP* 1(AB)>
- <ADD AB* [<(2) 2>]>
- <JUMPL AB* LOOP>
- <HLRES A>
- <ASH A* -1>
- <ADDI A* TABEND>
- <PUSHJ P* @ (A) 1>
- <JRST FINIS>
- <TELL4>
- <TELL3>
- <TELL2>
- TABEND <TELL1>
- <INTERNAL-ENTRY TELL1 1> ; "push 1"
- <PUSH TP* <TYPE-WORD FIX>>
- <PUSH TP* [1]>
- <INTERNAL-ENTRY TELL2 2>
- <PUSH TP* <TYPE-WORD FALSE>>
- <PUSH TP* [0]>
- <INTERNAL-ENTRY TELL3 3>
- <PUSH TP* <TYPE-WORD FALSE>>
- <PUSH TP* [0]>
- <INTERNAL-ENTRY TELL4 4>
- <SUBM M* (P)>
- <INTGO>
- <PUSHJ P* SETUP> ; "SETUP FOR INTERRUPTS"
- <JRST [<PUSH TP* <TYPE-WORD FALSE>>
- <PUSH TP* [0]>
- <DPUSH TP* <PQUOTE <STRING <ASCII 13> <ASCII 10>>>>
- <MOVE C* <MQUOTE <RGLOC OUTCHAN T>>>
- <ADD C* GLOTOP 1>
- <MOVE C* 1(C)>
- <PUSH P* 1(C)>
- <PUSHJ P* DOSIOT> ; "PRINT CRLF"
- <SUB TP* [<(2) 2>]>
- <JRST INTLV>]>
- INTLV <JRST [<SUB P* [<(1) 1>]>
- <JRST RLDONE1>]> ; "RETURN FROM NON-PRINT"
- <MOVE C* <MQUOTE <RGLOC OUTCHAN T>>>
- <ADD C* GLOTOP 1>
- <MOVE C* 1(C)>
- <MOVE C* 1(C)> ; "CHANNEL NUMBER IN C"
- <PUSH P* C> ; "SAVE ON STACK"
- <MOVE E* <MQUOTE <RGLOC SCRIPT-CHANNEL T>>>
- <ADD E* GLOTOP 1>
- <PUSH TP* (E)>
- <PUSH TP* 1(E)>
- <MOVE O* -6(TP)> ; "FIX SPECIFYING WHEN TO DO CR'S"
- <TRNN O* 2> ; "SKIP IF PRINT CR BEFORE"
- <JRST PTFST>
- <PUSH TP* <PQUOTE <STRING <ASCII 13> <ASCII 10>>>>
- <PUSH TP* <MQUOTE <STRING <ASCII 13> <ASCII 10>>>>
- <PUSHJ P* DOSIOT>
- PTFST <PUSH TP* -9(TP)> ; "PUSH ARGS FOR DOSIOT"
- <PUSH TP* -9(TP)>
- <PUSHJ P* DOSIOT>
- <INTGO>
- <GETYP O* -5(TP)>
- <CAIN O* <TYPE-CODE FALSE>> ; "IS IT FALSE?"
- <JRST DONE>
- <PUSH TP* -5(TP)>
- <PUSH TP* -5(TP)> ; "ARGS"
- <PUSHJ P* DOSIOT> ; "DO PRINT"
- <GETYP O* -3(TP)>
- <CAIN O* <TYPE-CODE FALSE>>
- <JRST DONE>
- <PUSH TP* -3(TP)>
- <PUSH TP* -3(TP)>
- <PUSHJ P* DOSIOT>
- DONE <MOVE O* -6(TP)>
- <TRNN O* 1> ; "CR AFTER?"
- <JRST RLDONE>
- <PUSH TP* <PQUOTE <STRING <ASCII 13> <ASCII 10>>>>
- <PUSH TP* <MQUOTE <STRING <ASCII 13> <ASCII 10>>>>
- <PUSHJ P* DOSIOT> ; "PRINT CRLF"
- RLDONE <MOVE A* <MQUOTE <RGLOC IN-TELL T>>>
- <ADD A* GLOTOP 1>
- <SETZM 1(A)> ; "NO LONGER IN TELL"
- <SUB P* [<(2) 2>]> ; "CLEAN UP P"
- <SUB TP* [<(2) 2>]>
- RLDONE1 <SUB TP* [<(8) 8>]>
- <MOVE C* <MQUOTE <RGLOC TELL-FLAG T>>> ;"SETG TELL-FLAG"
- <ADD C* GLOTOP 1>
- <MOVE A* <TYPE-WORD ATOM>>
- <MOVEM A* (C)>
- <MOVE B* <MQUOTE T>>
- <MOVEM B* 1(C)>
- <JRST MPOPJ>
- ; "SET UP FOR INTERRUPTS"
- SETUP <SUBM M* (P)>
- <PUSH P* (P)>
- <MOVE A* <MQUOTE <RGLOC NO-TELL T>>>
- <ADD A* GLOTOP 1>
- <SKIPGE 1(A)> ; "IF ALREADY TURNED OFF, JUST LEAVE"
- <JRST SPOPJ>
- <SKIPL -4(TP)> ; "DO THIS ONLY IF TOLD TO"
- <JRST SETUPO>
- <MOVE A* <MQUOTE <RGLOC TELL-VEC T>>>
- <ADD A* GLOTOP 1>
- <MOVE A* 1(A)>
- <HLRE B* A>
- <ADDI B* 1>
- <MOVNS B>
- <ADDI B* (A)>
- <HRLI A* AB>
- <SUB P* [<(1) 1>]>
- <BLT A* (B)>
- <ADD P* [<(1) 1>]>
- <MOVE A* <MQUOTE <RGLOC IN-TELL T>>>
- <ADD A* GLOTOP 1>
- <SETOM 1(A)> ; "NOW IN TELL"
- SETUPO <SOS (P)>
- SPOPJ <SOS (P)> ; "SKIP TWICE NORMALLY, ONCE IF NOT PRINTING"
- <JRST MPOPJ> ; "SKIP RETURN"
- ;"SYSTEM DEPENDENT"
- ;"PUSHJ DOSIOT WITH ARGS ON TOP OF TP STACK; CHANNEL/JFN IS -1(P); SCRIPT CHANNEL
- IS NEXT FROB ON TP. FORTUNATELY, NO AC'S ARE SACRED."
- DOSIOT <SUBM M* (P)>
- <HRRZ C* -1(TP)> ; "GET STRING LENGTH"
- <MOVE B* (TP)> ; "GET STRING"
- <SKIPL -8(TP)>
- <JRST DOSIOT1> ; "ONLY ENABLE IF TOLD TO"
- <AOSN INTFLG>
- <JSR LCKINT> ; "ENABLE INTERRUPTS"
- DOSIOT1 <IFN10X (<MOVNS C> ; "GET -LENGTH"
- <JUMPE C* DODONE> ; "0 LENGTH STRING"
- <MOVE A* -1(P)> ; "GET JFN"
- <SOUT> ; "DO IT")
- (<*CALL SIOT>
- <JFCL>)>
- <SKIPGE -6(TP)>
- <SETZM INTFLG> ; "DISABLE INTERRUPTS"
- <SKIPL -2(TP)> ; "SCRIPTING?"
- <JRST DODONE>
- <MOVSI A* <TYPE-CODE STRING>>
- <HRR A* -1(TP)>
- <PUSH TP* A> ; "PUSH STRING"
- <PUSH TP* -1(TP)>
- <PUSH TP* -5(TP)> ; "PUSH CHANNEL"
- <PUSH TP* -5(TP)>
- <MCALL 2 PRINTSTRING> ; "DO PRINTSTRING"
- DODONE <SUB TP* [<(2) 2>]> ; "GET RID OF ARGS"
- <JRST MPOPJ>
- <IFN10X ()
- (SIOT <SETZ>
- <SIXBIT "SIOT">
- <MOVSI *4000*> ; "TURN OFF DISPLAYNESS"
- <-1(P)>
- <B>
- <SETZ C>)>
- <TITLE CTRL-S>
- <DECLARE ("VALUE" <OR ATOM DISMISS> CHARACTER CHANNEL)>
- <DPUSH TP* (AB)>
- <DPUSH TP* 2(AB)>
- <PUSHJ P* ICTRL>
- <JRST FINIS>
- <INTERNAL-ENTRY ICTRL 2>
- <SUBM M* (P)>
- <MOVE B* -2(TP)>
- <CAIN B* 7> ; "CTRL-G?"
- <JRST GACK>
- <IFN10X
- (<CAIE B* <ASCII !\>>)
- (<CAIE B* <ASCII !\>>)>
- <JRST [<MOVSI A* <TYPE-CODE ATOM>>
- <JRST ICTRL1>]> ; "NOT CTRL-S, SO FLUSH"
- <SETZM INTFLG>
- <MOVE A* <MQUOTE <RGLOC INCHAN T>>>
- <ADD A* GLOTOP 1>
- <DPUSH TP* (A)>
- <MCALL 1 RESET>
- <PUSH TP* <TYPE-WORD FALSE>>
- <PUSH TP* [0]>
- <MCALL 1 TTY-INIT>
- <MOVE A* <MQUOTE <RGLOC NO-TELL T>>>
- <ADD A* GLOTOP 1>
- <SKIPGE 1(A)> ; "ALREADY TRUE?"
- <JRST ICTRLO> ; "YES, SO FLUSH"
- <SETOM 1(A)> ; "NO, SO MAKE IT TRUE"
- <MOVE A* <MQUOTE <RGLOC IN-TELL T>>>
- <ADD A* GLOTOP 1>
- <SKIPL 1(A)> ; "IN TELL?"
- <JRST ICTRLO> ; "NO, FLUSH"
- <SETZM 1(A)> ; "NOT ANY MORE"
- <PUSH TP* <TYPE-WORD FIX>>
- <PUSH TP* [0]>
- <MCALL 1 INT-LEVEL> ; "FIX UP INTERRUPTS"
- <MOVE A* <MQUOTE <RGLOC TELL-VEC T>>>
- <ADD A* GLOTOP 1> ; "GET POINTER TO SAVED AC'S (N OF THEM)"
- <MOVE A* 1(A)> ; "PICK UP POINTER"
- <HLRE B* A> ; "# OF AC'S IS IN B"
- <ADDI B* P 1> ; "FIRST ONE"
- <HRLS A>
- <HRR A* B> ; "BLT POINTER IN A"
- <BLT A* P> ; "BLT THE AC'S BACK"
- <JRST MPOPJ> ; "AND LEAVE"
- ICTRLO <MOVSI A* <TYPE-CODE DISMISS>>
- ICTRL1 <MOVEI B* <MQUOTE 'T>>
- <SUB TP* [<(4) 4>]>
- <JRST MPOPJ>
- GACK <MOVE A* <MQUOTE <RGLOC INCHAN T>>>
- <ADD A* GLOTOP 1>
- <DPUSH TP* (A)>
- <MCALL 1 RESET>
- <PUSH TP* <TYPE-WORD FALSE>>
- <PUSH TP* [0]>
- <MCALL 1 TTY-INIT>
- <PUSH TP* <TYPE-WORD FALSE>>
- <PUSH TP* [0]>
- <PUSH TP* <TYPE-WORD ATOM>>
- <PUSH TP* <MQUOTE CONTROL-G?!-ERRORS>>
- <MCALL 2 HANDLE>
- <JRST ICTRLO>
- ;"Get current time in disk format"
- ;"SYSTEM DEPENDENT (GROSSLY)"
- <TITLE DSKDATE>
- <DECLARE ("VALUE" WORD)>
- <PUSHJ P* IDSKDATE>
- <JRST FINIS>
- <INTERNAL-ENTRY IDSKDATE 0>
- <SUBM M* (P)>
- <IFN10X (<HRROI B* -1> ; "-1 TO SAY CURRENT TIME"
- <MOVEI D* 0> ; "NOTHING FANCY"
- <ODCNV> ; "GET IT: B HAS YEAR,,MONTH; C DAY,,; D ,,TIME"
- <TLZ D* -1> ; "CLEAN OUT LH OF D"
- <ASH D* 1> ; "TIME IN HALF-SECONDS"
- <HLRZS C> ; "GET DAY OF MONTH -1"
- <ADDI C* 1> ; "DO THE RIGHT THING"
- <DPB C* [<(*220500*) D>]> ; "STUFF DAY INTO D"
- <IDIV B* [(1)]> ; "SPLIT B IN HALF"
- <ADDI C* 1> ; "GET REAL MONTH"
- <DPB C* [<(*270400*) D>]> ; "STUFF IN MONTH"
- <IDIVI B* 100> ; "GET YEAR OF CENTURY IN C"
- <DPB C* [<(*330700*) D>]> ; "STUFF IN YEAR"
- <MOVE B* D>
- <MOVE A* <TYPE-WORD WORD>>
- <JRST MPOPJ>)
- (<*CALL RQDATE>
- <SETO B*>
- <MOVE A* <TYPE-WORD WORD>>
- <JRST MPOPJ>
- RQDATE <SETZ>
- <SIXBIT "RQDATE">
- <SETZM B>)>
- ;"GET STRING OF USER NAME (OR SOMETHING LIKE THAT)"
- <TITLE GXUNAME>
- <DECLARE ("VALUE" STRING)>
- <PUSHJ P* IXUNAME>
- <JRST FINIS>
- <INTERNAL-ENTRY IXUNAME 0>
- <SUBM M* (P)>
- <IFN10X (<GJINF> ; "GET DIRECTORY NUMBER IN B"
- <MOVE B* A>
- <MOVE C* <MQUOTE <RGLOC SCRATCH-STR T>>>
- <ADD C* GLOTOP 1>
- <MOVE A* 1(C)>
- <DIRST>
- <JFCL>
- <MOVE B* 1(C)>
- <MOVE A* (C)>
- <JRST MPOPJ>)
- (<*SUSET [<(*74*) A>]>
- <PUSH TP* <TYPE-WORD WORD>>
- <PUSH TP* A>
- <PUSHJ P* ISIXTO>
- <JRST MPOPJ>
- ;"TAKES WORD ON TOP OF TP, RETURNS STRING"
- ISIXTO <SUBM M* (P)>
- <LDB O* [<(*000613*) 0>]> ; "LAST BYTE IN WORD"
- <MOVEI C* 1>
- <JUMPE O* CONTIN>
- <MOVEI C* 2> ; "NUMBER OF WORDS REQUIRED"
- CONTIN <PUSH P* C> ; "SAVE #WORDS"
- <MOVE A* C>
- <MOVEI O* IBLOCK>
- <PUSHJ P* RCALL> ; "GET UVECTOR (IN A AND B)"
- <MOVE A* <TYPE-WORD STRING>>
- <POP P* C>
- <MOVEI O* 4(C)> ; "LENGTH IS FIVE OR SIX"
- <HRR A* O> ; "LENGTH OF STRING"
- <ADD C* B>
- <MOVEI O* <TYPE-CODE CHARACTER>>
- <DPB O* [<(*221503*) 0>]> ; "CLOBBER TYPE SLOT IN DOPE WORDS"
- <HRLI B* *440700*> ; "GET STRING POINTER TO UV"
- ; "AT THIS POINT, IN A AND B WE HAVE THE TYPE-VALUE WORD, ALMOST READY TO
- RETURN. ON TOP OF TP, THE WORD TO BE HACKED."
- START <PUSH P* B> ; "SAVE BP TO RETURN"
- <MOVE C* (TP)> ; "GET WORD TO HACK IN C"
- <MOVE D* [<(*440600*) C>]> ; "AND SIXBIT POINTER IN D"
- <HRRZ E* A> ; "LENGTH OF STRING"
- <JUMPE E* DONE> ; "CAN'T HACK EMPTY STRING"
- <CAILE E* 6>
- <MOVEI E* 6> ; "MAX # CHARS"
- STRLOP <ILDB O* D> ; "GET CHAR IN O"
- <ADDI O* *40*>
- <IDPB O* B> ; "STUFF CHAR INTO STRING"
- <SOJG E* STRLOP>
- DONE <POP P* B> ; "GET OLD BP BACK"
- <SUB TP* [<(2) 2>]>
- <JRST MPOPJ>)>
- ;"Takes channel open to name file, returns string of name"
- <IFN10X (
- <TITLE GET-NAME>
- <DECLARE ("VALUE" <OR FALSE STRING>)>
- <PUSHJ P* IGETNAME>
- <JRST FINIS>
- <INTERNAL-ENTRY IGETNAME 1>
- <SUBM M* (P)>
- ;"FIRST, WE NEED A JFN TO THE CRETIN FILE WITH THE RIGHT CRETIN BITS."
- <MOVSI A* *100001*> ; "I HOPE THIS MEANS GET
- EXISTING FILE, SHORT FORM"
- <MOVE B* <MQUOTE "DSK:<IMSSS>DATSYS.PMAP ">>
- ; "FILE NAME, ASCIZ"
- <GTJFN>
- <JRST OPLOST> ; "LOSE, LOSE"
- <TLZ A* -1>
- <MOVE B* [<(*440000*) *202200*>]>
- ; "36 BYTE SIZE, THAWED MODE, DON'T HANG"
- <OPENF>
- <JRST OPLOST>
- <PUSH P* A> ; "SAVE JFN"
- <MOVEI A* 4>
- <PUSHJ P* PGFIND> ; "GET FOUR PAGES FROM INTERPRETER"
- <JUMPL B* [<ERRUUO* <MQUOTE CANT-GET-PAGES>>]>
- <ASH B* 1> ; "CRETIN TENEX"
- <PUSH P* B> ; "SAVE PAGE NUMBER"
- <TLO B* *400000*> ; "TURN ON 'ME' BIT"
- <HRLZ A* -1(P)> ; "GET JFN"
- <HRRI A* *60*> ; "PAGE IN FILE"
- <MOVE C* [<(*400000*) *10*>]> ; "# OF PAGES"
- <PMAP> ; "DO MAP"
- <GJINF> ; "DIRNUM IS IN A; B AND C HAVE GONE AWAY"
- <IMULI A* 4> ; "OFFSET INTO BLOCK"
- <MOVE B* (P)> ; "PAGE #, TENEX STYLE"
- <ASH B* *11*> ; "MAKE IT AN ADDRESS"
- <ADDI B* (A)> ; "ADDRESS OF BEGINNING OF STRING"
- <PUSH P* B> ; "SAVE FOR EVENTUAL BLT"
- <HRLI B* *440700*> ; "BYTE POINTER"
- <MOVEI A* 0> ; "# OF CHARS"
- LENLP <ILDB O* B> ; "GET CHAR"
- <JUMPE O* ENDSTR> ; "DONE?"
- <AOJA A* LENLP> ; "NO, INCREASE COUNT AND TRY AGAIN"
- ENDSTR <PUSH P* A> ; "SAVE LENGTH"
- <IDIVI A* 5> ; "# OF WORDS"
- <CAIE B* 0> ; "REMAINDER 0?"
- <ADDI A* 1> ; "NOPE"
- <PUSH P* A> ; "SAVE # WORDS"
- <MOVEI O* IBLOCK>
- <PUSHJ P* RCALL> ; "GET UV"
- ; "# OF WORDS IN STRING IS (P); LENGTH OF STRING IS -1(P); ADDRESS OF SOURCE IS -2(P);
- PAGE # OF MAPPED AREA IS -3(P)"
- <MOVE D* B>
- <HRL D* -2(P)> ; "SOURCE POINTER"
- <MOVEI C* -1(D)> ; "DEST POINTER -1"
- <ADD C* (P)> ; "END OF DESTINATION"
- <BLT D* (C)> ; "GET STRING"
- <MOVEI O* <TYPE-CODE STRING>>
- <DPB O* [<(*221503*) 1>]> ; "CLOBBER DOPE WORDS"
- <HRLI B* *440700*>
- <MOVSI A* <TYPE-CODE STRING>>
- <HRR A* -1(P)> ; "FINISH STRING POINTER"
- <PUSH TP* A> ; "PUSH STRING"
- <PUSH TP* B>
- <HRROI A* -1> ; "A IS -1 FOR UNMAPPING"
- <MOVE B* -3(P)> ; "PAGE #"
- <TLO B* *400000*>
- <MOVE C* [<(*400000*) *10*>]> ; "# PAGES"
- <PMAP> ; "UNMAP"
- <MOVE A* -4(P)> ; "JFN"
- <CLOSF> ; "CLOSE, RELEASE JFN"
- <JFCL>
- <MOVE B* -3(P)>
- <ASH B* -1>
- <MOVEI A* *4*>
- <PUSHJ P* PGGIVE> ; "GIVE BACK PAGES"
- <POP TP* B>
- <POP TP* A> ; "GET STRING BACK"
- <SUB P* [<(5) 5>]> ; "CLEAN UP P"
- <JRST MPOPJ> ; "DONE"
- OPLOST <MOVE A* <TYPE-WORD FALSE>> ; "RETURN FALSE"
- <MOVEI B* 0>
- <JRST MPOPJ>) ()>
- <TITLE STARTER>
- <DECLARE ("VALUE" <OR FIX STRING>)>
- <PUSHJ P* ISTART>
- <JRST FINIS>
- <INTERNAL-ENTRY ISTART 0>
- <SUBM M* (P)>
- <IFN10X (
- ; "NOW FIGURE OUT WHAT'S GOING ON WITH DIRECTORIES"
- GETDIR <MOVEI A* *2500*> ; "ALMOST GUARANTEED--SHARING WITH SAVE FILE"
- <LSH A* -9> ; "10X PAGE #"
- <HRLI A* *400000*> ; "THIS PROCESS"
- <RMAP> ; "GET JFN IN LH OF B"
- <SKIPGE A>
- <JRST D*>
- <HLRZ B* A> ; "JFN TO THE RIGHT"
- <MOVE D* <MQUOTE <RGLOC SCRATCH-STR T>>>
- <ADD D* GLOTOP 1>
- <MOVE A* 1(D)> ; "DESTINATION"
- <MOVSI C* *010000*> ; "DIRECTORY FIELD ONLY"
- <JFNS>
- <MOVE B* 1(D)>
- <MOVE A* (D)>
- <JRST MPOPJ> ; "RETURN THE STRING"
- OUT <MOVSI A* <TYPE-CODE FIX>>
- <MOVEI B*>
- <JRST MPOPJ>)
- (<*CALL TTYGET>
- <JFCL>
- <TLO B* *300*>
- <*CALL TTYSET>
- <JFCL>
- <*IOPUS>
- <*CALL [<SETZ>
- <SIXBIT "OPEN">
- [<(0) 0>]
- [<SIXBIT "DSK">]
- [<SIXBIT "TRIVIA">]
- [<SIXBIT "CURFEW">]
- <SETZ [<SIXBIT "_MSGS_">]>]>
- <JRST [<*IOPOP>
- <JRST CORCHK>]>
- <*SUSET [<(*74*) A>]>
- <CAMN A* [<SIXBIT "GUEST">]>
- <JRST FLUSHO>
- <*CALL [<SETZ>
- <SIXBIT "OPEN">
- [<(0) 0>]
- [<SIXBIT "DSK">]
- [<SIXBIT ".FILE.">]
- [<SIXBIT "(DIR)">]
- <SETZ A>]>
- <JRST FLUSHO>
- <*CALL [<SETZ>
- <SIXBIT "OPEN">
- [<(*20*) 0>] ; "DON'T CHASE LINKS"
- [<SIXBIT "DSK">]
- [<SIXBIT "_MSGS_">]
- <MOVE A>
- <SETZ A>]>
- <JRST FLUSHO>
- <*IOPOP>
- <JRST CORCHK>
- FLUSHO <*IOPOP>
- <MOVEI B* 5>
- <JRST LEAVE>
- CORCHK <MOVNI A* 1>
- <*SUSET [<(*400021*) A>]> ; "FUNNY HACK"
- <*CALL [<SETZ> ; "#SHARERS OF 200. INTO B"
- <SIXBIT "CORTYP">
- <MOVEI 201.>
- <MOVEM C>
- <MOVEM 0>
- <MOVEM 0>
- <SETZM B>]>
- <*VALUE>
- <JUMPL C* NOTPUR>
- <TLZ B* -1> ; "CLEAR LH"
- LEAVE <MOVSI A* <TYPE-CODE FIX>>
- <JRST MPOPJ>
- NOTPUR <MOVEI B* 5>
- <JRST LEAVE>
- TTYGET <SETZ>
- <SIXBIT "TTYGET">
- <MOVEI 2>
- <MOVEM A>
- <MOVEM B>
- <MOVEM C>
- <MOVEM D>
- <SETZM E>
- TTYSET <SETZ>
- <SIXBIT "TTYSET">
- <MOVEI 2>
- <A>
- <B>
- <C>
- <SETZ D>)
- >
- <IFN10X (<TITLE GETSYS> ; "RETURN T IF 10X"
- <DECLARE ("VALUE" <OR ATOM FALSE>)>
- <PUSHJ P* IGETSYS>
- <JRST FINIS>
- <INTERNAL-ENTRY IGETSYS 0>
- <SUBM M* (P)>
- <HRROI A* 3>
- <HRLOI B* *600015*> ; "NUL/NIL DEVICE"
- <MOVEI C* 0>
- <DEVST>
- <JFCL>
- <CAMN C* [<(*472531*) *400000*>]>
- <JRST TOPS20>
- <MOVSI A* <TYPE-CODE ATOM>>
- <MOVE B* <MQUOTE T>>
- <JRST MPOPJ>
- TOPS20 <MOVSI A* <TYPE-CODE FALSE>>
- <MOVEI B*>
- <JRST MPOPJ>)
- ()>
- ; "ATMFIX takes an ATOM and returns a word which is the PNAME of the
- atom appropriately XORed."
- <TITLE ATMFIX>
- <DECLARE ("VALUE" FIX ATOM)>
- <DPUSH TP* (AB)>
- <PUSHJ P* ATMFIX1>
- <JRST FINIS>
- <INTERNAL-ENTRY ATMFIX1 1>
- <SUBM M* (P)>
- <MOVE A* <TYPE-WORD FIX>>
- <MOVE B* (TP)>
- <MOVE B* 3(B)>
- <MOVE C* <MQUOTE <RGLOC SRUNM T>>>
- <ADD C* GLOTOP 1>
- <MOVE C* 1(C)>
- <MOVE C* 1(C)>
- <XOR B* C>
- <SUB TP* [<2 (2)>]>
- <JRST MPOPJ>
- ; "FIXSTR is the inverse of ATMFIX. It takes a FIX and returns a STRING
- which is the PNAME of the ATOM which was previously given to ATMFIX."
- <TITLE FIXSTR>
- <DECLARE ("VALUE" STRING FIX)>
- <DPUSH TP* (AB)>
- <PUSHJ P* FIXSTR1>
- <JRST FINIS>
- <INTERNAL-ENTRY FIXSTR1 1>
- <SUBM M* (P)>
- <MOVE B* <MQUOTE <RGLOC SAVSTR T>>>
- <ADD B* GLOTOP 1>
- <MOVE A* (B)>
- <MOVE B* 1(B)>
- <SKIPN C* (TP)>
- <JRST FIXFLS>
- <MOVE D* <MQUOTE <RGLOC SRUNM T>>>
- <ADD D* GLOTOP 1>
- <MOVE D* 1(D)>
- <XOR C* 1(D)>
- <MOVEM C* 1(B)>
- FIXOUT <SUB TP* [<2 (2)>]>
- <JRST MPOPJ>
- FIXFLS <MOVE A* <TYPE-WORD FALSE>>
- <SETZ B*>
- <JRST FIXOUT>
- ; "CLEAR-UV BLTs zeros into a UVECTOR."
- <TITLE CLEAR-UV>
- <DECLARE ("VALUE" UVECTOR UVECTOR)>
- <DPUSH TP* (AB)>
- <PUSHJ P* CUV>
- <JRST FINIS>
- <INTERNAL-ENTRY CUV 1>
- <SUBM M* (P)>
- <MOVE A* (TP)>
- <SETZM (A)>
- <HLRZ B* A>
- <MOVNS B>
- <SUBI B* 1>
- <ADD B* A>
- <HRL A* A>
- <ADDI A* 1>
- <BLT A* (B)>
- <MOVE A* -1(TP)>
- <MOVE B* (TP)>
- <SUB TP* [<2 (2)>]>
- <JRST MPOPJ>
- <TITLE DISPATCH>
- <DECLARE ("VALUE" ANY OFFSET "OPTIONAL" ANY)>
- <MOVE A* AB>
- LOOP <DPUSH TP* (AB)>
- <ADD AB* [<(2) 2>]>
- <JUMPL AB* LOOP>
- <HLRES A>
- <ASH A* -1>
- <ADDI A* TABEND>
- <PUSHJ P* @ (A) 1>
- <JRST FINIS>
- <DISP2>
- TABEND <DISP1>
- <INTERNAL-ENTRY DISP1 1>
- <PUSH TP* <TYPE-WORD FALSE>>
- <PUSH TP* [0]>
- <INTERNAL-ENTRY DISP2 2>
- <SUBM M* (P)>
- <MOVE A* <MQUOTE <RGLOC DISPATCH-TABLE T>>>
- <ADD A* GLOTOP 1>
- <MOVE A* 1(A)> ; "get dispatch table"
- <GETYP C* -1(TP)>
- <SKIPG B* -2(TP)> ; "pick up offset"
- <JRST DOOPT>
- <ADDI A* -1(B)> ; "point to instruction"
- <CAIE C* <TYPE-CODE FALSE>>
- <JRST ONEARG>
- NOARG <XCT (A)>
- <SUB TP* [<(4) 4>]>
- <JRST MPOPJ>
- ONEARG <XCT (A)>
- <SUB TP* [<(2) 2>]>
- <JRST MPOPJ>
- DOOPT <MOVNS B>
- <CAIE C* <TYPE-CODE FALSE>>
- <JRST [<ADDI A* (B)> ; "point to next"
- <JRST ONEARG>]>
- <ADDI A* -1(B)>
- <JRST NOARG>
- ;"READER FOR ZORK: TAKES INPUT BUFFER AND PROMPT, RETURNS NUMBER OF
- CHARACTERS IN BUFFER.
- AC USAGE:
- O: RANDOM, MAINLY FOR SIOTING
- A: ON ITS, .IOT <INCHAN>,B; ON 10X, PRIMARY INPUT JFN
- B: USUALLY CHARACTER LAST READ, BUT CLOBBERED FOR SIOTS AND SOUTS
- C: USUALLY COUNT OF CHARACTERS READ; MAY BE FROBBED TEMPORARILY WHEN SOUTING
- D: ILDB POINTER TO NEXT CHAR IN BUFFER
- E: <0 --> RUBOUT SHOULD FLUSH A CHAR
- =0 --> RUBOUT SHOULD ECHO \<RUBBED OUT>
- >0 --> RUBOUT SHOULD ECHO <RUBBED OUT>--USED BY WDFLS
- PVP: OUTCHAN
- P: # CHARS IN BUFFER
- ARGS: INPUT BUFFER PROMPT ALTMODE ONLY TERMINATOR?"
- <TITLE READST>
- <DECLARE ("VALUE" FIX STRING STRING <OR ATOM FALSE>)>
- <DPUSH TP* (AB)>
- <DPUSH TP* 2(AB)>
- <DPUSH TP* 4(AB)>
- <PUSHJ P* IREADST>
- <JRST FINIS>
- <INTERNAL-ENTRY IREADST 1>
- <SUBM M* (P)>
- <IFN10X
- (<MOVEI E* 0>
- <MOVEI A* *400000*>
- <MOVEI B* 0>
- <STIW> ; "NO INTERRUPTS IN HERE")
- (<MOVE A* <MQUOTE <RGLOC RUBOUT? T>>>
- <ADD A* GLOTOP 1>
- <MOVEI E* 0>
- <SKIPGE 1(A)>
- <MOVNI E* 1>)>
- <MOVE A* <MQUOTE <RGLOC OUTCHAN T>>>
- <ADD A* GLOTOP 1>
- <MOVE A* 1(A)>
- <MOVE PVP* 1(A)> ; "OUTPUT CHANNEL/JFN"
- <MOVE A* <MQUOTE <RGLOC INCHAN T>>>
- <ADD A* GLOTOP 1>
- <MOVE A* 1(A)>
- <MOVE A* 1(A)> ; "GET CHANNEL #"
- <IFN10X
- ()
- (<LSH A* *27*>
- <IOR A* [<*IOT B>]>)> ; "JFN FOR 10X, I/O INS FOR ITS"
- <PUSHJ P* PPRMPT>
- <HRRZ C* -5(TP)>
- <PUSH P* C> ; "# CHARS IN STRING"
- <MOVEI C* 0>
- <MOVE D* -4(TP)> ; "BUFFER POINTER"
- CHRLOP <IFN10X
- (<BIN>)
- (<XCT A>)> ; "GET CHAR IN B"
- <SKIPGE INTFLG>
- <JRST INTHAK> ; "INTERRUPTS?"
- INTBCK <CAIGE B* *40*> ; "NOT SPECIAL?"
- <JRST SPCCHR>
- <CAIN B* *177*> ; "RUBOUT?"
- <JRST RUBOUT>
- PUTCHR <PUSHJ P* PUTCHR1>
- <JRST CHRLOP>
- <MOVEI B* *33*> ; "PUTCHR1 SKIPS IF BUFFER FULL"
- SPCCHR <CAIE B* *15*>
- <CAIN B* *37*> ; "EOL"
- <JRST CRHACK>
- <CAIN B* *33*> ; "ALTMODE"
- <JRST [<PUSHJ P* PCRLF>
- <JRST RDDONE>]>
- <JUMPE B* BUFFLS>
- <CAIE B* %<ASCII !\>>
- <CAIN B* %<ASCII !\>>
- <JRST BUFFLS> ; "KILL BUFFER"
- <CAIN B* %<ASCII !\>>
- <JRST WDFLS>
- <CAIN B* *10*>
- <JRST RUBOUT> ; "BS=RUBOUT"
- <CAIE B* %<ASCII !\>>
- <CAIN B* %<ASCII !\>>
- <JRST REBUF>
- <CAIN B* *14*>
- <JRST CREBUF> ; "BUFFER REDISPLAY"
- <CAIN B* 7>
- <JRST FAKINT> ; "CTRL-G SHOULD BE PROCESSED"
- <CAIN B* *12*> ; "IGNORE CTRL-J, SINCE ^M ADDS IT"
- <JRST CHRLOP>
- <JRST PUTCHR>
-
- PUTCHR1 <IDPB B* D> ; "STUFF IT OUT"
- <ADDI C* 1>
- <CAML C* -1(P)> ; "BUFFER FULL?"
- <AOS (P)> ; "YES, SKIP"
- <POPJ P*>
- FAKINT <PUSH P* A>
- <PUSH P* E>
- <PUSH P* PVP>
- <EXCH C* -3(P)>
- <SUB C* -3(P)>
- <HRLI C* <TYPE-CODE STRING>>
- <PUSH TP* C>
- <PUSH TP* D> ; "MAKE RESTED STRING TO PUSH"
- <PUSH TP* <PQUOTE "CHAR">>
- <PUSH TP* <MQUOTE "CHAR">>
- <PUSH TP* <TYPE-WORD CHARACTER>>
- <PUSH TP* B>
- <PUSH TP* <TYPE-WORD CHANNEL>>
- <MOVE B* <MQUOTE <RGLOC INCHAN T>>>
- <ADD B* GLOTOP 1>
- <PUSH TP* 1(B)>
- <IFN10X
- (<MOVEI A* *400000*>
- <MOVE B* [<(*002000*) *200000*>]>
- <STIW>)
- ()>
- <MCALL 3 INTERRUPT>
- <IFN10X
- (<MOVEI A* *400000*>
- <MOVEI B* 0>
- <STIW>)
- ()>
- <POP TP* D>
- <POP TP* C>
- <ADD C* -3(P)>
- <EXCH C* -3(P)>
- <POP P* PVP>
- <POP P* E>
- <POP P* A>
- <PUSHJ P* PPRMPT> ; "REDISPLAY PROMPT TO SHOW THAT BACK FROM INT"
- <JRST CHRLOP>
- INTHAK <PUSH P* PVP> ; "SAVE OUTCHAN"
- <EXCH C* -1(P)>
- <SUB C* -1(P)>
- <HRLI C* <TYPE-CODE STRING>> ; "MAKE C HAVE A VALID TYPE WORD FOR STRING"
- <#OPCODE!-OP!-PACKAGE *5000000000* [<(*001111*) *000311*>]>
- <POP P* PVP>
- <HRRZS C>
- <ADD C* (P)>
- <EXCH C* (P)>
- <JRST INTBCK> ; "RESTORE EVERYTHING, AND BACK"
- CRHACK <IFN10X
- (<CAIE B* *37*> ; "TURN EOL INTO CRLF"
- <JRST CRHACK1>
- <MOVEI B* *15*>
- <PUSHJ P* CHROUT>
- <MOVEI B* *12*>
- <PUSHJ P* CHROUT>
- <MOVEI B* *15*>)
- ()>
- CRHACK1 <SKIPL (TP)> ; "CAN CR TERMINATE?"
- <JRST RDDONE> ; "YES!"
- <PUSHJ P* PUTCHR1>
- <CAIA>
- <JRST RDDONE>
- <MOVEI B* *12*> ; "FOLLOW WITH LF"
- <JRST PUTCHR>
- <IFN10X ()
- (
- SIOT <SETZ>
- <SIXBIT "SIOT">
- <MOVSI *4000*> ; "TURN OFF DISPLAYNESS"
- <MOVE PVP>
- <B>
- <SETZ O>
- DSIOT <SETZ>
- <SIXBIT "SIOT">
- <MOVE PVP>
- <B>
- <SETZ O>)>
- CHROUT <IFN10X
- (<PUSH P* A>
- <MOVE A* PVP>
- <BOUT>
- <POP P* A>)
- (<*CALL [<SETZ>
- <SIXBIT "IOT">
- <MOVE PVP>
- <SETZ B>]>
- <*LOSE 1000>)>
- <POPJ P*>
- RDDONE <MOVE A* <MQUOTE <RGLOC SCRIPT-CHANNEL T>>>
- <ADD A* GLOTOP 1>
- <SKIPL 1(A)> ; "SKIPS IF SCRIPTING ON"
- <JRST RDDONE1>
- <PUSH P* C> ; "SAVE CHARACTER COUNT"
- <PUSH TP* (A)>
- <PUSH TP* 1(A)>
- <PUSH TP* -5(TP)> ; "PROMPT"
- <PUSH TP* -5(TP)>
- <PUSH TP* (A)>
- <PUSH TP* 1(A)>
- <MCALL 2 PRINTSTRING>
- <PUSH TP* -7(TP)>
- <PUSH TP* -7(TP)> ; "BUFFER"
- <PUSH TP* -3(TP)>
- <PUSH TP* -3(TP)> ; "SCRIPT CHANNEL"
- <PUSH TP* <TYPE-WORD FIX>>
- <PUSH TP* (P)> ; "# CHARACTERS"
- <MCALL 3 PRINTSTRING>
- <DPUSH TP* <PQUOTE <STRING <ASCII 13> <ASCII 10>>>>
- <PUSH TP* -3(TP)>
- <PUSH TP* -3(TP)>
- <PUSH TP* <TYPE-WORD FIX>>
- <PUSH TP* [2]>
- <MCALL 3 PRINTSTRING>
- <SUB TP* [<(2) 2>]>
- <POP P* C>
- RDDONE1 <IFN10X
- (<MOVEI A* *400000*>
- <MOVE B* [<(*002004*) *000000*>]>
- <STIW>)
- ()>
- <MOVSI A* <TYPE-CODE FIX>>
- <MOVE B* C>
- <SUB P* [<(1) 1>]>
- <SUB TP* [<(6) 6>]>
- <JRST MPOPJ>
- CREBUF <IFN10X
- (<JRST REBUF>)
- (<MOVEI O* 2>
- <MOVE B* <MQUOTE "C">>
- <*CALL DSIOT> ; "THIS HAS DISPLAY BIT ON"
- <*LOSE 1000>
- <JRST REBUF1>)>
- REBUF <IFN10X
- (<PUSH P* C>
- <PUSHJ P* PCRLF> ; "CR"
- <PUSHJ P* PPRMPT>
- <MOVE B* -4(TP)>
- <MOVN C* (P)>
- <SKIPE C>
- <SOUT> ; "BUFFER"
- <POP P* C>)
- (<PUSHJ P* PCRLF>
- REBUF1 <PUSHJ P* PPRMPT> ; "COMMON CODE FOR CTRL-D AND CTRL-L"
- <MOVE B* -4(TP)>
- <MOVE O* C>
- <*CALL SIOT>
- <*LOSE 1000>)>
- <JRST CHRLOP> ; "GO BACK FOR NEXT CHAR"
- PCRLF <IFN10X
- (<MOVE B* <MQUOTE %<STRING <ASCII 13> <ASCII 10>>>>
- <PUSH P* C>
- <MOVNI C* 2>
- <SOUT>
- <POP P* C>)
- (<MOVE B* <MQUOTE %<STRING <ASCII 13> <ASCII 10>>>>
- <MOVEI O* 2>
- <*CALL SIOT>
- <*LOSE 1000>)>
- <POPJ P*>
- PPRMPT <IFN10X
- (<MOVE B* -2(TP)>
- <PUSH P* C>
- <HRRZ C* -3(TP)>
- <MOVNS C>
- <SKIPE C>
- <SOUT>
- <POP P* C>)
- (<MOVE B* -2(TP)>
- <HRRZ O* -3(TP)>
- <*CALL SIOT>
- <*LOSE 1000>)>
- <POPJ P*>
- BUFFLS <MOVEI C* 0> ; "THROW EVERYTHING AWAY"
- <MOVE D* -4(TP)>
- <PUSHJ P* PCRLF>
- <PUSHJ P* PPRMPT>
- <JRST CHRLOP>
- RUBOUT <PUSHJ P* RRUBOUT>
- <JRST CHRLOP>
- RRUBOUT <JUMPE C* [<SUB P* [<(1) 1>]>
- <JRST REBUF>]> ; "IF RUBBING OUT PAST BEG OF LINE, REDO PROMPT &C"
- <IFN10X
- ()
- (<JUMPL E* RUBFLS> ; "IF E IS 0, HAVE TO PRINT \ FIRST")>
- <JUMPG E* RUBOUT1>
- <MOVEI B* <ASCII 92>>
- <PUSHJ P* CHROUT>
- RUBOUT1 <LDB B* D> ; "GET CHAR BEING FLUSHED"
- <PUSHJ P* CHROUT>
- RUBOUT2 <ADD D* [<(*70000*) 0>]>
- <TLNE D* *400000*>
- <ADD D* [<(*347777*) *777777*>]>
- <SUBI C* 1>
- <POPJ P*>
- <IFN10X ()
- (
- RUBFLS <LDB B* D> ; "GET CHAR"
- <CAIN B* *12*>
- <JRST [<MOVE B* <MQUOTE <STRING "U">>> ; "LINE STARVE"
- <JRST RUBFLO>]>
- <CAIN B* *15*>
- <JRST RUBFCR>
- <MOVE B* <MQUOTE <STRING "X">>>
- RUBFLO <MOVEI O* 2>
- <*CALL DSIOT>
- <*LOSE 1000>
- <JRST RUBOUT2>
- RUBFCR <PUSH P* C>
- <PUSH P* D>
- <PUSH P* E>
- <MOVE D* -4(TP)> ; "POINTER TO BUFFER"
- <HRRZ E* -3(TP)> ; "CURRENT HORIZONTAL POSITION--PROMPT"
- <SOJLE C* RUBCRE1> ; "FLUSH CR FROM END"
- RUBCRL <ILDB B* D>
- <CAIN B* *15*>
- <JRST [<MOVEI E* 0>
- <JRST RUBCRE>]>
- <CAIN B* *12*>
- <JRST RUBCRE>
- <ADDI E* 1>
- RUBCRE <SOJG C* RUBCRL>
- RUBCRE1 <ADDI E* 8>
- <MOVEI O* 2>
- <MOVE B* <MQUOTE "H">>
- <*CALL DSIOT>
- <*LOSE 1000>
- <*CALL [<SETZ>
- <SIXBIT "IOT">
- <PVP>
- <SETZ E>]> ; "SET HORIZONTAL POSITION"
- <*LOSE 1000>
- <POP P* E>
- <POP P* D>
- <POP P* C>
- <JRST RUBOUT2>)>
- WDFLS <JUMPE C* REBUF> ; "NOTHING TO FLUSH"
- <JUMPL E* WDFLS1> ; "CAN RUBOUTS HAPPEN?"
- <MOVEI B* <ASCII 92>>
- <PUSHJ P* CHROUT>
- <ADDI E* 1> ; "INHIBIT \ WHEN DOING RUBOUTS"
- WDFLS1 <LDB B* D> ; "GET CHAR BEING FLUSHED"
- <CAIE B* *40*> ; "SPACE?"
- <CAIN B* *15*> ; "CR?"
- <JRST WDFLS11>
- <CAIE B* *12*>
- <CAIN B* *11*>
- <JRST WDFLS11>
- <CAIE B* *54*> ; "COMMA"
- <JRST WDFLS2>
- WDFLS11 <PUSHJ P* RRUBOUT> ; "RUB IT OUT"
- <JUMPE C* WDFLSO> ; "EMPTY BUFFER"
- <JRST WDFLS1>
- WDFLS2 <LDB B* D>
- <CAIE B* *40*>
- <CAIN B* *15*>
- <JRST WDFLSO>
- <CAIE B* *12*>
- <CAIN B* *11*>
- <JRST WDFLSO>
- <CAIN B* *54*>
- <JRST WDFLSO>
- <PUSHJ P* RRUBOUT>
- <JUMPG C* WDFLS2>
- WDFLSO <JUMPLE E* CHRLOP>
- <MOVEI B* <ASCII 92>>
- <PUSHJ P* CHROUT>
- <MOVEI E* 0>
- <JRST CHRLOP>
- <TITLE TTY-INIT>
- <DECLARE ("VALUE" ATOM <OR ATOM FALSE>)>
- <DPUSH TP* (AB)>
- <PUSHJ P* IINIT>
- <JRST FINIS>
- <INTERNAL-ENTRY IINIT 1>
- <SUBM M* (P)>
- <MOVE A* <MQUOTE <RGLOC OUTCHAN T>>>
- <ADD A* GLOTOP 1>
- <MOVE A* 1(A)> ; "OUTCHAN"
- <IFN10X
- (<MOVEI B* 70>
- <SKIPN 25(A)>
- <MOVEM B* 25(A)> ; "MAKE CHANNEL WIDTH NON-ZERO")
- ()>
- <MOVE A* 1(A)>
- <IFN10X
- (<SKIPL (TP)> ; "SAVE CURRENT STATE?"
- <JRST STMODE>
- <MOVE E* <MQUOTE <RGLOC RUVEC T>>>
- <ADD E* GLOTOP 1>
- <MOVE E* 1(E)>
- STMODE <RFMOD>
- <SKIPGE (TP)>
- <MOVEM B* (E)> ; "MODE WORD"
- <TRO B* *140000*>
- <TRZ B* *030000*>
- <SFMOD>
- <SKIPL (TP)>
- <JRST SCMODE>
- <RFCOC> ; "CONTROL CHARACTER FORMATTING"
- <MOVEM B* 1(E)>
- <MOVEM C* 2(E)>
- SCMODE <MOVE B* <MQUOTE #2 {0 1 1 1 0 1 1 2 0 3 3 1 2 3 1 1 1 1}>>
- <MOVE B* 1(B)>
- <MOVE C* <MQUOTE #2 {1 1 1 1 1 0 0 1 1 1 1 1 1 0}>>
- <MOVE C* 1(C)>
- <SFCOC> ; "THIS DOES ECHOING FOR CTRL-CHARS"
- <MOVEI A* *400000*>
- <SKIPL (TP)>
- <JRST SIMODE>
- <RTIW>
- <MOVEM B* 3(E)>
- SIMODE <MOVE B* [<(*2004*) 0>]>
- <STIW>
- <SKIPL (TP)>
- <JRST INTSET>
- <MCALL 0 ACTIVATE-CHARS>
- <MOVE C* <MQUOTE <RGLOC ACT-STRING T>>>
- <ADD C* GLOTOP 1>
- <MOVEM A* (C)>
- <MOVEM B* 1(C)>
- INTSET <DPUSH TP* <PQUOTE "">>
- <MCALL 1 ACTIVATE-CHARS>)
- (<*CALL [<SETZ>
- <SIXBIT "CNSGET">
- <A>
- <MOVEM B>
- <MOVEM B>
- <MOVEM B>
- <MOVEM B>
- <SETZM B>]>
- <*LOSE 1000>
- <TLNN B* *40000*> ; "TEST %TOERS"
- <JRST INIT1>
- <MOVE B* <MQUOTE <RGLOC RUBOUT? T>>>
- <ADD B* GLOTOP 1>
- <MOVE C* <MQUOTE T>>
- <MOVEM C* 1(B)>
- <MOVSI C* <TYPE-CODE ATOM>>
- <MOVEM C* (B)> ; "SETG RUBOUT? TO T"
- INIT1 <SKIPL (TP)>
- <JRST DTTYST>
- <MOVE B* <MQUOTE <RGLOC RUVEC T>>>
- <ADD B* GLOTOP 1>
- <MOVE B* 1(B)>
- <*CALL [<SETZ>
- <SIXBIT "TTYGET">
- <A>
- <MOVEM (B)>
- <SETZM 1(B)>]>
- <*LOSE 1000>
- DTTYST <*CALL [<SETZ>
- <SIXBIT "TTYSET">
- <A>
- <MOVE [<(*022020*) *202020*>]>
- <SETZ [<(*032022*) *220222*>]>]>
- <*LOSE 1000>)>
- TTYIDN <SUB TP* [<(2) 2>]>
- <MOVSI A* <TYPE-CODE ATOM>>
- <MOVE B* <MQUOTE T>>
- <JRST MPOPJ>
- <TITLE TTY-UNINIT>
- <DECLARE ("VALUE" ATOM)>
- <PUSHJ P* IUNINIT>
- <JRST FINIS>
- <INTERNAL-ENTRY IUNINIT 0>
- <SUBM M* (P)>
- <MOVE A* <MQUOTE <RGLOC OUTCHAN T>>>
- <ADD A* GLOTOP 1>
- <MOVE A* 1(A)>
- <MOVE A* 1(A)>
- <IFN10X
- (<MOVE D* <MQUOTE <RGLOC RUVEC T>>>
- <ADD D* GLOTOP 1>
- <MOVE D* 1(D)>
- <MOVE B* (D)>
- <SFMOD> ; "RESTORE MODES"
- <MOVE B* 1(D)>
- <MOVE C* 2(D)>
- <SFCOC>
- <MOVEI A* *400000*>
- <MOVE B* 3(D)>
- <STIW>
- <MOVE D* <MQUOTE <RGLOC ACT-STRING T>>>
- <ADD D* GLOTOP 1>
- <PUSH TP* (D)>
- <PUSH TP* 1(D)>
- <MCALL 1 ACTIVATE-CHARS> ; "RESTORE INTERRUPTS")
- (<MOVE B* <MQUOTE <RGLOC RUVEC T>>>
- <ADD B* GLOTOP 1>
- <MOVE B* 1(B)>
- <*CALL [<SETZ>
- <SIXBIT "TTYSET">
- <A>
- <(B)>
- <SETZ 1(B)>]>
- <*LOSE 1000>)>
- <MOVE B* <MQUOTE T>>
- <MOVSI A* <TYPE-CODE ATOM>>
- <JRST MPOPJ>
- <TITLE EXCRUCIATINGLY-UNTASTEFUL-CODE>
- <DECLARE ("VALUE" ATOM)>
- <PUSHJ P* IEUC>
- <JRST FINIS>
- <INTERNAL-ENTRY IEUC 0>
- <SUBM M* (P)>
- <MOVE A* <MQUOTE <RGLOC PRSVEC T>>>
- <ADD A* GLOTOP 1>
- <HRRZ A* 1 (A)>
- <ADDI A* 1>
- <MOVEM A* *60*>
- <ADDI A* 2>
- <MOVEM A* *61*>
- <ADDI A* 2>
- <MOVEM A* *62*>
- <MOVE A* <TYPE-WORD ATOM>>
- <MOVE B* <MQUOTE T>>
- <JRST MPOPJ>
|