github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-04-01 11:58:40 +00:00
Code Issues Releases Wiki Activity
Files
lars/kl-ddt
PDP-10.its/src/sysen2/mudinq.43
Lars Brinkhoff 5ae4efe416 Change name of Muddle WHOM to WHOMUD. 
It's in conflict with the WHOJ alias WHOM.
2018-11-19 12:57:54 +01:00

1689 lines
27 KiB
Plaintext
Executable File
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
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-<<ZORK/5>*5>
<<ZORK+4>/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 /WHOMUD/ ;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 ;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 <CR>
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 [
<PROG!- LERR\ !-INTERRUPTS!-
((OUTCHAN!- <OR!- <OPEN!- "PRINT" "DSK:_NQRY_ >">
<OPEN!- "PRINT" "DSK:HUDINI;_NQRY_ >">>)
(O!- .OUTCHAN!- )
(STR!- <STRING!- <10 .O!- > ";" <7 .O!- > " " <8 .O!- >>)
(EPRINT!- <ON!- "ERROR"
#FUNCTION!- (("TUPLE" FRATM!- )
<COND!- (<ASSIGNED?!- INDENT-TO!- >
<PRINT!- .FRATM!- >
<INT-LEVEL!- 0>
<RETURN!- T!- .INDENT-TO!- >)>)
10000 0>)
(OBLIST!- ,OBLIST!- ))
<SET!- LERR\ !-INTERRUPTS!- <FRAME!- <FRAME!- <FRAME!- >>>>
<PUT!- .OUTCHAN!- 13 80>
<PROG!- INDENT-TO!- () <EVAL!- <PARSE!- "<PRINT ]
STRBOT: ASCIS [ >">>>
<OFF!- .EPRINT!- >
<CLOSE!- .OUTCHAN!- >
<COND!- (<SEND!- ]
STRFOO: ASCIS [ .STR!- >)
(<RENAME!- .STR!- >)>>]
;XORCST'S BASIC MESSAGE: SHORTER THAN STANDARD
XTRTOP: ASCIS [
<PROG!- LERR\ !-INTERRUPTS!-
((EPRINT!- <ON!- "ERROR"
#FUNCTION!- (("TUPLE" FRATM!- )
<COND!- (<ASSIGNED?!- INDENT-TO!- >
<INT-LEVEL!- 0>
<RETURN!- T!- .INDENT-TO!- >)>)
10000 0>)
(OBLIST!- ,OBLIST!- ))
<SET!- LERR\ !-INTERRUPTS!- <FRAME!- <FRAME!- <FRAME!- >>>>
<PROG!- INDENT-TO!- () <EVAL!- <PARSE!- " ]
XTRBOT: ASCIS [ ">>>
<OFF!- .EPRINT!- >>]
;XORCST'S INQUIRE MESSAGE
XORTOP: ASCIS [
<PROG!- ((S!- %<RSUBR!- <VECTOR %<PCODE!- \"SETSN\"0>
SNAME-SETTER
#DECL (\"VALUE\" ANY \"OPTIONAL\" ANY)>>)
(SNM!- <S!- >)
(STP!- <>))
<S!- ]
XORMID: ASCIS [\">
<SLEEP!- ]
XORBOT: ASCIS [ '.STP!- >
<S!- .SNM!- >>]
UNXMSG: ASCIS [<SET!- STP!- T>]
;PURGE'S INQUIRE MESSAGE
PURGEM: ASCIS [; \"Dungeon\" <FLUSH-ME!-INITIAL!- >]
MSM: ASCIS [; \"Dungeon\" <MAKE-SCRIPT>]
STATM: ASCIS [ <STATUS> ]
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
Reference in New Issue View Git Blame Copy Permalink