github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-02-15 04:16:21 +00:00
Code Issues Releases Wiki Activity
Files
cb2ac644e94505f05eaf476630e620be37f4f46e
PDP-10.its/src/sysen1/xxfile.mta224
Lars Brinkhoff dd476901a5 XXFILE source code and documentation.
2018-05-05 19:37:20 +01:00

2696 lines
57 KiB
Plaintext
Executable File
Raw 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 NX
O=0
A=1
B=2
C=3
D=4
E=5
F=6
G=7
T=15 ; CONTAINS NUMBER OF STY
U=16 ; USER INDEX, USED IN STATUS CODE
P=17
.xcref O,A,B,C,D,E,F,G,P
DSKI==0 ; FILE INPUT
OUTCHN==1 ; NON-INTERACTIVE OUTPUT
TTYI==2 ; TTY INPUT
TTYO==3 ; TTY OUTPUT
ECHO==4 ; ECHO AREA OUTPUT (COMMANDS)
STYI==5 ; STY INPUT
STYO==6 ; STY OUTPUT
; DEVICE CODES USED
SNTTY==1
SNTDS==2
SNSTY==25
; BLOCKS ON INPUT CHAIN
OUTBLK==6 ; LENGTH OF BLOCK
OUTNXT==0 ; NEXT BLOCK ON CHAIN
OUTTYP==1 ; TYPE
OUTLEN==2 ; LENGTH
OUTPTR==3 ; BYTE POINTER
OUTTLN==4 ; TOTAL LENGTH OF SOURCE
OUTRED==5 ; NUMBER OF CHARS READ SO FAR
; TYPES FOR BLOCKS
$TFILE==1
$TTEXT==2
; OFFSETS INTO FILE NAME BLOCKS
DEV==0
SNM==1
FN1==2
FN2==3
; OFFSETS INTO ERROR STRING BLOCKS
ERRBLK==5 ; LENGTH OF BLOCK
ENEXT==0 ; NEXT BLOCK IN CHAIN OR 0
EMATCH==1 ; NEXT CHAR TO BE MATCHED
EMATLN==2 ; # OF CHARACTERS LEFT TO MATCH
ESTRING==3 ; BEGINNING OF STRING
ELENGTH==4 ; LENGTH OF STRING
; DECREMENT BYTE POINTER
DEFINE DBP AC
ADD AC,[70000,,]
TLNE AC,400000
ADD AC,[347777,,-1]
TERMIN
LOC 40
0
JSR UUOH
-TSINTL,,TSINT
LOC 100
UUOERR==1 ; WE WANT AN ERROR UUO
.INSRT TAA;UUOS >
; BLOCKS
PDLLEN==200
PDL: BLOCK PDLLEN
INBLEN==50
INPBUF: BLOCK INBLEN
INPBU1: BLOCK INBLEN
DBUFLN==50
DSKBUF: BLOCK DBUFLN
JCLBUF: BLOCK 50
TTYBUF: BLOCK 50
STTBUF: BLOCK 50 ; BUFFER FOR STATUS LINE
; VARIABLES
XUNAME: 0
SNAME: 0
HSNAME: 0
FILFIL: 0 ; BLOCK FOR PARSING INPUT FILE NAMES
0
0
0
FILFDF: SIXBIT /DSK/
0
0
SIXBIT />/
OUTFIL: SIXBIT /NUL/
SIXBIT /HUDINI/
0
SIXBIT />/
OUTFDF: SIXBIT /NUL/
SIXBIT /HUDINI/
0
SIXBIT />/
CDEFAU: 0
SYSVER: 0 ; VERSION OF SYSTEM INITIALIZED IN
IERRST: 0 ; LIKE ERRSTK, FOR INPUT FAILURE ERRORS
ERRSTK: 0 ; IF NON-ZERO, SET P TO THIS AND DO
; .CALL DISMIS AFTER ERROR
STIFLG: 0 ; IF -1, READING FROM STY
STOFLG: 0 ; IF -1, WRITING TO STY
LSTLEN: 0
LSTPTR: 0
LSTTMP: 0
LSTOLN==4
LSTOUT: BLOCK LSTOLN
LSTBUF: BLOCK 2*LSTOLN ; STUFF FOR CTRL-T
ESCAPE: ^^ ; ESCAPE CHARACTER
CTRLT: ^T ; STATUS CHARACTER
PRSW: 0 ; IF -1, LEAVE STY AS PRINTING TERMINAL
COMGLN: 0 ; FIRST ARG TO COMND--GET LINE
COMPRT: 0 ; SECOND ARG--PRINT CRAP
ECHOQ: 0 ; -1 IF ECHO AREA SET UP
TTYQ: 0 ; -1 IF TTY OPEN
TTYOPT: 0 ; TTY OPTION WORD FOR OUR TTY
TOERS: 0 ; SET FROM TTYOPT BY GETLIN
ECCPOS: 0 ; SET BY GETLIN--USED FOR FLUSHING ENTIRE LINE
CTTST1: 0
CTTST2: 0
CTTSTS: 0 ; CURRENT TTYGET SETTINGS
SIIFLG: 0 ; USED TO CAUSE RESUMPTION OF SII AFTER COMMAND
NTTST1: 030202,,020202 ; NORMAL CASE IS TO INTERRUPT ONLY ON
NTTST2: 030202,,020202 ; CTRLS, ACTIVATE ON EVERYTHING
TTTST1: 030303,,030303 ; WHEN IN TTY INPUT, EVERYTHING INTERRUPTS
TTTST2: 030303,,030303
STYST1: 0
STYST2: 0 ; TTYSTn WORDS FOR STY
STHIGH: 0 ; HEIGHT OF STY SCREEN
STVPOS: -1 ; VERTICAL POSITION (ONLY IF OUTPUT TO FILE)
STHPOS: 0 ; HORIZONTAL POSITION
INPSRC: 0 ; POINTER TO CHAIN OF INPUT BLOCKS
JOBFRC: 0 ; IF NON-ZERO, # OF JOB ALL INPUT MUST GO TO
FILOPQ: 0 ; FILE SPECIFIED BY CURRENT BLOCK IS OPEN
CTRLM: 0 ; LAST CHAR 'SENT' WAS CTRL-M
FORCSW: 0 ; IF -1, OUTPUT SHOULD BE FORCED
FORCTM: 0 ; USED IN SNDCOM FOR SPECIAL HACK W/ FORCE SWITCH
LSTBLK: 0
0
4
440700,,[ASCII /0U/] ; LAST BLOCK TO BE SENT--LOG OUT
4
0
CINPLN: 0 ; # CHARACTERS GOBBLED FROM STYI
DSKOUT: 0 ; OUTPUT TO NORMAL DEVICE (OUTCHN)
TTYSRC: 0 ; READING FROM TTY, SO PRINT THERE
DSKCHN: 0 ; OUTCHAN IS TTY-TYPE (0) OR DSK (-1)
NULOUT: -1 ; NO OUTPUT CHANNEL (INCLUDING TTY)
NOCNSL: 0 ; SET -1 BY ERROR UUO IF NO CONSOLE WHEN RUNS
CNSFLS: 0 ; IF E SWITCH--DIE IF ERROR AND NO TTY
STYTRY: 0 ; IF 0, TRY MANY TIMES TO OPEN STY WHEN DEV FULL
ERESET: 0 ; SET BY SENDIT--RESET ALL ERROR STRINGS
ERRORS: DEFER1 ; INITIALLY LOOK FOR *ERROR* AND ?U?
DEFER1: DEFER2
440700,,[ASCII /*ERROR*/]
7
440700,,[ASCII /*ERROR*/]
7
DEFER2: DEFER3
440700,,[ASCIZ /?U?/]
3
440700,,[ASCIZ /?U?/]
3
DEFER3: 0
440700,,[ASCII /??/]
2
440700,,[ASCII /??/]
2
START: MOVE P,[-PDLLEN,,PDL-1]
.RSYSI A,
CAME A,SYSVER
PUSHJ P,INIT
PUSHJ P,TTYOP1 ; OPEN TTY FOR READING, SET UP OPTION WORD,...
PUSHJ P,JCLHAK
PUSHJ P,STYOPN ; SET UP STY, CAUSE IT TO ASK FOR INPUT
MOVE B,[200000,,A]
MOVEI A,300. ; EVERY FIVE SECONDS
.REALT B,
JFCL ; PROBABLY NEVER SKIPS WITH THIS CALL...
JFCL
.HANG
TTYSU: .SOPTIO,,A
.SMSK2,,[<1_TTYO>\<1_TTYI>\<1_STYO>\<1_STYI>]
.RXUNAM,,XUNAME
.RSNAME,,SNAME
.RHSNA,,HSNAME
TTYSUS: TTYSU-.,,TTYSU
TTYOP1: SETZM TTYQ
.SUSET [.ROPTIO,,A]
TLNE A,OPTDDT
.VALUE [ASCIZ \..SAFE/-1
P\]
TLO A,<OPTINT\OPTOPC>
MOVE B,TTYSUS
.SUSET B ; SET UP MASKS, READ XUNAME, SNAME, SET OPTION
MOVE B,SNAME
MOVEM B,SNM+FILFDF
MOVEM B,FN1+OUTFDF
MOVE B,HSNAME
MOVEM B,SNM+OUTFDF ; DEFAULT OUTPUT DIRECTORY
.SUSET [.RCNSL,,A]
JUMPL A,CPOPJ ; IF CNSL IS <0, IN A DAEMON'S TREE, SO FLUSH
SETOM TTYQ ; WE HAVE TTY
.CALL [SETZ
SIXBIT /OPEN/
[.UAI,,TTYI]
[SIXBIT /TTY/]
[SIXBIT /TTY/]
SETZ [SIXBIT /TTY/]]
.LOSE %LSFIL
.CALL [SETZ
SIXBIT /OPEN/
[.UAO+%TJPP2+%TJMOR,,ECHO]
[SIXBIT /TTY/]
[SIXBIT /TTY/]
SETZ [SIXBIT /TTY/]]
.LOSE %LSFIL
.CALL [SETZ
SIXBIT /CNSGET/
MOVEI TTYI
MOVEM
MOVEM
MOVEM
MOVEM
SETZM TTYOPT] ; READ TTY OPTION WORD
.LOSE %LSSYS
.CALL [SETZ
SIXBIT /TTYGET/
MOVEI TTYI
MOVEM A
MOVEM A
SETZM CTTSTS]
.LOSE %LSSYS
MOVE A,NTTST1
MOVEM A,CTTST1
MOVE A,NTTST2
MOVEM A,CTTST2
.CALL [SETZ
SIXBIT /TTYSET/
MOVEI TTYI
NTTST1
SETZ NTTST2] ; SET UP TTY INTERRUPTS
.LOSE %LSSYS
POPJ P,
SUBTTL STY INITIALIZATION
; OPEN STY, SET UP BITS TO BE SOMETHING LIKE OURS. WHEN DONE, CAUSE
; INTERRUPT ON STYO SO WE'LL BE LOGGED IN AND ALL.
STYOPN: PUSH P,A
STYOPC: .CALL [SETZ
SIXBIT /OPEN/
[<10\.UAI>,,STYI] ; DON'T HANG ON INPUT
[SIXBIT /STY/]
[SIXBIT /STY/]
[SIXBIT /STY/]
SETZB A] ; ERROR CODE
JRST STYLOS
.CALL [SETZ
SIXBIT /OPEN/
[.UAO,,STYO] ; HANG ON OUTPUT
[SIXBIT /STY/]
[SIXBIT /STY/]
SETZ [SIXBIT /STY/]]
.LOSE %LSFIL
.CALL [SETZ
SIXBIT /RFNAME/
MOVEI STYO
SETZM A] ; 'Snn
.LOSE %LSSYS
LDB T,[300600,,A]
SUBI T,20
IMULI T,10
LDB A,[220600,,A]
ADDI T,-20(A)
ADD T,NFSTTY ; GET TTY NUMBER WE GOT
PUSHJ P,STYSET
SKIPE NULOUT
JRST PROCED
SKIPN TTYSRC ; CAN'T :PROCED IF TTY INPUT
SKIPN DSKCHN ; OR NON-DISK OUTPUT
JRST STYOP1
PROCED: SKIPE TTYQ ; IF NO TTY, DON'T :PROCED
.VALUE [ASCIZ /:PROCED
/]
STYOP1: .SUSET [.SIIFPIR,,[<1_STYO>]] ; CAUSE IT TO ASK FOR INPUT
.SUSET [.SMASK,,[%PIRLT\%PIATY]] ; ENABLE WORD ONE INTERRUPTS
POP P,A
POPJ P,
; HERE IF LOSSAGE OPENING STY
STYLOS: SKIPE STYTRY
SOSG STYTRY
STYLS1: .CALL [SETZ
SIXBIT /LOSE/
[STYOPC,,%LSFIL]
SETZI STYOPC] ; REPORT LOSSAGE
CAIE A,%EFLDV ; ONLY IF DEVICE FULL ERROR
JRST STYLS1
MOVEI A,<10.*30.>
.SLEEP A,
JRST STYOPC ; TRY AGAIN
; SET UP STY'S BITS
STYSET: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,E
SKIPE TTYQ ; IF NO TTY, THEN PRINTING TERMINAL
SKIPE PRSW ; OR IF USER GAVE /P SWITCH
JRST STYSE1
MOVE A,TTYOPT
TRO A,%TPTEL ; TREAT CRLF AS CR (TELNET PROTOCOL)
MOVEI C,0
DPB C,[$TPPLF,,A] ; NO PADDING OF LINE FEEDS
DPB C,[$TPPCR,,A] ; NO PADDING OF CR
DPB C,[$TPPTB,,A] ; NO PADDING OF TABS
TDZ A,[%TOMOR\%TORAW\%TOHDX,,%TPCBS\%TPORS]
.CALL [SETZ
SIXBIT /RSSIZE/
MOVEI TTYI
MOVEM D
SETZM E]
.LOSE %LSSYS ; GET SCREEN SIZE OF THIS
CAIG D,60.
SUBI D,2
MOVEM D,STHIGH ; HEIGHT OF STY'S SCREEN
SUBI E,1 ; ALLOW FOR ! COLUMN
MOVE C,[-STYBLN,,STYBLK]
.CALL [SETZ
SIXBIT /TTYVAR/
MOVEI STYO
SETZ C]
.LOSE %LSSYS
.CALL [SETZ
SIXBIT /SCPOS/
MOVEI STYO
MOVEI 0
SETZI 0]
.LOSE %LSSYS
.CALL [SETZ
SIXBIT /TTYGET/
MOVEI STYO
MOVEM B
MOVEM C
SETZM A]
.LOSE %LSSYS
TLO A,%TSMOR ; TURN OFF MORE HACKING
.CALL [SETZ
SIXBIT /TTYSET/
MOVEI STYO
B
C
SETZ A]
.LOSE %LSSYS
STYSTO: .CALL [SETZ
SIXBIT /TTYVAR/
MOVEI STYO
[SIXBIT /TTYCOM/]
MOVEI O
SETZ [TLO %TCRFS]]
.LOSE %LSSYS ; SET UP REFUSE MODE
POP P,E
POP P,D
POP P,C
POP P,B
POP P,A
POPJ P,
STYSE1: .CALL [SETZ
SIXBIT /TTYVAR/
MOVEI STYO
[SIXBIT /TTYOPT/]
MOVEI O
SETZ [TRO %TPTEL]] ; JUST TURN ON TELNET PROTOCOL AND FLUSH
.LOSE %LSSYS
JRST STYSTO
STYBLK: SIXBIT /TCTYP/
MOVEI O,%TNSFW ; SOFTWARE TTY
SIXBIT /TTYOPT/
MOVE O,A ; SET TTYOPT APPROPRIATELY
SIXBIT /HEIGHT/
MOVE O,D ; SCREEN HEIGHT
SIXBIT /WIDTH/
MOVE O,E ; SCREEN WIDTH
STYBLN==.-STYBLK
SUBTTL STY OUTPUT
; SHIPS BITS OUT TO THE STY. PRINTS UNTIL HAS SENT ACTIVATION OR INTERRUPT
; CHARACTER; THE PRINTING MAY BE BROKEN BY THE OCCURRENCE OF CARRIAGE RETURNS
; (WHICH GET TURNED INTO JUST CR INSTEAD OF CRLF), COMMANDS, AND SUCH.
; DATA STRUCTURE IS A LINKED LIST:
; OUTTYP ; TYPE OF INPUT SOURCE--FILE, STRING IN JCL, ETC.
; OUTNXT ; NEXT BLOCK OR 0
; OUTLEN ; # OF CHARACTERS AVAILABLE HERE
; OUTPTR ; BYTE POINTER TO NEXT AVAILABLE CHARACTER
; THE ROUTINE FOR DETERMINING WHETHER A CHARACTER IS AN ACTIVATION/INTERRUPT
; CHAR IS STOLEN MORE OR LESS DIRECTLY FROM THE SYSTEM.
SNDSTR: PUSH P,O
PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,E
PUSH P,F
PUSH P,U
.CALL [SETZ
SIXBIT /TTYGET/
MOVEI STYO
MOVEM STYST1
SETZM STYST2]
.LOSE %LSSYS ; GET THE BITS FOR THE TTY
.CALL [SETZ
SIXBIT /STYGET/
MOVEI STYO
MOVEM B
MOVEM B ; OWNER OF TTY
MOVEM C
SETZM C] ; STY STATUS
.LOSE %LSSYS
SKIPN A,JOBFRC ; CHECKING JOB HACK?
JRST SNCONS
CAME A,B ; SAME JOB?
ERROR [ASCIZ /Job changed when not allowed./]
; THE FOLLOWING IS MAINLY FOR PUB, GOD HELP IT.
SNCONS: TLNE C,400000
JRST SNCONT ; WANTS INPUT, SO GO
AOJE B,SNCONT ; NOT LOGGED IN YET, SO FEED IT THE CTRL-Z
MOVEI U,-1(B)
IMUL U,LUBLK
MOVE A,@UPC
TLNE A,%PCUSR
JRST SNDOUT ; IN USER MODE, SO DOESN'T REALLY CARE
MOVE A,@LSUUO
CAME A,[.HANG] ; PUB WOULD BE IN .HANG IF IT WANTED INPUT
JRST SNDOUT ; LAST UUO NOT HANG, SO NOT WAITING FOR ANYTHING
SNCONT: PUSHJ P,SNSTRT ; INITIALIZE O AND F
SNDLOP: PUSHJ P,SNGCHR ; PICK UP A CHAR IN A
CAMN A,ESCAPE ; COMMAND STARTER?
JRST SNDCOM ; GO PROCESS A COMMAND
SNDLP1: ADDI O,1 ; # CHARS TO SEND
SKIPE CTRLM
JRST [SETZM CTRLM ; IF LAST WAS CTRLM, CTRL-J IS NO-OP
CAIE A,^J
JRST .+1
MOVEI B,0
JRST SNDACT]
CAIN A,^M
SETOM CTRLM
PUSHJ P,GETGRP ; GET TYPE OF CHAR IN B, CLOBBERING C & D
SNDACT: TRNN B,%TGACT+%TGINT ; ACTIVATES OR INTERRUPTS?
JRST SNDLOP ; NO, GO DO THE NEXT ONE
PUSHJ P,SENDIT ; DO THE SEND--COUNT IN O, BPTR IN OUTPTR(E)
SKIPE FORCSW ; FORCING?
JRST SNDLOP ; GO SEND SOME MORE
SNDOUT: POP P,U
POP P,F
POP P,E
POP P,D
POP P,C
POP P,B
POP P,A
POP P,O
POPJ P,
; INTERFACE FOR COMMANDS IN FILE
SNDCOM: PUSHJ P,SENDIT ; SEND OUT WHAT WE HAVE
PUSHJ P,SNSTRT ; RESET O AND F
PUSHJ P,SNGCHR ; GET COMMAND INTO A
MOVEM F,OUTPTR(E) ; SAVE F AWAY
SETZM FORCTM ; SAVE STATE OF FORCSW
SKIPE FORCSW
SETOM FORCTM
SKIPE ECHOQ ; ECHO AREA EXISTS?
JRST [OCTLP ECHO,"C ; CLEAR
OASC ECHO,[ASCIZ /Command: /]
JRST .+1]
PUSHJ P,COMND
PUSHJ P,SNGLIN ; INSTRUCTION TO GET A LINE
PUSHJ P,SNGPRT ; INSTRUCTION TO DO OUTPUT
JRST SNDOUT ; FLUSH FROM HERE IF COMND DIDN'T SKIP
SKIPN FORCTM ; WAS FORCSW FORMERLY ON?
JRST SNCONT ; NO, RETURN TO LOOP
SKIPE FORCSW ; DID ITS STATE JUST CHANGE?
JRST SNCONT ; NO, RETURN TO LOOP
JRST SNDOUT ; YES, FLUSH IMMEDIATE
; ROUTINE TO GET A LINE OF TEXT FOR THE COMMAND READER. RETURN LENGTH
; IN A, POINTER IN B. ALWAYS SKIPS
SNGLIN: PUSH P,O
PUSH P,C
PUSH P,E
PUSH P,F
PUSHJ P,SNSTRT ; SET UP O AND F
MOVE B,[440700,,TTYBUF]
SNGLLP: PUSHJ P,SNGCHR
CAIN A,^M
JRST SNGLCR ; ENCOUNTERED CR
IDPB A,B
AOJA O,SNGLLP ; GET THE NEXT CHAR
SNGLCR: MOVEI A,0
IDPB A,B ; MAKE IT ASCIZ
PUSHJ P,SNGCHR ; THROW AWAY THE LINEFEED
MOVEM F,OUTPTR(E) ; AND UPDATE THE CURRENT SOURCE
MOVEI A,TTYBUF
PUSHJ P,SNGPRT ; PRINT IF APPROPRIATE
MOVE A,O
MOVE B,[440700,,TTYBUF]
POP P,F
POP P,E
POP P,C
POP P,O
AOS (P)
POPJ P,
; CALL WITH POINTER TO ASCIZ IN A, DUMP OUTPUT TO SUITABLE PLACE.
SNGPRT: SKIPN ECHOQ
POPJ P,
OASC ECHO,(A)
POPJ P,
; INITIALIZE O, E, AND F FOR SENDING ROUTINE
SNSTRT: SKIPN E,INPSRC
ERROR [ASCIZ /Requesting input when none available./]
MOVEI O,0
MOVE F,OUTPTR(E)
POPJ P,
; GET A CHARACTER FROM THE INPUT SOURCE INTO A. SEND CURRENT STUFF IF
; HAVE TO CHANGE INPUT SOURCE.
SNGCHR: SOSGE OUTLEN(E) ; ANY LEFT IN THIS SOURCE?
JRST SNGMOR ; NO, GET MORE
ILDB A,F
AOS OUTRED(E)
POPJ P,
SNGMOR: PUSHJ P,SENDIT ; SEND OUT CURRENT STUFF
MOVE A,OUTTYP(E) ; TYPE
CAIE A,$TFILE ; A FILE?
JRST SNGNXT ; NO, SO GET NEXT ONE
SKIPN FILOPQ ; IS THE FILE OPEN?
JRST SNGNXT ; NO
PUSHJ P,FILNXT
MOVEM C,OUTPTR(E)
MOVEM B,OUTLEN(E)
SNGCON: PUSHJ P,SNSTRT
JRST SNGCHR ; TRY IT NOW
; HERE IF THE CURRENT SOURCE IS EXHAUSTED.
SNGNXT: PUSH P,B
PUSH P,C
SNGNX1: SKIPN A,OUTNXT(E)
JRST SNGTOT ; NOTHING HERE
MOVE B,OUTTYP(A)
CAIE B,$TFILE ; FILE?
JRST [MOVE B,OUTLEN(A)
MOVEM B,OUTTLN(A) ; SET UP TOTAL LENGTH FOR TEXT
JRST SNGTOT]
PUSHJ P,FILOPN ; TRY TO OPEN IT
ERROR 1,(A) ; LOST
.CALL [SETZ
SIXBIT /FILLEN/
MOVEI DSKI
SETZM OUTTLN(A)]
.LOSE %LSSYS
PUSHJ P,FILNXT
MOVEM C,OUTPTR(A)
MOVEM B,OUTLEN(A)
SNGTOT: MOVEM A,INPSRC
POP P,C
POP P,B
JRST SNGCON ; TRY AGAIN
; HERE TO SHIP A STRING OUT. LENGTH IS IN O, BPTR IS IN OUTPTR(E).
; ALSO UPDATES OUTPTR(E), WHICH WILL CONTAIN THE CONTENTS OF F WHEN
; WE'RE DONE. STORES SOME STUFF IN LSTOUT AND LSTLEN FOR CTRL-T.
SENDIT: EXCH F,OUTPTR(E)
JUMPE O,CPOPJ
PUSH P,A
PUSH P,B
MOVE A,F
TLNN A,760000
ADDI A,1
HRLS A
HRRI A,LSTOUT
BLT A,LSTOUT+LSTOLN-1 ; BLT 3 WORDS
MOVE A,F
HRRI A,LSTOUT
MOVEM A,LSTPTR ; SAVE BPTR
MOVEM O,LSTLEN ; AND LENGTH
POP P,B
POP P,A
.CALL [SETZ
SIXBIT /SIOT/
MOVEI STYO
F
SETZ O]
.LOSE %LSSYS
SETOM ERESET ; ERROR STRINGS WILL BE RESET
POPJ P,
SUBTTL FILE HACKERS
; OPEN FILE DESCRIBED IN (A): LENGTH OF NAME IS OUTLEN(A), POINTER IS OUTPTR(A).
; SKIP IF FILE EXISTS.
FILOPN: PUSH P,A
PUSH P,B
SETZM FN1+FILFIL
SETZM FN2+FILFIL
MOVE B,OUTLEN(A)
MOVE A,OUTPTR(A)
PUSHJ P,FILPRS
FILFDF,,FILFIL
.CALL [SETZ
SIXBIT /OPEN/
[.UAI,,DSKI]
DEV+FILFIL
FN1+FILFIL
FN2+FILFIL
SETZ SNM+FILFIL]
JRST FILPOP
AOS -2(P)
SETOM FILOPQ ; HAVE SOMETHING OPEN
FILPOP: POP P,B
POP P,A
CPOPJ: POPJ P,
; PARSE A FILE NAME. POINTER IS IN A, LENGTH IN B, BLOCK TO USE IS
; @(P)
FILPRS: PUSH P,C
PUSH P,D
PUSH P,E
PUSH P,F
MOVEI E,0
MOVE F,@-4(P)
HLRM F,CDEFAU
SETZM DEV(F)
SETZM SNM(F)
SETZM FN1(F)
SETZM FN2(F) ; ZERO THE SLOTS
AOS -4(P)
FILOLP: MOVE C,[440600,,E]
FILOL1: ILDB D,A
CAIN D,":
JRST [JUMPE E,FILOLE ; DON'T STORE NULL NAME
MOVEM E,DEV(F)
MOVEI E,0
JRST FILOLE]
CAIN D,";
JRST [JUMPE E,FILOLE
MOVEM E,SNM(F)
MOVEI E,0
JRST FILOLE]
CAIE D,40
CAIN D,^I
JRST FILFLD
CAIN D,^J
JRST FILFLD
TLNN C,770000 ; WORD ALREADY FULL?
JRST FILOLE ; IGNORE THIS CHAR
SUBI D,40
CAIL D,100
SUBI D,40
IDPB D,C ; STUFF IT IN
SOJG B,FILOL1
FILOUT: PUSHJ P,FILFL1
; FILL IN THE DEFAULTS AND SUCH
MOVE E,CDEFAU
HRLI E,-4
FILDEF: PUSHJ P,DEFHAK
ADDI F,1
AOBJN E,FILDEF
POP P,F
POP P,E
POP P,D
POP P,C
POPJ P,
FILOLE: SOJLE B,FILOUT ; RAN OUT OF CHARACTERS
JRST FILOLP
DEFHAK: SKIPE (F) ; NEED SOMETHING FROM DEFAULT
JRST [MOVE C,(F)
MOVEM C,(E)
POPJ P,]
MOVE C,(E)
MOVEM C,(F)
POPJ P,
; HERE WITH EITHER FN1 OR FN2 IN E
FILFL1: JUMPE E,CPOPJ
PUSH P,A
SKIPN FN1(F)
JRST [MOVEM E,FN1(F)
JRST FILFL2]
MOVEM E,FN2(F)
FILFL2: MOVEI E,0
POP P,A
POPJ P,
; HERE WITH FN1 OR FN2 IN E, TERMINATED BY SPACE OR SOMETHING
FILFLD: PUSHJ P,FILFL1
JRST FILOLE
; COME HERE TO OPEN FILE PARSED INTO OUTFIL, SET PARAMETERS APPROPRIATELY.
OUTHCK: PUSH P,A
PUSH P,B
.CALL [SETZ ; DO THE OPEN
SIXBIT /OPEN/
[.UAO,,OUTCHN]
DEV+OUTFIL
FN1+OUTFIL
FN2+OUTFIL
SETZ SNM+OUTFIL]
.LOSE %LSFIL
OUTHAK: .STATUS OUTCHN,A
JUMPE A,[SETZM DSKCHN ; OUTCHAN DOESN'T LOOK LIKE DSK
SETZM DSKOUT ; DOESN'T EXIST
SKIPN TTYSRC
SETOM NULOUT ; IF INPUT ISN'T FROM TTY, THERE'S NO OUTPUT
JRST OUTHCO]
SETOM DSKCHN
ANDI A,77 ; ISOLATE DEVICE
CAIE A,SNTTY
CAIN A,SNTDS ; TTY AND DISPLAY TTY AREN'T DISK-LIKE
SETZM DSKCHN
CAIN A,SNSTY
SETZM DSKCHN ; NOR IS STY
SETZM NULOUT
SETOM DSKOUT
SKIPN TTYQ ; HAVE WE OPENED TTY?
JRST OUTHCO ; NO, SO DON'T DO SCML
MOVEI B,2
CAIE A,SNTDS
MOVEI B,0
.CALL [SETZ ; SET UP ECHO AREA IF OUTPUT IS TO DISPLAY TTY
SIXBIT /SCML/
MOVEI ECHO
SETZ B]
.LOSE %LSSYS
MOVEM B,ECHOQ ; B IS 0 IF THERE'S NO ECHO AREA
OUTHCO: POP P,B
POP P,A
POPJ P,
; HERE TO SET ALL THE SWITCHES WITHOUT OPENING THE CHANNEL
OUTHC1: PUSH P,A
PUSH P,B
JRST OUTHAK
; GET BUFFER AT LEAST PARTIALLY FULL OF CRUFT. SKIP IF ANYTHING. CLOSE
; DSKI IF THROUGH WITH IT, AND CLEAR FLAG. RETURN LENGTH OF BUFFER IN B,
; POINTER IN C.
FILNXT: SKIPN FILOPQ
JRST CPOPJ ; FLUSH IMMEDIATE
MOVEI B,5*DBUFLN
MOVE C,[010700,,DSKBUF-1] ; SO FLUSHING OF PADDING WILL WORK RIGHT
.CALL [SETZ
SIXBIT /SIOT/
MOVEI DSKI
C
SETZ B]
.LOSE %LSSYS
JUMPE B,FILNXO ; FULL BUFFER
.CLOSE DSKI, ; DIDN'T GET BUFFER FULL, SO DONE
SETZM FILOPQ
PUSH P,A ; ADJUST FOR PADDING
PUSH P,D
MOVEI D,4
PADLOP: LDB A,C
CAIN A,C
JRST [DBP C ; BACK UP THE BPTR
ADDI B,1 ; AOSING HERE SOSES LATER
SOJG D,PADLOP
JRST .+1]
POP P,D
POP P,A
FILNXO: SUBI B,5*DBUFLN
MOVNS B ; GET # CHARS
JUMPE B,CPOPJ ; NONE HERE
MOVE C,[440700,,DSKBUF]
POPJ P,
SUBTTL GET CHARACTER GROUP
; GETS BYTE IN B, GROUP NUMBER IN C, BYTE POINTER IN D; TAKES CHAR IN A
; USED BY SNDSTR
GETGRP: PUSH P,E
PUSH P,A
MOVE B,A
IDIVI B,5
POP P,A
LDB C,GRPBPT(C) ; GET GROUP BITS
MOVEI D,STYST1
CAIL C,6
JRST GETGR2
LDB E,[301400,,SBTBL(C)] ; LOAD LH OF BYTE PTR
GETGR1: DPB E,[301400,,D] ; MAKE TTYST1 OR TTYST2 APPROPRIATE BYTE POINTER
LDB B,D
POP P,E
POPJ P,
GETGR2: LDB E,[301400,,SBTBL-6(C)]
MOVEI D,STYST2
JRST GETGR1
SBTBL: 360600,,
300600,,
220600,,
140600,,
060600,,
000600,,
DEFINE GGRPTB A,B,C,D,E
A_29.+B_22.+C_15.+D_8+E_1
TERMIN
GRPTBL: GGRPTB 0,0,0,0,0
GGRPTB 0,0,6,13,7
GGRPTB 7,0,0,11,0
GGRPTB 0,0,0,0,6
GGRPTB 0,0,0,0,0
GGRPTB 0,0,10,0,0
GGRPTB 0,0,13,3,3
GGRPTB 3,3,3,3,3
GGRPTB 5,5,4,4,3
GGRPTB 4,3,4,2,2
GGRPTB 2,2,2,2,2
GGRPTB 2,2,2,3,3
GGRPTB 5,4,5,3,3
REPEAT 5,GGRPTB 1,1,1,1,1
GGRPTB 1,5,3,5,4
GGRPTB 4,3,1,1,1
REPEAT 4,GGRPTB 1,1,1,1,1
GGRPTB 1,1,1,5,3
GGRPTB 5,3,12,0,0
GRPBPT: 350700,,GRPTBL(B)
260700,,GRPTBL(B)
170700,,GRPTBL(B)
100700,,GRPTBL(B)
010700,,GRPTBL(B)
SUBTTL STY INPUT
; COME HERE TO GOBBLE CHARACTERS FROM THE STY INPUT CHANNEL AND
; SEND THEM TO THE APPROPRIATE OUTPUT DEVICE(S). NOTE THAT THE
; STY'S TTY IS A SOFTWARE TTY, SO WE READ IN 8-BIT BYTES AND CONVERT
; WHERE REQUIRED. READ UNTIL OUT OF CHARACTERS.
RECSTR: PUSH P,O
PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
MOVE C,[440700,,INPBU1]
MOVEI D,5*INBLEN
RECNXT: MOVEI B,0 ; SO RECGET WILL READ
RECLOP: PUSHJ P,RECGET ; GET A CHAR
JRST RECPRT ; NONE LEFT
SKIPE NULOUT ; THROW AWAY SOME INPUT
JRST RECLPP
CAILE O,177 ; ASCII?
JRST RECDSP ; HACK FOR DISPLAY CODES
AOS STHPOS ; UPDATE HORIZONTAL POSITION
RECLPP: PUSHJ P,RECPUT ; STUFF INTO OUTPUT, PRINT IF FULL
JRST RECLOP ; GET THE NEXT ONE
RECPRT: SKIPE NULOUT
JRST RECPR1 ; NUL OUTPUT, SO FLUSH
PUSHJ P,RECBUO ; PRINT BUFFER TO APPROPRIATE PLACES
RECPR1: MOVE B,CINPLN
CAIL B,4*INBLEN
JRST RECNXT ; GOT FULL BUFFER, SO TRY AGAIN
RECOUT: POP P,D
POP P,C
POP P,B
POP P,A
POP P,O
POPJ P,
; READ CHARS FROM STY. RETURN # READ IN B, POINTER TO INPBUF IN A
RECDOR: MOVE A,[440800,,INPBUF]
MOVEI B,4*INBLEN
.CALL [SETZ
SIXBIT /SIOT/
MOVEI STYI
A
SETZ B]
.LOSE %LSSYS
SUBI B,4*INBLEN
MOVNS B ; # CHARS READ
MOVE A,[440800,,INPBUF]
POPJ P,
; GET A CHARACTER FROM STY BUFFER. CURRENT LENGTH IN B, POINTER IN A.
; SKIP IF SUCCESSFUL.
RECGET: JUMPE B,RECMOR
RECGT1: ILDB O,A
SOJA B,POPJ1 ; SOS COUNT, RETURN
RECMOR: PUSHJ P,RECDOR ; READ A BUFFER FULL
JUMPE B,CPOPJ ; NONE LEFT
MOVEM B,CINPLN
JRST RECGT1
POPJ1: AOS (P) ; SKIP IF GOT A CHAR
POPJ P,
; SOME ROUTINES MAY COME HERE IF RECGET DOESN'T SKIP, TO SEE IF THE LOSSAGE
; IS TRANSIENT. ALGORITHM IS SUBJECT TO CHANGE WITHOUT NOTICE.
INPERR: MOVEI O,30.
.SLEEP O, ; SLEEP FOR A SECOND, TO LET THINGS SETTLE
PUSHJ P,RECGET ; CAN WE WIN IMMEDIATE?
JRST RECER1
POPJ P, ; YES, RETURN
RECER1: PUSH P,A
PUSH P,B
.CALL [SETZ
SIXBIT /STYGET/
MOVEI STYO
MOVEM A
MOVEM A
MOVEM A
MOVEM A
SETZM B]
.LOSE %LSSYS
JUMPL A,RETRY1 ; JUMP IF OUTPUT CLAIMS TO BE AVAILABLE
TLNN B,200000 ; SKIP IF OUTPUT BUFFER HAS ROOM
JRST RETRY2 ; NO ROOM?
; OUTUT BUFFER HAS ROOM, NO OUTPUT AVAILABLE. WE ARE REALLY CHOMPING.
POP P,B
POP P,A
PUSHJ P,RECGET ; LAST CHANCE
CAIA
POPJ P, ; WON, SOMEHOW
ERROR 2,[ASCIZ /Ran out of chars during cursor positioning command./]
.VALUE ; SORRY, AS.
POPJ P,
; HERE IF OUTPUT IS AVAILABLE (GOSPEL ACCORDING TO STYGET)
RETRY1: TLNN B,200000 ; ROOM IN OUTPUT BUFFER?
JRST [POP P,B
POP P,A
PUSHJ P,RECGET
CAIA
POPJ P,
ERROR 2,[ASCIZ /Chars here, no room in buffer, but I can't get any?/]
.VALUE
POPJ P,]
POP P,B
POP P,A
PUSHJ P,RECGET ; GET IT
CAIA
POPJ P, ; GOT IT
ERROR 2,[ASCIZ /STYGET says chars here when there aren't any./]
.VALUE
POPJ P,
; HERE IF NO ROOM IN OUTPUT BUFFER, BUT NO CHARS AVAILABLE
RETRY2: POP P,B
POP P,A
PUSHJ P,RECGET
CAIA
POPJ P, ; GOT OUTPUT ANYWAY
ERROR 2,[ASCIZ /No room in buffer, but no chars available./]
.VALUE
POPJ P,
; PUT CHARACTER IN O INTO OUTPUT BUFFER (IN C). PRINT BUFFER IF BECOMES FULL
; (COUNT IS IN D) AND DON'T SKIP;
; RECPUT CHECKS FOR ERRORS, RECPU1 DOESN'T
RECPU1: PUSH P,A
IDPB O,C
SETOM ERESET
SOJG D,POPAJ
JRST RECPPR
RECPUT: PUSH P,A
IDPB O,C
SUBI D,1
SKIPE A,ERRORS ; ERRORS TO LOOK FOR?
PUSHJ P,RECERR
JUMPG D,POPAJ
RECPPR: PUSHJ P,RECBUO ; GO PRINT BUFFER
MOVE C,[440700,,INPBU1]
MOVEI D,5*INBLEN
POPAJ: POP P,A
POPJ P,
; HERE TO CHECK FOR ERROR STRINGS
RECERR: SKIPE TTYSRC
POPJ P, ; DON'T CHECK IF TTY INPUT
SKIPE ERESET
PUSHJ P,RECRST ; RESET EVERYBODY
SETZM ERESET
PUSH P,B
RECELP: SKIPG EMATLN(A)
JRST RECELE ; ALREADY MATCHED?
ILDB B,EMATCH(A)
CAIN O,(B)
JRST [SOSE EMATLN(A) ; ALL OUT?
JRST RECELE ; NO
PUSHJ P,RECBUO
MOVE C,[440700,,INPBU1]
MOVEI D,5*INBLEN
ERROR [ASCIZ /ERROR string found./]
JRST .+1]
MOVE B,ESTRING(A)
MOVEM B,EMATCH(A) ; RESET, SINCE DIDN'T MATCH
MOVE B,ELENGTH(A)
MOVEM B,EMATLN(A)
RECELE: SKIPE A,ENEXT(A)
JRST RECELP ; GO TO NEXT
POP P,B
POPJ P,
; RESET ALL ERROR BLOCKS
RECRST: PUSH P,B
RECRSL: MOVE B,ESTRING(A)
MOVEM B,EMATCH(A)
MOVE B,ELENGTH(A)
MOVEM B,EMATLN(A)
SKIPE A,ENEXT(A)
JRST RECRSL
MOVE A,ERRORS
POP P,B
POPJ P,
; HERE TO PRINT OUTPUT BUFFER TO SUITABLE PLACES. # OF CHARACTERS LEFT
; IS IN D. MAY CLOBBER C AND D.
RECBUO: SKIPE NULOUT
POPJ P, ; NO OUTPUT, SO FLUSH
SUBI D,5*INBLEN
MOVNS D ; # CHARACTERS
JUMPE D,CPOPJ
PUSH P,D
SKIPN DSKOUT ; NORMAL OUTPUT?
JRST TTYCHK
SKIPE TTYSRC
JRST [SKIPN DSKCHN ; IF INPUT FROM TTY, MAY NOT WANT TO OUTPUT
JRST TTYCHK
JRST .+1]
MOVE C,[440700,,INPBU1]
.CALL [SETZ
SIXBIT /SIOT/
MOVEI OUTCHN
MOVSI %TJDIS
C
SETZ D]
.LOSE %LSSYS
TTYCHK: POP P,D
SKIPN TTYSRC ; IN TTY INPUT?
POPJ P,
MOVE C,[440700,,INPBU1]
.CALL [SETZ
SIXBIT /SIOT/
MOVEI TTYO
MOVSI %TJDIS ; DISPLAY MODE
C
SETZ D]
.LOSE %LSSYS
POPJ P,
; JRST HERE TO TURN DISPLAY CODE INTO SUITABLE CHARACTERS FOR OUTPUT.
; IF DOES PRINTING, JRSTS TO RECPR1, ELSE TO RECLOP.
; CHARACTER IS IN O; A, B, C,D MUST NOT BE TOUCHED.
RECDSP: TRZ O,200
ASH O,1 ; MULTIPLY BY 2
ADDI O,DSPTBL+1
ADD O,DSKCHN ; OUTPUT TO DISK? (VAL IS 0 OR -1)
PUSH P,E
SKIPL E,@O ; IF TABLE ENTRY < 0, POINTER TO ASCIZ STRING
JRST [PUSHJ P,(E)
JRST RECDOT]
HRLI E,440700
RECDLP: ILDB O,E
JUMPE O,RECDOT
PUSHJ P,RECPU1 ; DON'T CHECK FOR ERROR STRINGS
AOS STHPOS ; UPDATE HORIZONTAL POSITION
JRST RECDLP
RECDOT: POP P,E
JRST RECLOP
; SPECIAL ROUTINES FOR HAIRY CRAP
; %TDMOV, FOLLOWED BY %TDMVO, FOR TTY OUTPUT
RTDMOV: PUSHJ P,RECGET
PUSHJ P,INPERR
PUSHJ P,RECGET ; OLD POSITION
PUSHJ P,INPERR
RTDMVO: MOVEI E,"V
PUSHJ P,CP1ARG
MOVEI E,"H
PUSHJ P,CP1ARG
POPJ P,
CP1ARG: MOVEI O,^P ; TAKES LETTER IN A, PUTS ^P<arg><num>
PUSHJ P,RECPU1 ; IN STRING, WHERE <num> IS 8+next input char
MOVEI O,(E)
PUSHJ P,RECPU1
PUSHJ P,RECGET
PUSHJ P,INPERR
ADDI O,10
PUSHJ P,RECPU1
POPJ P,
; %TDMOV &C FOR FILE OUTPUT
RTDMVD: PUSH P,F
MOVE F,STVPOS
MOVE E,STHPOS
JRST RTDMV1
RTDMOD: PUSH P,F
PUSHJ P,RECGET ; OLD VERTICAL POS
PUSHJ P,INPERR
MOVE F,O
PUSHJ P,RECGET ; OLD HORIZONTAL POS
PUSHJ P,INPERR
MOVE E,O
RTDMV1: PUSHJ P,RECGET ; NEW VERTICAL POS
PUSHJ P,INPERR
MOVEM O,STVPOS
SUBM O,F ; CHANGE IN VERTICAL POS
CAIGE F,0
ADD F,STHIGH ; IF <0, ADD HEIGHT
JUMPE F,RTDMVH
CAILE F,3
MOVEI F,3 ; LEAVE US NOT BE RIDICULOUS
MOVEI E,0 ; SINCE DOING CR'S, HPOS WILL BE ZERO
RTDCRL: MOVEI O,^M
PUSHJ P,RECPU1
MOVEI O,^J
PUSHJ P,RECPU1
SOJG F,RTDCRL ; STUFF OUT SUITABLE CRLFS
RTDMVH: PUSHJ P,RECGET ; NEW HORIZONTAL POS
PUSHJ P,INPERR
MOVEM O,STHPOS
CAIG O,(E) ; > THAN OLD?
JRST RTDMDN ; NO, LEAVE
SUBM O,E
RTDSPL: MOVEI O,40
PUSHJ P,RECPU1
SOJG E,RTDSPL
RTDMDN: POP P,F
POPJ P,
; CRLF FOR FILE OUTPUT
RTDNWL: MOVEI O,^M
PUSHJ P,RECPU1
MOVEI O,^J
PUSHJ P,RECPU1
AOS E,STVPOS
CAIL E,STHIGH
SETOM STVPOS ; ZERO VERTICAL POSITION ON WRAPAROUND
SETZM STHPOS
POPJ P,
RTDCLR: SETOM STVPOS ; SO VERTICAL POSITION WORKS
PUSHJ P,RTDNWL
POPJ P,
; %TDNOP, %TDMV1, %TDMTF, %TDMTN, %TDBS, %TDLF, %TDRCR, %TDORS, %TDQOT
RTDNOP: POPJ P,
; %TDILP, %TDDLP, %TDICP, %TDDCP
RTDILP: MOVEI E,"[ ; INSERT LINE
JRST RTDXXX
RTDDLP: MOVEI E,"\
JRST RTDXXX
RTDICP: MOVEI E,"^
JRST RTDXXX
RTDDCP: MOVEI E,"_
RTDXXX: PUSHJ P,RECGET ; GET NUMBER TO DO
PUSHJ P,INPERR
JUMPLE O,CPOPJ
PUSH P,F
MOVE F,O
RTDXXL: MOVEI O,^P
PUSHJ P,RECPU1
MOVE O,E
PUSHJ P,RECPU1
SOJG F,RTDXXL
POP P,F
POPJ P,
; TABLE FOR DISPLAY CODES
DSPTBL: RTDMOD
RTDMOV ; %TDMOV--200
RTDNOP
RTDNOP ; %TDMV1--201
RTDNOP
SETZ [ASCIZ /E/] ; %TDEOF--202
RTDNOP
SETZ [ASCIZ /L/] ; %TDEOL--203
RTDNOP
SETZ [ASCIZ /K/] ; %TDDLF--204
RTDNOP
RTDNOP ; %TDMTF--205
RTDNOP
RTDNOP ; %TDMTN--206
RTDNWL
SETZ [ASCIZ /
/] ; %TDCRL--207
RTDNOP
RTDNOP ; %TDNOP--210
RTDNOP
RTDNOP ; %TDBS--211
RTDNOP
RTDNOP ; %TDLF--212
RTDNOP
RTDNOP ; %TDRCR--213
RTDNOP
RTDNOP ; %TDORS--214
RTDNOP
RTDNOP ; %TDQOT--215
SETZ [ASCIZ / /]
SETZ [ASCIZ /F/] ; %TDFS--216
RTDMVD
RTDMVO ; %TDMVO--217
RTDNWL
SETZ [ASCIZ /C/] ; %TDCLR--220
SETZ [ASCIZ //]
SETZ [ASCIZ //] ; %TDBEL--221
RTDNOP
RTDNOP ; %TDINT--222
RTDILP
RTDILP ; %TDILP--223
RTDDLP
RTDDLP ; %TDDLP--224
RTDICP
RTDICP ; %TDICP--225
RTDDCP
RTDDCP ; %TDDCP--226
RTDNOP
RTDNOP ; %TDBOW--227
RTDNOP
RTDNOP ; %TDRST--230
SUBTTL JCL PARSER
JCLHAK: .SUSET [.ROPTIO,,A]
TLNE A,OPTCMD
.BREAK 12,[..RJCL,,JCLBUF]
IBLOCK C,OUTBLK ; GET AN INITIAL BLOCK
MOVEM C,INPSRC
PUSHJ P,JCLFST ; GET STRING foo0U:GAG 0<CR>
MOVEM A,OUTLEN(C)
MOVEM B,OUTPTR(C)
MOVE A,[440700,,JCLBUF]
PUSH P,A
JCLLP1: MOVEI B,0
JCLLOP: MOVEM A,(P)
ILDB O,A
CAIE O,40
CAIN O,^I
JRST JCLLOP
CAIA
JCLLNX: ILDB O,A
CAIE O,"/
CAIN O,"[
JRST JCLFLD ; END A FILE NAME
CAIE O,",
CAIN O,"\
JRST JCLFLD
CAIE O,^C
CAIN O,^M
JRST JCLFLD
JUMPE O,JCLFLD
CAIN O,"_
JRST JCOUTF ; OUTPUT FILE
AOJA B,JCLLNX
JCLFLD: JUMPE B,JCLFL1
IBLOCK D,OUTBLK
MOVEM D,OUTNXT(C) ; CHAIN BLOCKS
MOVEM B,OUTLEN(D)
POP P,OUTPTR(D)
MOVEI B,$TFILE
MOVEM B,OUTTYP(D)
MOVE C,D
MOVEI B,0
PUSH P,A
JCLFL1: CAIE O,^C
CAIN O,^M
JRST JCLDON
JUMPE O,JCLDON
CAIN O,",
JRST JCLLOP
CAIN O,"\
JRST JCLTTY
CAIN O,"[
JRST JCLTXT
CAIN O,"/
JRST JCLSW
.VALUE
JCLTTY: IBLOCK D,OUTBLK
MOVEI B,$TTEXT
MOVEM B,OUTTYP(D)
MOVE B,[440700,,[ASCII /B/]]
MOVEM B,OUTPTR(D)
MOVEI B,2
MOVEM B,OUTLEN(D)
MOVEM D,OUTNXT(C)
MOVE C,D
MOVEI B,0
JRST JCLLOP
JCLSW: ILDB O,A
CAIE O,"P
CAIN O,"p
SETOM PRSW ; SUPPRESS FANCY HACKING W/ STY
CAIE O,"E
CAIN O,"e
SETOM CNSFLS ; DIE IF ERROR WITH NO TTY
CAIE O,"S
CAIN O,"s
JRST [MOVEI O,360. ; TRY 360. TIMES TO OPEN (EVERY 10 SEC)
MOVEM O,STYTRY
JRST JCLLOP]
JRST JCLLOP
JCLTXT: PUSH P,C
MOVEM A,-1(P)
MOVNI B,1
PUSHJ P,STRGET ; NEW BPTR IN A, LEN IN B, PTR IN C
IBLOCK D,OUTBLK ; POINTER FOR CROCK
MOVEM C,OUTPTR(D)
MOVEM B,OUTLEN(D)
MOVEI B,$TTEXT
MOVEM B,OUTTYP(D)
POP P,C
MOVEM D,OUTNXT(C)
MOVE C,D
JRST JCLLP1
JCLDON: MOVEI A,LSTBLK
MOVEM A,OUTNXT(C) ; LSTBLK HAS STUFF TO LOG OUT
POP P,A
POPJ P,
; CONS UP STRING TO LOG IN, SAY :GAG 0. RETURN LENGTH IN A, PTR IN B.
JCLFST: PUSH P,C
PUSH P,D
PUSH P,E
PUSH P,F
IBLOCK B,4 ; MAXIMUM LENGTH IS 17. CHARS
HRLI B,440700
PUSH P,B
MOVEI A,1
MOVEI C,^Z
IDPB C,B ; STUFF OUT CTRL-Z
MOVE C,XUNAME
MOVE D,[440600,,C]
JCLUNM: TLNN D,770000
JRST JCLFS1
ILDB E,D
JUMPE E,JCLFS1
ADDI E,40
IDPB E,B
AOJA A,JCLUNM
JCLFS1: MOVE C,[440700,,[ASCIZ /0U:GAG 0
/]]
JCLFLP: ILDB D,C
JUMPE D,JCLFS2
IDPB D,B
AOJA A,JCLFLP
JCLFS2: POP P,B
POP P,F
POP P,E
POP P,D
POP P,C
POPJ P,
; OUTPUT FILE SPECIFICATION. LENGTH OF FILE SPEC IS IN B, POINTER
; TO FIRST CHAR IS (P). A MUST BE RESTORED, B ZEROED BEFORE RETURN.
JCOUTF: EXCH A,(P)
JUMPE B,JCOUTO
MOVE O,[SIXBIT /DSK/]
MOVEM O,DEV+OUTFDF
PUSHJ P,FILPRS ; PARSE A FILE NAME
OUTFDF,,OUTFIL ; INTO BLOCK STARTING HERE
PUSHJ P,OUTHCK ; SET PARAMETERS
MOVEI B,0
JCOUTO: MOVE A,(P)
JRST JCLLOP
; TAKE A STRING WITH '^foo' FOR CONTROL CHARACTERS, COPY IT SOMEPLACE
; AND SUBSTITUTE REAL CHARS. TAKES POINTER TO STRING IN A, -1 IN B
; IF ']' IS TERMINATOR FOR STRING. IF B >0, IT'S CHAR COUNT OF STRING.
; RETURNS UPDATED POINTER IN A, LENGTH IN B, STRING POINTER IN C.
STRGET: PUSH P,O
PUSH P,D
PUSH P,E
PUSH P,F
PUSH P,A ; SAVE ARGS
PUSH P,B
MOVEI B,0 ; ACCUMULATE CHAR COUNT
MOVE C,(P)
STRLP1: ILDB O,A
CAIN O,"]
JUMPL C,STRLE1
CAIN O,"^
JRST [IBP A
SOJA C,STRLD] ; EAT NEXT CHAR
CAIN O,^Q
JRST [SUBI C,1
ILDB O,A
JRST .+1]
STRLD: ADDI B,1
JUMPL C,STRLP1 ; IF C<0, ONLY ] TERMINATES
SOJG C,STRLP1
; # CHARS IS IN B, STRING PTR IS -1(P), TERM CONDITION IS (P)
STRLE1: PUSH P,B
ADDI B,1 ; MAKE SURE HAVE A CHAR AT END SO ASCIZ
IDIVI B,5
JUMPE C,.+2
ADDI B,1
IBLOCK B,(B) ; STORAGE FOR STRING
HRLI B,440700
PUSH P,B
MOVE C,-2(P) ; GET TERMINATING CONDITION BACK
MOVE A,-3(P) ; GET STRING BACK
STRLP2: ILDB O,A
CAIN O,"]
JUMPL C,STRLE2
CAIN O,"^
JRST STRCTL
CAIN O,^Q
JRST [SUBI C,1
ILDB O,A
JRST .+1]
STRDEP: IDPB O,B
JUMPL C,STRLP2
SOJG C,STRLP2
STRLE2: POP P,C ; NEW STRING
POP P,B ; LENGTH
SUB P,[2,,2]
POP P,F
POP P,E
POP P,D
POP P,O
POPJ P,
; HACKERY FOR CTRL CHARS
STRCTL: SUBI C,1
ILDB O,A
CAIN O,"?
JRST [MOVEI O,177
JRST STRDEP]
CAIL O,100
SUBI O,100
CAIL O,40
SUBI O,40
JRST STRDEP
SUBTTL COMMAND PARSER
; CALL COMND WITH A CHARACTER IN A (INDICATING WHICH COMMAND WE HAVE)
; AND TWO ARGUMENTS FOLLOWING THE CALL: THE FIRST IS AN INSTRUCTION
; USED TO GET A LINE OF TEXT (FOR COMMANDS WHICH TAKE THAT), RETURNING
; THE LENGTH IN A AND AN ILDB POINTER TO THE FIRST CHAR IN B; THE SECOND IS
; USED TO DO PRINTING, BY HAVING THE ADDRESS OF THE FIRST WORD OF AN
; ASCIZ STRING STUFFED INTO A--THUS OASC WILL NOT WORK.
; WHEN CALLED FROM SNDSTR, THE TWO ARGS ARE PUSHJ P,SNGLIN AND PUSHJ P,SNGPRT;
; WHEN CALLED FROM THE TTY INTERRUPT HANDLER, THEY ARE PUSHJ P,GETLIN
; AND PUSHJ P,TTYPRT.
; ROUTINES SKIP IF COMND SHOULD SKIP. FAILURE TO SKIP INDICATES THAT
; THE ROUTINE CALLING COMND SHOULD PROBABLY FLUSH IMMEDIATE (AS, FOR
; EXAMPLE, WHEN SNDSTR CALLS IT WITH THE 'B' COMMAND).
COMND: PUSH P,B
PUSH P,C
PUSH P,D
MOVE B,@-3(P) ; PICK UP FIRST ARG
MOVEM B,COMGLN
AOS -3(P)
MOVE B,@-3(P)
MOVEM B,COMPRT
AOS -3(P)
CAIN A,177 ; NULL COMMAND
JRST COMEXO ; EXIT VIA SKIP
CAME A,CTRLT ; QUOTED CTRL-T?
CAMN A,ESCAPE ; QUOTED ESCAPE?
JRST [.IOT STYO,A
JRST COMEXO]
CAIN A,"?
JRST COMINF ; PRINT INFO ON COMMANDS
CAIL A,"A
CAIL A,"z
JRST COMERR ; ILLEGAL COMMAND
CAIL A,"a
SUBI A,40
CAILE A,"Z
JRST COMERR ; ILLEGAL COMMAND
SUBI A,"A
ASH A,1
PUSHJ P,PRCOM ; PRINT COMMAND DESC
PUSHJ P,@COMTBL(A) ; EXECUTE COMMAND
CAIA ; COMMAND ROUTINES SKIP IF COMND SHOULD
COMEXO: AOS -3(P) ; STUFF THE CHARACTER OUT, WHATEVER IT WAS
COMEXD: POP P,D
POP P,C
POP P,B
POPJ P,
; PRINT COMMAND DESCRIPTION
PRCOM: PUSH P,A
MOVE A,COMTBL+1(A)
XCT COMPRT ; DO THE PRINT
POP P,A
POPJ P,
; PRINT BRIEF DESCRIPTION OF COMMANDS TO CONVENIENT PLACE
COMINF: SKIPE TTYSRC
JRST COMIN0
.CALL [SETZ
SIXBIT /OPEN/
[.UAO,,TTYO]
[SIXBIT /TTY/]
[SIXBIT /TTY/]
SETZ [SIXBIT /TTY/]]
.LOSE %LSFIL
COMIN0: OCTLP TTYO,"T
OCTLP TTYO,"L
OASCR TTYO,COMDSC ; PRINT DESCRIPTION
SKIPE TTYSRC
JRST COMEXO
.CLOSE TTYO,
JRST COMEXO
COMDSC: ASCIZ \Commands:
The intercept character is initially ctrl-^. Some commands may
request a line of text; in a file, this must be terminated by
crlf. From the tty, ctrl-Z and ctrl-_ may be given normally to
the 'Command:' prompt, since super-image input is turned off.
<escape char> Send escape character out on sty.
A Abort input source--flush current file/string
B Begin tty input. The state of the current file is saved.
C Change output file. Takes line containing new output file.
D DDT. Return to ddt.
E Error strings. Which output strings cause an error. May be
several, separated by commas.
F Force input. Text through the next 'F' command will be fed to
receiving job whether it wants it or not. Useful for PUB &c.
H Halt job. Sends control-Z out, begins tty input.
I Intercept character. Takes line containing new intercept.
J Undoes effect of 'R' command.
P Proced XXFILE.
Q Quit XXFILE.
R Remain in job. All input must go to the job which currently has
the tty, until a 'J' command has been given. Ignored if input
from tty.
S Stop tty input. Returns to whatever the source was before.
T Ctrl-T character. Takes line containing replacement for ^T.
V Valret string. Takes line and valrets it. Control characters,
including crlf, may be included by typing as <uparrow>-char:
crlf--^M.
Line editor: <rubout> erases a char; ctrl-W a word; ctrl-U, ctrl-X,
and ctrl-@ erase the entire line. Carriage return terminates.
Attempts to rubout past the beginning of the line abort the
command.\
; DISPATCH TABLE FOR COMMANDS
COMTBL: CABORT ; A--ABORT CURRENT INPUT SOURCE
[ASCIZ /Abort input source/]
CTTYB ; B--BEGIN TTY INPUT
[ASCIZ /Begin tty input/]
CCHANG ; C--CHANGE OUTPUT FILE (TAKES A LINE)
[ASCIZ /Change output file/]
CDDT ; D--RETURN TO SUPERIOR
[ASCIZ /DDT/]
CERROR ; E--SET ERROR STRINGS (TAKES A LINE)
[ASCIZ /Error strings/]
CFORCE ; F--FORCE INPUT
[ASCIZ /Force input/]
COMER1 ; G
[ASCIZ /Illegal command/]
CHALT ; H--HALT JOB
[ASCIZ /Halt job/]
CINTER ; I--SET INTERCEPT CHARACTER (TAKES A LINE)
[ASCIZ /Set intercept character/]
CNREMA ; J
[ASCIZ /Job may change/]
COMER1 ; K
[ASCIZ /Illegal command/]
COMER1 ; L
[ASCIZ /Illegal command/]
COMER1 ; M
[ASCIZ /Illegal command/]
COMER1 ; N
[ASCIZ /Illegal command/]
COMER1 ; O
[ASCIZ /Illegal command/]
CPROCE ; P--PROCED SELF
[ASCIZ /Proceed/]
CQUIT ; Q--QUIT
[ASCIZ /Quit/]
CREMAN ; R--DON'T CHANGE JOBS UNTIL J COMMAND
[ASCIZ /Remain in this job/]
CTTYE ; S--STOP TTY INPUT
[ASCIZ /Stop TTY input/]
CCTRLT ; T
[ASCIZ /'Ctrl-T' character/]
COMER1 ; U
[ASCIZ /Illegal command/]
CVALUE ; V
[ASCIZ /Valret string/]
COMER1 ; W
[ASCIZ /Illegal command/]
COMER1 ; X
[ASCIZ /Illegal command/]
COMER1 ; Y
[ASCIZ /Illegal command/]
COMER1 ; Z
[ASCIZ /Illegal command/]
; COMMANDS. ROUTINES MAY USE A, B, C, AND D WITHOUT PUSHING THEM.
; IF THE ROUTINE SKIPS, IT SHOULD PUT A CHARACTER IN A TO BE THE NEXT
; ONE SENT TO THE JOB. ROUTINES SHOULD USUALLY SKIP RETURN.
; ILLEGAL COMMAND
COMER1: JRST POPJ1
COMERR: OASC ECHO,[ASCIZ /Illegal command/]
JRST COMEXO
; ABORT CURRENT INPUT SOURCE--'A' COMMAND
CABORT: SKIPN A,INPSRC ; IS THERE ONE?
JRST POPJ1
SKIPN B,OUTNXT(A) ; CAN'T ABORT THE LAST ONE
JRST POPJ1
MOVEM B,INPSRC
JRST POPJ1
; START TTY INPUT--'B' COMMAND
CTTYB: SKIPE TTYSRC ; ALREADY STARTED?
JRST POPJ1 ; YES, SO FLUSH
PUSHJ P,SETTTY ; SET IT UP
OASC TTYO,[ASCIZ /Begin TTY input: /]
POPJ P, ; DON'T SKIP
; CHANGE OUTPUT FILE--'C' COMMAND
CCHANG: PUSHJ P,CPRMPT ; PRINT A PROMPT
XCT COMGLN ; GET A LINE INTO A AND B
JRST POPJ1
JUMPE A,CCHFLS ; 0-LENGTH INPUT-->FLUSH OUTPUT CHANNEL
EXCH A,B ; SHUFFLE THE AC'S
PUSHJ P,FILPRS
OUTFDF,,OUTFIL ; PARSE THE NAME INTO OUTFIL
PUSHJ P,OUTHCK ; SET EVERYTHING UP PROPERLY
JRST POPJ1
CCHFLS: .CLOSE OUTCHN,
PUSHJ P,OUTHC1 ; HACK ALL THE SWITCHES
JRST POPJ1
; PRINT A PROMPT.
CPRMPT: MOVEI A,[ASCIZ /: /]
XCT COMPRT
POPJ P,
; DDT--'D' COMMAND
CDDT: .SUSET [.SIPIRQC,,[%PIC.Z]]
JRST POPJ1
; SET ERROR STRINGS--'E' COMMAND
CERROR: PUSHJ P,CPRMPT ; PRINT A PROMPT
XCT COMGLN ; GET NEW ONES
JRST POPJ1 ; IF DOESN'T SKIP, IGNORE IT
SETZM ERRORS
JUMPE A,POPJ1
PUSH P,E ; GET AN EXTRA AC
PUSH P,B ; SAVE BPTR
CERLST: MOVEI C,0
CERLOP: ILDB D,B
CAIN D,",
SOJA A,CERMAK ; UPDATE COUNT AND MAKE THE NEW BLOCK
CAIN D,^Q ; QUOTE CHARACTER?
JRST [ILDB D,B ; GOBBLE THE NEXT CHAR
SOJG A,CERLOP ; AND DON'T UPDATE THE COUNT
JRST CERMAK]
ADDI C,1 ; LENGTH OF STRING
SOJG A,CERLOP
; MAKE A NEW ERROR BLOCK. LENGTH OF STRING IS IN C, POINTER TO FIRST
; CHAR IS (P).
CERMAK: JUMPE C,CERMAE ; NO NULL STRINGS ALLOWED
IBLOCK E,ERRBLK ; GET AN ERROR BLOCK
MOVE D,ERRORS
MOVEM D,ENEXT(E)
MOVEM E,ERRORS ; SPLICE IT INTO CHAIN
MOVEM C,EMATLN(E)
MOVEM C,ELENGTH(E) ; SET UP LENGTHS
IDIVI C,5
SKIPE D
ADDI C,1 ; # WORDS NEEDED FOR STRING
IBLOCK C,(C) ; GET STORAGE FOR IT
HRLI C,440700
MOVEM C,EMATCH(E)
MOVEM C,ESTRING(E) ; STUFF OUT BPTRS
EXCH B,(P) ; GET POINTER TO FIRST CHAR
MOVE E,ELENGTH(E) ; GET LENGTH
CERCLP: ILDB D,B
CAIN D,^Q
ILDB D,B
IDPB D,C ; STUFF THE CHARACTER OUT
SOJG E,CERCLP
MOVE B,(P)
CERMAE: JUMPN A,CERLST ; IF CHARS LEFT, GO GET THE NEXT ONE
POP P,B
POP P,E
JRST POPJ1
; TOGGLE STATE OF OUTPUT FORCING--'F' COMMAND
CFORCE: SETCMM FORCSW
JRST POPJ1
; HALT JOB--'H' COMMAND
CHALT: .IOT STYO,[^Z]
PUSHJ P,CTTYB
POPJ P,
JRST POPJ1
; SET INTERCEPT CHARACTER--'I' COMMAND
CINTER: PUSHJ P,CPRMPT
XCT COMGLN ; GET A LINE OF INPUT
JFCL
JUMPE A,POPJ1 ; NULL INPUT
ILDB A,B
MOVEM A,ESCAPE ; NEW INTERCEPT
JRST POPJ1
; UNDO EFFECTS OF 'R' COMMAND--'J' COMMAND
CNREMA: SETZM JOBFRC ; JUST CLEAR THE FLAG
JRST POPJ1
; PROCED XXFILE--'P' COMMAND
CPROCE: .VALUE [ASCIZ /:PROCED
J/]
JRST POPJ1
; QUIT--'Q' COMMAND
CQUIT: .SUSET [.ROPTIO,,A]
TLNE A,OPTDDT
.VALUE [ASCIZ \..SAFE/0
P\]
.CLOSE OUTCHN,
.CLOSE STYI,
.CLOSE STYO,
.LOGOUT 1,
; FORCE INPUT TO GO TO THE CURRENT JOB UNTIL 'J' COMMAND--'R' COMMAND
CREMAN: .CALL [SETZ
SIXBIT /STYGET/
MOVEI STYO
MOVEM A
SETZM A]
.LOSE %LSSYS
JUMPL A,CPOPJ ; NOBODY HAS THE STY
MOVEM A,JOBFRC ; OTHERWISE, A HAS THE INDEX
JRST POPJ1
; STOP TTY INPUT--'S' COMMAND
CTTYE: SKIPN TTYSRC
JRST POPJ1 ; NOT IN TTY INPUT
PUSHJ P,RSTTTY ; FROB ALL THE SWITCHES AND CHANNELS AND SUCH
.CALL [SETZ
SIXBIT /STYGET/
MOVEI STYO
MOVEM A
MOVEM A ; JOB OWNING TTY
MOVEM B
SETZM B] ; WAITING FOR CHARS? (BIT 1.1)
.LOSE %LSSYS ; READ STATUS OF TTY
JUMPL A,CTTYST
TLNN B,400000 ; SEE IF TTY WANTS CHARS
POPJ P, ; NOPE
CTTYST: .SUSET [.SIIFPIR,,[<1_STYO>]] ; CAUSE THE INTERRUPT
POPJ P,
; SET CTRL-T CHARACTER--'T' COMMAND
CCTRLT: PUSHJ P,CPRMPT
XCT COMGLN
JFCL
JUMPE A,POPJ1
ILDB A,B
MOVEM A,CTRLT
JRST POPJ1
; VALRET STRING--'V' COMMAND
CVALUE: PUSHJ P,CPRMPT ; PRINT PROMPT
XCT COMGLN ; GET A LINE
JRST POPJ1
JUMPE A,POPJ1
EXCH A,B
PUSHJ P,STRGET ; GET STRING INTO B AND C
HRRZS C
.VALUE (C)
JRST POPJ1
SUBTTL TTY INTERACTIONS
; COME HERE TO SET THINGS UP FOR TTY INTERACTIONS--APPROPRIATE TTYSETS,
; MOVING OF CURSOR, SETTING UP OF ECHO AREA (IF IT DOESN'T ALREADY EXIST),
; AND SO ON. UNFORTUNATELY, ALL CHARACTERS INTERRUPT IN THIS MODE.
; REQUIREMENTS: THIS WILL OFTEN FALL IN THE MIDDLE OF A FILE, SO IT
; MIGHT BE NICE IF EVERYTHING WERE CONSISTENT. WHEN THE 'B' COMMAND IS
; GIVEN FROM A FILE, IT WILL BE; WHEN GIVEN FROM THE TTY, WE WIN ONLY
; BECAUSE TTYI INTERRUPTS ARE DEFERRED BY STYO INTERRUPTS.
SETTTY: PUSH P,A
PUSH P,B
PUSH P,C
.SUSET [.SAMSK2,,[<1_STYO>]] ; DISABLE STYO INTERRUPTS
.SUSET [.SIDF2,,[<1_TTYI>]] ; DEFER TTY INTERRUPTS (IF NOT ALREADY)
.SUSET [.SAIFPI,,[<1_STYO>]] ; AND FLUSH ANY PENDING STY INTERRUPTS
MOVE A,TTTST1
MOVEM A,CTTST1
MOVE A,TTTST2
MOVEM A,CTTST2
MOVE A,CTTSTS
TLO A,%TSSII
MOVEM A,CTTSTS
.CALL [SETZ
SIXBIT /TTYSET/
MOVEI TTYI
TTTST1
TTTST2
SETZ A] ; ENABLE INTERRUPTS, SUPER-IMAGE INPUT
.LOSE %LSSYS
SKIPN ECHOQ ; DOES ECHO AREA EXIST?
JRST [MOVEI A,2
.CALL [SETZ
SIXBIT /SCML/
MOVEI TTYI
SETZ A]
.LOSE %LSSYS
MOVEM A,ECHOQ
JRST .+1] ; TURN IT ON
.CALL [SETZ
SIXBIT /OPEN/
[.UAO,,TTYO]
[SIXBIT /TTY/]
[SIXBIT /TTY/]
SETZ [SIXBIT /TTY/]]
.LOSE %LSFIL ; OPEN TTY FOR NORMAL OUTPUT
SETOM TTYSRC ; SET FLAG SO RECBUO WILL USE THIS
SETZM NULOUT ; THERE IS SOME OUTPUT CHANNEL
.CALL [SETZ
SIXBIT /TTYGET/
MOVEI STYO
MOVEM A
MOVEM B
SETZM C]
.LOSE %LSSYS
TLO C,%TSMOR
.CALL [SETZ
SIXBIT /TTYSET/
MOVEI STYO
A
B
SETZ C]
.LOSE %LSSYS
.CALL [SETZ
SIXBIT /TTYVAR/
MOVEI STYO
[SIXBIT /TTYOPT/]
MOVEI 0
SETZ [TLO %TOMOR]]
.LOSE %LSSYS ; TURN ON MORE HACKING IN OTHER JOB
.CALL [SETZ
SIXBIT /RCPOS/
MOVEI STYO
SETZM A]
.LOSE %LSSYS
HLRZ B,A
HRRZS A
OVPOS TTYO,(B)
OHPOS TTYO,(A) ; MOVE CURSOR TO CORRESPOND WITH IMAGE
OCTLP TTYO,"L ; FLUSH TO END OF LINE
SKIPN DSKOUT ; IS THERE ANOTHER OUTPUT CHANNEL OPEN?
JRST SETTTO
SKIPN DSKCHN ; IS IT DISK-STYLE?
SETZM DSKOUT ; NO, SO FLUSH IT--DON'T WANT TWO TTYO CHANNELS
SETTTO: SETZM DSKCHN ; DO OUTPUT FOR TTY, NOT FOR DSK
POP P,C
POP P,B
POP P,A
POPJ P,
; INVERT SETTTY.
RSTTTY: PUSH P,A
PUSH P,B
PUSH P,C
MOVE A,NTTST1
MOVEM A,CTTST1
MOVE A,NTTST2
MOVEM A,CTTST2
MOVE A,CTTSTS
TLZ A,%TSSII
MOVEM A,CTTSTS ; TURN OFF SUPER-IMAGE INPUT
.CALL [SETZ
SIXBIT /TTYSET/
MOVEI TTYI
NTTST1
NTTST2
SETZ A]
.LOSE %LSSYS
SETZM TTYSRC
PUSHJ P,OUTHC1 ; SET OUTPUT FLAGS CORRECTLY
.CLOSE TTYO,
.CALL [SETZ
SIXBIT /TTYGET/
MOVEI STYO
MOVEM A
MOVEM B
SETZM C]
.LOSE %LSSYS
TLZ C,%TSMOR
.CALL [SETZ
SIXBIT /TTYSET/
MOVEI STYO
A
B
SETZ C]
.LOSE %LSSYS
.CALL [SETZ
SIXBIT /TTYVAR/
MOVEI STYO
[SIXBIT /TTYOPT/]
MOVEI O
SETZ [TLZ %TOMOR]]
.LOSE %LSSYS
.SUSET [.SIMSK2,,[<1_STYO>]] ; RE-ENABLE STYO INTERRUPTS
POP P,C
POP P,B
POP P,A
POPJ P,
; TTY INTERRUPT HANDLER
TTYINT: MOVEI O,TTYI ; O, A, B ALREADY PUSHED
.ITYIC O, ; GET THE CHAR IN O
.CALL DISMIS
CAME O,ESCAPE ; ESCAPE CHARACTER?
JRST TTYOTC ; NO, SEE IF WANT TO SHIP TO STY OR DO CTRL-T
.CALL [SETZ
SIXBIT /TTYFLS/
MOVEI TTYI
ANDI 1]
.LOSE %LSSYS ; FLUSH STUFF TYPED AHEAD
PUSH P,C
SKIPN TTYSRC ; INPUT FROM TTY?
JRST TTYCOM
MOVE C,CTTSTS
TLZN C,%TSSII ; TURN OFF SUPER-IMAGE INPUT
JRST TTYCOM ; NOT ON, SO NO NEED
.CALL [SETZ
SIXBIT /TTYSET/
MOVEI TTYI
CTTST1
CTTST2
SETZ C]
.LOSE %LSSYS
MOVNI A,2
MOVEM A,SIIFLG ; SET FLAG FOR REALTIME INTERRUPT
TTYCOM: PUSHJ P,ECINIT ; CLEAR/CR IN "ECHO AREA"
OASC ECHO,[ASCIZ /Command: /]
TTYGCM: .CALL TTYIOT ; READ THE COMMAND CHAR
.LOSE %LSSYS
SETZM SIIFLG ; CLEAR THE FLAG
MOVE A,O
PUSHJ P,COMND
PUSHJ P,GETLIN
PUSHJ P,TTYPRT
JFCL ; DOESN'T MATTER
TTYCFL: SKIPN TTYSRC
JRST TTYEND
MOVE A,CTTSTS
TLO A,%TSSII
MOVEM A,CTTSTS
.CALL [SETZ
SIXBIT /TTYSET/
MOVEI TTYI
CTTST1
CTTST2
SETZ A]
.LOSE %LSSYS ; TURN SII BACK ON
TTYEND: POP P,C
.CALL DISMIS ; AND FLUSH
; COME HERE TO SEE IF CHAR WANTS TO GO OUT TO STY
TTYOTC: .CALL [SETZ
SIXBIT /TTYFLS/
MOVEI TTYI
ANDI 1]
.LOSE %LSSYS
CAMN O,CTRLT ; CONTROL T?
JRST TTYCTT
SKIPN TTYSRC ; INPUT IS TTY?
.CALL DISMIS ; NO
.IOT STYO,O ; YES, SO SHIP IT.
.CALL DISMIS
; NORMAL IOT FOR READ CHARS FROM TTY (INTO O, AS IT TURNS OUT)
TTYIOT: SETZ
SIXBIT /IOT/
MOVEI TTYI
MOVSI %TIECH+%TIINT+%TIACT
SETZ O ; READ NO MATTER WHAT
; ROUTINE TO CLEAR ECHO AREA IF IT EXISTS, OTHERWISE PRINT CR
ECINIT: SKIPE ECHOQ
JRST [OCTLP ECHO,"C ; CLEAR THE ECHO AREA IF IT EXISTS
POPJ P,]
OASCR ECHO,[0]
POPJ P,
SUBTTL JOB STATUS
; HERE TO DISPLAY STATUS OF JOB AT OTHER END OF STY. WHEN DONE,
; JUST DO .CALL DISMIS
TTYCTT: PUSHJ P,ECINIT ; WILL GO IN ECHO AREA
.SUSET [.SADF2,,[<1_STYO>]] ; ALLOW STYO INTERRUPTS HERE
PUSH P,C
PUSH P,D
PUSH P,E
PUSH P,F
PUSH P,U
MOVEI E,0
MOVE F,[440700,,STTBUF] ; INITIALIZE AC'S FOR UUOS
OASCB E,"T
OOCTA E,T ; PRINT 'Tnn'
HRRZ U,@TTYSTS ; PICK UP THE USER INDEX (TTYSTS IS (T))
CAIN U,777777 ; LOGGED OUT?
JRST [OASCA E,[ASCIZ / Logged out./]
JRST TTOTST] ; YES, FLUSH IMMEDIATE (ALMOST)
OASCB E,40
MOVE A,U
IDIV A,LUBLK
OOCTA E,A ; USER INDEX
OASCB E,40
OSIXA E,@JNAME
OASCB E,40
OSIXA E,@USYSNM ; JNAME AND SNAME
OASCB E,40
SKIPN STIFLG ; ARE WE GETTING INPUT?
JRST TTSTOF
OASCA E,[ASCIZ /<=/]
TTSTOF: SKIPN STOFLG ; ARE WE SENDING STUFF?
JRST TTSTST
SKIPN STIFLG
OASCB E,"=
OASCB E,">
; PRINT STATUS OF JOB
TTSTST: PUSHJ P,JSTATU ; GROSS ROUTINE RIPPED OFF FROM WHOIML
OASCB E,40
MOVE A,@JTMU
ADDI A,9830.
IDIVI A,19661. ; MAGICALLY PRODUCES %
ODECA E,A
OASCA E,[ASCIZ /% /]
MOVE A,@UTRNTM ; TIME USED
MOVEI C,0
IDIVI A,25000. ; IN 10TH'S
IDIVI A,36000. ; HOURS
JUMPE A,UTRNT1 ; DON'T PRINT IF 0
ODECA E,A
OASCB E,":
MOVNI C,1 ; SET FLAG
UTRNT1: MOVE A,B
IDIVI A,600. ; MINUTES
JUMPN C,[CAIGE A,10.
OASCB E,"0
ODECA E,A
JRST UTRNT2]
JUMPE A,UTRNT3
MOVNI C,1
ODECA E,A
UTRNT2: OASCB E,":
UTRNT3: MOVE A,B
IDIVI A,10. ; SECONDS
JUMPN C,[CAIGE A,10.
OASCB E,"0
JRST .+1]
ODECA E,A
OASCB E,".
ODECA E,B
OASCB E,40
TTOTST: .SUSET [.SIDF2,,[<1_STYO>]]
SKIPN A,INPSRC
JRST [MOVEI B,100. ; READ EVERYTHING
JRST PERCRD]
MOVE B,OUTRED(A)
IMULI B,100.
IDIV B,OUTTLN(A) ; % OF CURRENT SOURCE READ
PERCRD: ODECA E,B
OASCA E,[ASCIZ /%RD /]
MOVE F,[440700,,STTBUF]
.CALL [SETZ
SIXBIT /SIOT/
MOVEI ECHO
F
SETZ E]
.LOSE %LSSYS
SKIPN B,LSTLEN
JRST TTSTOT
MOVE A,LSTPTR ; POINTER TO SAVED STUFF
LDB C,[360600,,A]
IDIVI C,7 ; # OF CHARS IN FIRST WORD
ADDI C,<LSTOLN-1>*5 ; MAX # OF CHARS WE HAVE
CAIL B,(C)
MOVEI B,(C) ; IF LESS THAN # SAVED, USE IT
ILDB C,A
CAIE C,^J
JRST [DBP A
JRST LSLNF] ; FLUSH LEADING CTRL-J
SUBI B,1
LSLNF: MOVEM B,LSTTMP
MOVE C,[440700,,LSTBUF]
LSLOOP: ILDB O,A ; PICK UP CHAR
CAILE O,^Z
JRST LSLOPE
ADDI O,100
MOVEI D,"^
IDPB D,C
AOS LSTTMP
LSLOPE: IDPB O,C
SOJG B,LSLOOP
MOVE A,[440700,,LSTBUF]
.CALL [SETZ
SIXBIT /SIOT/
MOVEI ECHO
A
SETZ LSTTMP]
.LOSE %LSSYS
TTSTOT: POP P,U
POP P,F
POP P,E
POP P,D
POP P,C
.CALL DISMIS ; ALL DONE
; HACK TO PRINT STATUS OF JOB WHOSE INDEX IS IN U, STOLEN FROM WHOIML
JSTATU: MOVEI A,0
SKIPN @PICLR
MOVEI A,"* ; HACKING INTERRUPT
SKIPN @IDF1
SKIPE @IDF2
MOVEI A,"* ; HACKING INTERRUPT
SKIPGE B,@USWST
MOVEI A,"_ ; DESIRED OUT
SKIPGE @USWSCD
MOVEI A,"> ; SWAP-BLOCKED
SKIPE A
OASCB E,(A)
SKIPE A,@USTP ; RUNNING?
JRST JRUN1
SKIPE @FLSINS ; BLOCKED?
JRST JHAIR
MOVE B,@UPC
TLNN B,%PCUSR ; USER MODE?
JRST JEHAIR ; EXEC MODE
MOVE A,@JTMU
ADDI A,9830.
IDIVI A,19661.
MOVEI B,6
CAIGE A,2
JRST [MOVE B,A
JRST JRUNST]
CAIG A,10.
JRST [MOVEI B,2
JRST JRUNST]
CAIG A,49.
JRST [MOVEI B,3
JRST JRUNST]
CAIG A,79.
JRST [MOVEI B,4
JRST JRUNST]
CAIG A,89.
MOVEI B,5
JRUNST: OASCA E,@RUNTBL(B)
JSTAT2: SKIPN A,@RPCL ; RPCLSR'ING?
POPJ P,
SKIPL A
OASCB E,">
SKIPG A
OASCB E,"<
ANDI A,-1
IDIV A,LUBLK
OOCTA E,A
POPJ P,
; NOT RUNNING. USTP IS IN A
JRUN1: LSHC A,-30.
OOCTA E,A ; LEFT TWO DIGITS OF USTP
OASCB E,"!
LSH B,-6
OOCTA E,B
JRST JSTAT2 ; GO CHECK FOR PCLSR-ING
; NON-ZERO FLSINS. USWST IS IN B
JHAIR: TLNN B,200000
JRST HAIR
MOVE A,[SIXBIT /IPAGE/]
TLNN B,10000
MOVE A,[SIXBIT /PAGE/]
OSIXA E,A
JRST JSTAT2
; IN EXEC MODE, FOLLOWED BY HAIR FOR SYS CALLS.
JEHAIR: OASCB E,"+
HAIR: SKIPGE A,@SV40
JRST IOTUUO
LSH A,-27.
CAIG A,47 ; SKIP IF TOO BIG FOR SYS UUO
CAIGE A,40 ; SKIP IF SYS UUO
SKIPA A,[SIXBIT /UUO/] ; USER UUO
XCT UUOTB-40(A) ; DISPATCH/PICK UP MNEMONIC
HAIR1: OSIXA E,A
JRST JSTAT2
IOTUUO: LDB A,[270300,,A]
MOVE A,UIOTAB(A)
JRST HAIR1
UIOTAB: IRPS A,,[BLKI DATAI BLKO DATAO CONO CONI CONSZ CONSO]
SIXBIT /A/
TERMIN
UUOTB: JRST AIOT ; IOT
MOVE A,[SIXBIT /OPEN/]
JRST AOPER ; .OPER
JRST ACALL ; .CALL
MOVE A,[SIXBIT /USET/]
MOVE A,[SIXBIT /BREAK/]
MOVE A,[SIXBIT /STATUS/]
MOVE A,[SIXBIT /ACCESS/]
AIOT: LDB C,[270400,,@SV40] ; .IOT, GET AC
MOVEI D,0
AIOT1: MOVEI A,@IOCHNM
ADD A,U
HRRZ C,(A)
PUSHJ P,AIOTNM
JRST JSTAT2
AIOTNM: MOVEI B,(C)
HLL A,@CLSTB
TLNN A,100040
JRST AIOTN1
HLRZ C,(A)
SKIPA A,@JBDEV
AIOTN1: HLLZ A,@DCHSTB
OSIXA E,A
MOVEI C,(B)
MOVE O,@IOTTB
TLNE O,400000
JRST [OASCB E,"B
JRST AIOTN2]
CAMN D,[SIXBIT /SIOT/]
JRST [OASCB E,"S
JRST AIOTN2]
AIOTN2: MOVEI C,"I
TLNE O,200000
MOVEI C,"O
OASCB E,(C)
POPJ P,
; HACK .CALL
ACALL: LDB C,[270400,,@SV40] ; AC
JUMPE C,ACALLO
OSIX @CALSXB
JRST JSTAT2
ACALLO: MOVE C,@LSCALL
CAME C,[SIXBIT /SIOT/]
CAMN C,[SIXBIT /IOT/]
JRST ACALL1
OSIXA E,@LSCALL
JRST JSTAT2
ACALL1: SKIPE C,@UUAC
MOVE D,@LSCALL
JRST AIOT1
; HACK .OPER
AOPER: HRRZ C,@SV40
MOVE A,CALSXB
SUB A,OPRSXB
CAML C,A
MOVEI C,0
OSIXA E,@OPRSXB
JRST JSTAT2
RUNTBL: [ASCIZ /MULTIX/]
[ASCIZ /TENEX/]
[ASCIZ /WALK/]
[ASCIZ /RUN/]
[ASCIZ /FLY/]
[ASCIZ /ZOOM/]
[ASCIZ /WARP/]
SUBTTL TTY READER
; ROUTINE FOR PRINTING WHEN IN COMMAND READER FROM TTY
; CALLED WITH ADDRESS OF ASCIZ IN A.
TTYPRT: OASC ECHO,(A)
POPJ P,
; ROUTINE TO READ A LINE FROM TTY FOR COMMAND READER
; RETURN LENGTH OF LINE IN A, POINTER TO IT IN B.
; SKIPS USUALLY, FAILING ONLY IF RUBOUT TYPED WHEN BUFFER EMPTY
; (TO ALLOW USER TO ABORT).
GETLIN: PUSH P,C
PUSH P,D
MOVE C,TTYOPT
SETZM TOERS
TLNE C,%TOERS
SETOM TOERS ; SET UP FOR ERASURE IF POSSIBLE
.CALL [SETZ
SIXBIT /RCPOS/
MOVEI ECHO
MOVEM C
SETZM ECCPOS]
.LOSE %LSSYS ; SAVE CURRENT CURSOR POSITION
GETRST: MOVEI A,0
MOVE B,[440700,,TTYBUF]
GETLOP: .CALL TTYIOT ; READ A CHARACTER INTO C
.LOSE %LSSYS
CAIN O,177 ; RUBOUT?
JRST RUBOUT
CAIN O,^W ; WORD FLUSH?
JRST WDFLUS
CAIE O,^X
CAIN O,^U
JRST LNFLUS ; FLUSH WHOLE LINE
JUMPE O,LNFLUS
CAIE O,^L
CAIN O,^D
JRST BREDIS ; REDISPLAY BUFFER
CAIE O,^M
.IOT ECHO,O ; ECHO THE CHARACTER--EXCEPT CTRL-M
CAIN O,^Q ; QUOTE CHARACTER
JRST QUOTER
GETPUT: CAIN O,^M
JRST GETLO1 ; DONE
IDPB O,B ; STUFF INTO BUFFER
AOJA A,GETLOP ; GET THE NEXT ONE
GETLO1: AOS -2(P) ; SKIP--> USE THIS DATA
GETLOT: OASC ECHO,[ASCIZ / [CR]/]
MOVE B,[440700,,TTYBUF]
POP P,D
POP P,C
POPJ P,
; QUOTE A CHAR
QUOTER: .CALL TTYIOT ; READ THE CHAR
.LOSE %LSSYS
SKIPN TOERS
JRST QUOTOT ; NOTHING SPECIAL
OCTLP ECHO,"X
OCTLP ECHO,"X ; FLUSH THE ^Q
QUOTOT: .IOT ECHO,O
JRST GETPUT
; FLUSH THE WHOLE LINE
LNFLUS: SKIPN TOERS ; ON A DISPLAY?
JRST [OASCR [ASCIZ /XXX?/]
JRST GETRST]
PUSHJ P,RSTPOS ; RESTORE CURSOR POSITION
OCTLP ECHO,"E ; CLEAR TO END OF FILE
JRST GETRST
; RESTORE CURSOR POSITION TO ORIGINAL
RSTPOS: SKIPN TOERS
POPJ P,
PUSH P,A
HLRZ A,ECCPOS
OVPOS ECHO,(A)
HRRZ A,ECCPOS
OHPOS ECHO,(A)
POP P,A
POPJ P,
; REDISPLAY BUFFER
BREDIS: PUSHJ P,RSTPOS
OCTLP ECHO,"E
PUSH P,A
PUSH P,B
MOVE B,[440700,,TTYBUF]
.CALL [SETZ
SIXBIT /SIOT/
MOVEI ECHO
B
SETZ A]
.LOSE %LSSYS
POP P,B
POP P,A
POPJ P,
RUBOUT: JUMPE A,GETLOT ; FLUSH IF RUBOUT WHEN BUFFER EMPTY
PUSHJ P,DORUB ; DO THE RUBOUT, GET CHAR KILLED INTO C
JRST GETLOP ; AND RETURN
DORUB: SUBI A,1
LDB C,B ; PICK UP CHAR BEING FLUSHED
DBP B ; UPDATE POINTER
SKIPN TOERS
JRST RUBECH ; IF CAN'T ERASE, ECHO
OCTLP ECHO,"X ; ERASE ONE
CAIN C," ; ALTMODE IS ONLY ONE LONG
POPJ P,
CAIE C,177
CAIGE C,40
OCTLP ECHO,"X ; ERASE ANOTHER, SOMETIMES
POPJ P,
RUBECH: .IOT ECHO,C
POPJ P,
; FLUSH A WORD
WDFLUS: JUMPE A,GETLOT ; FLUSH IMMEDIATE
WDLP1: PUSHJ P,DORUB ; FLUSH A CHAR
PUSHJ P,BREAK ; WAS IT A BREAK?
JUMPN A,WDFLU1 ; NO, AND THERE ARE CHARACTERS LEFT
JUMPN A,WDLP1 ; YES, FLUSH ANOTHER
JRST GETLOP ; ALL DONE
WDFLU1: PUSHJ P,DORUB
PUSHJ P,BREAK
JUMPN A,WDFLU1 ; KEEP FLUSHING UNTIL BREAK ENCOUNTERED
JRST GETLOP
; IS CHAR IN C A BREAK?
BREAK: CAIE C,"?
CAIN C,".
JRST BREAKW
CAIE C,"!
CAIN C,",
JRST BREAKW
CAIE C,40
CAIN C,^I
JRST BREAKW
CAIE C,"-
CAIN C,^J
BREAKW: AOS (P)
POPJ P,
SUBTTL INTERRUPTS
; INTERRUPT TABLE
ACPUSH==400003 ; PUSH O,A,B, + DEBUGGING VARIABLES
TSINT: ACPUSH,,P ; P IS AC STACK
%PIATY ? 0 ? %PIRLT\%PIATY ? <1_TTYI>\<1_STYO>\<1_STYI> ? TSATTY
0 ? <1_TTYO> ? 0 ? <1_STYI>\<1_STYO> ? [.CALL DISMIS]
0 ? <1_STYI> ? 0 ? <1_STYO>\<1_STYI> ? TSSTYI
0 ? <1_STYO> ? %PIRLT ? <1_TTYI>\<1_STYO> ? TSSTYO
0 ? <1_TTYI> ? 0 ? <1_TTYI>\<1_STYO> ? TTYINT
%PIRLT ? 0 ? %PIRLT\%PIATY ? 0 ? TSRLT
TSINTL==.-TSINT
TSRLT: AOSE SIIFLG ; NEED TO TURN SII BACK ON?
JRST TSRLT1
SKIPN TTYSRC
JRST TSRLT2
HRRZ A,-6(P) ; PICK UP OLD PC
CAIE A,TTYGCM ; HANGING IN IOT?
JRST [SETOM SIIFLG
JRST TSRLT1] ; NOPE
MOVEI A,TTYCFL
HRRM A,-6(P) ; CAUSE DISMISS TO RIGHT PLACE
TSRLT1: SKIPE TTYSRC
.CALL DISMIS
TSRLT2: SKIPE @INPSRC ; LAST INPUT BLOCK?
.CALL DISMIS
.CALL [SETZ
SIXBIT /STYGET/
MOVEI STYO
MOVEM A
MOVEM A
MOVEM B
SETZM B]
.CALL DISMIS ; PROBABLY DON'T HAVE IT YET
JUMPL A,CQUIT ; FLUSH IF LOGGED OUT
TLNN B,400000 ; DOES HACKER WANT INPUT?
.CALL DISMIS
.SUSET [.SIIFPIR,,[<1_STYO>]] ; GIVE HIM SOME
.CALL DISMIS
; ATTY INTERRUPT
TSATTY: MOVE O,-6(P) ; PICK UP THE PC
TLNE O,%PC1PR ; BEING SINGLE-STEPPED, SO FLUSH
.CALL DISMIS
SKIPE TTYSRC ; INPUT FROM TTY?
JRST TSATY1 ; YES, SO HAVE WORK TO DO
SKIPN DSKOUT ; OUTPUT SOMEWHERE?
.CALL DISMIS ; NO
SKIPE DSKCHN ; AND TO TTY-LIKE DEVICE?
.CALL DISMIS
SKIPE NULOUT
.CALL DISMIS
TSATY1: .CALL [SETZ
SIXBIT /RCPOS/
MOVEI STYO
SETZM A]
.LOSE %LSSYS
HLRZ B,A ; GET VERTICAL POS
HRRZS A
SKIPN TTYSRC
JRST [OVPOS OUTCHN,(B)
OHPOS OUTCHN,(A)
OCTLP OUTCHN,"L ; CLEAR TO END OF LINE
JRST TSATTO]
OVPOS TTYO,(B)
OHPOS TTYO,(A)
OCTLP TTYO,"L
MOVE A,CTTSTS
TLO A,%TSSII
MOVEM A,CTTSTS
.CALL [SETZ
SIXBIT /TTYSET/
MOVEI TTYO
CTTST1
CTTST2
SETZ A]
.LOSE %LSSYS
TSATTO: .CALL DISMIS
TSSTYI: MOVEM P,IERRST ; SAVE STACK FOR RETURNS
SETOM STIFLG
PUSHJ P,RECSTR
SETZM IERRST
SETZM STIFLG
.CALL DISMIS
DISMIS: SETZ
SIXBIT /DISMIS/
MOVSI ACPUSH
SETZ P
TSSTYO: MOVE O,ERRSTK
MOVEM P,ERRSTK
PUSH P,O
SETOM STOFLG
PUSHJ P,SNDSTR
SETZM STOFLG
POP P,ERRSTK
.CALL DISMIS
SUBTTL ERROR UUO
; COME HERE FROM UUO HANDLER. O-E HAVE BEEN PUSHED, EFFECTIVE
; ADDRESS IS IN UUOE, CONTENTS OF EFF ADDR IN UUOE, AC IN E.
UERROR: .SUSET [.SPICLR,,[0]] ; NO INTERRUPTS
SETZM NOCNSL
SKIPL CNSFLS ; SWITCH SET?
JRST UERRGO
.SUSET [.RCNSL,,A] ; CONSOLE?
SKIPL A
JRST UERRGO
SETOM NOCNSL
.SUSET [.RIOS+OUTCHN,,A]
JUMPN A,UERRGT
.CALL [SETZ
SIXBIT /OPEN/
[.UAO,,OUTCHN]
[SIXBIT /NUL/]
[SIXBIT /NUL/]
SETZ [SIXBIT /NUL/]]
.LOSE %LSFIL
UERRGT: .IOPUSH OUTCHN,
.IOPOP ECHO, ; WHAT A HACK
OASCR ECHO,[0]
UERRGO: SETOM ERESET ; CAUSE ERROR STRINGS TO BE RESET NEXT TIME
MOVE A,UUOE(P) ; SAVE EFFECTIVE ADDRESS
CAIE E,2 ; IF INPUT ERROR, DON'T GO TO TTY INPUT
SKIPGE NOCNSL ; SIMILARLY IF NOCNSL
JRST UERRO0
SKIPN TTYSRC
PUSHJ P,SETTTY ; SET UP TTY INPUT
UERRO0: SKIPL NOCNSL
OCTLP ECHO,"C
SOJE E,UERFIL ; FILE-TYPE ERROR
SOJE E,UERINP ; INPUT FAILURE
UERRO1: OASC ECHO,[ASCIZ /ERROR: /]
OASC ECHO,(A)
UERROT: SKIPN ERRSTK
JRST UERREX
SKIPGE NOCNSL
JRST CQUIT ; FLUSH
MOVE P,ERRSTK ; HAVE A PLACE TO DISMISS TO
.CALL DISMIS ; WILL RESET .PICLR
UERREX: .SUSET [.SPICLR,,[-1]]
SKIPGE NOCNSL
JRST CQUIT
JRST UUORET
UERFIL: OASC ECHO,[ASCIZ /ERROR: /]
MOVEM A,INPSRC ; ADVANCE THE POINTER
MOVE B,OUTPTR(A)
MOVE C,OUTLEN(A)
.CALL [SETZ
SIXBIT /SIOT/
MOVEI ECHO
B
SETZ C]
.LOSE %LSSYS
OASC ECHO,[ASCIZ / not found./]
SETZM OUTLEN(A)
JRST UERROT
UERINP: OASC ECHO,[ASCIZ /ERROR: /]
OASC ECHO,(A) ; PRINT THE MSG
SKIPN IERRST
JRST UERREX
MOVE P,IERRST
SKIPGE NOCNSL
JRST CQUIT
.CALL DISMIS ; AND AWAY WE GO
SUBTTL INITIALIZATION
; CALL WITH SYSTEM VERSION IN A
INIT: MOVEM A,SYSVER
MOVE A,[-200,,200]
MOVEI B,0
.CALL [SETZ
SIXBIT /CORBLK/
MOVEI %CBRED
MOVEI %JSELF
A
MOVEI %JSABS
SETZ B]
.LOSE %LSSYS ; CONS UP SYSTEM
MOVE A,USRVAR ; USER VARIABLES
PUSHJ P,DOEVAL
IOR B,[U,,400000] ; WILL ALL BE VAL+400000(U)
MOVE A,SYSCON ; CONSTANTS
PUSHJ P,DOEVAL
JFCL
MOVE A,SYSTBL
PUSHJ P,DOEVAL
IOR B,[C,,400000] ; VAL+400000(C)
MOVE A,TTYVAR
PUSHJ P,DOEVAL
IOR B,[T,,400000]
.SUSET [.ROPTIO,,A]
TLNE A,OPTDDT ; ONLY DUMP IF UNDER DDT
.VALUE [ASCIZ / :PDUMP SYS2;TS XXFILE
P/]
POPJ P,
DOEVAL: MOVE B,(A)
.EVAL B,
.VALUE
XCT @(P)
MOVEM B,1(A)
ADD A,[2,,2]
JUMPL A,DOEVAL
AOS (P)
POPJ P,
; CRUFT TO EVAL
USRVRS: IRPS X,,[JNAME:USYSNM:JTMU:UTRNTM:PICLR:IDF1:IDF2:USWST:
USWSCD:USTP:FLSINS:UPC:LSUUO:RPCL:SV40:LSCALL:UUAC]
SQUOZE 0,X
X: 0
TERMIN
USRVAR: USRVRS-.,,USRVRS
SYSCNS: IRPS X,,[LUBLK:NFSTTY]
SQUOZE 0,X
X: 0
TERMIN
SYSCON: SYSCNS-.,,SYSCNS
SYSTBS: IRPS X,,[IOCHNM:CLSTB:DCHSTB:IOTTB:JBDEV:CALSXB:OPRSXB]
SQUOZE 0,X
X: 0
TERMIN
SYSTBL: SYSTBS-.,,SYSTBS
TTYVRS: IRPS X,,[TTYSTS]
SQUOZE 0,X
X: 0
TERMIN
TTYVAR: TTYVRS-.,,TTYVRS
CONSTA
VARIAB
FREBOT: .+2
FRETOP: <<./2000>+1>*2000
END START
Reference in New Issue View Git Blame Copy Permalink