;<FOONEX>IO.MAC;19 18-Mar-81 19:45:31, Edit by MMCM ; SUMEX ERJMP/ERCAL additions ;<FOONEX>IO.MAC;18 14-Mar-81 13:11:49, Edit by MMCM ;VARIOUS KLUDGES TO MAKE CHAOSNET JFN'S WORK IN INPUT OR OUTPUT MODE ;<134-TENEX>IO.MAC;17 28-Mar-80 20:32:22 EDIT BY PETERS ; Moved IOXBUF declaration into PARAMS ;<134-TENEX>IO.MAC;16 27-Jan-80 17:36:53 EDIT BY PETERS ; Fix KAFLG to KAFLG!F3FLG ;<134-TENEX>IO.MAC;15 28-Nov-79 16:00:01 EDIT BY PETERS ;#1 Fixed ancient eof bug in sin ;<134-TENEX>IO.MAC;14 2-Jul-79 14:31:46 EDIT BY PETERS ;<134-TENEX>IO.MAC;13 10-Sep-78 18:08:35 EDIT BY PETERS ;<134-TENEX>IO.MAC;12 10-Sep-78 16:28:01 EDIT BY PETERS ;<134-TENEX>IO.MAC;11 10-Sep-78 14:41:01 EDIT BY PETERS ;<TENEX-SOURCES>IO.MAC;13416 14-JUL-77 13:31:25 EDIT BY DALE ;[BBN] Add .SOUT2 (which for now equals .SOUT) ;<XTENEX>IO.MAC;9503 10-JUL-76 15:31:42 EDIT BY DALE ;[ISI] Bug fix at DMPSE7+11: force UMOVES to avoid possible AC value ;<XTENEX>IO.MAC;9502 10-FEB-76 03:35:53 EDIT BY DALE ;[ISI] force SIN on MLP thru SINOLD ;<XTENEX>IO.MAC;9501 20-JAN-76 18:44:54 EDIT BY DALE ;[1.34] don't use locking macros with FILLCK, LCKTST = CNTLCK (See SCHED), ;[1.34] correct check for page existance @ DMPSE5, ;[1.34] NIN remembers errors into LSTERR ;<XTENEX>IO.MAC;4 16-JUN-75 12:13:09 EDIT BY DALE ;[ISI] allow lowercase input to be recognized valid in NIN (DIGIN1+3 lit) ;<XTENEX>IO.MAC;3 16-APR-75 21:40:00 EDIT BY DALE ;[ISI] corrected disastrous typeo at BYTBL1+33 ;<XTENEX>IO.MAC;2 26-FEB-75 22:48:46 EDIT BY DALE ;[ISI] added necessary KI mods to BYTBLT, ;[ISI] replaced STRDEV with STRDTB ;<133-TENEX>IO.MAC;86 19-SEP-74 11:45:12 EDIT BY ALLEN ; CORRECT BUG IN LCKTST ;<133-TENEX>IO.MAC;85 16-SEP-74 19:56:39 EDIT BY ALLEN ; CORRECT LCKTST SO THAT LOCK MAY BE ADDRESSED BY ANY AC EXCEPT P ;<133-TENEX>IO.MAC;84 4-SEP-74 17:17:20 EDIT BY ALLEN ; FIX BUG IN LCKTST WHEN INDEXING INTO TABLE OF LOCKS ;<133-TENEX>IO.MAC;83 4-SEP-74 16:28:51 EDIT BY ALLEN ; CORRECT ERROR IN DISPLACEMENT FROM FRAME BASE IN DEFINITIONS ; OF BYTREM, BYTSIZ AND TRMBYT ;<133-TENEX>IO.MAC;82 11-JUL-74 17:50:29 EDIT BY CLEMENTS ; SIOR FIX FOR BYTE COUNT 0 SIN ;<TENEX-132>IO.MAC;81 19-JUN-74 12:55:01 EDIT BY TOMLINSON ; FIXED FAST SIN BUG WITH 0 AC3 (FAILED TO COUNT FINAL BYTE) ; REMOVED NULL SUPPRESSOR FROM BYTIN ;<TENEX-132>IO.MAC;80 14-MAY-74 09:02:02 EDIT BY TOMLINSON ; INTERNED DOINT FOR FILE INTERRUPTS ;<TENEX-132>IO.MAC;79 17-APR-74 21:42:42 EDIT BY TOMLINSON ; MISSING JRST EDESX1 AFTER PUSHJ P,FIXPTR IN PSOUT ;<TENEX-132>IO.MAC;78 16-APR-74 15:52:48 EDIT BY TOMLINSON ;<TENEX-132>IO.MAC;77 16-APR-74 14:19:25 EDIT BY TOMLINSON ; INSTALL CHECKS FOR INDIRECTION/INDEXING OF BYTE POINTERS ;<TENEX-132>IO.MAC;76 15-APR-74 13:11:47 EDIT BY TOMLINSON ;<TENEX-132>IO.MAC;75 1-APR-74 20:30:01 EDIT BY TOMLINSON ;<TENEX-132>IO.MAC;74 1-APR-74 19:53:25 EDIT BY TOMLINSON ;<TENEX-132>IO.MAC;73 1-APR-74 19:21:15 EDIT BY TOMLINSON ; CONVERTED CHKJFN TO RETURN DOUBLE SKIP FOR NIL DESIGNATOR ;<TENEX-132>IO.MAC;72 1-APR-74 19:03:08 EDIT BY TOMLINSON ; ALLOW RADIX UP TO 36 FOR NIN ;<TENEX-132>IO.MAC;71 25-NOV-73 23:23:48 EDIT BY CLEMENTS ; YET ANOTHER FIX TO NO FREE 0 ON END OF -N TYPE SIN ;<TENEX-132>IO.MAC;70 10-NOV-73 20:01:14 EDIT BY CLEMENTS ;<TENEX-132>IO.MAC;69 10-NOV-73 14:34:14 EDIT BY CLEMENTS ; KI CHANGES, SMALL BUG FIXES ;<TENEX-132>IO.MAC;68 13-JUN-73 21:12:19 EDIT BY CLEMENTS ;<TENEX-132>IO.MAC;67 9-APR-73 16:11:23 EDIT BY TOMLINSON ; FIXED NEG WORD COUNT SIN TO NOT APPEND 0 BYTE ;<TENEX-132>IO.MAC;66 3-APR-73 18:04:30 EDIT BY PLUMMER ;<TENEX-132>IO.MAC;65 12-MAR-73 13:16:25 EDIT BY TOMLINSON ; Fix BYTBL1 to leave unused bits 0 ;<TENEX-132>IO.MAC;63 6-MAR-73 12:59:49 EDIT BY TOMLINSON ; MISC FIXES TO SIN/SOUT ;<TENEX-132>IO.MAC;62 23-FEB-73 18:03:51 EDIT BY CLEMENTS ;<TENEX-132>IO.MAC;61 22-FEB-73 18:45:00 EDIT BY CLEMENTS ;<TENEX-132>IO.MAC;60 13-FEB-73 19:58:17 EDIT BY CLEMENTS ;<TENEX-132>IO.MAC;57 26-JAN-73 08:45:16 EDIT BY TOMLINSON ;<TENEX-132>IO.MAC;56 24-JAN-73 22:42:43 EDIT BY TOMLINSON ;<TENEX-132>IO.MAC;55 24-JAN-73 16:07:56 EDIT BY TOMLINSON ;<TENEX-132>IO.MAC;54 24-JAN-73 14:40:10 EDIT BY TOMLINSON ;<TENEX-131>IO.MAC;53 10-JAN-73 11:00:09 EDIT BY TOMLINSON ;<TENEX-131>IO.MAC;52 9-JAN-73 14:36:18 EDIT BY TOMLINSON ; FIXED DUMPI/O LOCKUP BUG ;<TENEX-130>IO.MAC;51 20-NOV-72 13:14:45 EDIT BY TOMLINSON ; ADDED OPNF CHECK IN RIN ;<FILESYSTEM>IO.MAC;50 25-AUG-72 17:38:36 EDIT BY TOMLINSON ;<FILESYSTEM>IO.MAC;49 25-AUG-72 16:08:17 EDIT BY TOMLINSON ;<FILESYSTEM>IO.MAC;48 25-AUG-72 15:45:03 EDIT BY TOMLINSON ;<FILESYSTEM>IO.MAC;47 29-JUN-72 9:59:08 EDIT BY TOMLINSON SEARCH PROLOG,STENEX TITLE IO SUBTTL R.S.Tomlinson EXTERN CPOPJ,SKPRET,SK2RET,SK3RET,ERRSAV,LSTERR,PRIMRY,CAPENB EXTERN PBYTSZ,PBYTPO EXTERN EDISMS,ERRD,FKHPTN,FPTA,MJRSTF,MLKPG,MRPT,MULKPG,SKIIF,BHC EXTERN NILDTB,STRDTB,TTYDTB,SFBNR EXTERN ITRAP,TTFORK,JOBPT,DISGE,MENTR,MRETN,MSTKOV,MRTNE1 EXTERN MRPACS,SETMPG USE SWAPPC DEFINE FILINT(N,EXTRA)< PUSHJ P,[EXTRA MOVEI A,N JRST DOINT]> DEFINE FILABT(N,EXTRA)< JRST [ EXTRA MOVEI A,N JRST ABTDO]> DOINT:: MOVEM JFN,ERRSAV MOVEM A,LSTERR TEST(NE,HLTF) JRST ABTDO ; Halt on these conditions MOVEI 1,400000 MOVSI 2,(1B11) PUSHJ P,JSERT## ; ERJMP/ERCAL handling? POPJ P, ; Yes, don't interrupt IIC POPJ P, ABTDO: MOVEM A,LSTERR PUSHJ P,UNLCKF JRST ITRAP ; Check tenex source/destination designator ; Call: JFN ; The designator ; PUSHJ P,CHKJFN ; Return ; +1 ; Error, as has error # ; +2 ; Tty ; +3 ; Byte pointer, or other special designator type (e.g. NIL:) ; +4 ; File ; In all cases, the following is set up ; LH(DEV) ; Unit number (tty no dta no etc) ; RH(DEV) ; Loc of device dispatch table ; JFN ; True jfn for files, byte pointer for same ; STS ; File status bits ; The file is locked if it is a file CHKJFN::SETZB F,F1 TLNE JFN,777777 ; Lh zero? JRST CHKJF1 ; No, some kind of byte pointer CAIN JFN,100 ; Primary input designator? HLRZ JFN,PRIMRY ; Get primary input jfn from psb CAIN JFN,101 ; Primary output designator? HRRZ JFN,PRIMRY ; Get primary output jfn from psb CAMGE JFN,MAXJFN ; Possibly a jfn? JRST CHKJF3 ; Yes CAIN JFN,777777 ; Controlling tty JRST CHKJF4 ; Yes CAIN JFN,377777 ; Nil designator JRST CHKJFW ; Yes. CAIGE JFN,400000+NLINES ; Valid tty designator? CAIGE JFN,400000 JRST CHKJF7 ; No, garbage designator HLRZ DEV,TTFORK-400000(JFN) ; Get assignment of tty CAIE DEV,777777 ; Unattached? CAMN DEV,JOBNO ; Or assigned to this job? JRST CHKJF5 ; Yes, ok to use MOVE A,CAPENB TRNE A,WHEEL!OPR JRST CHKJF5 IFN NPTY,< ; PARTIAL CODE FOR PTY'S - NOT YET SUPPORTED SUBI JFN,400000+PTYLO ;SEE IF DEV DESIG IS A PTY CAIL JFN,0 ;RANGE CHECK CAIL JFN,NPTY ; .. JRST CHKJF0 ;NO. GIVE UP MOVE DEV,PTYJOB##(JFN) ;YES. SEE IF THIS JOB OWNS IT. ADDI JFN,400000+PTYLO ;RESTORE JFN TO TTY DESIGNATOR CAMN DEV,JOBNO JRST CHKJF5 ;JOB MATCHES. ACCEPT THIS DESIGNATOR >;END COND ON NPTY CHKJF0: MOVEI A,DESX2 ; Illegal tty designator POPJ P, CHKJF4: MOVE A,JOBNO MOVEI A,JOBPT(A) SKIPGE DEV,(A) PUSHJ P,DISGE ; Dismiss until it is greater or equal SKIPGE DEV,(A) JRST CHKJF4 HLRZS DEV MOVEI JFN,400000(DEV) CHKJF5: MOVEI DEV,TTYDTB ; Set up dev to be tty HRLI DEV,-400000(JFN) ; And the proper unit HRLZI STS,READF!WRTF!OPNF JRST SKPRET ; Skip return CHKJFW: MOVEI DEV,NILDTB HRLZI STS,READF!WRTF!OPNF JRST SK2RET CHKJF3: LSH JFN,SJFN MOVEI A,^D60 ; Try 60 times to lock file CHKJF2: SOJL A,CHKJFB ; Then fail NOINT AOSE FILLCK(JFN) JRST [ OKINT PUSH P,A MOVEI A,^D1000 DISMS POP P,A JRST CHKJF2] MOVE STS,FILSTS(JFN) TEST(NN,NAMEF) JRST CHKJF8 TEST(NN,FRKF) ; Test for file restricted to one fork JRST CHKJF9 HLRZ A,FILVER(JFN) PUSHJ P,SKIIF JRST CHKJF8 ; Can't access CHKJF9: MOVE DEV,FILDEV(JFN) ; Set up dev HRRZ A,DEV CAIN A,TTYDTB JRST [ SETOM FILLCK(JFN) OKINT JRST .+1] JRST SK3RET ; Triple skip return CHKJF8: SETOM FILLCK(JFN) OKINT CHKJFB: MOVEI A,DESX3 POPJ P, CHKJF1: MOVE A,JFN CALL FIXPTR JRST CHKJF7 ; BAD DESIGNATOR MOVEM A,JFN MOVEI DEV,STRDTB ; Set up to dispatch to string routines HRLZI STS,READF!WRTF!OPNF JRST SK2RET ; Double skip return CHKJF7: MOVEI A,DESX1 ; Garbage designator POPJ P, ; Unlock file ; Call: JFN ; Job file number ; STS ; New filsts ; PUSHJ P,UNLCKF UNLCKF::TLNE JFN,777777 UMOVEM JFN,1 CAIL JFN,0 CAIL JFN,RJFN POPJ P, MOVEM STS,FILSTS(JFN) PUSH P,A MOVEI A,(DEV) CAIN A,TTYDTB JRST [ POP P,A POPJ P,] POP P,A SETOM FILLCK(JFN) OKINT POPJ P, NOTOPN: FILABT CLSX1 EDESX1: MOVEI A,DESX1 IOERR:: MOVEM A,LSTERR JRST ITRAP ; Bin from primary io file ; Call: 1 ; Character ; PBIN .PBIN:: JSYS MENTR MOVEI JFN,100 PUSHJ P,BYTIN UMOVEM B,1 JRST MRETN ; Byte input jsys ; Call: 1 ; Tenex source designator ; BIN ; Return ; +1 ; B ; A byte PS(BIOAC0) .BIN:: NOINT JUMPL 1,SLBIN CAML 1,MAXJFN ; Possible a jfn? JRST SLBIN LSH 1,SJFN AOSE FILLCK(1) JRST SLBIN0 MOVE 2,FILSTS(1) TLC 2,OPNF!READF TLCN 2,OPNF!READF TLNE 2,ERRF!FRKF JRST SLBIN1 SOSGE FILCNT(1) JRST SLBIN2 AOS 2,FILBYN(1) CAMLE 2,FILLEN(1) JRST SLBIN3 ILDB 2,FILBYT(1) SETOM FILLCK(1) LSH 1,-SJFN OKINT XCT MJRSTF SLBIN3: SOS FILBYN(1) SLBIN2: AOS FILCNT(1) SLBIN1: SETOM FILLCK(1) SLBIN0: LSH 1,-SJFN SLBIN: OKINT JSYS MENTR ; Become slow etc. MOVE JFN,1 PUSHJ P,BYTIN ; Read the byte XCTUU [MOVEM B,2] ; Store in user's ac JRST MRETN ; Restore user ac's and return ; Random input jsys ; Call: 1 ; Tenex source designator ; 3 ; Byte number ; RIN ; Returns ; +1 ; 2 ; The byte .RIN:: JSYS MENTR MOVE JFN,1 PUSHJ P,CHKJFN JRST IOERR JFCL FILABT DESX4 ; Tty and byte designators are illegal JUMPGE STS,NOTOPN TEST(NN,RNDF) FILABT IOX3 ; Illegal to change pointer TEST(NN,READF) FILABT IOX1 ; Illegal to read IFDEF CHAOS,<HRRZ A,DEV CAIN A,CHADTB## CALL CHAINP##> ;SET FOR INPUT UMOVE A,3 PUSHJ P,SFBNR ; Set up byte pointer JRST ABTDO PUSHJ P,BYTINA ; Get the byte UMOVEM B,2 JRST MRETN ; String input jsys ; Call: 1 ; Tenex source designator ; 2 ; Byte pointer (lh = 777777 will be filled in) ; 3 ; Byte count or zero ; ; If zero, the a zero byte terminates ; ; If positive then transfer the specified number ; ; Of characters, or terminate on reading a byte ; ; Equal to that given in 4 ; ; If negative, then transfer the specified number ; ; Of bytes ; 4 ; (optional) if 3 is > 0, 4 has a terminating byte ; SIN ; Return ; +1 ; Always ; 2 ; Updated string pointer ; 3 ; Updated count (always counts toward zero) ; The updated string pointer always points to the last byte read ; Unless 3 contained zero, then it points to the last non-zero byte. .SIN:: JSYS MENTR ; Become slow etc. SIN0: UMOVE JFN,1 CAIN JFN,100 JRST SINOOO ; DO IT THIS WAY TO GET ECHOOS DONE PUSHJ P,SIOR1 ; CHECK JFN ETC JRST SINTTY ; TTY JRST [ CAIE DEV,STRDTB JRST .+1 JRST SINBYT] ; BYTE POINTER TEST(NN,READF) FILABT(IOX1) ; ILLEGAL READ IFDEF CHAOS,<HRRZ A,DEV CAIN A,CHADTB## CALL CHAINP##> ;SET FOR INPUT MOVE A,FILLEN(JFN) ;#1 GET TOTAL LENGTH OF FILE IN BYTES SUB A,FILBYN(JFN) ;#1 MINUS PTR GIVES BYTES UNTIL EOF CAMGE A,FILCNT(JFN) ;#1 IF THIS IS FEWER THAN BYTES LEFT IN BUFFER MOVEM A,FILCNT(JFN) ;#1 THEN CLOBBER SO EOF WORKS SKIPG FILCNT(JFN) ; ANY BYTES IN BUFFER? JRST SINOLD ; NO, DO IT THE SLOW WAY MOVE A,FILBYT(JFN) ; SOURCE POINTER UMOVE B,2 ; TARGET MOVE D,[1B3+1] ; FROM FILE, TO USER. PUSHJ P,SIOR2 ; SET UP REST OF ARGS AND DO BYTBLT UMOVEM B,2 ; UPDATE POINTERS MOVEM A,FILBYT(JFN) PUSHJ P,UNLCKF ; UNLOCK FILE TO ALLOW INTS JUMPN D,SIN0 ; DO MORE IF NOT DONE JUMPN E,MRETN ; IF NON-ZERO COUNT SUPPLIED, NO 0. JRST SIN2 ; PUT THE ZERO ON THE END. ; DO SIN FROM BYTE POINTER SINBYT: MOVE A,JFN UMOVE B,2 MOVE D,[1B2+3] ; BYTE POINTER AND USER TO USER PUSHJ P,SIOR2 UMOVEM B,2 UMOVEM A,1 JRST SIN3 ; DO SLOW SIN FOR ONE BYTE SINOOO: UMOVE A,2 PUSHJ P,FIXPTR ; FIX UP POINTER JRST EDESX1 UMOVEM A,2 PUSHJ P,BYTIN JRST SINOL1 SINTTY: SINOLD: PUSHJ P,BYTINA ; Read a byte from the source SINOL1: JUMPE B,[TEST(NN,EOFF) XCTUU [SKIPN 3] JRST SIN2 JRST .+1] IFN KAFLG!F3FLG,< XCTUU [IDPB B,2]> ; Deposit the byte IFN KIFLG,< ; ON KI-10, MUST HANDLE WITH XCTUU [MOVE 3,2] ; THE POINTER IN MONITOR SPACE TLNE 3,37 ; AND INDIRECTING/INDEXING FILABT DESX1 ; DOESN'T WORK XCTUU [IDPB B,3] ; OK. STORE THE BYTE XCTUU [MOVEM 3,2] ; RETURN UPDATED POINTER > JSP A,SIONXT ; Test for end of string JRST SIN0 ; Not end, continue SIN3: XCTUU [SKIPE 3] ; NON-ZERO COUNT CASE? JRST MRETN ;YES. RETURN. SIN2: SETZ B, UMOVE A,2 XCTBU [IDPB B,A] JRST MRETN ; SUBROUTINE TO FIX AC2 AND CHECK JFN SIOR1: UMOVE A,2 PUSHJ P,FIXPTR JRST EDESX1 UMOVEM A,2 UMOVE JFN,1 PUSHJ P,CHKJFN JRST IOERR ; GARBAGE POPJ P, JRST [ CAIN DEV,STRDTB AOS 0(P) ; SINGLE SKIP FOR STRING POINTERS RET] ; NONE FOR OTHER SPECIAL DESIGNATORS TEST(NN,OPNF) FILABT(DESX5) CAIL JFN,RJFN POPJ P, JRST SK2RET FIXPTR: TLC A,777777 ; IF LH = -1 CONVERT TO 0 TLCN A,777777 ; UNCONVERT WAS IT -1? HRLI A,440700 ; YES. SET TO LEFT BYTE 7-BIT TLZN A,37 ; DOES POINTER HAVE INDIRECTION OR INDEXING? AOS 0(P) ; NO, GIVE SKIP RETURN POPJ P, ; SUBROUTINE TO SET UP REST OF SIN/SOUT AND DO BYTBLT SIOR2: UMOVE E,3 ; GET COUNT MOVM C,E ; MAGNITUDE OF COUNT SKIPL E ; TERMINATING BYTE? TLO D,(1B0) ; YES, SET FLAG SKIPLE E ; SPECIFIC TERMINATOR? JRST [ UMOVE E,4 ; YES. GET (NOTE 0 IN E IF COUNT=0) TLO D,(1B1) ; FLAG SPECIFIC TERMINATOR JRST .+1] SKIPN C ; NON-ZERO COUNT HRLOI C,77 ; NO, SET MAX COUNT TLNE D,(1B2) ; BYTE POINTER IN JFN? JRST SIOR23 ; YES, IGNORE FILCNT CAML C,FILCNT(JFN) ; KEEP MIN OF THIS MOVE C,FILCNT(JFN) ; AND BYTES IN BUFFER SIOR23: PUSH P,C ; SAVE COUNT PUSHJ P,BYTBLT ; DO THE TRANSFER SUB C,0(P) ; GET NEG OF BYTES TRANSFERRED TLNE D,(1B2) ; BYTE POINTER IN JFN? JRST SIOR24 TLNE D,(1B4) ; WAS AN EXTRA BYTE READ BUT NOT WRITTEN TLNN D,(1B3) ; YES. IS THIS A SIN? SKIPA E,C ; NO. USE STRAIGHT COUNT HRREI E,-1(C) ; YES. COMPENSATE FOR THE EXTRA BYTE ADDM E,FILCNT(JFN) ; UPDATE FILCNT MOVNS E ADDB E,FILBYN(JFN) CAML E,FILLEN(JFN) MOVEM E,FILLEN(JFN) SIOR24: XCTUU [SKIPGE E,3] ; WHAT KIND OF COUNT MOVNS C ; MAKE SIGN AGREE JUMPE E,SIOR21 ; DON'T UPDATE COUNT IF 0 XCTUU [ADDB C,3] ; DO UPDATE JUMPE C,SIOR22 ; IF COUNT BECOMES 0, THEN DONE SKIPL C ; NOT DONE IF NEG COUNT SUPPLIED & STILL SIOR21: TLNE D,(1B0) ; ELSE DONE IF TERMINATOR FOUND TROA D,-1 ; NOT DONE, SET D NON-0 SIOR22: SETZ D, ; DONE, SET D = 0 SUB P,BHC+1 POPJ P, ; Check for end of string io string ; Call: B ; Character just transfered ; User 3 ; Sin/sout argument ; User 4 ; Sin/sout argument ; JSP A,SIONXT ; Return ; +1 ; Continue ; MRETN ; If no more left to do ; Updates user 3 SIONXT: TLNE JFN,777777 ; If byte pointer, UMOVEM JFN,1 ; Restore updated jfn XCTUU [SKIPN C,3] JRST (A) SIO1: JUMPG C,SIO2 ; Positive XCTUU [AOSGE 3] JRST (A) JRST MRETN SIO2: XCTUU [SOSLE 3] XCTUU [CAMN B,4] JRST MRETN JRST (A) IFN KAFLG!F3FLG,< ;[ISI] for KA, define MOVE/MOVEM .xor. UMOVE/UMOVEM MXUM==<<MOVE>&<-1-<UMOVE>>>!<<-1-<MOVE>>&<UMOVE>> MXUMM==<<MOVEM>&<-1-<UMOVEM>>>!<<-1-<MOVEM>>&<UMOVEM>> > ; Accumulators ; Arguments...returned updated SRC=1 ; Source byte pointer TGT=2 ; Target byte pointer CNT=3 ; Byte count MOD=4 ; Mode ; Temporaries T1=5 T2=6 T3=7 ; Program space starts here PRG==T3 P=17 FRM=16 ; Local variables DEFINE BYTREM<4(FRM)> DEFINE BYTSIZ<5(FRM)> DEFINE TRMBYT<6(FRM)> NLCLS==3 ; Move bytes ; Call: ; 1/ SOURCE POINTER ; 2/ TARGET POINTER ; 3/ BYTE COUNT ; 4/ MODE BITS AS FOLLOWS: ; B1/ TRANSFER TERMINATOR BYTE ; B0/ TRANSFER UNTIL TERMINATOR ; B34/ FROM USER ; B35/ TO USER ; E/ TERMINATOR IF ANY BYTBLT::PUSH P,FRM ; Save old frm MOVE FRM,P ; Set up frame base PUSH P,T1 ; Save temps PUSH P,T2 PUSH P,T3 ADD P,BHC+NLCLS ; Cover space for locals JUMPGE P,MSTKOV MOVEM E,TRMBYT ; Shuffle args ; Preliminaries out of the way ; Now get to work BYTB1: TLNE MOD,(1B0) ; Terminator? JRST CHKTRM ; Yes, look for it TLNN TGT,7700 ; Zero byte size? JRST BYTLP ; Well...if you insist MOVE T1,TGT ; Compare target XOR T1,SRC ; To source TLNN T1,7700 ; And if byte size differs CAIG CNT,20 ; Or short transfer JRST BYTLP ; Do byte at a time LDB T2,[POINT 6,TGT,11] ; Get byte size MOVEM T2,BYTSIZ ; Save it ROT T2,-6 ; Position in p field LP1: SOJL CNT,DONE ; Until cnt < 0 XCT LDBTB(MOD) ; Do transfer bytes XCT DPBTB(MOD) CAMG T2,TGT ; Until less than 1 byte remains in tgt JUMPGE T2,LP1 ; Loop unless bytesize >= 32 ; (once is always enough) BYTB2: MOVEI T1,^D36 ; Word size IDIV T1,BYTSIZ ; Compute bytes/word and remainder MOVEM T1+1,BYTREM ; Save remainder MOVE T2,CNT IDIV T2,T1 ; Compute words to transfer MOVEM T2+1,CNT ; Remaining bytes JUMPE T2,BYTLP ; Zero words...do byte at a time HLLO T1,SRC ; Get source...prevent borrows SUB T1,TGT ; When getting bit offset ROT T1,6 ANDI T1,77 ; Retain just the position difference JUMPN T1,BYTBL1 ; Move word at a time HRLZ T1,SRC ; Make blt pointer HRR T1,TGT ADD T1,BHC+1 ; Adjust 'cause byte pointer behind by 1 ADDM T2,SRC ; Adjust src by word count ADDB T2,TGT ; And adjust tgt XCT BLTTB(MOD) ; Blt t1,0(t2) BYTLP: JUMPLE CNT,DONE ; Do rest a byte at a time BYTLP1: XCT LDBTB(MOD) XCT DPBTB(MOD) SOJG CNT,BYTLP1 DONE: SUB P,BHC+NLCLS ; Flush local storage POP P,T3 ; Restore temps POP P,T2 POP P,T1 POP P,FRM ; Restore frm POPJ P, ; Transfer a word at a time ; T1/ POSITION OFFSET (RIGHT SHIFT AMOUNT) ; T2/ WORD COUNT ; Bytrem/ lsh amount to right justify first word BYTBL1: ADD P,BHC+LPRG-1 ; Make room to save ac's JUMPGE P,MSTKOV MOVSI T3,PRG+1 HRRI T3,2-LPRG(P) BLT T3,0(P) ; Save ac's MOVE PRG+LPRG-2,[PROTO,,PRG] BLT PRG+LPRG-2,PRG+LPRG-2 ; Load up proto program except last word HRRI PRG+0,0(SRC) ; Address of first move HRRI PRG+1,1(SRC) ; Address of second move HRR PRG+4,BYTREM ; Fill in shift amount to left justify MOVNS BYTREM ; Get right shift amount HRR PRG+2,BYTREM ; Fill in LSH MOVNS T1 ; NEGATE OFFSET ADD T1,BYTREM ; Total right shift = offset + remainder CAMG T1,[-^D18] ; Less than half a word? TLCA PRG+4,(<Z <<T1&<-1-T2>>!<<-1-T1>&T2>>,0>) ; My kingdom for an xor operator ; Change ac of lsh from t1 to t2 TLCA PRG+5,(<Z <<T1&<-1-T2>>!<<-1-T1>&T2>>,0>) ; No, change ac of MOVEM to T1 ADDI T1,^D36 ; Leave movem t1, change shift amount HRRI PRG+5,1(TGT) ; Address of movem HRRM T1,PRG+3 ; Fill in lshc amount ADDM T2,TGT ; Update target ADDM T2,SRC ; And source PUSH P,SRC ; Want to use SRC for AOBJN MOVNS T2 ; Make aobjn HRLZ SRC,T2 ; word in SRC MOVE PRG+LPRG-1,PROTO+LPRG-1; Last word of program IFN KAFLG!F3FLG,< ;[ISI] possible change of MOVE/MOVEM to UMOVE/UMOVEM TRNE MOD,1 ;Is to "user"? TLC PRG+5,(MXUMM) ; yes, use UMOVEM TRNN MOD,2 ;Is from "user"? JRST PRG ; No, do the program, return to BYTLPD TLC PRG+0,(MXUM) ; yes, use "UMOVE" TLC PRG+1,(MXUM) JRST PRG ;Do the program, return to BYTLPD > IFN KIFLG,< ;[ISI] do same for KI, but in a more difficult way.. PUSH P,PRG+5 ;KI has no wired UMOVE/UMOVEM, PUSH P,PRG+1 ; so push instructions and replace with PUSH P,PRG+0 ; "XCTUU stack" if necessary TRNE MOD,1 MOVE PRG+5,[XCTUU -2(P)] TRNN MOD,2 JRST PRG MOVE PRG+0,[XCTUU -0(P)] MOVE PRG+1,[XCTUU -1(P)] JRST PRG > BYTLPD: IFN KIFLG,< ;[ISI] remove UMOVEx literals from stack SUB P,BHC+3 > POP P,SRC MOVSI T1,2-LPRG(P) ; Cleanup HRRI T1,PRG+1 BLT T1,PRG+LPRG-1 SUB P,BHC+LPRG-1 JRST BYTLP ; Finish up any odd bytes ; Transfer til terminator CHKTRM: JUMPLE CNT,DONE CHKTR1: XCT LDBTB(MOD) CAMN T1,TRMBYT JRST [ TLZ MOD,(1B0) ; TERMINATOR HAS BEEN SEEN TLNN MOD,(1B1) ; SPECIFIC TERMINATOR (I.E. KEEP IT?) JRST [ TLO MOD,(1B4) JRST DONE] XCT DPBTB(MOD) SOJA CNT,DONE] XCT DPBTB(MOD) SOJG CNT,CHKTR1 JRST DONE ; Instruction tables for different mapping modes ; 00 -- monitor to monitor ; 01 -- monitor to user ; 10 -- user to monitor ; 11 -- user to user LDBTB: ILDB T1,SRC ILDB T1,SRC XCTBU LDBTB XCTBU LDBTB DPBTB: IDPB T1,TGT XCTBU DPBTB IDPB T1,TGT XCTBU DPBTB BLTTB: BLT T1,0(T2) XCTMU BLTTB XCTUM BLTTB XCTUU BLTTB ; Prototype byte blt program ; Note that address designated by .-. are filled in at run time ; also, the LSH and MOVEM instructions at PROTO +4 and +5 have their ; ac fields modified depending on where the LSHC is made to shift right ; or left. Only one of these instructions is modified in either case ; thus the two instruction end up using T1 if shift left and T2 if right ; Furthermore, the MOVE's and MOVEM's may be changed to UMOVE or ; UMOVEM's depending on the address space of SRC and TGT respectively PROTO: MOVE T1,.-.(SRC) ; Note most rh's are filled at run time MOVE T2,.-.(SRC) ; Pick up next word LSH T1,.-. ; Right justify first word LSHC T1,.-. ; Shift to target position+unused bits LSH T2,.-. ; Shift back to clear unused bits MOVEM T1,.-.(SRC) ; Store AOBJN SRC,PRG ; Loop JRST BYTLPD ; Done LPRG==.-PROTO ; Byte input subroutine ; Call: 1 ; Source designator ; PUSHJ P,BYTIN ; Return ; +1 ; Ok ; B ; A byte ; Clobbers most everything BYTIN:: MOVS B,PRIMRY CAIN JFN,100 ; If not from primary input CAMN B,PRIMRY ; Or if primary input = output JRST BYTINQ ; Not special PUSHJ P,BYTINQ ; Otherwise, do byte in JUMPE B,CPOPJ ; Cone if null EXCH A,B PBOUT EXCH A,B POPJ P, BYTINQ: PUSHJ P,CHKJFN ; Check the designator JRST IOERR ; Bad designator JFCL ; Tty JFCL ; Byte pointer, or special designator IFDEF CHAOS,<HRRZ A,DEV CAIN A,CHADTB## CALL CHAINP##> ;SET FOR INPUT BYTINA: JUMPGE STS,NOTOPN TEST(NN,READF) FILABT IOX1 ; Illegal read TEST(NE,ERRF) FILINT(IOX5) ; Generate data error interrupt TEST(NE,EOFF) JRST INEOF PUSHJ P,@BIND(DEV) ; Dispatch to device dependent code TEST(NE,ERRF) FILINT(IOX5) TEST(NE,EOFF) JRST INEOF MOVE B,A JRST UNLCKF INEOF: MOVEI A,IOX4 MOVEM A,LSTERR MOVEM JFN,ERRSAV MOVEI 1,400000 MOVSI 2,(1B10) PUSHJ P,JSERT## ; ERJMP/ERCAL handling? SKIPA ; Yes, don't interrupt IIC ; Initiate interrupt on channel 10 MOVEI B,0 JRST UNLCKF ; Output to primary output file ; Call: 1 BYTE ; PBOUT .PBOUT::JSYS MENTR MOVEI JFN,101 UMOVE B,1 PUSHJ P,BYTOUT JRST MRETN ; Byte output ; Call: 1 ; Tenex destination designator ; 2 ; A byte ; BOUT .BOUT:: NOINT JUMPL 1,SLBOU CAML 1,MAXJFN ; Possibly a jfn? JRST SLBOU ; Not possible LSH 1,SJFN ; Convert number to index AOSE FILLCK(1) JRST SLBOU0 MOVEM C,BIOAC0 MOVE C,FILSTS(1) TLC C,OPNF!WRTF TLCN C,OPNF!WRTF TLNE C,FRKF!ERRF JRST SLBOU1 SOSGE FILCNT(1) JRST SLBOU2 AOS C,FILBYN(1) CAMLE C,FILLEN(1) MOVEM C,FILLEN(1) IDPB 2,FILBYT(1) MOVE C,BIOAC0 SETOM FILLCK(1) LSH 1,-SJFN OKINT XCT MJRSTF SLBOU2: AOS FILCNT(1) SLBOU1: MOVE C,BIOAC0 SETOM FILLCK(1) SLBOU0: LSH 1,-SJFN SLBOU: OKINT JSYS MENTR MOVE JFN,1 PUSHJ P,BYTOUT ; Output the byte JRST MRETN ; Random output jsys ; Call: 1 ; Tenex source designator ; 2 ; A byte ; 3 ; Byte number ; ROUT .ROUT:: JSYS MENTR MOVE JFN,1 PUSHJ P,CHKJFN JRST IOERR JFCL FILABT DESX4 ; Tty and byte designators are illegal JUMPGE STS,NOTOPN TEST(NN,RNDF) FILABT IOX3 ; Illegal to change pointer TEST(NN,WRTF) FILABT IOX2 ; Illegal write IFDEF CHAOS,<HRRZ A,DEV CAIN A,CHADTB## CALL CHAOUP##> ;SET FOR OUTPUT UMOVE A,3 PUSHJ P,SFBNR JRST ABTDO UMOVE B,2 PUSHJ P,BYTOUA JRST MRETN ; String output to primary io file ; Call: 1 ; String pointer, designator, or location of string ; PSOUT .PSOUT::JSYS MENTR PSOUT1: TLCE A,777777 ; IS LH = 0? TLC A,777777 ; NO. UNCOMPLEMENT PUSHJ P,FIXPTR ; YES. LEAVE IT -1 AND FIX IT UP ANYWAY JRST EDESX1 PSOUT0: PUSH P,A ; Make a copy of byte pointer XCTBU [ILDB B,0(P)] JUMPE B,[XCTMU [POP P,1] JRST MRETN] MOVEI JFN,101 PUSHJ P,BYTOUT POP P,A UMOVEM A,1 JRST PSOUT0 ; PRIMARY ERROR STRING OUTPUT .ESOUT::JSYS MENTR MOVEI A,101 DOBE HRROI A,[ASCIZ / ?/] PSOUT MOVEI A,100 CFIBF UMOVE 1,1 JRST PSOUT1 ; String output ; Call: 1 ; Tenex source designator ; 2 ; Byte pointer (lh = 777777 will be filled in) ; 3 ; Byte count or zero ; ; If zero, the a zero byte terminates ; ; If positive then transfer the specified number ; ; Of characters, or terminate on reading a byte ; ; Equal to that given in 4 ; ; If negative, then transfer the specified number ; ; Of bytes ; 4 ; (optional) if 3 is > 0, 4 has a terminating byte ; SOUT ; Return ; +1 ; Always ; 2 ; Updated string pointer ; 3 ; Updated count (always counts toward zero) ; The updated string pointer always points to the last byte read ; Unless 3 contained zero, then it points to the last non-zero byte. .SOUT2:: ;[BBN] .SOUT:: JSYS MENTR ; Become slow etc SOUT0: PUSHJ P,SIOR1 ; FIX UP AC2, CHECK JFN JRST SOUTTY JRST [ CAIE DEV,STRDTB JRST .+1 JRST SOUBYT] TEST(NN,WRTF) FILABT(IOX2) IFDEF CHAOS,<HRRZ A,DEV CAIN A,CHADTB## CALL CHAOUP##> ;SET FOR OUTPUT SKIPG FILCNT(JFN) JRST SOUTLD ; DO IT THE OLD WAY MOVE B,FILBYT(JFN) ; TARGET IS FILE UMOVE A,2 ; SOURCE IS USER MOVEI D,2 PUSHJ P,SIOR2 UMOVEM A,2 MOVEM B,FILBYT(JFN) PUSHJ P,UNLCKF JUMPN D,SOUT0 JRST MRETN ; SOUT TO STRING POINTER SOUBYT: MOVE B,JFN UMOVE A,2 MOVE D,[1B2+3] PUSHJ P,SIOR2 UMOVEM A,2 UMOVEM B,1 MOVEM B,JFN PUSHJ P,APPNUL ; APPEND NULL JRST MRETN ; OLD STYLE SOUT SOUTTY: SOUTLD: XCTUM [PUSH P,2] XCTBU [ILDB B,0(P)] XCTUU [SKIPN 3] JUMPE B,[XCTMU [POP P,2] PUSHJ P,UNLCKF JRST MRETN] ; Don't write zero bytes if arg3 = 0 PUSH P,B PUSHJ P,BYTOUA POP P,B XCTMU [POP P,2] PUSHJ P,APPNUL JSP A,SIONXT JRST SOUT0 ; Byte output subroutine ; Call: 1 ; Source designator ; PUSHJ P,BYTOUT ; Return ; +1 ; Ok ; Clobbers most everything BYTOUT::PUSHJ P,CHKJFN ; Check the designator JRST IOERR ; Bad designator JFCL ; Tty JFCL ; Byte pointer or special designator IFDEF CHAOS,<HRRZ A,DEV CAIN A,CHADTB## CALL CHAOUP##> ;SET FOR OUTPUT BYTOUA::JUMPGE STS,NOTOPN TEST(NN,WRTF) FILABT IOX2 ; Illegal write TEST(NE,ENDF) FILABT(IOX6) ; Past abs end of file TEST(NE,ERRF) FILINT(IOX5) ; Error interrupt MOVE A,B PUSHJ P,@BOUTD(DEV) ; Dispatch to device dependent code JRST UNLCKF ; Append null to string output designator APPNUL::PUSH P,JFN PUSH P,C MOVEI C,0 TLZ JFN,7700 TLO JFN,700 CAMN JFN,-1(P) XCTBU [IDPB C,JFN] POP P,C POP P,JFN POPJ P, ; Dump io ; Parameters and variables LS(DMPASW) ; Dump buffer assignment word LS(DMPCNT) ; Dump buffer free count LS(DMPLCK) ; Dump buffer assignment lock ; Initialize dump io USE RESPC DMPINI::MOVEI A,NDUMP MOVEM A,DMPCNT SETOM DMPLCK SETCM A,[-1_<^D36-NDUMP>] MOVEM A,DMPASW POPJ P, USE SWAPPC ; Dump input ; Call: 1 ; Jfn ; 2 ; Pointer to first command ; DUMPI ; Return ; +1 ; Error ; +2 ; Ok .DUMPI::JSYS MENTR PUSHJ P,DUMPC ; Call common dump code TEST(NN,READF) ; Executed to discover file access IOX1 ; Error number for no read access PUSHJ P,@DMPID(DEV) ; Device dependent routine dispatch 040400000000 ; Memory access needed ; Dump output ; Call: 1 ; Jfn ; 2 ; Pointer to first command ; DUMPO ; Return ; +1 ; Error ; +2 ; Ok .DUMPO::JSYS MENTR PUSHJ P,DUMPC TEST(NN,WRTF) IOX2 PUSHJ P,@DMPOD(DEV) 100000000000 ; Memory access needed ; Dump common code DMPSEB: JUMPE B,[AOS -1(P) JRST MRETN] UMOVEM B,2 DUMPC: UMOVE A,2 ; Get command pointer UMOVE B,(A) ; And command JUMPGE B,DMPSEB ; Branch or disconnect PUSH P,B ; Save iowd HLRE A,B ; - word count MOVNS A ; Word count ADDI A,(B) ; Last address CAILE A,777777 ; Must not cross end of memory JRST [ MOVEI A,DUMPX3 ; Error if happens JRST ERRD] MOVEI B,1(B) ; First address LSH A,-9 ; Last page number LSH B,-9 ; First page number SUBM B,A SOS A ; -# pages CAMGE A,[-NDUMP] JRST [ MOVEI A,DUMPX3 JRST ERRD] ; Too many pages NOINT MOVE C,-1(P) ; Get saved pc PUSH P,3(C) ; Save access bits LOCK DMPLCK,<PUSHJ P,LCKTST##> DMPSE0: MOVSI B,400000 ASH B,1(A) ; Get a one for each page needed HRLZ C,A ; Initial aobjn word PUSH P,DMPCNT ; SAVE CURRENT LEVEL OF AVAILABILITY DMPSE1: TDNN B,DMPASW ; Are these contiguous buffers free JRST DMPSE2 ; Yes, assign them ROT B,-1 ; No, try next set AOS C ; Modify aobjn word JUMPGE B,DMPSE1 ; When low bit wraps around EXCH A,0(P) ; SAVE A, GET FORMER DMPCNT HRLZS A HRRI 1,DMPTST JSYS EDISMS ; Dismiss until buffers released POP P,1 JRST DMPSE0 ; Then try again DMPSE2: SUB P,BHC+1 ; FLUSH SAVE DMPCNT IORM B,DMPASW ; Mark these buffers as taken ADDM A,DMPCNT ; Decrement count of free buffers UNLOCK DMPLCK PUSH P,C ; Save aobjn word HRRZ A,-2(P) ; Get user first address-1 AOS A LSH A,-9 ; Page number IFN KAFLG!F3FLG,< JSP B,.+1 TLNN B,2000 ; Call from monitor? > IFN KIFLG,< MOVE B,-4(P) ; CHECK CALLER'S PC WORD TLNE B,(1B5)> ; CALL FROM MONITOR? HRLI A,400000 ; No, insert fork id DMPSE3: PUSH P,A ; Save vulnerable ac's PUSH P,C JUMPGE A,[LSH A,9 PUSHJ P,FPTA ; Convert monitor address to ptn.pn JRST DMPSE5] PUSHJ P,FKHPTN ; Convert user address to ptn.pn DMPSE5: PUSH P,A ; Save ptn.pn PUSHJ P,MRPACS ; Read access of page TLNN A,(1B5) JRST [ MOVE A,-2(P) ; Non-existant page, create it LSH A,9 UMOVE A,(A) ; By referencing it POP P,A JRST DMPSE5] TDNN A,-4(P) ; Test against needed access JRST DMPSE4 ; Access not permitted TLNN A,(1B6) ; Indirect? JRST DMPSE7 ; No. POP P,A ; Yes, track it down PUSHJ P,MRPT ; Get id of page pointed to JRST DMPSE5 ; Not file, continue PUSH P,A ; File, repush JRST DMPSE6 DMPSE7: TLNN A,400 ; Write copy? JRST DMPSE6 ; No. MOVE B,-4(P) ; Yes. TLNN B,40000 ; Write? JRST DMPSE6 ; No. TLNN A,100000 ; Yes, can we read? JRST DMPSE4 ; No, must fail MOVE B,-2(P) LSH B,9 UMOVES 0,20(B) ;[ISI] Write in page to make not write copy POP P,A POP P,C POP P,A JRST DMPSE3 ; Recompute DMPSE6: HRRZ A,-1(P) ; Get buffer number LSH A,9 ADDI A,IOXBUF ; Convert to address MOVE B,A EXCH A,(P) ; Save address, get ptn.pn HRLI B,140000 PUSHJ P,SETMPG ; Map the user page into monitor POP P,A ; Get back address PUSHJ P,FPTA PUSHJ P,MLKPG ; Lock the page POP P,C ; Restore vulnerable ac's POP P,A AOS A ; Next page AOBJN C,DMPSE3 ; Until done POP P,C ; Aobjn word MOVEM C,(P) ; Back to stack (clobers access bit) MOVEI A,IOXBUF ; Do things the hard way cause macro ASH A,-9 ; Can't divide externals ADDI A,(C) AOS -1(P) DPB A,[POINT 9,-1(P),26]; Modify iowd to address monitor buffer SOS -1(P) ; At this point the dump region has been mapped into the monitor ; Buffer region and access checked ; -1(p) has the iowd needed for the data xfer ; 0(p) has the aobjn word needed to restore buffers when finished UMOVE JFN,1 PUSHJ P,CHKJFN JRST DMPER1 ; Error, release buffers JFCL JRST [ CAIE DEV,STRDTB JRST .+1 MOVEI A,DESX4 JRST DMPER1] TEST(NN,OPNF) JRST [ MOVEI A,DESX5 JRST DMPER2] MOVE B,STS ANDI B,17 CAIE B,17 JRST [ MOVEI A,DUMPX2 JRST DMPER2] MOVE B,-2(P) MOVE A,1(B) XCT 0(B) JRST DMPER2 POP P,A EXCH A,(P) ; Get iowd, leave aobjn word on stack XCT 2(B) ; Call device dependent routine POP P,A PUSHJ P,DMPREL ; Release buffers OKINT PUSHJ P,UNLCKF MOVEI A,IOX4 TEST(NE,EOFF) JRST [ UMOVEM A,1 JRST MRTNE1] ; Stop if eof MOVEI A,IOX5 TEST(NE,ERRF) JRST [ UMOVEM A,1 JRST MRTNE1] ; Or error XCTUU [AOS 2] JRST DUMPC DMPER2: PUSHJ P,UNLCKF DMPER1: EXCH A,(P) PUSHJ P,DMPREL XCTMU [POP P,1] JRST MRTNE1 DMPSE4: POP P,A POP P,A POP P,B PUSH P,A PUSHJ P,DMPRL1 ; Release buffers assigned but unlocked POP P,C HLRES C MOVNS C HRLZS C POP P,A ADD A,C SKIPGE A PUSHJ P,DMPREL ; Release buffers both lock and assigned MOVEI A,DUMPX4 JRST ERRD ; Access error DMPREL: PUSH P,A DMPRL0: PUSH P,A LSH A,9 MOVEI A,IOXBUF(A) PUSH P,A PUSHJ P,FPTA PUSHJ P,MULKPG POP P,B MOVEI A,0 PUSHJ P,SETMPG POP P,A AOBJN A,DMPRL0 POP P,A DMPRL1: HLRE B,A MOVSI C,400000 ASH C,1(B) MOVNI A,(A) ROT C,(A) ANDCAM C,DMPASW MOVNS B ADDM B,DMPCNT POPJ P, USE RESPC DMPTST: CAML 1,DMPCNT JRST 0(4) JRST 1(4) USE SWAPPC ; Fixed point number output ; Call: 1 ; Destination designator ; 2 ; Number to be output ; RH(3) ; Radix ; 3(0) ; 1 to treat number as 36 bit magnitude ; 3(1) ; 1 to always print some kind of sign ; 3(2) ; Right justify the number ; 3(3) ; Print leading zeros if any ; 3(4) ; Print something on errors ; 3(5) ; Print * on errors rather than whole number ; 3(11-17) ; Field width, 0 means large enough to hold all ; NOUT ; Return ; +1 ; Error, bad radix, or number too big for field ; +2 ; Successful .NOUT:: JSYS MENTR PUSHJ P,NOUTX JRST [ MOVE A,LSTERR UMOVEM A,3 JRST MRTNE1] AOS (P) JRST MRETN NOUTX:: HRRZ D,C ; Get radix CAIL D,2 CAILE D,^D10+^D26 ; Must be 2 - 36 JRST [ MOVEI A,NOUTX1 MOVEM A,LSTERR POPJ P,] HLL D,C ; Save flags in d too LDB F,[POINT 8,D,17] ; Extract column width MOVEI E,1 ; Initilize digit counter TLNN D,(1B0) ; Magnitude printout? CAIL B,0 ; Or positive number? TLZA D,(1B6) ; Yes, remember not minus sign TLO D,(1B6+1B1) ; No, remember minus sign TLNE D,(1B6) ; - sign to be printed? MOVMS B ; Yes complement number TLNE D,(1B1) ; A sign of some sort to be printed? NOUT1: AOS E ; Yes, count as digit LSHC B,-^D35 ; Make into double LSH C,-1 ; Length dividend DIVI B,(D) ; Produce a digit PUSH P,C ; Save on stack JUMPN B,NOUT1 ; Repeat until all digits generated CAIN F,0 ; Zero field width specified? MOVE F,E ; Yes, make it same as number of digits TLNE D,(1B2) ; Right justify number? NOUT2: CAML E,F ; And filler needed? JRST NOUT3 ; No TLNE D,(1B3) ; Yes. leading 0's? PUSHJ P,SGNOUT ; Yes, output sign now MOVEI B," " ; Get a space TLNE D,(1B3) ; Unless 0's wanted MOVEI B,"0" ; Then get a 0 PUSHJ P,BOUTN ; Call bout so strings will work SOJA F,NOUT2 ; Decrease remaining width and loop NOUT3: CAML F,E ; Sufficient room? JRST NOUT4 ; Yes MOVEI B,NOUTX2 ; Error MOVEM B,LSTERR TLNN D,(1B4) ; Print something anyway? JRST NOUT7 ; No, go away TLNN D,(1B5) ; Asterisks? JRST NOUT4 ; No, print the whole number MOVEI B,"*" ; Yes, NOUT6: SOJL F,NOUT7 ; Column filled PUSHJ P,BOUTN JRST NOUT6 NOUT7: TLNE D,(1B1) ; If one position reserved for -, SOS E ; One less thing on stack NOUT71: SOJL E,CPOPJ POP P,B JRST NOUT71 NOUT4: PUSHJ P,SGNOUT ; Output sign before number NOUT5: SOJL E,NOUT8 ; Any digits left? POP P,B ; Yes, get one ADDI B,"0" CAILE B,"9" ADDI B,"A"-"9"-1 PUSHJ P,BOUTN ; Print it SOJA F,NOUT5 ; Decrease field width NOUT8: SKIPL F AOS (P) ; Skip if no error MOVEI B," " JRST NOUT6 ; Insert trailing blanks if necessary SGNOUT: TLZN D,(1B1) ; Sign still needed? POPJ P, ; No, return immediately MOVEI B,"-" TLNN D,(1B6) MOVEI B,"+" PUSHJ P,BOUTN SOS E ; Decrement digit count SOS F ; Decrement remaining field width POPJ P, ; Call bout BOUTN:: PUSH P,A UMOVE A,1 ; Output designator TLNN A,777777 ; String pointer? JRST BOUTN1 ; No PUSHJ P,FIXPTR ; FIX BYTE POINTER JFCL ; IGNORE INDEX/INDIRECTION XCTBU [IDPB B,A] UMOVEM A,1 PUSH P,B SETZ B, XCTBU [IDPB B,A] POP P,B POP P,A POPJ P, BOUTN1: BOUT ; For ordinary jfn's just do a bout POP P,A POPJ P, ; Number input ; Call: 1 ; Source designator ; NIN ; Return ; +1 ; Error ; +2 OK ; 2 NUMBER .NIN:: JSYS MENTR CAILE 3,1 CAILE 3,^D10+^D26 JRST [ MOVEI A,IFIXX1 ; Illegal radix UMOVEM A,3 MOVEM A,LSTERR ; Leave it around for ERSTR JRST MRTNE1] MOVEI 1,400000 RCM ; Read interrupt enables PUSH P,1 ; Save to restore when done MOVEI 1,400000 MOVSI 2,(1B6) DIC ; Turn off overflow int JOV .+1 MOVEI C,0 PUSHJ P,BIN1 CAIN B,40 JRST .-2 ; Skip leading spaces CAIN B,"-" JRST MININ CAIN B,"+" PUSHJ P,BIN1 PUSHJ P,DIGIN1 JRST [ MOVEI A,IFIXX2 UMOVEM A,3 MOVEM A,LSTERR ; For ERSTR JRST PLINX] PLIN: PUSHJ P,NIN9 UMOVEM C,2 JOV [ MOVEI A,IFIXX3 UMOVEM A,3 MOVEM A,LSTERR JRST PLINX] AOS -1(P) SKIPA 2,[MRETN] ; Set success return PLINX: MOVEI 2,MRTNE1 ; Set error return EXCH 2,0(P) ; 2 _ interrupt enables, save rtn MOVEI 1,400000 AIC ; Re-enable POP P,2 ; 2 _ return routine adr JRST 0(2) MININ: PUSHJ P,NIN91 MOVNS C JRST PLIN+1 NIN9: XCTUU [MUL C,3] ASH C,^D34 ; Shift lost bits off setting ovrflo LSH C,1 ; Position old b35 at b0 ADD C+1,C ; Complete the 36-bit mult EXCH C,C+1 ; 36-bit prod to c, hi part to c+1 ADD C+1,C+1 ; Set overflow if sign is wrong now ADD C,B ; Add in digit NIN91: PUSHJ P,DIGIN POPJ P, JRST NIN9 DIGIN: PUSHJ P,BIN1 DIGIN1: SUBI 2,60 JUMPL 2,CPOPJ CAILE 2,9 JRST [ CAIL 2,"A"+40-60 ;[ISI] Allow lowercase a-z SUBI 2,40 ;[ISI] CAIL 2,"A"-60 CAILE 2,"Z"-60 POPJ P, SUBI 2,"A"-"9"-1 JRST .+1] XCTUU [CAMGE 2,3] AOS (P) POPJ P, BIN1:: PUSH P,A UMOVE A,1 TLNN A,777777 JRST BIN1A PUSHJ P,FIXPTR ; FIX UP POINTER JFCL ; IGNORE BADNESS XCTBU [ILDB B,A] UMOVEM A,1 POP P,A POPJ P, BIN1A: BIN POP P,A POPJ P, POPJ P, ;DELCH CALL: 1 JFN ;RETURN +1 NOT TERMINAL ; +2 DISPLAY-LINE EMPTY ; +3 DISPLAY-DELETE DONE ; +4 NON-DISPLAY TERMINAL .DELCH::JSYS MENTR UMOVE JFN,1 PUSHJ P,CHKTC1 JRST MRETN HLRZ 2,DEV PUSHJ P,TTDELO## JRST DCH4 ;NON-DISPLAY OR BINARY MODE JRST DCH2 JRST DCH3 DCH4: AOS (P) DCH3: AOS (P) DCH2: AOS (P) JRST MRETN ;CHECK FOR TTY AND SKIP IF TTY CHKTCO:: HRRZ JFN,PRIMRY CHKTC1:: PUSHJ P,CHKJFN JRST IOERR ;ERROR JRST CHKTC2 ;TTY POPJ P, ;STRING MOVEI A,(DEV) CAIE A,TTYDTB JRST [PUSHJ P,UNLCKF POPJ P,] CHKTC2: AOS (P) ;SKIP POPJ P, END