From cbe5fdf62b1aa17a05ad402fde4bd73a4e5e007b Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Fri, 16 Nov 2018 14:59:36 +0100 Subject: [PATCH] MUDINQ - Muddle inquirer. Used to send a form for a Muddle job to evaluate, printing the result. Aliases: - PURGE, flushes Zork. - MAKSCR, make Zork script. - STATUS, queries status of compiler. - WHOM, lists listening Muddle jobs. --- build/muddle.tcl | 7 + doc/programs.md | 1 + src/sysen2/mudinq.43 | 1689 ++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 1697 insertions(+) create mode 100755 src/sysen2/mudinq.43 diff --git a/build/muddle.tcl b/build/muddle.tcl index c78fec62..4e4c75dd 100644 --- a/build/muddle.tcl +++ b/build/muddle.tcl @@ -20,6 +20,13 @@ respond "*" ":start\r" respond "..PERM/ -1" ":pdump mudsav; ts mdl56\r" respond "*" ":kill\r" +respond "*" ":midas sys3; ts mudinq_sysen2; mudinq\r" +expect ":KILL" +respond "*" ":link sys3; ts purge, sys3; ts mudinq\r" +respond "*" ":link sys3; ts makscr, sys3; ts mudinq\r" +respond "*" ":link sys3; ts status, sys3; ts mudinq\r" +respond "*" ":link sys3; ts whom, sys3; ts mudinq\r" + respond "*" ":link sys3; ts mdl,mudsav; ts mdl56\r" respond "*" ":link sys3; ts muddle,mudsav; ts mdl56\r" diff --git a/doc/programs.md b/doc/programs.md index a0151eb2..99203ef3 100644 --- a/doc/programs.md +++ b/doc/programs.md @@ -185,6 +185,7 @@ - MTBOOT, make bootable tapes. - MUDCOM/MUDCHK/MUDFND/MUDLST, compare/check/find/list Muddle files. - MUDDLE, MDL interpreter. +- MUDINQ, Muddle inquirer. - MUNCH, TV-munching square. - NAME, shows logged in users and locations, aka FINGER. - NETIME, network time dragon. diff --git a/src/sysen2/mudinq.43 b/src/sysen2/mudinq.43 new file mode 100755 index 00000000..5d37f1d2 --- /dev/null +++ b/src/sysen2/mudinq.43 @@ -0,0 +1,1689 @@ +TITLE MUDINQ -- MUDDLE INQUIRER +.MLLIT==1 + +O=0 +A=1 +B=2 +C=3 +D=4 +E=5 +F=6 +P=10 +SC=11 +CH=12 +CNT=13 +CONTIN=14 +FREBUF=15 +INTAC=16 + +TYIC==0 +TYOC==1 +DSKI==2 +MSPI1==3 ; CAN HAVE 3 MESSAGES OUT AT ONCE +MSPO==4 +MSPI2==5 +MSPI3==6 +MSCHNS==1_MSPI3+1_MSPI2+1_MSPI1 ;MSP READ CHANNELS + +USEUJ==20 +SIMM==10 +SANDH==4 +ITSPGS==300000/2000 ;# ITS PAGES +HIPORG==200 ;PAGE # OF A ORIGIN OF HIGH PAGES + +LOC 42 + -TSINTL,,TSINT +LOC 100 + + +DEFINE DBP X ;DECREMENT BYTE POINTER + ADD X,[070000,,0] + JUMPGE X,.+3 + SOS X + HRLI X,010700 +TERMIN + +DEFINE MACT ADDR + MOVEI 0,ADDR + MOVEM 0,ACT2 + MOVEM P,ACT1 +TERMIN + +DEFINE ASCIS VAL + ZORK==.LENGTH /VAL/ + BB==ZORK-<*5> + </5> + IFE BB,[ASCII /VAL/] + IFE BB-1,[ASCII /VAL /] + IFE BB-2,[ASCII /VAL /] + IFE BB-3,[ASCII /VAL /] + IFE BB-4,[ASCII /VAL /] +TERMIN + +DEFINE BLATIT MSG + MOVEI E,MSG + PUSHJ P,BLAT +TERMIN + +DEFINE COPBLK MSG + MOVEI E,MSG + PUSHJ P,COPYBL +TERMIN + +JCLPTR: 440700,,JCL +LSTCHN: 0 ;IF NON-ZERO, POINTER TO LAST LISTEN CHANNEL OPENED +STATFL: 0 +STY: 0 +NPCOMP: 0 +COMTRY: 0 +SYSHER: 0 +OPFFLG: 0 +XORFLG: 0 +PURGER: 0 +SCRIPT: 0 +UNXSW: 0 +RDERR: 0 +XMSGLN: 0 +STRSW: 0 +RDSW: 0 +PRTSW: -1 ;LOCK SO INTERRUPT HANDLER AND PRINTER DON'T COMPETE +CHRCNT: 0 +CURUNM: 0 + +ACT1: 0 ;SAVED P FOR MORE HANDLER TO DO DISMISS +ACT2: 0 ;ADDR TO DISMISS TO + +NUMCHR: 0 ;#CHARACTERS TYPED AHEAD +INTBUF: 440700,,TINBUF ;POINTER TO TEMPORARY INPUT BUFFER +FBUF: 440700,,TINBUF ;POINTER TO FRONT OF TEMPORARY BUFFER +EBUF: 440700,,TINBUF ;POINTER TO END OF TEMPORARY BUFFER +PRGJNM: SIXBIT /PURGE/ +MKSJNM: SIXBIT /MAKSCR/ +STTJNM: SIXBIT /STATUS/ +WHOJNM: SIXBIT /WHOM/ ;JNAME CHECKS FOR INQUIRE +XORJN1: SIXBIT /XORCST/ +XORJN2: SIXBIT /X/ + +UNAMEB: 2 + ASCII / \"X=/ +AUNAME: 0 + +STIMEB: 1 +STIME: ASCII /1800 / + +MYUNM: 0 +MYJNM: 0 +XUNAME: 0 ;XUNAME OF USER +NAME: 0 ;SLOT FOR FILLING IN FILE NAMES + +DBUF: +JCL: BLOCK 40. +DBUFLN==.-DBUF +CHSTK: BLOCK 40 +PSTK: BLOCK 60 +INTSTK: BLOCK 40 +MSGBLK: BLOCK 200. +TINBUF: BLOCK 20 ;INPUT BUFFER + +UNAMES: 0 ;BLOCK FOR IPC SENDS +JNAMES: 0 +WDCNT: 0 +SNDBLK: 0 +IPCTYP: 400000,,0 + BLOCK 198. + +MSPCHS: MSPI1,,MSPIN1 ;CHANNEL #,,BUFFER + 0 ;IS THERE AN UNPRINTED MESSAGE HERE? + SIXBIT /MUDINQ/ ;JNAME FOR THIS CHANNEL + MSPI2,,MSPIN2 + 0 + SIXBIT /MUDINR/ + MSPI3,,MSPIN3 + 0 + SIXBIT /MUDINS/ +MSPCHL: MSPCHS-.,,MSPCHS +MSPCHK==2 +;BLOCKS FOR MSP LISTENS +MSPIN1: 0 ;BLOCK FOR MSPI1 + 0 + 15 + BLOCK 15 +MSPIN2: 0 ;BLOCK FOR MSPI2 + 0 + 15 + BLOCK 15 +MSPIN3: 0 ;BLOCK FOR MSPI3 + 0 + 15 + BLOCK 15 + +EBLOCK: 0 ;COPY OF MSPINP BLOCK + 0 + 15 + BLOCK 15 + +MSPBLK: 0 +MSPADD: 0 +MSPUNM: 0 +MSPJNM: 0 + +OPBLK: 0 ;OPEN BLOCK FOR MSPO + -203.,,UNAMES + 0 + 0 + +FILBLK: SETZ ;OPEN BLOCK FOR DSKI + SIXBIT /OPEN/ + [.BII,,DSKI] ;BLOCK IMAGE MODE + DEVICE + FNAME1 + FNAME2 + SETZ SNAME + +DEVICE: SIXBIT /DSK / +FNAME1: 0 +FNAME2: SIXBIT /> / +SNAME: 0 + +TTYSET: SETZ ;BLOCK FOR CALL TO TTYSET + SIXBIT /TTYSET/ + 1000,,TYIC + [232323,,232323] + SETZ [232323,,230323] + +;INTERRUPT TABLE: MORE FIRST, THEN CHARACTERS, THEN MSP (SO MORES WILL HAPPEN +;IF PROCESSING MSP INTERRUPT) +;AUTOMAGICALLY PUSH O, A AND B +ACPUSH==3 +TSINT: ACPUSH,,INTAC + 0 ? 1_TYOC ? 0 ? MSCHNS ? DOMORE ; CHAR INTERRUPTS CAN HAPPEN DURING MORE + 0 ? 1_TYIC ? 0 ? 1_TYIC+MSCHNS ? DOREAD + 0 ? 1_MSPI1 ? 0 ? MSCHNS ? DOMSP1 + 0 ? 1_MSPI2 ? 0 ? MSCHNS ? DOMSP2 + 0 ? 1_MSPI3 ? 0 ? MSCHNS ? DOMSP3 +TSINTL==.-TSINT + +;MORE INTERRUPT HANDLER +DOMORE: PUSH P,C + SETOM MORFLG' ; SO CHAR INTERRUPTS DISMISS IMMEDIATE + MOVEI C,0 + MOVEI A,10 + MOVE B,[440700,,[ASCII /--More--/]] + .CALL SIOT + .LOSE 1000 + .CALL [SETZ + SIXBIT /FLUSH/ + SETZI TYOC] + .LOSE 1000 + SKIPN C + .HANG + MOVE A,C + SETZM MORFLG + POP P,C + CAIE A," + JRST DOMFLS + MOVEI A,4 + MOVE B,[440700,,[ASCII /TL/]] + .CALL SIOT + .LOSE 1000 + .CALL NDISMI ; NORMAL DISMISS IF SPACE TYPED + .LOSE 1000 +DOMFLS: CAIN A,^G + JRST FINIS + MOVEI A,7 + MOVE B,[440700,,[ASCII /Flushed/]] + .CALL SIOT + .LOSE 1000 + SKIPN ACT1 + JRST [.CALL NDISMI + .LOSE 1000] + MOVE P,ACT1 + SETZM ACT1 + .CALL [SETZ + SIXBIT /DISMIS/ + MOVSI ACPUSH + INTAC + SETZ ACT2] + .LOSE 1000 + +;DISMISS FOR NORMAL STUFF: JUST RESTORE EVERYTHING +NDISMI: SETZ + SIXBIT /DISMIS/ + MOVSI ACPUSH + SETZ INTAC + +SIOT: SETZ + SIXBIT /SIOT/ + MOVEI TYOC + B + SETZ A + +DOREAD: MOVEI A,TYIC + .ITYIC A, + .CALL NDISMI + CAIN A,^G + JRST FINIS + CAIN A,^S + JRST RESET + JUMPE A,QUITTE + SKIPLE NUMCHR + JRST DOREA1 + MOVE 0,INTBUF + MOVEM 0,FBUF + MOVEM 0,EBUF + SETZM NUMCHR +DOREA1: .IOT TYIC,A + SKIPE MORFLG + JRST [MOVE C,A + JRST DOREA2] + IDPB A,EBUF + AOS NUMCHR +DOREA2: .CALL NDISMI + .LOSE 1000 + +; MSP INTERRUPT HANDLER. IF READING FROM TTY, QUEUE FOR PRINTING; +; OTHERWISE, PRINT IMMEDIATE. THE PRINTING ROUTINE CLOSES THE CHANNEL +; AND FREES ITS SLOT. +DOMSP1: SETOM MSPCHS+1 ;REPLY ON THIS CHANNEL + JRST DMSPCK +DOMSP2: SETOM MSPCHS+4 + JRST DMSPCK +DOMSP3: SETOM MSPCHS+7 +DMSPCK: AOS MSPMSG' ;COUNT OF PENDING MESSAGES + SKIPE RDSW ;AM I IN READER? + JRST DMSPC1 + PUSHJ P,MSPACK ;NOPE. GO DO PRINTING +DMSDIS: .CALL NDISMI ;AND DISMISS + .LOSE 1000 +DMSPC1: SKIPE RDCHR ;DON'T ASK ME + JRST DMSPDF ;DEFER PRINTING + PUSHJ P,MSPACK ;DO PRINTING + JRST DMSPDF ;DISMISS IF FAILED + OASC @PRMPT ;PRINT PROMPT + PUSHJ P,BUFPRI ;PRINT BUFFER +DMSPDF: .CALL NDISMI ;AND DISMISS + .LOSE 1000 + +MSPACK: AOSE PRTSW ;CAN I GET IT? + POPJ P, ;NO, SO SOMEBODY ELSE MUST HAVE IT + PUSH P,A + PUSH P,B + PUSH P,E + PUSH P,F +MSPLOO: MOVE A,MSPCHL ;POINTER TO CHANNEL BLOCK +MSPLO1: SKIPN 1(A) ;MESSAGE ON THIS CHANNEL? + JRST MSNEXT ;NO + PUSHJ P,ACKPRT + SOSG MSPMSG ;ANY MESSAGES TO PRINT? + JRST MSPEND ;NO +MSNEXT: ADD A,[3,,3] + JUMPL A,MSPLO1 ;CHECK REST OF CHANNELS + JRST MSPLOO ;START OVER +MSPEND: SETOM PRTSW ;FREE PRINTER FOR INTERRUPTS + POP P,F + POP P,E + POP P,B + POP P,A +POPJ1: AOS (P) + POPJ P, + +RESET: SETZM UNAMES + SETZM JNAMES +QUITTE: MOVE 0,INTBUF ;THROW AWAY ANYTHING TYPED AHEAD + MOVEM 0,FBUF + MOVEM 0,EBUF + SETZM NUMCHR + .RESET TYIC, + .RESET TYOC, + MOVE P,[-60,,PSTK-1] + .CALL [SETZ + SIXBIT /DISMIS/ + MOVSI ACPUSH + INTAC + SETZI MLOOP] + .LOSE 1000 + +FINIS: .RESET TYIC, + .RESET TYOC, + .BREAK 16,160000 + + + +;MAIN PROGRAM FOR INQUIRE + +START: .BREAK 12,[5,,JCL] + .SUSET [.RSNAME,,SNAME] ;SET SNAME TO USERS NAME + .SUSET [.RXUNAM,,XUNAME] + .SUSET [.RUNAME,,MYUNM] + .SUSET [.RJNAME,,MYJNM] + .SUSET [.ROPTIO,,0] + TLO 0,OPTINT ;NEW-STYLE INTERRUPTS + .SUSET [.SOPTIO,,0] + MOVE P,[-40,,PSTK-1] + MOVE INTAC,[-40,,INTSTK-1] + MOVE CH,[-40,,CHSTK-1] + PUSHJ P,TTYOPN ;SET UP THE TTY CHANNELS + MOVE MYJNM +; CAME XORJN1 +; CAMN XORJN2 +; JRST XORCST + CAMN PRGJNM + SETOM PURGER + CAMN MKSJNM + SETOM SCRIPT + CAMN WHOJNM + JRST WHOM + CAMN STTJNM + JRST STATUS + PUSHJ P,GETJCL +MLOOP: SETZM LSTCHN + SKIPE MSPMSG + JRST [PUSHJ P,MSPACK + .VALUE + JRST .+1] + SETZM CONTIN + SKIPN SCRIPT + SKIPE PURGER + JRST PURGE + PUSHJ P,GETNM + MOVEI A,[ASCIZ /Inquiry: /] + MOVEM A,PRMPT + OASCR [0] + OASC (A) + MOVEI MLOOP + MOVEM RDERR + PUSHJ P,RTOALT ;READ A MESSAGE + OASCR [0] ;ECHO A TERPRI +MLOOP1: PUSHJ P,SNDMSG ;SEND IT + OASCR [ASCIZ /Message sent./] + JRST MLOOP + +ACKPRT: PUSH P,A + OASCR [0] + MOVE A,(A) ;-CHANNEL,,BLOCK + SKIPN STATFL + OASC [ASCIZ /Acknowledgement from /] + OSIX (A) + OASCI 40 + OSIX 1(A) + OASCI ": + OASCR [0] + MOVE E,[440700,,6] + ADDI E,(A) ;OFFSET FOR BLOCK + PUSHJ P,FPARSE + PUSHJ P,DELETE + SKIPE STATFL + .BREAK 16,40000 + OASCR [0] + POP P,A + SETZM 1(A) ;NOTHING TO PROCESS + HLRE D,(A) ;-CHANNEL + MOVMS D ;CHANNEL + HRLM D,(A) ;FREE SLOT + ASH D,27 ;SINCE .CALL DOESN'T WORK + IOR D,[.CLOSE] + XCT D + POPJ P, + +;ASSORTED HACKERS FOR JCL, COPYING OT MSGBLK, ETC. + +;READ JCL FOR UNAME AND JNAME + +GETJCL: MOVE E,[440700,,JCL] ;READ JCL + MOVE F,[440600,,UNAMES] + PUSHJ P,NXTCHR + PUSHJ P,NAMFND + MOVE F,[440600,,JNAMES] + PUSHJ P,NXTCHR + PUSHJ P,NAMFND + PUSHJ P,NXTCHR +JCLOUT: DBP E + MOVEM E,JCLPTR + POPJ P, + +NXTCHR: IBP E,E ;GET NEXT NON-SEPARATION CHAR + LDB E + JUMPE CPOPJ + CAIN "- + JRST NUMBR + CAIL "0 + CAILE "9 + JRST .+2 + JRST NUMBR + CAIN 40 + JRST NXTCHR + DBP E, +CPOPJ: POPJ P, + +NUMBR: SUB P,[1,,1] + JRST JCLOUT + +NAMFND: ILDB E + TLNN F,760000 + POPJ P, + CAIE 15 + CAIN 40 ;END OF NAME + POPJ P, + JUMPE CPOPJ + CAIL "a + CAILE "z + ADDI 40 ;TO SIXBIT AND CAPITALIZED! + IDPB F + JRST NAMFND + +; HERE TO COPY SOMETHING INTO MSGBLK +; POINTER TO MSGBLK IS IN F +; POINTER TO OTHER BLOCK IS IN E" + +COPYBL: MOVE A,(E) ;LENGTH + HRLZI C,1(E) + HRR C,F + ADD F,A + BLT C,-1(F) + ADDM A,MSGBLK ;HACK WORD COUNT + POPJ P, + + +;STUFF TO GET UNAME/JNAME IF NOT PROVIDED + +GETNM: SKIPE UNAMES + JRST JCHK + SKIPE JNAMES + JRST GETUNM + +GETUJ: PUSHJ P,GETUNM + PUSHJ P,GETJNM + POPJ P, + +JCHK: SKIPE JNAMES + POPJ P, + +GETJNM: MOVEI A,[ASCIZ /Jname: /] + MOVEM A,PRMPT + OASCR [0] + OASC (A) + MOVE F,UNAMES + CAME F,[SIXBIT /COMWIN/] + JRST NOWIN + MOVE F,[SIXBIT /COMSYS/] + MOVEM F,UNAMES + SETOM IPCTYP +NOWIN: PUSHJ P,UNMLKP + CAIE F,0 + JRST FNDJNM + MOVEI GETJNM + MOVEM RDERR + PUSHJ P,RTOALT + MOVE E,[440700,,MSGBLK+1] + MOVE F,[440600,,JNAMES] + PUSHJ P,NXTCHR + PUSHJ P,NAMFND + OASCR [0] + POPJ P, + +FNDJNM: MOVE F + MOVEM JNAMES + OSIX JNAMES + OASCR [0] + POPJ P, + +ALIPCJ: OASCR [0] + PUSHJ P,IPCERS + JRST GETJNM + +ALIPCU: OASCR [0] + PUSHJ P,IPCERS + JRST GETUNM + +GETUNM: MOVEI A,[ASCIZ /Uname: /] + MOVEM A,PRMPT' + OASCR [0] + OASC (A) + MOVEI GETUNM + MOVEM RDERR + PUSHJ P,RTOALT + MOVE E,[440700,,MSGBLK+1] + MOVE F,[440600,,UNAMES] + PUSHJ P,NXTCHR + PUSHJ P,NAMFND + POPJ P, + +UNMLKP: SETZ SC, + SKIPN SYSHER + PUSHJ P,GETSYS + MOVEI B,40 + +UNMLK1: SOJL B,[MOVE F,SC + POPJ P,] + MOVE A,@MSUSER + JUMPE A,UNMLK1 + MOVE @MSREAD + CAME F + JRST UNMLK1 + JUMPN SC,[SETZ F, + POPJ P,] + MOVE SC,@MSRED2 + JRST UNMLK1 + + +UJFILL: MOVEI E,UJNAME+1 ;REINITIALIZE UJNAME BLOCK + SETZM UJFLAG + HRLI E,BLOCK4 + MOVE F,E + BLT E,3(F) + MOVE E,[440700,,UJNAME+1] + MOVE F,[440600,,MYUNM] +UJLOOP: MOVEI "" + IDPB E + MOVEI B,6 +UJIDPB: ILDB F + ADDI 40 + IDPB E + SOJN B,UJIDPB + MOVEI "" + IDPB E + SKIPE UJFLAG + POPJ P, + MOVE F,[440600,,MYJNM] + SETOM UJFLAG' + JRST UJLOOP + +;STUFF TO PIECE TOGETHER MESSAGE AND SEND IT + +SETUP: PUSH P,A + MOVE A,STRTOP + ADD A,STRBOT + ADD A,STRFOO + ADD A,UJNAME + ADD A,MSGBLK + IMULI A,5 + MOVEM A,CHRCNT + POP P,A + MOVEI FREBUF,197. ;LENGTH OF BUFFER + JUMPE CONTIN,SETUP1 ;FIRST TIME + MOVE F,[440700,,SNDBLK] ;MAKE BYTE POINTER + POPJ P, + +SETUP1: MOVE CHRCNT ;GET CHARS IN MESSAGE + MOVEM SNDBLK+2 ;PUT IN TOTAL CHARACTERS IN MESSAGE + ADDI 4 + IDIVI 5 + ADDI 2 + HRRM SNDBLK ;PUT IN TOTAL WORDS (ROUNDED) IN MESSAGE + MOVE F,[440700,,SNDBLK+2] + POPJ P, + +SNDMSG: PUSHJ P,MSPOPN ;GET CHANNEL +SNDMS1: PUSHJ P,UJFILL ;CONS U/JNAME + SETZM CHRCNT + PUSHJ P,SETUP + BLATIT STRTOP + BLATIT MSGBLK + BLATIT STRBOT + BLATIT UJNAME + BLATIT STRFOO + PUSHJ P,IPCMSG + POPJ P, + +BLAT: MOVE A,(E) ;WORDS IN FROBBER +IBLAT: ADDI F,1 + HRRZ B,F + HRLI B,1(E) ;START OF FROBBER + CAMLE A,FREBUF + JRST PBLAT + ADDI F,-1(A) ;END OF FROBBER + BLT B,(F) ;PUT IN MESSAGEE + SUB FREBUF,A ;UPDATE FREE BUFFER LENGTH + POPJ P, + +PBLAT: SETOM MLTSND' ;SAY MORE IS COMING + ADDI F,-1(FREBUF) + BLT B,(F) ;PUT IN MESSAGE TO EOB + SUB A,FREBUF + ADDI E,(FREBUF) + PUSHJ P,IPCMSG ;SEND IT + SETZM MLTSND + JRST IBLAT + +IPCMSG: MOVEI 100000 + SKIPE MLTSND + TRO 200000 + SKIPE CONTIN + TRO 400000 + HRLM SNDBLK + HRRZ F + SUBI SNDBLK-2 + SKIPE MLTSND + MOVEI 200. + MOVEM WDCNT + PUSHJ P,OPEN + AOS CONTIN + PUSHJ P,SETUP + POPJ P, + +OPEN: HRRZI (SIXBIT /IPC/) + TLO USEUJ + SKIPE CONTIN + JRST COPEN + TLO SIMM + +OPEN1: MOVEM OPBLK + SKIPE STY + POPJ P, + .OPEN MSPO,OPBLK + JRST IPCOPF + POPJ P, + +COPEN: TLO SANDH + JRST OPEN1 + + +;OPENERS OF MSP AND TTY CHANNELS + +MSPOPN: PUSH P,A + PUSH P,B + MOVE A,MSPCHL +MSPLOP: SKIPL (A) + JRST MSPWIN + ADD A,[3,,3] + JUMPL A,MSPLOP + JRST [OASCR [ASCIZ /All listening channels in use. Aborting./] + JRST RESET] +MSPWIN: MOVEM A,LSTCHN ;SAVE IN CASE OPEN FAILS + HLRZ (A) ;GET CHANNEL NUMBER TO USE + MOVN B, + HRLM B,(A) ;SAY THIS ONE IN USE + MOVE B,2(A) ;GET JNAME OF CHANNEL + MOVEM B,MYJNM + MOVEM B,MSPJNM ;SAVE AS JNAME AND IN OPEN BLOCK + MOVE B,(A) ;GET ADDRESS OF BLOCK + HRRM B,MSPADD ;STUFF IN OPEN BLOCK + HRLI B,EBLOCK + MOVEI A,17(B) + BLT B,(A) ;RE-INITIALIZE BUFFER + MOVE A,[SIXBIT / IPC/] + TLO A,1 + MOVEM A,MSPBLK + MOVE A,MYUNM + MOVEM A,MSPUNM + ASH 0,27 ;PUT CHANNEL NUMBER IN AC SLOT + MOVE A,[.OPEN MSPBLK] + IOR A, + XCT A ;OPEN CHANNEL + .LOSE 1000 +MSPPOP: POP P,B + POP P,A + POPJ P, + +TTYOPN: .CALL [SETZ + SIXBIT /OPEN/ + 5000,,4001 + 1000,,TYOC + SETZ [SIXBIT /TTY /]] + .VALUE + .OPEN TYIC,[.UAI,,'TTY] + .VALUE + .SUSET [.SIMSK2,,[1_TYOC+1_TYIC+MSCHNS]] + .CALL TTYSET ;SET UP TTY TO TAKE CONTROL-S + .VALUE + .SUSET [.RCNSL,,A] + CAILE A,20 + SETOM STY + POPJ P, + + + +;READER + +RTOALT: SETOM RDSW + SETZM RDCHR' + MOVEI CNT,1000. + MOVE F,[440700,,MSGBLK+1] + +READCH: PUSHJ P,RDACHR + SETOM RDCHR + CAIN A," + JRST UNBLOK + CAIE A,"" + CAIN A,"\ + JRST QUOTE + CAIE A,^D + CAIN A,^L + JRST PBUF + CAIN A,177 + JRST RUBOUT + +CHRLOD: IDPB A,F + SOJG CNT,READCH + JRST BIGERR + +PBUF: CAIE A,^D +BUFPRT: OASC @PRMPT + PUSHJ P,BUFPRI + JRST READCH + +RDACHR: SKIPG NUMCHR + .HANG + ILDB A,FBUF + SOS NUMCHR + POPJ P, + +RUBOUT: CAIN CNT,1000. + JRST READCH + DBP F, + PUSHJ P,RUBFLS + AOS CNT ;AOS THE CHAR COUNTER + JRST READCH + +RUBFLS: LDB A,F + CAIN A,177 + JRST RUBTWO + CAIL A,40 + JRST RUBONE + CAIE A,33 + CAIN A,10 + JRST RUBONE + CAIE A,^I + CAIN A,^L + JRST RUBONE +RUBTWO: OCTLP "X ; DO THE RUBOUT(S) +RUBONE: OCTLP "X + POPJ P, + +QUOTE: PUSH P,A + MOVEI A,"\ + IDPB A,F + POP P,A + SOJG CNT,CHRLOD + JRST BIGERR + +UNBLOK: PUSH P,A + PUSH P,B + MOVE A,CNT + IDIVI A,5 + JUMPE B,UNFXOT + MOVEI A," +UNFXLP: IDPB A,F ;STUFF IN A SPACE + SUBI CNT,1 + SOJG B,UNFXLP +UNFXOT: POP P,A + POP P,B + SETZ A, + CAIN CNT,1000. + JRST RSTNM + IDPB A,F + DBP F, + PUSH CH,A + MOVE E,[440700,,MSGBLK+1] + +UNBLK1: MOVE C,A + ILDB A,E + JUMPE A,BALANC + CAIN A,"" + JRST STRHAK + CAIN A,"< + PUSH CH,[">] + CAIN A,"( + PUSH CH,[")] + CAIN A,"[ + PUSH CH,["]] + CAIN A,"{ + PUSH CH,["}] + CAIE A,"> + CAIN A,") + JRST POPPER + CAIE A,"] + CAIN A,"} + JRST POPPER + JRST UNBLK1 + +RSTNM: MOVE RDERR + CAIN GETUNM + JRST ALIPCU + CAIN GETJNM + JRST ALIPCJ + MOVEM A,UNAMES + MOVEM A,JNAMES + JRST QUITTE + +STRHAK: PUSH P,A + MOVE A,STRSW + SETCA A,A + MOVEM A,STRSW + POP P,A + JRST UNBLK1 + +POPPER: POP CH,B + CAME A,B + JRST MSMTCH + JRST UNBLK1 + +BALANC: POP CH,B + CAIE B,0 + JRST UNMTCH + SKIPE STRSW + JRST UNMTCH + +RDONE: MOVN A,CNT + ADDI A,1000. + IDIVI A,5 + JUMPE B,RDONE1 +RDPAD: SETZ C, + IDPB C,F + SOJN B,RDPAD + ADDI A,1 +RDONE1: MOVEM A,MSGBLK + SETZM RDSW + POPJ P, + +UNMTCH: PUSH CH,B ;OOPS + CAIN C,"! + JRST PMATCH + PUSH P,F + OASC [ASCIZ / +ERROR - UNMATCHED (try !)/] + POP P,F + PUSHJ P,BUFPRI + PUSHJ P,POPOFF + JRST READCH + +PMATCH: POP CH,B + JUMPE B,PMATC1 + DPB B,F + IBP F, + SOJG CNT,PMATCH + JRST BIGERR + +PMATC1: SETZ SC, + IDPB SC,F + DBP F, + JRST RDONE + +MSMTCH: PUSH CH,B + OASCR [0] + OASC [ASCIZ /ERROR - /] + MOVE SC,A + .IOT TYOC,SC + PUSH P,F + OASC [ASCIZ / INSTEAD OF /] + POP P,F + .IOT TYOC,B + OASCR [0] + PUSHJ P,BUFPRI + PUSHJ P,POPOFF + JRST READCH + +POPOFF: POP CH,B + CAIE B,0 + JRST POPOFF + POPJ P, + + +;PRINTING ROUTINES + +BUFPRI: SKIPN RDSW + POPJ P, + CAIE A,^L + OASCR [0] + MOVEI SC,0 + IDPB SC,F + DBP F, + PUSH P,F + OASC MSGBLK+1 + POP P,F + POPJ P, + + +;ASK DELETE QUESTION AND DO THE RIGHT THING + +DELETE: SKIPE STATFL + JRST DELET1 + OASCR [0] + OASC [ASCIZ / + Delete file? (Y or N) /] + MOVEI C,0 + SETOM MORFLG + SKIPN C + .HANG + SETZM MORFLG + MOVE A,C + CAIN A,"N + JRST PFNAME + CAIN A,"? + JRST DUMMY + CAIE A,"Y + JRST DELETE +DELET1: .CALL [SETZ + SIXBIT /DELETE/ + DEVICE + FNAME1 + FNAME2 + SETZ SNAME] + .LOSE 1000 + POPJ P, + +PFNAME: OASC [ASCIZ / +Acknowledgement saved in /] + PUSHJ P,PFILE + OASCI ". + POPJ P, + +PFILE: OSIX DEVICE + OASCI ": + OSIX SNAME + OASCI "; + OSIX FNAME1 + OASCI " + OSIX FNAME2 + POPJ P, + +DUMMY: OASC [ASCIZ / +Why the hell do you type ? when it says to type Y or N, DUMMY!!! +/] + POPJ P, + + +;ERROR ROUTINES + +ILFILE: .VALUE ;SHOULD NEVER HAPPEN + +ILLCHR: .VALUE ;SAME AS ABOVE + +IPCOPF: PUSH P,A + SKIPN A,LSTCHN + JRST IPCOP1 + HLRE 0,(A) + MOVMS 0 + HRLM 0,(A) + ASH 27 + IOR 0,[.CLOSE] + XCT 0 + SETZM LSTCHN +IPCOP1: POP P,A + SKIPN PURGER ;CONTINUE IF IN PURGE + SKIPE XORFLG ;CONTINUE IF IN XORCST + JRST [SETOM OPFFLG + POPJ P,] + SKIPN SCRIPT + SKIPE STATFL + JRST [SETOM OPFFLG + POPJ P,] + OASC [ASCIZ / +IPC open failed (no one is listening with that name). +/] + SETZ A, + JRST RSTNM + +BIGERR: .VALUE [ASCIZ /: +Input buffer exhausted. You will never get this message.KILL +/] + + +;HERE IF XORCST + +XORONE: PUSHJ P,XORSND + OASC [ASCIZ /The evil spirit '/] + OSIX UNAMES + OASCI 40 + OSIX JNAMES + OASC [ASCIZ /' /] + MOVEI A,[ASCIZ /has been shown mercy./] + SKIPN UNXSW + MOVEI A,[ASCIZ /has met its maker./] + SKIPE OPFFLG + MOVEI A,[ASCIZ /does not listen./] + OASCR (A) + .BREAK 16,40000 + +XORCST: PUSHJ P,GETJCL + SETOM XORFLG + PUSHJ P,CDMSG + SKIPE UNAMES + JRST XORONE + PUSHJ P,GETSYS + MOVEI B,40 + +SCLP: SOJL B,[.BREAK 16,40000] + MOVE A,@MSUSER + JUMPE A,SCLP + MOVE @UNAME + MOVE SC,MUDDMN + +SCLP1: CAMN MUDDMN(SC) + JRST [PUSHJ P,XDEMON + JRST SCLP] + SOJG SC,SCLP1 + JRST SCLP + +XDEMON: PUSH P,A + PUSH P,B + MOVEM CURUNM + MOVE @MSREAD + MOVEM UNAMES + MOVE @MSRED2 + MOVEM JNAMES + SETZM CONTIN + PUSHJ P,XORSND ;FUNNY MESSAGES IF XORCST + SKIPE OPFFLG + JRST [SETZM OPFFLG + JRST XOUT] + OASCR [0] + OSIX UNAMES + OASCI " + OSIX JNAMES + SKIPE UNXSW + JRST UNXPR + OASC [ASCIZ / resting comfortably./] +XOUT: POP P,B + POP P,A + POPJ P, + +UNXPR: OASC [ASCIZ / spared./] + JRST XOUT + +; CREATE THE MESSAGE FOR THE DEMON + +CDMSG: PUSHJ P,FIXTIM + PUSHJ P,FIXUNM + SETZM MSGBLK + MOVEI F,MSGBLK+1 + SKIPE UNXSW + JRST CDUMSG + COPBLK XORTOP + COPBLK UNAMEB + COPBLK XORMID + COPBLK STIMEB + COPBLK XORBOT + POPJ P, + +CDUMSG: COPBLK UNXMSG + POPJ P, + +;COPY OF SNDMSG FOR XORCST: SENDS SHORTER MESSAGE +XORSND: PUSHJ P,UJFILL ;CONS U/JNAME + SETZM CHRCNT + PUSHJ P,XSETUP + BLATIT XTRTOP + BLATIT MSGBLK + BLATIT XTRBOT + PUSHJ P,IPCMSG + POPJ P, + +XSETUP: PUSH P,A + MOVE A,XTRTOP + ADD A,XTRBOT + ADD A,MSGBLK + IMULI A,5 + MOVEM A,CHRCNT + POP P,A + MOVEI FREBUF,197. ;LENGTH OF BUFFER + JUMPE CONTIN,SETUP1 ;FIRST TIME + MOVE F,[440700,,SNDBLK] ;MAKE BYTE POINTER + POPJ P, + +; GET THE UNAME IN ASCII + +FIXUNM: MOVE E,[440600,,MYUNM] + MOVE F,[440700,,AUNAME] + MOVEI C,5 +FIXULP: ILDB E + ADDI 40 + IDPB F + SOJN C,FIXULP + POPJ P, + +; GET THE TIME TO SLEEP FROM JCL + +FIXTIM: MOVE E,JCLPTR + MOVE F,[440700,,STIME] +GETTLP: ILDB E + JUMPE CPOPJ + TLNN F,760000 ;WORD IS NOW FULL + POPJ P, + CAIN "- + JRST UNXOR + CAIL "0 + CAILE "9 + JRST FIXTM1 + IDPB F + JRST GETTLP + +FIXTM1: MOVEI 40 +FIXTM2: IDPB F + TLNN F,760000 + POPJ P, + JRST FIXTM2 + +UNXOR: SETOM UNXSW + POPJ P, + +MUDDMN: 3 + SIXBIT /COMBAT/ + SIXBIT /BATCHN/ + SIXBIT /.BATCH/ + + +;HERE IF WHOMING + +WHOM: PUSHJ P,IPCERS + OASC [ASCIZ / + Total of /] + ODEC IPCCNT + MOVE IPCCNT + CAIN 1 + JRST ALONE + OASCR [ASCIZ / MUDDLErs./] + .BREAK 16,40000 + +ALONE: OASCR [ASCIZ / MUDDLEr./] + .BREAK 16,40000 + + +;HERE IF STATUSING + +STATUS: SETOM STATFL + MOVE XUNAME + MOVEM UNAMES + MOVE [SIXBIT /PCOMP/] + MOVEM JNAMES + OASC [ASCIZ /PCOMP/] +STAT1: SETZM CONTIN + SETZM MSGBLK + MOVEI F,MSGBLK+1 + COPBLK STATM + PUSHJ P,MSPOPN + PUSHJ P,SNDMS1 + SKIPE OPFFLG + JRST SFAIL + OASCR [0] + OASCR [ASCIZ /Status:/] + CAI + .HANG + .BREAK 16,40000 + +SFAIL: SKIPN NPCOMP + JRST SFAIL1 + SKIPE COMTRY + JRST SFAIL2 + SETZM OPFFLG + OASC [ASCIZ /...COMBAT ZONE/] + MOVE [SIXBIT /COMBAT/] + MOVEM UNAMES + MOVE [SIXBIT /ZONE/] + MOVEM JNAMES + SETOM COMTRY + JRST STAT1 + +SFAIL1: SETZM OPFFLG + MOVE [SIXBIT /NPCOMP/] + MOVEM JNAMES + OASC [ASCIZ /...NPCOMP/] + SETOM NPCOMP + JRST STAT1 + +SFAIL2: OASCR [0] + OASC [ASCIZ /Yes, we have no compilers./] + .BREAK 16,40000 + +;HERE IF PURGING + +PURGE: MOVE [SIXBIT /ZORK/] + MOVEM JNAMES + PUSHJ P,MSPOPN + PUSHJ P,GETNM + SETZM MSGBLK + MOVEI F,MSGBLK+1 + SKIPE SCRIPT + JRST PURGE2 + COPBLK PURGEM +PURGEX: PUSHJ P,SNDMS1 + SKIPE OPFFLG + JRST PFAIL + OASCR [0] + MOVEI A,[ASCIZ /Purged him!/] + SKIPE SCRIPT + MOVEI A,[ASCIZ /Scripted him!/] + OASC (A) +PURGE1: OASCR [0] + SETZM CONTIN + SETZM UNAMES + JRST PURGE+2 + +PURGE2: COPBLK MSM + JRST PURGEX + +PFAIL: SETZM OPFFLG + OASCR [0] + OASC [ASCII /Not playing ZORK/] + JRST PURGE1 + + +;HERE TO PRINT ALL IPC USERS + +IPCERS: MACT IPCERO ;MAKE ACTIVATION FOR MORE INTERRUPT + SETZM IPCCNT + OASC [ASCIZ ? + IPC names U/Jnames + + UNAME JNAME UNAME JNAME?] + SKIPN SYSHER + PUSHJ P,GETSYS + MOVEI B,40 + +IPCLP: SOJL B,IPCERO + MOVE A,@MSUSER + JUMPE A,IPCLP + AOS IPCCNT + OASC [ASCIZ / + /] + MOVE E,@MSREAD + PUSHJ P,PRINTE + MOVE E,@MSRED2 + PUSHJ P,PRINTE + MOVE F,@MSRED2 + MOVE E,@JNAME + CAME E,F + JRST PRUJ + MOVE F,@MSREAD + MOVE E,@UNAME + CAMN E,F + JRST IPCLP +PRUJ: MOVE E,@UNAME + PUSHJ P,PRINTE + MOVE E,@JNAME + PUSHJ P,PRINTE + JRST IPCLP + +PRINTE: OSIX E + OASC [ASCIZ / /] + POPJ P, +IPCERO: OASCR [0] + SETZM ACT1 + POPJ P, + +IPCCNT: 0 + + +;PRINT A FILE WHOSE NAME IS SOMEWHERE IN BLOCK POINTED AT BY E + +FPARSE: SETZM NAME + MOVE F,[440600,,NAME];CLEARS NAME SLOT +GETCHR: ILDB B,E + JUMPE B,DSKOPN + CAIE B,40 + CAIN B,11 + JRST GETCHR +FIELD: CAIE B,40 ;HERE TO GET A NAME + CAIN B,11 + JRST FNAM ;SPACE AND TAB MAKE FNAME1 AND 2 + CAIE B,0 + CAIN B,15 + JRST FNAM ;SO DOES 0 AND + CAIN B,": + JRST DEV + CAIN B,"; + JRST DIR + CAIN B,^Q ;HANDLE QUOTING + ILDB B,E + CAIGE B,40 ;SUBI B,40 < 0 (BAD CHARACTER) + JRST ILLCHR + SUBI B,40 + CAIL B,100 + SUBI B,40 ;CASE CONVERSION + TLNE F,770000 ;IGNORE MORE THAN 6 CHARACTERS + IDPB B,F + ILDB B,E + JRST FIELD + +DEV: MOVE A,NAME + MOVEM A,DEVICE + JRST FPARSE + +DIR: MOVE A,NAME + MOVEM A,SNAME + JRST FPARSE + +FNAM: MOVE A,NAME + SKIPN FNAME1 + JRST FNAM1 + MOVEM A,FNAME2 + JRST FPARSE + +FNAM1: MOVEM A,FNAME1 + JRST FPARSE + +DSKOPN: MOVE A,FNAME1 + JUMPN A,DSKOP2 ;GIVE HIM > AS A DEFAULT + MOVE A,[SIXBIT /> /] + MOVEM A,FNAME1 + +DSKOP2: .CALL FILBLK ;DO ALL OF THE OPENS + JRST ILFILE + +FILPRT: PUSH P,C + PUSH P,D + MACT FILPRO ;MAKE ACTIVATION IN CASE MORE FLUSHED + .CALL [SETZ + SIXBIT /FILLEN/ + MOVEI DSKI + SETZM C] + .LOSE 1000 + IDIVI C,DBUFLN ; # OF ITERATIONS NEEDED + JUMPE D,PFLOOP + ADDI C,1 +PFLOOP: MOVE A,[-DBUFLN,,DBUF] + .IOT DSKI,A ; IOT IN FIRST PART + SOJE C,CTCHAK ; IF LAST ITERATION, FROB CTRL-C'S + MOVEI O,5*DBUFLN ; # OF CHARACTERS, IF NOT LAST ITER +DOSIOT: MOVE B,[440700,,DBUF] + .CALL [SETZ ; PRINT IT TO TTY + SIXBIT /SIOT/ + MOVSI %TJDIS + MOVEI TYOC + B + SETZ O] + .LOSE 1000 + JUMPN C,PFLOOP ; DONE? +FILPRO: SETZM ACT1 + .CLOSE DSKI, + POP P,D + POP P,C + POPJ P, + +CTCHAK: HLRE B,A ; CONS UP BPTR TO LAST BYTE OF LAST WORD + MOVEI O,DBUFLN + ADD O,B + IMULI O,5 + MOVEI D,5 + SUBI A,1 + HRLI A,010700 +CTCLOP: LDB B,A ; PICK UP CHAR + CAIE B,^C + CAIN B,0 + CAIA ; IF IT'S CTRL-C OR -@, FLUSH IT + JRST DOSIOT + DBP A ; BACK UP ONE + SUBI O,1 + SOJG D,CTCLOP + JRST DOSIOT ; IF READ WHOLE WORD, GO PRINT ANYWAY + + +;GET A COPY OF THE SYSTEM FOR USE IN LOOKING UP IPC HACKERS + +GETSYS: .CALL [SETZ ;GET THE SYSTEM + SIXBIT /CORBLK/ + 1000,,200000 + [-1] + [-ITSPGS,,HIPORG] + [400000] + SETZ [0]] + .LOSE 1000 +EVLP: MOVEI A,4 + MOVE B,EVTBLB(A) + .EVAL B, + JRST [OASCR [ASCIZ /EVAL failed. MUDINQ won't work until this is fixed./] + .BREAK 16,160000] + ADD B,[B,,400000] + MOVEM B,EVTBLB+1(A) + SUBI A,2 + JUMPGE A,EVLP+1 + MOVEI A,2 +EVLP1: MOVE B,EVTBLA(A) + .EVAL B, + JRST [OASCR [ASCIZ /EVAL failed. MUDINQ won't work until this is fixed./] + .BREAK 16,160000] + ADD B,[A,,400000] + MOVEM B,EVTBLA+1(A) + SUBI A,2 + JUMPGE A,EVLP1 + SETOM SYSHER + POPJ P, + +EVTBLB: SQUOZE 4,MSUSER ;INDEX OFF B +MSUSER: 0 + SQUOZE 4,MSREAD +MSREAD: 0 + SQUOZE 4,MSRED2 +MSRED2: 0 +EVTBLA: SQUOZE 4,UNAME ;INDEX OFF A +UNAME: 0 + SQUOZE 4,JNAME +JNAME: 0 + + + +;STANDARD INQUIRE MESSAGE (BEFORE FILLED BY USER) + +STRTOP: ASCIS [ + "> + ">>) + (O!- .OUTCHAN!- ) + (STR!- ";" <7 .O!- > " " <8 .O!- >>) + (EPRINT!- + + + )>) + 10000 0>) + (OBLIST!- ,OBLIST!- )) + >>> + + ">>> + + + ) + ()>>] + + +;XORCST'S BASIC MESSAGE: SHORTER THAN STANDARD +XTRTOP: ASCIS [ + + + )>) + 10000 0>) + (OBLIST!- ,OBLIST!- )) + >>> + >> + >] + +;XORCST'S INQUIRE MESSAGE +XORTOP: ASCIS [ + + SNAME-SETTER + #DECL (\"VALUE\" ANY \"OPTIONAL\" ANY)>>) + (SNM!- ) + (STP!- <>)) + + + >] + +UNXMSG: ASCIS [] + + +;PURGE'S INQUIRE MESSAGE + +PURGEM: ASCIS [; \"Dungeon\" ] + +MSM: ASCIS [; \"Dungeon\" ] + +STATM: ASCIS [ ] + +UJNAME: ASCIS [ ] +BLOCK4: ASCII / / + +; TYPEOUT UUOS (STRAIGHT FROM DIRED, WITH SOME HELP FROM PDL) + +HPOS: 0 + +ZZZ==. + LOC 40 + 0 + JSR UUOH + LOC ZZZ +UUOCT==0 +UUOTAB: JRST ILUUO + IRPS X,,[ODEC OBPTR OHPOS OCTLP OALIGN OSIX OASC OASCI OASCR OSIXS] + UUOCT==UUOCT+1 + X=UUOCT_33 + JRST U!X + TERMIN + +UUOMAX==.-UUOTAB + +UUOH: 0 + PUSH P,A + PUSH P,B + PUSH P,C + PUSH P,D + MOVEI @40 ; GET EFF ADDR. OF UUO + MOVEM UUOE' + MOVE @0 + MOVEM UUOD' ; CONTENTS OF EFF ADR + MOVE B,UUOE ; EFF ADR + LDB A,[270400,,40] ; GET UUO AC, + LDB C,[330600,,40] ; OP CODE + CAIL C,UUOMAX + MOVEI C,0 ; GRT=>ILLEGAL + JRST @UUOTAB(C) ; GO TO PROPER ROUT + +UUORET: POP P,D + POP P,C + POP P,B + POP P,A ; RESTORE AC'S + JRST 2,@UUOH + +ILUUO: .VALUE [ASCIZ /:ILLEGAL UUO +/] +UOBPTR: MOVEI C,0 + MOVE B,@40 + JRST UOASC1 +UOASCR: SKIPA C,[^M] ; CR FOR END OF TYPE +UOASC: MOVEI C,0 ; NO CR + HRLI B,440700 ; MAKE ASCII POINTER +UOASC1: ILDB A,B ; GET CHAR + JUMPE A,.+3 ; FINISH? + PUSHJ P,IOTA + JRST .-3 ; AND GET ANOTHER + SKIPE A,C ; GET SAVED CR? + PUSHJ P,IOTA + JRST UUORET + +UOASCC: HRLI B,440700 ; MAKE ASCII POINTER +UOAS1C: ILDB A,B ; GET CHAR + CAIN A,^C + JRST UUORET + PUSHJ P,IOTA + JRST UOAS1C ; AND GET ANOTHER + +UOCTLP: MOVEI A,^P + PUSHJ P,IOTA1 + +UOASCI: MOVE A,B ; PRT ASCII IMMEDIATE + PUSHJ P,IOTA + JRST UUORET + +UOSIX: MOVE B,UUOD +USXOOP: JUMPE B,UUORET + LDB A,[360600,,B] + ADDI A,40 + PUSHJ P,IOTA + LSH B,6 + JRST USXOOP + +UOSIXS: MOVE A,[440600,,UUOD] +USLOOP: ILDB C,A + ADDI C,40 + PUSHJ P,IOTC + TLNE A,770000 + JRST USLOOP + JRST UUORET + +UOHPOS: SUB B,HPOS + JUMPLE B,UOASCI +UOHPO1: MOVEI A,40 + PUSHJ P,IOTA + SOJG B,UOHPO1 + JRST UUORET + +POWER: 0 ? 1 ? 10. ? 100. ? 1000. ? 10000. ? 100000. ? 1000000. + +UOALIG: MOVE D,UUOD + ANDI A,7 + MOVE A,POWER(A) + MOVEI C,40 +UOALI1: CAMLE A,D + PUSHJ P,IOTC + IDIVI A,10. + CAIE A,1 + JRST UOALI1 + SETZ A, + +UODEC: SKIPA C,[10.] ; GET BASE FOR DECIMAL +UOOCT: MOVEI C,8. ; OCTAL BASE + MOVE B,UUOD ; GET ACTUAL WORD TO PRT + JRST .+3 ; JOIN CODE +UODECI: SKIPA C,[10.] ; DECIMAL +UOOCTI: MOVEI C,8. + MOVEM C,BASE' + SKIPN A + HRREI A,-1 ; A=DIGIT COUNT + PUSHJ P,UONUM ; PRINT NUMBR + JRST UUORET + +UONUM: IDIV B,BASE + HRLM C,(P) ; SAVE DIGIT + SOJE A,UONUM1 ; DONE IF 0 + SKIPG A ; + => MORE + SKIPE B ; - => B=0 => DONE + PUSHJ P,UONUM ; ELSE MORE +UONUM1: HLRZ C,(P) ; RETREIVE DIGITS + ADDI C,"0 ; MAKE TO ASCII + CAILE C,"9 ; IS IT GOOD DIG + ADDI C,"A-"9-1 ; MAKE HEX DIGIT + PUSHJ P,IOTC + POPJ P, ; RET + +IOTC: PUSH P,A + MOVE A,C + PUSHJ P,IOTA + JRST POPAJ + +IOTA: CAIN A,^P + JRST IOTAP +IOTA1: CAIN A,^J + POPJ P, + .IOT TYOC,A + CAIN A,^I + JRST [MOVE A,HPOS + ADDI A,10 + ANDI A,7770 + MOVEM A,HPOS + POPJ P,] + AOS HPOS + CAIE A,^M + POPJ P, + SETZM HPOS + POPJ P, +IOTAP: .IOT TYOC,["^] + ADDI A,100 + JRST IOTA1 + +POPAJ: POP P,A + POPJ P, + + END START \ No newline at end of file