github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-19 09:29:15 +00:00
Code Issues Releases Wiki Activity
PDP-10.its/src/mudsys/fopen.63
Adam Sampson d88315865a Use .MCALL instead of MCALL for complex args. 
MCALL tries to make its second arg global, which doesn't work when it's
an expression.
2018-04-25 09:32:25 +01:00

4722 lines
94 KiB
Plaintext
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 OPEN - CHANNEL OPENER FOR MUDDLE
RELOCATABLE
;C. REEVE MARCH 1973
.INSRT MUDDLE >
SYSQ
FNAMS==1
F==E+1
G==F+1
IFE ITS,[
IF1, .INSRT STENEX >
]
;THIS PROGRAM HAS ENTRIES: FOPEN, FCLOSE, RENAME, READB, PRINTB, FILECOPY, READSTRING,
; PRINTSTRING, NETSTATE, NETACC, NETS, ACCESS, AND FILE-EXISTS?
;THESE SUBROUTINES HANDLE I/O STREAMS FOR THE MUDDLE SYSTEM.
; FOPEN - OPENS A FILE FOR EITHER READING OR WRITING. IT TAKES
; FIVE OPTINAL ARGUMENTS AS FOLLOWS:
; FOPEN (<DIR>,<FILE NAME1>,<FILE NAME2>,<DEVICE>,<SYSTEM NAME>)
;
; <DIR> - DIRECTION EITHER READ (INPUT) OR PRINT (OUPUT). DEFAULT IS READ
; <FILE NAME1> - FIRST FILE NAME. DEFAULT INPUT OR OUTPUT.
; <FILE NAME2> - SECOND FILE NAME. DEFAULT MUDDLE.
; <DEVICE> - DEVICE FROM WHICH TO OPEN. DEFAULT IS DSK.
; <SNAME> - SYSTEM (DIRECTORY) NAME. DEFAULT UNAME.
; FOPEN RETURNS AN OBJECT OF TYPE CHANNEL IF IT SUCCEEDS OTHERWISE NIL
; FCLOSE - CLOSES A FILE. TAKES A CHANNEL OBJECT AS ITS ARGUMENT. IT ALSO TAKES
; ACCESS - DOES A .ACCESS ON A CHARACTER BASIS FOR CHARACTER FILES
; A CHANNEL OBJECT IS A VECTOR CONTAINIG THE FOLLOWING INFORMATION
; CHANNO ;ITS I/O CHANNEL NUMBER. 0 MEANS NOT A REAL CHANNEL.
; DIRECT ;DIRECTION (EITHER READ OR PRINT)
; NAME1 ;FIRST NAME OF FILE AS OPENED.
; NAME2 ;SECOND NAME OF FILE
; DEVICE ;DEVICE UPON WHICH THE CHANNEL IS OPEN
; SNAME ;DIRECTORY NAME
; RNAME1 ;REAL FIRST NAME (AS RETURNED BY READING CHANNEL STATUS)
; RNAME2 ;REAL SECOND NAME
; RDEVIC ;REAL DEVICE
; RSNAME ;SYSTEM OR DIRECTORY NAME
; STATUS ;VARIOUS STATUS BITS
; IOINS ;INSTRUCTION EXECUTED TO INPUT OR OUTPUT ONE CHARACTER
; ACCESS ;ACCESS POINTER FOR RAND ACCESS (OR USED FOR DISPLAY INFO)
; RADX ;RADIX FOR CHANNELS NUMBER CONVERSION
; *** THE FOLLOWING FIELDS FOR OUTPUT ONLY ***
; LINLN ;LENGTH OF A LINE IN CHARACTERS FOR THIS DEVICE
; CHRPOS ;CURRENT POSITION ON CURRENT LINE
; PAGLN ;LENGTH OF A PAGE
; LINPOS ;CURRENT LINE BEING WRITTEN ON
; *** THE FOLLOWING FILEDS FOR INPUT ONLY ***
; EOFCND ;GETS EVALUATED ON EOF
; LSTCH ;BACKUP CHARACTER
; WAITNS ;FOR TTY INPUT, BECOMES A .SLEEP WHEN WAITING
; EXBUFR ;FOR TTY INPUT, CONTAINS A WAITING BUFFER LIST
; BUFSTR ;A CHARACTER STRING USED AS BUFFER FOR NON-TTY DEVICES
; THIS DEFINES THE LENGTH OF THE NON-TTY BUFFER
BUFLNT==100
;THIS DEFINES BLOCK MODE BIT FOR OPENING
BLOCKM==2 ;DEFINED IN THE LEFT HALF
IMAGEM==4
;THIS IRP DEFINES THE FIELDS AT ASSEMBLY TIME
CHANLNT==4 ;INITIAL CHANNEL LENGTH
; BUILD A PROTOTYPE CHANNEL AND DEFINE FILEDS
BUFRIN==-1 ;SPECIAL HACK SO LOSERS WON'T SEE TTY BUFFER
SCRPTO==-3 ;SPECIAL HACK FOR SCRIPT CHANNELS
PROCHN:
IRP A,,[[CHANNO,FIX],[DIRECT,CHSTR]
[NAME1,CHSTR],[NAME2,CHSTR],[DEVICE,CHSTR],[SNAME,CHSTR]
[RNAME1,CHSTR],[RNAME2,CHSTR],[RDEVIC,CHSTR],[RSNAME,CHSTR]
[STATUS,FIX],[IOINS,FIX],[LINLN,FIX],[CHRPOS,FIX],[PAGLN,FIX],[LINPOS,FIX]
[ACCESS,FIX],[RADX,FIX],[BUFSTR,CHSTR]]
IRP B,C,[A]
B==CHANLNT-3
T!C,,0
0
.ISTOP
TERMIN
CHANLNT==CHANLNT+2
TERMIN
; EQUIVALANCES FOR CHANNELS
EOFCND==LINLN
LSTCH==CHRPOS
WAITNS==PAGLN
EXBUFR==LINPOS
DISINF==BUFSTR ;DISPLAY INFO
INTFCN==BUFSTR ;FUNCTION (OR SUBR, OR RSUBR) TO BE APPLIED FOR INTERNAL CHNLS
;DEFINE VARIABLES ASSOCIATED WITH TTY BUFFERS
IRP A,,[IOIN2,ECHO,CHRCNT,ERASCH,KILLCH,BRKCH,ESCAP,SYSCHR,BRFCHR,BRFCH2,BYTPTR]
A==.IRPCNT
TERMIN
EXTBFR==BYTPTR+1+<100./5> ;LENGTH OF ADD'L BUFFER
.GLOBAL IPNAME,MOPEN,MCLOSE,MIOT,ILOOKU,6TOCHS,ICLOS,OCLOS,RGPARS,RGPRS
.GLOBAL OPNCHN,CHMAK,READC,TYO,SYSCHR,BRFCHR,LSTCH,BRFCH2,EXTBFR
.GLOBAL CHRWRD,STRTO6,TTYBLK,WAITNS,EXBUFR,TTICHN,TTOCHN,GETCHR,IILIST
.GLOBAL CHANNO,STATUS,LINPOS,PAGLN,CHRPOS,LINLN,IOINS,ACCESS,ADDNUL
.GLOBAL DIRECT,DISINF,RADX,EOFCND,BUFSTR,MODE1,MODE2,GCHACK,GMTYO,INMTYO
.GLOBAL T.CHAN,NAME1,BFCLOS,DOIOTI,DOIOTO,DOACCS,NOTTY,DEMFLG,BYTDOP,TNXIN
.GLOBAL DISOPN,DISROP,DISCLS,DCHAR,DISLNL,DISPGL,INSTAT,MTYO,CIREST
.GLOBAL ECHO,ERASCH,KILLCH,BRKCH,BYTPTR,SYSCHR,CHRCNT,ESCAP,N.CHNS
.GLOBAL REOPN,QUITTE,CHNL0,CHNL1,BUFRIN,IOIN2,IFALSE,GFALS,IDVAL,PVSTOR,SPSTOR
.GLOBAL BADCHN,WRONGD,CHNCLS,GSNAME,GIBLOK,APLQ,NAPT,ICONS,INCONS,IBLOCK,IDVAL1
.GLOBAL GRB,GWB,R1CHAR,W1CHAR,BFCLS1,TTYOP2,MPOPJ,COMPER,R1C,W1C,WXCT,RXCT
.GLOBAL TMTNXS,TNXSTR,RDEVIC,CPCH1,RCYCHN,CGFALS,CISTNG,CFILLE,FRSTCH
.GLOBAL TGFALS,ONINT
.VECT.==40000
; PAIR MOVING MACRO
DEFINE PMOVEM A,B
MOVE 0,A
MOVEM 0,B
MOVE 0,A+1
MOVEM 0,B+1
TERMIN
; DEFINITIONS OF THE OFFSETS INTO THE TP STACK FOR OPEN
T.SPDL==0 ; SAVES P STACK BASE
T.DIR==2 ; CONTAINS DIRECTION AND MODE
T.NM1==4 ; NAME 1 OF FILE
T.NM2==6 ; NAME 2 OF FILE
T.DEV==10 ; DEVICE NAME
T.SNM==12 ; SNAME
T.XT==14 ; EXTRA CRUFT IF NECESSARY
T.CHAN==16 ; CHANNEL AS GENERATED
; OFFSETS FROM PSTACK BASE (USED FOR OPENS, .RCHST AND .FDELES)
S.DIR==0 ; CODE FOR DIRECTION 0-IN, 1-OUT, 2-BIN, 3-BOUT,4-DISPLAY
; S.DIR(P) = <control word>,,<direction>
IFN ITS,[
S.DEV==1 ; SIXBIT DEVICE RIGHT JUSTIFIED
S.NM1==2 ; SIXBIT NAME1
S.NM2==3 ; SIXBIT NAME2
S.SNM==4 ; SIXBIT SNAME
S.X1==5 ; TEMPS
S.X2==6
S.X3==7
]
IFE ITS,[
S.DEV==1
S.X1==2
S.X2==3
S.X3==4
]
; FLAGS SPECIFYING STATE OF THE WORLD AT VARIOUS TIMES
NOSTOR==400000 ; ON MEANS DONT BUILD NEW STRINGS
MSTNET==200000 ; ON MEANS ONLY THE "NET" DEVICE CAN WIN
SNSET==100000 ; FLAG, SNAME SUPPLIED
DVSET==040000 ; FLAG, DEV SUPPLIED
N2SET==020000 ; FLAG, NAME2 SET
N1SET==010000 ; FLAG, NAME1 SET
4ARG==004000 ; FLAG, CONSIDER ARGS TO BE 4 STRINGS
RMT [EXPUNGE N1SET,N2SET,DVSET,SNSET,MSTNET,NOSTOR
]
; TABLE OF LEGAL MODES
MODES: IRP A,,[READ,PRINT,READB,PRINTB,PRINTO,PRINAO]
SIXBIT /A/
TERMIN
NMODES==.-MODES
MODCOD: 0?1?2?3?3?1
; TABLE OF KNOWN DEVICES AND A POINTER TO THEIR OPENERS
IFN ITS,[
DEVSTB: IRP A,,[DSK,TTY,USR,STY,ST,NET,INT,PTP,PTR,UT,T,NUL]
SIXBIT /A/ ; DEVICE NAMES
TERMIN
DEVS: IRP B,,[ODSK,OTTY,OUSR,OSTY,OSTY,ONET,OINT,OPTP,OPTP,OUTN,OTTY,ONUL]
SETZ B ; POINTERS
TERMIN
]
IFE ITS,[
DEVSTB: IRP A,,[PS,SS,SRC,DSK,TTY,INT,NET]
SIXBIT /A/
TERMIN
DEVS: IRP B,,[ODSK,ODSK,ODSK,ODSK,OTTY,OINT,ONET]
SETZ B
TERMIN
]
NDEVS==.-DEVS
;SUBROUTINE TO DO OPENING BEGINS HERE
MFUNCTION NFOPEN,SUBR,[OPEN-NR]
JRST FOPEN1
MFUNCTION FOPEN,SUBR,[OPEN]
FOPEN1: ENTRY
PUSHJ P,MAKCHN ;MAKE THE CHANNEL
PUSHJ P,OPNCH ;NOW OPEN IT
JUMPL B,FINIS
SUB D,[4,,4] ; TOP THE CHANNEL
MOVEM D,RCYCHN+1 ; RECYCLE DEAD CHANNEL
SETZM (D) ; ZAP IT
MOVEI C,1(D)
HRLI C,(D)
BLT C,CHANLNT-1(D)
JRST FINIS
; SUBR TO JUST CREATE A CHANNEL
IMFUNCTION CHANNEL,SUBR
ENTRY
PUSHJ P,MAKCHN
MOVSI A,TCHAN
JRST FINIS
; THIS ROUTINE PARSES ARGUMENTS TO FOPEN ETC. AND BUILDS A CHANNEL BUT DOESN'T OPEN IT
MAKCHN: PUSH TP,$TPDL
PUSH TP,P ; POINT AT CURRENT STACK BASE
PUSH TP,$TCHSTR
PUSH TP,CHQUOTE READ
MOVEI E,10 ; SLOTS OF TP NEEDED
PUSH TP,[0]
SOJG E,.-1
MOVEI E,0
EXCH E,(P) ; GET RET ADDR IN E
IFE ITS, PUSH P,[0]
IRP ATM,,[DEV,NM1,NM2,SNM]MDF,,[DSK,INPUT,>,[ ]]TMDF,,[DSK,INPUT,MUD,[ ]]
MOVE B,IMQUOTE ATM
IFN ITS, PUSH P,E
PUSHJ P,IDVAL1
GETYP 0,A
CAIN 0,TCHSTR
JRST MAK!ATM
MOVE A,$TCHSTR
IFN ITS, MOVE B,CHQUOTE MDF
IFE ITS, MOVE B,CHQUOTE TMDF
MAK!ATM:
MOVEM A,T.!ATM(TB)
MOVEM B,T.!ATM+1(TB)
IFN ITS,[
POP P,E
PUSHJ P,STRTO6 ; RESULT LEFT ON P STACK AS DESIRED
]
TERMIN
PUSH TP,[0] ; PUSH SLOTS
PUSH TP,[0]
PUSH P,[0] ; EXT SLOTS
PUSH P,[0]
PUSH P,[0]
PUSH P,E ; PUSH RETURN ADDRESS
MOVEI A,0
JUMPGE AB,MAKCH0 ; NO ARGS, ALREADY DONE
GETYP 0,(AB) ; 1ST ARG MUST BE A STRING
CAIE 0,TCHSTR
JRST WTYP1
MOVE A,(AB) ; GET ARG
MOVE B,1(AB)
PUSHJ P,CHMODE ; CHECK OUT OPEN MODE
PMOVEM (AB),T.DIR(TB) ; SAVE MODE NAME IN TEMPS
ADD AB,[2,,2] ; BUMP PAST DIRECTION
MOVEM AB,ABSAV(TB)
MOVEI A,0
JUMPGE AB,MAKCH0 ; CHECK NAME1 BASED ON JUST MODE
MOVEI 0,0 ; FLAGS PRESET
PUSHJ P,RGPARS ; PARSE THE STRING(S)
JRST TMA
; ARGUMENTS PARSED, DO FINAL CHECKS AND BUILD CHANNEL
MAKCH0:
IFN ITS,[
MOVE C,T.SPDL+1(TB)
MOVE D,S.DEV(C) ; GET DEV
]
IFE ITS,[
MOVE A,T.DEV(TB)
MOVE B,T.DEV+1(TB)
PUSHJ P,STRTO6
POP P,D
HLRZS D
MOVE C,T.SPDL+1(TB)
MOVEM D,S.DEV(C)
]
IFE ITS, CAIE D,(SIXBIT /INT/);INTERNAL?
IFN ITS, CAME D,[SIXBIT /INT /]
JRST CHNET ; NO, MAYBE NET
SKIPN T.XT+1(TB) ; WAS FCN SUPPLIED?
JRST TFA
; FALLS TROUGH IF SKIP
; NOW BUILD THE CHANNEL
ARGSOK: MOVEI A,CHANLNT ; GET LENGTH
SKIPN B,RCYCHN+1 ; RECYCLE?
PUSHJ P,GIBLOK ; GET A BLOCK OF STUFF
SETZM RCYCHN+1
ADD B,[4,,4] ; HIDE THE TTY BUFFER SLOT
PUSH TP,$TCHAN
PUSH TP,B
HRLI C,PROCHN ; POINT TO PROTOTYPE
HRRI C,(B) ; AND NEW ONE
BLT C,CHANLN-5(B) ; CLOBBER
MOVSI C,TLIST ; TO GIVE HIM A CLEAN LIST OF SCRIPT CHANS
HLLM C,SCRPTO-1(B)
; NOW BLT IN STUFF FROM THE STACK
MOVSI C,T.DIR(TB) ; DIRECTION
HRRI C,DIRECT-1(B)
BLT C,SNAME(B)
MOVEI C,RNAME1-1(B) ; NOW "REAL" SLOTS
HRLI C,T.NM1(TB)
BLT C,RSNAME(B)
MOVE B,IMQUOTE MODE
PUSHJ P,IDVAL1
GETYP 0,A
CAIN 0,TFIX
JRST .+3
MOVE B,(TP)
POPJ P,
MOVE C,(TP)
IFE ITS,[
ANDI B,403776 ; ONLY ALLOW NON-CRITICAL BITSS
]
HRRM B,-4(C) ; HIDE BITS
MOVE B,C
POPJ P,
; HERE TO VALIDIFY ARGUMENTS FOR A NET OPEN
CHNET:
IFN ITS,[
CAME D,[SIXBIT /NET /] ; IS IT NET
JRST MAKCH1]
IFE ITS,[
CAIE D,(SIXBIT /NET/) ; IS IT NET
JRST ARGSOK]
MOVSI D,TFIX ; FOR TYPES
MOVEI B,T.NM1(TB) ; MAKE SURE ALL ARE FIXED
PUSHJ P,CHFIX
MOVEI B,T.NM2(TB)
PUSHJ P,CHFIX
MOVEI B,T.SNM(TB)
LSH A,-1 ; SKIP DEV FLAG
PUSHJ P,CHFIX
JRST ARGSOK
MAKCH1: TRNN A,MSTNET ; CANT HAVE SEEN A FIX
JRST ARGSOK
JRST WRONGT
IFN ITS,[
CHFIX: TRNE A,N1SET ; SKIP IF NOT SPECIFIED
JRST CHFIX1
SETOM 1(B) ; SET TO -1
SETOM S.NM1(C)
MOVEM D,(B) ; CORRECT TYPE
]
IFE ITS,CHFIX:
GETYP 0,(B)
CAIE 0,TFIX
JRST PARSQ
CHFIX1: ADDI C,1 ; POINT TO NEXT FIELD
LSH A,-1 ; AND NEXT FLAG
POPJ P,
PARSQ: CAIE 0,TCHSTR
JRST WRONGT
IFE ITS, POPJ P,
IFN ITS,[
PUSH P,A
PUSH P,C
PUSH TP,(B)
PUSH TP,1(B)
SUBI B,(TB)
PUSH P,B
MCALL 1,PARSE
GETYP 0,A
CAIE 0,TFIX
JRST WRONGT
POP P,C
ADDI C,(TB)
MOVEM A,(C)
MOVEM B,1(C)
POP P,C
POP P,A
POPJ P,
]
; SUBROUTINE TO CHECK VALIDITY OF MODE AND SAVE A CODE
CHMODE: PUSHJ P,CHMOD ; DO IT
MOVE C,T.SPDL+1(TB)
HRRZM A,S.DIR(C)
POPJ P,
CHMOD: PUSHJ P,STRTO6 ; TO SIXBIT
POP P,B ; VALUE ENDSUP ON STACK, RESTORE IT
MOVSI A,-NMODES ; SCAN TO SEE IF LEGAL MODE
CAME B,MODES(A)
AOBJN A,.-1
JUMPGE A,WRONGD ; ILLEGAL MODE NAME
MOVE A,MODCOD(A)
POPJ P,
IFN ITS,[
; RGPARS -- PARSE THE STRINGS COMPRISING FILE NAMES INTO STANDARD ITS GOODIES
RGPRS: MOVEI 0,NOSTOR ; DONT STORE STRINGS IF ENTER HERE
RGPARS: CAMGE AB,[-7,,] ; MULTI-STRING CASE POSSIBLE?
IORI 0,4ARG ; 4 STRING CASE
HRLM 0,(P) ; LH IS FLAGS FOR THIS PROG
MOVSI E,-4 ; FIELDS TO FILL
RPARGL: GETYP 0,(AB) ; GET TYPE
CAIE 0,TCHSTR ; STRING?
JRST ARGCLB ; NO, JUST CLOBBER IT IN RAW
JUMPGE E,CPOPJ ; DON'T DO ANY MORE
PUSH TP,(AB) ; GET AN ARG
PUSH TP,1(AB)
FPARS: PUSH TP,-1(TP) ; ANOTHER COPY
PUSH TP,-1(TP)
HLRZ 0,(P)
TRNN 0,4ARG
PUSHJ P,FLSSP ; NO LEADING SPACES
MOVEI A,0 ; WILL HOLD SIXBIT
MOVEI B,6 ; CHARS PER 6BIT WORD
MOVE C,[440600,,A] ; BYTE POINTER INTO A
FPARSL: HRRZ 0,-1(TP) ; GET COUNT
JUMPE 0,PARSD ; DONE
SOS -1(TP) ; COUNT
ILDB 0,(TP) ; CHAR TO 0
CAIE 0," ; FILE NAME QUOTE?
JRST NOCNTQ
HRRZ 0,-1(TP)
JUMPE 0,PARSD
SOS -1(TP)
ILDB 0,(TP) ; USE THIS
JRST GOTCNQ
NOCNTQ: HLL 0,(P)
TLNE 0,4ARG
JRST GOTCNQ
ANDI 0,177
CAIG 0,40 ; SPACE?
JRST NDFLD ; YES, TERMINATE THIS FIELD
CAIN 0,": ; DEVICE ENDED?
JRST GOTDEV
CAIN 0,"; ; SNAME ENDED
JRST GOTSNM
GOTCNQ: ANDI 0,177
PUSHJ P,A0TO6 ; CONVERT TO 6BIT AND CHECK
JUMPE B,FPARSL ; IGNORE IF AREADY HAVE 6
IDPB 0,C
SOJA B,FPARSL
; HERE IF SPACE ENCOUNTERED
NDFLD: MOVEI D,(E) ; COPY GOODIE
PUSHJ P,FLSSP ; FLUSH REDUNDANT SPACES
JUMPE 0,PARSD ; NO CHARS LEFT
NFL0: PUSH P,A ; SAVE SIXBIT WORD
SKIPGE -1(P) ; SKIP IF STRING TO BE STORED
JRST NFL1
PUSH TP,$TAB ; PREVENT AB LOSSAGE
PUSH TP,AB
PUSHJ P,6TOCHS ; CONVERT TO STRING
MOVE AB,(TP)
SUB TP,[2,,2]
NFL1: HRRZ 0,-1(TP) ; RESTORE CHAR COUNT
NFL2: MOVEI C,(D) ; COPY REL PNTR
SKIPGE -1(P) ; SKIP IF STRINGS TO BE STORED
JRST NFL3
ASH D,1 ; TIMES 2
ADDI D,T.NM1(TB)
MOVEM A,(D) ; STORE
MOVEM B,1(D)
NFL3: MOVSI A,N1SET ; FLAG IT
LSH A,(C)
IORM A,-1(P) ; AND CLOBBER
MOVE D,T.SPDL+1(TB) ; GET P BASE
POP P,@SIXTBL(C) ; AND STORE SIXBIT OF IT
POP TP,-2(TP) ; MAKE NEW STRING POINTER
POP TP,-2(TP)
JUMPE 0,.+3 ; SKIP IF NO MORE CHARS
AOBJN E,FPARS ; MORE TO PARSE?
CPOPJ: POPJ P, ; RETURN, ALL DONE
SUB TP,[2,,2] ; FLUSH OLD STRING
ADD E,[1,,1]
ADD AB,[2,,2] ; BUMP ARG
MOVEM AB,ABSAV(TB)
JUMPL AB,RPARGL ; AND GO ON
CPOPJ1: AOS A,(P) ; PREPARE TO WIN
HLRZS A
POPJ P,
; HERE IF STRING HAS ENDED
PARSD: PUSH P,A ; SAVE 6 BIT
MOVE A,-3(TP) ; CAN USE ARG STRING
MOVE B,-2(TP)
MOVEI D,(E)
JRST NFL2 ; AND CONTINUE
; HERE IF JUST READ DEV
GOTDEV: MOVEI D,2 ; CODE FOR DEVICE
JRST GOTFLD ; GOT A FIELD
; HERE IF JUST READ SNAME
GOTSNM: MOVEI D,3
GOTFLD: PUSHJ P,FLSSP
SOJA E,NFL0
; HERE FOR NON STRING ARG ENCOUNTERED
ARGCLB: SKIPGE (P) ; IF NOT STORING, CONSIDER THIS THE END
POPJ P,
MOVE C,T.SPDL+1(TB) ; GET P-BASE
MOVE A,S.DEV(C) ; GET DEVICE
CAME A,[SIXBIT /INT /]; IS IT THE INTERNAL DEVICE
JRST TRYNET ; NO, COUD BE NET
MOVE A,0 ; OFFNEDING TYPE TO A
PUSHJ P,APLQ ; IS IT APPLICABLE
JRST NAPT ; NO, LOSE
PMOVEM (AB),T.XT(TB)
ADD AB,[2,,2] ; MUST BE LAST ARG
MOVEM AB,ABSAV(TB)
JUMPL AB,TMA
JRST CPOPJ1 ; ELSE SUCCESSFUL RETURN
TRYNET: CAIE 0,TFIX ; FOR NET DEV, ARGS MUST BE FIX
JRST WRONGT ; TREAT AS WRONG TYPE
MOVSI A,MSTNET ; BETTER BE NET EVENTUALLY
IORM A,(P) ; STORE FLAGS
MOVSI A,TFIX
MOVE B,1(AB) ; GET NUMBER
MOVEI 0,(E) ; MAKE SURE NOT DEVICE
CAIN 0,2
JRST WRONGT
PUSH P,B ; SAVE NUMBER
MOVEI D,(E) ; SET FOR TABLE OFFSETS
MOVEI 0,0
ADD TP,[4,,4]
JRST NFL2 ; GO CLOBBER IT AWAY
]
; ROUTINE TO FLUSH LEADING SPACES FROM A FIELD
FLSSP: HRRZ 0,-1(TP) ; GET CHR COUNNT
JUMPE 0,CPOPJ ; FINISHED STRING
FLSS1: MOVE B,(TP) ; GET BYTR
ILDB C,B ; GETCHAR
CAIE C,^Q ; DONT FLUSH CNTL-Q
CAILE C,40
JRST FLSS2
MOVEM B,(TP) ; UPDATE BYTE POINTER
SOJN 0,FLSS1
FLSS2: HRRM 0,-1(TP) ; UPDATE STRING
POPJ P,
IFN ITS,[
;TABLE FOR STFUFFING SIXBITS AWAY
SIXTBL: SETZ S.NM1(D)
SETZ S.NM2(D)
SETZ S.DEV(D)
SETZ S.SNM(D)
SETZ S.X1(D)
]
RDTBL: SETZ RDEVIC(B)
SETZ RNAME1(B)
SETZ RNAME2(B)
SETZ RSNAME(B)
IFE ITS,[
; TENEX VERSION OF FILE NAME PARSER (ONLY ACCEPT ARGS IN SINGLE STRING)
RGPRS: MOVEI 0,NOSTOR
RGPARS: HRLM 0,(P) ; SAVE FOR STORE CHECKING
CAMGE AB,[-2,,] ; MULTI-STRING CASE POSSIBLE?
JRST TN.MLT ; YES, GO PROCESS
RGPRSS: GETYP 0,(AB) ; CHECK ARG TYPE
CAIE 0,TCHSTR
JRST WRONGT ; FOR NOW ONLY STRING ARGS WIN
PUSH TP,(AB)
PUSH TP,1(AB)
PUSHJ P,FLSSP ; FLUSH LEADING SPACES
PUSHJ P,RGPRS1
ADD AB,[2,,2]
MOVEM AB,ABSAV(TB)
CHKLST: JUMPGE AB,CPOPJ1
SKIPGE (P) ; IF FROM OPEN, ALLOW ONE MORE
POPJ P,
PMOVEM (AB),T.XT(TB)
ADD AB,[2,,2]
MOVEM AB,ABSAV(TB)
JUMPL AB,TMA
CPOPJ1: AOS (P)
POPJ P,
RGPRS1: PUSH P,[0] ; ALLOW A DEVICE SPEC
TN.SNM: MOVE A,(TP)
HRRZ 0,-1(TP)
JUMPE 0,RPDONE
ILDB A,A
CAIE A,"< ; START "DIRECTORY" ?
JRST TN.N1 ; NO LOOK FOR NAME1
SETOM (P) ; DEV NOT ALLOWED
IBP (TP) ; SKIP CHAR
SOS -1(TP)
PUSHJ P,TN.CNT ; COUNT CHARS TO ">" OR "."
JUMPE B,ILLNAM ; RAN OUT
CAIE A,".
JRST TN.SN3
PUSH TP,0
PUSH TP,C
TN.SN1: PUSHJ P,TN.CNT ; COUNT CHARS TO ">"
JUMPE B,ILLNAM ; RAN OUT
CAIE A,".
JRST TN.SN2
MOVEM 0,-1(TP)
MOVEM C,(TP)
JRST TN.SN1
TN.SN2: HRRZ B,-3(TP)
SUB B,0
SUBI B,1
SUB TP,[2,,2]
TN.SN3: CAIE A,"> ; SKIP IF WINS
JRST ILLNAM
PUSHJ P,TN.CPS ; COPY TO NEW STRING
HLLOS T.SPDL(TB)
MOVEM A,T.SNM(TB)
MOVEM B,T.SNM+1(TB)
TN.N1: PUSHJ P,TN.CNT
JUMPE B,RPDONE
CAIE A,": ; GOT A DEVICE
JRST TN.N11
SKIPE (P)
JRST ILLNAM
SETOM (P)
PUSHJ P,TN.CPS
MOVEM A,T.DEV(TB)
MOVEM B,T.DEV+1(TB)
JRST TN.SNM ; NOW LOOK FOR SNAME
TN.N11: CAIE A,">
CAIN A,"<
JRST ILLNAM
MOVEM A,(P) ; SAVE END CHAR
PUSHJ P,TN.CPS ; GEN STRING
MOVEM A,T.NM1(TB)
MOVEM B,T.NM1+1(TB)
TN.N2: SKIPN A,(P) ; GET CHAR BACK
JRST RPDONE
CAIN A,"; ; START VERSION?
JRST .+3
CAIE A,". ; START NAME2?
JRST ILLNAM ; I GIVE UP!!!
HRRZ B,-1(TP) ; GET RMAINS OF STRING
PUSHJ P,TN.CPS ; AND COPY IT
MOVEM A,T.NM2(TB)
MOVEM B,T.NM2+1(TB)
RPDONE: SUB P,[1,,1] ; FLUSH TEMP
SUB TP,[2,,2]
CPOPJ: POPJ P,
TN.CNT: HRRZ 0,-1(TP) ; CHAR COUNT
MOVE C,(TP) ; BPTR
MOVEI B,0 ; INIT COUNT TO 0
TN.CN1: MOVEI A,0 ; IN CASE RUN OUT
SOJL 0,CPOPJ ; RUN OUT?
ILDB A,C ; TRY ONE
CAIE A," ; TNEX FILE QUOTE?
JRST TN.CN2
SOJL 0,CPOPJ
IBP C ; SKIP QUOTED CHAT
ADDI B,2
JRST TN.CN1
TN.CN2: CAIE A,"<
CAIN A,">
POPJ P,
CAIE A,".
CAIN A,";
POPJ P,
CAIN A,":
POPJ P,
AOJA B,TN.CN1
TN.CPS: PUSH P,B ; # OF CHARS
MOVEI A,4(B) ; ADD 4 TO B IN A
IDIVI A,5
PUSHJ P,IBLOCK ; GET BLOCK OF WORDS FOR STRING
POP P,C ; CHAR COUNT BACK
HRLI B,010700
SUBI B,1
MOVSI A,TCHSTR
HRRI A,(C) ; CHAR STRING
MOVE D,B ; COPY BYTER
JUMPE C,CPOPJ
ILDB 0,(TP) ; GET CHAR
IDPB 0,D ; AND STROE
SOJG C,.-2
MOVNI C,(A) ; - LENGTH TO C
ADDB C,-1(TP) ; DECREMENT WORDS COUNT
TRNN C,-1 ; SKIP IF EMPTY
POPJ P,
IBP (TP)
SOS -1(TP) ; ELSE FLUSH TERMINATOR
POPJ P,
ILLNAM: ERRUUO EQUOTE ILLEGAL-TENEX-FILE-NAME
TN.MLT: MOVE A,AB ; AOBJN POINTER TO ARGS IN A
TN.ML1: GETYP 0,(A) ; IS THIS ARG OF RIGHT TYPE
CAIE 0,TFIX
CAIN 0,TCHSTR
JRST .+2
JRST RGPRSS ; ASSUME SINGLE STRING
ADD A,[2,,2]
JUMPL A,TN.ML1 ; TRY NEXT ARG IF ANY LEFT
MOVEI 0,T.NM1(TB) ; 1ST WORD OF DESTINATION
HLRO A,AB ; MINUS NUMBER OF ARGS IN A
MOVN A,A ; NUMBER OF ARGS IN A
SUBI A,1
CAMGE AB,[-10,,0]
MOVEI A,7 ; IF MORE THAN 10 ARGS, PUT 7
ADD A,0 ; LAST WORD OF DESTINATION
HRLI 0,(AB)
BLT 0,(A) ; BLT 'EM IN
ADD AB,[10,,10] ; SKIP THESE GUYS
MOVEM AB,ABSAV(TB)
JRST CHKLST
]
; ROUTINE TO OPEN A CHANNEL FOR ANY DEVICE. NAMES ARE ASSUMED TO ALREADY
; BE ON BOTH TP STACK AND P STACK
OPNCH: MOVE C,T.SPDL+1(TB) ; GET PDL BASE
HRRZ A,S.DIR(C)
ANDI A,1 ; JUST WANT I AND O
IFE ITS,[
HRLM A,S.DEV(C)
; .TRANS S.DEV(C) ; UNDO ANY TRANSLATIONS
; JRST TRLOST ; COMPLAIN
]
IFN ITS,[
HRLM A,S.DIR(C)
]
IFN ITS,[
MOVE A,S.DEV(C) ; GET SIXBIT DEVICE CODE
]
IFE ITS,[HRLZS A,S.DEV(C)
]
MOVSI B,-NDEVS ; AOBJN COUNTER
DEVLP: SETO D,
MOVE 0,DEVSTB(B) ; GET ONE FROM TABLE
MOVE E,A
DEVLP1: AND E,D ; FLUSH POSSIBLE DIGITNESS
CAMN 0,E
JRST CHDIGS ; MAKE SURE REST IS DIGITS
LSH D,6
JUMPN D,DEVLP1 ; KEEP TRUCKING UNTIL DONE
; WASN'T THAT DEVICE, MOVE TO NEXT
NXTDEV: AOBJN B,DEVLP
JRST ODSK ; UNKNOWN DEVICE IS ASSUMED TO BE DISK
IFN ITS,[
OUSR: HRRZ A,S.DIR(C) ; BLOCK OR UNIT?
TRNE A,2 ; SKIP IF UNIT
JRST ODSK
PUSHJ P,OPEN1 ; OPEN IT
PUSHJ P,FIXREA ; AND READCHST IT
MOVE B,T.CHAN+1(TB) ; RESTORE CHANNEL
MOVE 0,[PUSHJ P,DOIOT] ; GET AN IOINS
MOVEM 0,IOINS(B)
MOVE C,T.SPDL+1(TB)
HRRZ A,S.DIR(C)
TRNN A,1
JRST EOFMAK
MOVEI 0,80.
MOVEM 0,LINLN(B)
JRST OPNWIN
OSTY: HLRZ A,S.DIR(C)
IORI A,10 ; THE DONT LOSE BIT (DONT HANG ON INPUT DO ON OUTPUT)
HRLM A,S.DIR(C)
JRST OUSR
]
; MAKE SURE DIGITS EXIST
CHDIGS: SETCA D,
JUMPE D,DISPA ; NO DIGITS, WIN IMMEDIATE
MOVE E,A
AND E,D ; LEAVES ONLY DIGITS, IF WINNING
LSH E,6
LSH D,6
JUMPG D,.-2 ; KEEP GOING TIL DIGITS LEFT SHIFTED
JRST CHDIGN
CHDIG1: CAIG D,'9
CAIGE D,'0
JRST NXTDEV ; NOT A DIGIT, LOSE
JUMPE E,DISPA ; IF THAT'S ALL THE CHARACTERS, WIN!
CHDIGN: SETZ D,
ROTC D,6 ; GET NEXT CHARACTER INTO D
JRST CHDIG1 ; GO TEST?
; HERE TO DISPATCH IF SUCCESSFUL
DISPA: JRST @DEVS(B)
IFN ITS,[
; DISK DEVICE OPNER COME HERE
ODSK: MOVE A,S.SNM(C) ; GET SNAME
.SUSET [.SSNAM,,A] ; CLOBBER IT
PUSHJ P,OPEN0 ; DO REAL LIVE OPEN
]
IFE ITS,[
; TENEX DISK FILE OPENER
ODSK: MOVE B,T.CHAN+1(TB) ; GET CHANNEL
PUSHJ P,STSTK ; EXPAND STRING ONTO STACK (E POINTS TO OLD P)
MOVE A,DIRECT-1(B)
MOVE B,DIRECT(B)
PUSHJ P,STRTO6 ; GET DIR NAME
MOVE C,(P)
MOVE D,T.SPDL+1(TB)
HRRZ D,S.DIR(D)
CAME C,[SIXBIT /PRINAO/]
CAMN C,[SIXBIT /PRINTO/]
IORI D,100 ; TURN ON BIT TO SAY USE OLD FILE
MOVSI A,101 ; START SETTING UP BITS EXTRA BIT FOR MSB
TRNE D,1 ; SKIP IF INPUT
TRNE D,100 ; WITE OVER?
TLOA A,100000 ; FORCE OLD VERSION
TLO A,600000 ; FORCE NEW VERSION
HRROI B,1(E) ; POINT TO STRING
GTJFN
TDZA 0,0 ; SAVE FACT OF NO SKIP
MOVEI 0,1 ; INDICATE SKIPPED
POP P,C ; RECOVER OPEN MODE SIXBIT
MOVE P,E ; RESTORE PSTACK
JUMPE 0,GTJLOS ; FIND OUT WHAT HAPPENED
MOVE B,T.CHAN+1(TB) ; GET CHANNEL
HRRZ 0,-4(B) ; FUNNY MODE BITS
HRRZM A,CHANNO(B) ; SAVE IT
ANDI A,-1 ; READ Y TO DO OPEN
MOVSI B,440000 ; USE 36. BIT BYES
HRRI B,200000 ; ASSUME READ
; CAMN C,[SIXBIT /READB/]
; TRO B,2000 ; TURN ON THAWED IF READB
IOR B,0
TRNE D,1 ; SKIP IF READ
HRRI B,300000 ; WRITE BIT
HRRZ 0,FSAV(TB) ; SEE IF REF DATE HACK
CAIN 0,NFOPEN
TRO B,400 ; SET DON'T MUNG REF DATE BIT
MOVE E,B ; SAVE BITS FOR REOPENS
OPENF
JRST OPFLOS
MOVE B,[2,,11] ; GET LENGTH & BYTE SIZE
PUSH P,[0]
PUSH P,[0]
MOVEI C,-1(P)
GTFDB
LDB 0,[300600,,-1(P)] ; GET BYTE SIZE
MOVE B,(P)
SUB P,[2,,2]
CAIN 0,7
JRST SIZASC
CAIN 0,36.
SIZEF ; USE OPENED SIZE
JFCL
IMULI B,5 ; TO BYTES
SIZASC: MOVEI 0,C.OPN+C.READ+C.DISK
TRNE D,1 ; SKIP FOR READ
MOVEI 0,C.OPN+C.PRIN+C.DISK
TRNE D,2 ; SKIP IF NOT BINARY FILE
TRO 0,C.BIN
HRL 0,B
MOVE B,T.CHAN+1(TB)
TRNE D,1
HLRM 0,LSTCH-1(B) ; SAVE CURRENT LENGTH
MOVEM E,STATUS(B)
HRRM 0,-2(B) ; MUNG THOSE BITS
ASH A,1 ; POINT TO SLOT
ADDI A,CHNL0 ; TO REAL SLOT
MOVEM B,1(A) ; SAVE CHANNEL
PUSHJ P,TMTNXS ; GET STRING FROM TENEX
MOVE B,CHANNO(B) ; JFN TO A
HRROI A,1(E) ; BASE OF STRING
MOVE C,[111111,,140001] ; WEIRD CONTROL BITS
JFNS ; GET STRING
MOVEI B,1(E) ; POINT TO START OF STRING
SUBM P,E ; RELATIVIZE E
PUSHJ P,TNXSTR ; MAKE INTO A STRING
SUB P,E ; BACK TO NORMAL
PUSH TP,A
PUSH TP,B
PUSHJ P,RGPRS1 ; PARSE INTO FIELDS
MOVE B,T.CHAN+1(TB)
MOVEI C,RNAME1-1(B)
HRLI C,T.NM1(TB)
BLT C,RSNAME(B)
JRST OPBASC
OPFLOS: MOVEI C,(A) ; SAVE ERROR CODE
MOVE B,T.CHAN+1(TB)
HRRZ A,CHANNO(B) ; JFN BACK TO A
RLJFN ; TRY TO RELEASE IT
JFCL
MOVEI A,(C) ; ERROR CODE BACK TO A
GTJLOS: MOVE B,T.CHAN+1(TB)
PUSHJ P,TGFALS ; GET A FALSE WITH REASON
JRST OPNRET
STSTK: PUSH TP,$TCHAN
PUSH TP,B
MOVEI A,4+5 ; COUNT CHARS NEEDED (NEED LAST 0 BYTE)
MOVE B,(TP)
ADD A,RDEVIC-1(B)
ADD A,RNAME1-1(B)
ADD A,RNAME2-1(B)
ADD A,RSNAME-1(B)
ANDI A,-1 ; TO 18 BITS
MOVEI 0,A(A)
IDIVI A,5 ; TO WORDS NEEDED
POP P,C ; SAVE RET ADDR
MOVE E,P ; SAVE POINTER
PUSH P,[0] ; ALOCATE SLOTS
SOJG A,.-1
PUSH P,C ; RET ADDR BACK
INTGO ; IN CASE OVERFLEW
PUSH P,0
MOVE B,(TP) ; IN CASE GC'D
MOVE D,[440700,,1(E)] ; BYTE POINTER TO IT
MOVEI A,RDEVIC-1(B)
PUSHJ P,MOVSTR ; FLUSH IT ON
HRRZ A,T.SPDL(TB)
JUMPN A,NLNMS ; USER GAVE NAME, USE IT (CAREFUL, RELIES ON
; A BEING NON ZERO)
PUSH P,B
PUSH P,C
MOVEI A,0 ; HERE TO SEE IF THIS IS REALLY L.N.
HRROI B,1(E)
HRROI C,1(P)
LNMST ; LOOK UP LOGICAL NAME
MOVNI A,1 ; NOT A LOGICAL NAME
POP P,C
POP P,B
NLNMS: MOVEI 0,":
IDPB 0,D
JUMPE A,ST.NM1 ; LOGICAL NAME, FLUSH SNAME
HRRZ A,RSNAME-1(B) ; ANY SNAME AT ALL?
JUMPE A,ST.NM1 ; NOPE, CANT HACK WITH IT
MOVEI A,"<
IDPB A,D
MOVEI A,RSNAME-1(B)
PUSHJ P,MOVSTR ; SNAME UP
MOVEI A,">
IDPB A,D
ST.NM1: MOVEI A,RNAME1-1(B)
PUSHJ P,MOVSTR
MOVEI A,".
IDPB A,D
MOVEI A,RNAME2-1(B)
PUSHJ P,MOVSTR
SUB TP,[2,,2]
POP P,A
POPJ P,
MOVSTR: HRRZ 0,(A) ; CHAR COUNT
MOVE A,1(A) ; BYTE POINTER
SOJL 0,CPOPJ
ILDB C,A ; GET CHAR
IDPB C,D ; MUNG IT UP
JRST .-3
; MAKE A TENEX ERROR MESSAGE STRING
TGFALS: PUSH TP,$TCHAN
PUSH TP,B
PUSH P,A ; SAVE ERROR CODE
PUSHJ P,TMTNXS ; STRING ON STACK
HRROI A,1(E) ; POINT TO SPACE
MOVE B,(E) ; ERROR CODE
HRLI B,400000 ; FOR ME
MOVSI C,-100. ; MAX CHARS
ERSTR ; GET TENEX STRING
JRST TGFLS1
JRST TGFLS1
MOVEI B,1(E) ; A AND B BOUND STRING
SUBM P,E ; RELATIVIZE E
PUSHJ P,TNXSTR ; BUILD STRING
SUB P,E ; P BACK TO NORMAL
TGFLS2:
IFE FNAMS, SUB P,[1,,1] ; FLUSH ERROR CODE SLOT
IFN FNAMS,[
PUSH TP,A
PUSH TP,B
SKIPN B,-2(TP)
JRST TGFLS3
PUSHJ P,STSTK
MOVEI B,1(E)
SUBM P,E
MOVSI A,440700
HRRI A,(P)
MOVEI C,5
ILDB 0,A
JUMPE 0,.+2
SOJG C,.-2
PUSHJ P,TNXSTR
PUSH TP,A
PUSH TP,B
SUB P,E
TGFLS3: POP P,A
PUSH TP,$TFIX
PUSH TP,A
MOVEI A,3
SKIPN B
MOVEI A,2
]
IFE FNAMS,[
MOVEI A,1
]
PUSHJ P,IILIST ; BUILD LIST
MOVSI A,TFALSE ; MAKE IT FALSE
SUB TP,[2,,2]
POPJ P,
TGFLS1: MOVE P,E ; RESET STACK
MOVE A,$TCHSTR
MOVE B,CHQUOTE UNKNOWN PROBLEM IN I/O
JRST TGFLS2
]
; OTHER BUFFERED DEVICES JOIN HERE
OPDSK1:
IFN ITS,[
PUSHJ P,FIXREA ; STORE THE "REAL" NAMES INTO THE CHANNEL
]
OPBASC: MOVE C,T.SPDL+1(TB) ; C WAS CLOBBERED, GET IT BACK
HRRZ A,S.DIR(C) ; FIND OUT IF OPEN IS ASCII OR WORD
TRZN A,2 ; SKIP IF BINARY
PUSHJ P,OPASCI ; DO IT FOR ASCII
; NOW SET UP IO INSTRUCTION FOR CHANNEL
MAKION: MOVE B,T.CHAN+1(TB)
MOVEI C,GETCHR
JUMPE A,MAKIO1 ; JUMP IF INPUT
MOVEI C,PUTCHR ; ELSE GET INPUT
MOVEI 0,80. ; DEFAULT LINE LNTH
MOVEM 0,LINLN(B)
MOVSI 0,TFIX
MOVEM 0,LINLN-1(B)
MAKIO1:
HRLI C,(PUSHJ P,)
MOVEM C,IOINS(B) ; STORE IT
JUMPN A,OPNWIN ; GET AN EOF FORM FOR INPUT CHANNEL
; HERE TO CONS UP <ERROR END-OF-FILE>
EOFMAK: MOVSI C,TATOM
MOVE D,EQUOTE END-OF-FILE
PUSHJ P,INCONS
MOVEI E,(B)
MOVSI C,TATOM
MOVE D,IMQUOTE ERROR
PUSHJ P,ICONS
MOVE D,T.CHAN+1(TB) ; RESTORE CHANNEL
MOVSI 0,TFORM
MOVEM 0,EOFCND-1(D)
MOVEM B,EOFCND(D)
OPNWIN: MOVEI 0,10. ; SET UP RADIX
MOVSI A,TCHAN ; OPEN SUCCEEDED, RET CHANNEL
MOVE B,T.CHAN+1(TB)
MOVEM 0,RADX(B)
OPNRET: MOVE D,T.CHAN+1(TB) ; IN CASE WE RECYCLE IT
MOVE C,(P) ; RET ADDR
SUB P,[S.X3+2,,S.X3+2]
SUB TP,[T.CHAN+2,,T.CHAN+2]
JRST (C)
; HERE TO CREATE CHARACTER BUFFERS FOR ASCII I/O
OPASCI: PUSH P,A ; CONTAINS MODE, SAVE IT
MOVEI A,BUFLNT ; GET SIZE OF BUFFER
PUSHJ P,IBLOCK ; GET STORAGE
MOVSI 0,TWORD+.VECT. ; SET UTYPE
MOVEM 0,BUFLNT(B) ; AND STORE
MOVSI A,TCHSTR
SKIPE (P) ; SKIP IF INPUT
JRST OPASCO
MOVEI D,BUFLNT-1(B) ; REST BYTE POINTER
OPASCA: HRLI D,010700
MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK
MOVEI 0,C.BUF
IORM 0,-2(B) ; TURN ON BUFFER BIT
MOVEM A,BUFSTR-1(B)
MOVEM D,BUFSTR(B) ; CLOBBER
POP P,A
POPJ P,
OPASCO: HRROI C,777776
MOVEM C,(B) ; -1 THE BUFFER (LEAVE OFF LOW BIT)
MOVSI C,(B)
HRRI C,1(B) ; BUILD BLT POINTER
BLT C,BUFLNT-1(B) ; ZAP
MOVEI D,-1(B) ; START MAKING STRING POINTER
HRRI A,BUFLNT*5 ; SET UP CHAR COUNT
JRST OPASCA
; OPEN NON FILE ORIENTED DEVICES (NUL, PTR, PTP ETC.)
IFN ITS,[
ONUL:
OPTP:
OPTR: PUSHJ P,OPEN0 ; SET UP MODE AND OPEN
SETZM S.NM1(C) ; CLOBBER UNINTERESTING FIELDS
SETZM S.NM2(C)
SETZM S.SNM(C)
JRST OPDSK1
; OPEN DEVICES THAT IGNORE SNAME
OUTN: PUSHJ P,OPEN0
SETZM S.SNM(C)
JRST OPDSK1
]
; INTERNAL CHANNEL OPENER
OINT: HRRZ A,S.DIR(C) ; CHECK DIR
CAIL A,2 ; READ/PRINT?
JRST WRONGD ; NO, LOSE
MOVE 0,INTINS(A) ; GET INS
MOVE D,T.CHAN+1(TB) ; AND CHANNEL
MOVEM 0,IOINS(D) ; AND CLOBBER
MOVEI 0,C.OPN+C.READ
TRNE A,1
MOVEI 0,C.OPN+C.PRIN
HRRM 0,-2(D)
SETOM STATUS(D) ; MAKE SURE NOT AA TTY
PMOVEM T.XT(TB),INTFCN-1(D)
; HERE TO SAVE PSEUDO CHANNELS
SAVCHN: HRRZ E,CHNL0+1 ; POINT TO CURRENT LIST
MOVSI C,TCHAN
PUSHJ P,ICONS ; CONS IT ON
HRRZM B,CHNL0+1
JRST OPNWIN
; INT DEVICE I/O INS
INTINS: PUSHJ P,GTINTC
PUSHJ P,PTINTC
; HERE TO OPEN THE NET DEVICE (I.E. THE ARPA NET)
IFN ITS,[
ONET: HRRZ A,S.DIR(C) ; DIRECTION CODE
CAILE A,1 ; ASCII ?
IORI A,4 ; TURN ON IMAGE BIT
SKIPGE S.NM1(C) ; NAME1 I.E. LOCAL HOST GIVEN
IORI A,10 ; NO, WE WILL LET ITS GIVE US ONE
SKIPGE S.NM2(C) ; NORMAL OR "LISTEN"
IORI A,20 ; TURN ON LISTEN BIT
MOVEI 0,7 ; DEFAULT BYTE SIZE
TRNE A,2 ; UNLESS
MOVEI 0,36. ; IMAGE WHICH IS 36
SKIPN T.XT(TB) ; BYTE SIZE GIVEN?
MOVEM 0,S.X1(C) ; NO, STORE DEFAULT
SKIPG D,S.X1(C) ; BYTE SIZE REASONABLE?
JRST RBYTSZ ; NO <0, COMPLAIN
TRNE A,2 ; SKIP TO CHECK ASCII
JRST ONET2 ; CHECK IMAGE
CAIN D,7 ; 7-BIT WINS
JRST ONET1
CAIE D,44 ; 36-BIT INDICATES BLOCK ASCII MODE
JRST .+3
IORI A,2 ; SET BLOCK FLAG
JRST ONET1
IORI A,40 ; USE 8-BIT MODE
CAIN D,10 ; IS IT RIGHT
JRST ONET1 ; YES
]
RBYTSZ: ERRUUO EQUOTE BYTE-SIZE-BAD
IFN ITS,[
ONET2: CAILE D,36. ; IMAGE SIZE REASONABLE?
JRST RBYTSZ ; NO
CAIN D,36. ; NORMAL
JRST ONET1 ; YES, DONT SET FIELD
ASH D,9. ; POSITION FOR FIELD
IORI A,40(D) ; SET IT AND ITS BIT
ONET1: HRLM A,S.DIR(C) ; CLOBBER OPEN BLOCK
MOVE E,A ; SAVE BLOCK MODE INFO
PUSHJ P,OPEN1 ; DO THE OPEN
PUSH P,E
; CLOBBER REAL SLOTS FOR THE OPEN
MOVEI A,3 ; GET STATE VECTOR
PUSHJ P,IBLOCK
MOVSI A,TUVEC
MOVE D,T.CHAN+1(TB)
HLLM A,BUFRIN-1(D)
MOVEM B,BUFRIN(D)
MOVSI A,TFIX+.VECT. ; SET U TYPE
MOVEM A,3(B)
MOVE C,T.SPDL+1(TB)
MOVE B,T.CHAN+1(TB)
PUSHJ P,INETST ; GET STATE
POP P,A ; IS THIS BLOCK MODE
MOVEI 0,80. ; POSSIBLE LINE LENGTH
TRNE A,1 ; SKIP IF INPUT
MOVEM 0,LINLN(B)
TRNN A,2 ; BLOCK MODE?
JRST .+3
TRNN A,4 ; ASCII MODE?
JRST OPBASC ; GO SETUP BLOCK ASCII
MOVE 0,[PUSHJ P,DOIOT]
MOVEM 0,IOINS(B)
JRST OPNWIN
; INTERNAL ROUTINE TO GET THE CURRENT STATE OF THE NETWROK CHANNEL
INETST: MOVE A,S.NM1(C)
MOVEM A,RNAME1(B)
MOVE A,S.NM2(C)
MOVEM A,RNAME2(B)
LDB A,[1100,,S.SNM(C)]
MOVEM A,RSNAME(B)
MOVE E,BUFRIN(B) ; GET STATE BLOCK
INTST1: HRRE 0,S.X1(C)
MOVEM 0,(E)
ADDI C,1
AOBJN E,INTST1
POPJ P,
; ACCEPT A CONNECTION
MFUNCTION NETACC,SUBR
PUSHJ P,ARGNET ; CHECK THAT ARG IS AN OPEN NET CHANNEL
MOVE A,CHANNO(B) ; GET CHANNEL
LSH A,23. ; TO AC FIELD
IOR A,[.NETACC]
XCT A
JRST IFALSE ; RETURN FALSE
NETRET: MOVE A,(AB)
MOVE B,1(AB)
JRST FINIS
; FORCE SYSTEM NETWORK BUFFERS TO BE SENT
MFUNCTION NETS,SUBR
PUSHJ P,ARGNET
CAME A,MODES+1
CAMN A,MODES+3
SKIPA A,CHANNO(B) ; GET CHANNEL
JRST WRONGD
LSH A,23.
IOR A,[.NETS]
XCT A
JRST NETRET
; SUBR TO RETURN UPDATED NET STATE
MFUNCTION NETSTATE,SUBR
PUSHJ P,ARGNET ; IS IT A NET CHANNEL
PUSHJ P,INSTAT
JRST FINIS
; INTERNAL NETSTATE ROUTINE
INSTAT: MOVE C,P ; GET PDL BASE
MOVEI 0,S.X3 ; # OF SLOTS NEEDED
PUSH P,[0]
SOJN 0,.-1
; RESTORED FROM MUDDLE 54. IT SEEMED TO WORK THERE, AND THE STUFF
; COMMENTED OUT HERE CERTAINLY DOESN'T.
MOVEI D,S.DEV(C)
HRL D,CHANNO(B)
.RCHST D,
; HRR D,CHANNO(B) ; SETUP FOR RFNAME CALL
; DOTCAL RFNAME,[D,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]]
; .LOSE %LSFIL ; THIS MAY NOT BE DESIRABLE, BUT I ASSUME WE CARE IF
; LOSSAGE
PUSHJ P,INETST ; INTO VECTOR
SUB P,[S.X3,,S.X3]
MOVE B,BUFRIN(B)
MOVSI A,TUVEC
POPJ P,
]
; INTERNAL ROUTINE TO CHECK FOR CORRECT CHANNEL TYPE
ARGNET: ENTRY 1
GETYP 0,(AB)
CAIE 0,TCHAN
JRST WTYP1
MOVE B,1(AB) ; GET CHANNEL
SKIPN CHANNO(B) ; OPEN?
JRST CHNCLS
MOVE A,RDEVIC-1(B) ; GET DEV NAME
MOVE B,RDEVIC(B)
PUSHJ P,STRTO6
POP P,A
CAME A,[SIXBIT /NET /]
JRST NOTNET
MOVE B,1(AB)
MOVE A,DIRECT-1(B) ; CHECK FOR A READ SOCKET
MOVE B,DIRECT(B)
PUSHJ P,STRTO6
MOVE B,1(AB) ; RESTORE CHANNEL
POP P,A
POPJ P,
IFE ITS,[
; TENEX NETWRK OPENING CODE
ONET: MOVE B,T.CHAN+1(TB) ; GET CHANNEL
MOVSI C,100700
HRRI C,1(P)
MOVE E,P
PUSH P,[ASCII /NET:/] ; FOR STRINGS
GETYP 0,RNAME1-1(B) ; CHECK TYPE
CAIE 0,TFIX ; SKIP IF # SUPPLIED
JRST ONET1
MOVE 0,RNAME1(B) ; GET IT
PUSHJ P,FIXSTK
JFCL
JRST ONET2
ONET1: CAIE 0,TCHSTR
JRST WRONGT
HRRZ 0,RNAME1-1(B)
MOVE B,RNAME1(B)
JUMPE 0,ONET2
ILDB A,B
JSP D,ONETCH
SOJA 0,.-3
ONET2: MOVEI A,".
JSP D,ONETCH
MOVE B,T.CHAN+1(TB)
GETYP 0,RNAME2-1(B)
CAIE 0,TFIX
JRST ONET3
GETYP 0,RSNAME-1(B)
CAIE 0,TFIX
JRST WRONGT
MOVE 0,RSNAME(B)
CAIG 0,377 ;NEW STYLE 32 BIT HOST NUMBER?
JRST ONET2A
;CONVERT HOSTS2 HOST NUMBERS TO INTERNET (TOPS-20) HOST NUMBERS
MOVEI A,0
LDB B,[001100,,0] ;HOST NUMBER: 1.1-1.9 ->
DPB B,[201000,,A] ; 2.8-3.6
LDB B,[111100,,0] ;IMP LOW BITS: 2.1-2.9 ->
DPB B,[001000,,A] ; 1.1-1.8
LDB B,[221100,,0] ;IMP HIGH BITS: 3.1-3.9 ->
DPB B,[101000,,A] ; 1.9-2.7
LDB B,[331100,,0] ;NETWORK: 4.1-4.9 ->
DPB B,[301000,,A] ; 3.7-4.5
MOVE 0,A
ONET2A: PUSHJ P,FIXSTK
JRST ONET4
MOVE B,T.CHAN+1(TB)
MOVEI A,"-
JSP D,ONETCH
MOVE 0,RNAME2(B)
PUSHJ P,FIXSTK
JRST WRONGT
JRST ONET4
ONET3: CAIE 0,TCHSTR
JRST WRONGT
HRRZ 0,RNAME2-1(B)
MOVE B,RNAME2(B)
JUMPE 0,ONET4
ILDB A,B
JSP D,ONETCH
SOJA 0,.-3
ONET4:
ONET5: MOVE B,T.CHAN+1(TB)
GETYP 0,RNAME2-1(B)
CAIN 0,TCHSTR
JRST ONET6
MOVEI A,";
JSP D,ONETCH
MOVEI A,"T
JSP D,ONETCH
ONET6: MOVSI A,1
HRROI B,1(E) ; STRING POINTER
GTJFN ; GET THE G.D JFN
TDZA 0,0 ; REMEMBER FAILURE
MOVEI 0,1
MOVE P,E ; RESTORE P
JUMPE 0,GTJLOS ; CONS UP ERROR STRING
MOVE B,T.CHAN+1(TB)
HRRZM A,CHANNO(B) ; SAVE THE JFN
MOVE C,T.SPDL+1(TB)
MOVE D,S.DIR(C)
MOVEI B,10
TRNE D,2
MOVEI B,36.
SKIPE T.XT(TB)
MOVE B,T.XT+1(TB)
JUMPL B,RBYTSZ
CAILE B,36.
JRST RBYTSZ
ROT B,-6
TLO B,3400
HRRI B,200000
TRNE D,1 ; SKIP FOR INPUT
HRRI B,100000
ANDI A,-1 ; ISOLATE JFCN
OPENF
JRST OPFLOS ; REPORT ERROR
MOVE B,T.CHAN+1(TB)
ASH A,1 ; POINT TO SLOT
ADDI A,CHNL0 ; TO REAL SLOT
MOVEM B,1(A) ; SAVE CHANNEL
MOVE C,T.SPDL+1(TB) ; POINT TO P BASE
HRRZ A,S.DIR(C) ; 0/ 0 FOR READ 0/ 1 FOR PRINT
MOVEI 0,C.OPN+C.READ
TRNE A,1
MOVEI 0,C.OPN+C.PRIN
TRNE A,2
TRO 0,C.BIN
HRRM 0,-2(B)
MOVE A,CHANNO(B)
CVSKT ; GET ABS SOCKET #
FATAL NETWORK BITES THE BAG!
MOVE D,B
MOVE B,T.CHAN+1(TB)
MOVEM D,RNAME1(B)
MOVSI 0,TFIX
MOVEM 0,RNAME1-1(B)
MOVSI 0,TFIX
MOVEM 0,RNAME2-1(B)
MOVEM 0,RSNAME-1(B)
MOVE C,T.SPDL+1(TB)
MOVE C,S.DIR(C)
MOVE 0,[PUSHJ P,DONETO]
TRNN C,1 ; SKIP FOR OUTPUT
MOVE 0,[PUSHJ P,DONETI]
MOVEM 0,IOINS(B)
MOVEI 0,80. ; LINELENGTH
TRNE C,1 ; SKIP FOR INPUT
MOVEM 0,LINLN(B)
MOVEI A,3 ; GET STATE UVECTOR
PUSHJ P,IBLOCK
MOVSI 0,TFIX+.VECT.
MOVEM 0,3(B)
MOVE C,B
MOVE B,T.CHAN+1(TB)
MOVEM C,BUFRIN(B)
MOVSI 0,TUVEC
HLLM 0,BUFRIN-1(B)
MOVE B,CHANNO(B) ; GET JFN
MOVEI A,4 ; CODE FOR GTNCP
MOVEI C,1(P)
ADJSP P,4 ; ROOM FOR DATA
MOVE D,[-4,,1] ; GET FHOST, LOC SOC, F SOC
GTNCP
FATAL NET LOSSAGE ; GET STATE
MOVE B,(P)
MOVE D,-1(P)
MOVE C,-3(P)
ADJSP P,-4
MOVE E,T.CHAN+1(TB)
MOVEM D,RNAME2(E)
MOVEM C,RSNAME(E)
MOVE C,BUFRIN(E)
MOVEM B,(C) ; INITIAL STATE STORED
MOVE B,E
JRST OPNWIN
; DOIOT FOR TENEX NETWRK
DONETO: PUSH P,0
MOVE 0,[BOUT]
JRST .+3
DONETI: PUSH P,0
MOVE 0,[BIN]
PUSH P,0
PUSH TP,$TCHAN
PUSH TP,B
MOVEI 0,(A) ; POSSIBLE OUTPUT CHAR TO 0
MOVE A,CHANNO(B)
MOVE B,0
ENABLE
XCT (P)
DISABLE
MOVEI A,(B) ; RET CHAR IN A
MOVE B,(TP)
MOVE 0,-1(P)
SUB P,[2,,2]
SUB TP,[2,,2]
POPJ P,
NETPRS: MOVEI D,0
HRRZ 0,(C)
MOVE C,1(C)
ONETL: ILDB A,C
CAIN A,"#
POPJ P,
SUBI A,60
ASH D,3
IORI D,(A)
SOJG 0,ONETL
AOS (P)
POPJ P,
FIXSTK: CAMN 0,[-1]
POPJ P,
JFFO 0,FIXS3 ; PUT OCTAL DIGITS INTO STIRNG
MOVEI A,"0
POP P,D
AOJA D,ONETCH
FIXS3: IDIVI A,3
MOVEI B,12.
SUBI B,(A)
HRLM B,(P)
IMULI A,3
LSH 0,(A)
POP P,B
FIXS2: MOVEI A,0
ROTC 0,3 ; NEXT DIGIT
ADDI A,60
JSP D,ONETCH
SUB B,[1,,0]
TLNN B,-1
JRST 1(B)
JRST FIXS2
ONETCH: IDPB A,C
TLNE C,760000 ; SKIP IF NEW WORD
JRST (D)
PUSH P,[0]
JRST (D)
INSTAT: MOVE E,B
MOVE B,CHANNO(B) ; GET JFN
MOVEI A,4 ; CODE FOR GTNCP
MOVEI C,1(P)
ADJSP P,4 ; ROOM FOR DATA
MOVE D,[-4,,1] ; GET FHOST, LOC SOC, F SOC
GTNCP
FATAL NET LOSSAGE ; GET STATE
MOVE B,(P)
MOVE D,-1(P)
MOVE C,-3(P)
ADJSP P,-4
MOVEM D,RNAME2(E) ; UPDATE FOREIGN SOCHKET
MOVEM C,RSNAME(E) ; AND HOST
MOVE C,BUFRIN(E)
XCT ITSTRN(B) ; XLATE TO LOOK MORE LIKE ITS
MOVEM B,(C) ; STORE STATE
MOVE B,E
POPJ P,
ITSTRN: MOVEI B,0
JRST NLOSS
JRST NLOSS
MOVEI B,1
MOVEI B,2
JRST NLOSS
MOVEI B,4
PUSHJ P,NOPND
MOVEI B,0
JRST NLOSS
JRST NLOSS
PUSHJ P,NCLSD
MOVEI B,0
JRST NLOSS
MOVEI B,0
NLOSS: FATAL ILLEGAL NETWORK STATE
NOPND: MOVE B,DIRECT(E) ; SEE IF READ OR PRINT
ILDB B,B ; GET 1ST CHAR
CAIE B,"R ; SKIP FOR READ
JRST NOPNDW
SIBE ; SEE IF INPUT EXISTS
JRST .+3
MOVEI B,5
POPJ P,
MOVEM B,2(C) ; STORE BYTES IN STATE VECTOR
MOVEI B,11 ; RETURN DATA PRESENT STATE
POPJ P,
NOPNDW: SOBE ; SEE IF OUTPUT PRESENT
JRST .+3
MOVEI B,5
POPJ P,
MOVEI B,6
POPJ P,
NCLSD: MOVE B,DIRECT(E)
ILDB B,B
CAIE B,"R
JRST RET0
SIBE
JRST .+2
JRST RET0
MOVEI B,10
POPJ P,
RET0: MOVEI B,0
POPJ P,
MFUNCTION NETSTATE,SUBR
PUSHJ P,ARGNET
PUSHJ P,INSTAT
MOVE B,BUFRIN(B)
MOVSI A,TUVEC
JRST FINIS
MFUNCTION NETS,SUBR
PUSHJ P,ARGNET
CAME A,MODES+1 ; PRINT OR PRINTB?
CAMN A,MODES+3
SKIPA A,CHANNO(B)
JRST WRONGD
MOVEI B,21
MTOPR
NETRET: MOVE B,1(AB)
MOVSI A,TCHAN
JRST FINIS
MFUNCTION NETACC,SUBR
PUSHJ P,ARGNET
MOVE A,CHANNO(B)
MOVEI B,20
MTOPR
JRST NETRET
]
; HERE TO OPEN TELETYPE DEVICES
OTTY: HRRZ A,S.DIR(C) ; GET DIR CODE
TRNE A,2 ; SKIP IF NOT READB/PRINTB
JRST WRONGD ; CANT DO THAT
IFN ITS,[
MOVE A,S.NM1(C) ; CHECK FOR A DIR
MOVE 0,S.NM2(C)
CAMN A,[SIXBIT /.FILE./]
CAME 0,[SIXBIT /(DIR)/]
SKIPA E,[-15.*2,,]
JRST OUTN ; DO IT THAT WAY
HRRZ A,S.DIR(C) ; CHECK DIR
TRNE A,1
JRST TTYLP2
HRRI E,CHNL1
PUSH P,S.DEV(C) ; SAVE THE SIXBIT DEV NAME
; HRLZS (P) ; POSTITION DEVICE NAME
TTYLP: SKIPN D,1(E) ; CHANNEL OPEN?
JRST TTYLP1 ; NO, GO TO NEXT
MOVE A,RDEVIC-1(D) ; GET DEV NAME
MOVE B,RDEVIC(D)
PUSHJ P,STRTO6 ; TO 6 BIT
POP P,A ; GET RESULT
CAMN A,(P) ; SAME?
JRST SAMTYQ ; COULD BE THE SAME
TTYLP1: ADD E,[2,,2]
JUMPL E,TTYLP
SUB P,[1,,1] ; THIS ONE MUST BE UNIQUE
TTYLP2: MOVE C,T.SPDL+1(TB) ; POINT TO P BASE
HRRZ A,S.DIR(C) ; GET DIR OF OPEN
SKIPE A ; IF OUTPUT,
IORI A,20 ; THEN USE DISPLAY MODE
HRLM A,S.DIR(C) ; STORE IN OPEN BLOCK
PUSHJ P,OPEN2 ; OPEN THE TTY
MOVE A,S.DEV(C) ; GET DEVICE NAME
PUSHJ P,6TOCHS ; TO A STRING
MOVE D,T.CHAN+1(TB) ; POINT TO CHANNEL
MOVEM A,RDEVIC-1(D)
MOVEM B,RDEVIC(D)
MOVE C,T.SPDL+1(TB) ; RESTORE PDL BASE
MOVE B,D ; CHANNEL TO B
HRRZ 0,S.DIR(C) ; AND DIR
JUMPE 0,TTYSPC
TTY1: DOTCAL TTYGET,[CHANNO(B),[2000,,0],[2000,,A],[2000,,D]]
.LOSE %LSSYS
DOTCAL TTYSET,[CHANNO(B),MODE1,MODE2,D]
.LOSE %LSSYS
MOVE A,[PUSHJ P,GMTYO]
MOVEM A,IOINS(B)
DOTCAL RSSIZE,[CHANNO(B),[2000,,A],[2000,,D]]
.LOSE %LSSYS
MOVEM D,LINLN(B)
MOVEM A,PAGLN(B)
JRST OPNWIN
; MAKE AN IOT
IOTMAK: HRLZ A,CHANNO(B) ; GET CHANNEL
ROT A,5
IOR A,[.IOT A] ; BUILD IOT
MOVEM A,IOINS(B) ; AND STORE IT
POPJ P,
; HERE IF POSSIBLY OPENING AN ALREADY OPEN TTY
SAMTYQ: MOVE D,1(E) ; RESTORE CURRENT CHANNEL
MOVE A,DIRECT-1(D) ; GET DIR
MOVE B,DIRECT(D)
PUSHJ P,STRTO6
POP P,A ; GET SIXBIT
MOVE C,T.SPDL+1(TB)
HRRZ C,S.DIR(C)
CAME A,MODES(C) ; SKIP IF DIFFERENT DIRECTION
JRST TTYLP1
; HERE IF A RE-OPEN ON A TTY
HRRZ 0,FSAV(TB) ; IS IT FROM A FOPEN
CAIN 0,FOPEN
JRST RETOLD ; RET OLD CHANNEL
PUSH TP,$TCHAN
PUSH TP,1(E) ; PUSH OLD CHANNEL
PUSH TP,$TFIX
PUSH TP,T.CHAN+1(TB)
MOVE A,[PUSHJ P,CHNFIX]
MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS
PUSHJ P,GCHACK
SUB TP,[4,,4]
RETOLD: MOVE B,1(E) ; GET CHANNEL
AOS CHANNO-1(B) ; AOS REF COUNT
MOVSI A,TCHAN
SUB P,[1,,1] ; CLEAN UP STACK
JRST OPNRET ; AND LEAVE
; ROUTINE TO PASS TO GCHACK TO FIX UP CHANNEL POINTER
CHNFIX: CAIN C,TCHAN
CAME D,(TP)
POPJ P,
MOVE D,-2(TP) ; GET REPLACEMENT
SKIPE B
MOVEM D,1(B) ; CLOBBER IT AWAY
POPJ P,
]
IFE ITS,[
MOVE C,T.SPDL+1(TB) ; POINT TO P BASE
HRRZ 0,S.DIR(C) ; 0/ 0 FOR READ 0/ 1 FOR PRINT
MOVE A,[PUSHJ P,INMTYO]
MOVE B,T.CHAN+1(TB)
MOVEM A,IOINS(B)
MOVEI A,100 ; PRIM INPUT JFN
JUMPN 0,TNXTY1
MOVEI E,C.OPN+C.READ+C.TTY
HRRM E,-2(B)
MOVEM B,CHNL0+2*100+1
JRST TNXTY2
TNXTY1: MOVEM B,CHNL0+2*101+1
MOVEI A,101 ; PRIM OUTPUT JFN
MOVEI E,C.OPN+C.PRIN+C.TTY
HRRM E,-2(B)
TNXTY2: MOVEM A,CHANNO(B)
JUMPN 0,OPNWIN
]
; SETUP FUNNY BUFFER FOR TTY INPUT DEVICES
TTYSPC: MOVEI A,EXTBFR ; GET EXTRA BUFFER
PUSHJ P,IBLOCK ; GET BLOCK
MOVE D,T.CHAN+1(TB) ;RESTORE CHANNEL POINTER
IFN ITS,[
MOVE A,CHANNO(D)
LSH A,23.
IOR A,[.IOT A]
MOVEM A,IOIN2(B)
]
IFE ITS,[
MOVE A,[PBIN]
MOVEM A,IOIN2(B)
]
MOVSI A,TLIST
MOVEM A,EXBUFR-1(D) ; FOR WAITING TTY BUFFERS
SETZM EXBUFR(D) ; NIL LIST
MOVEM B,BUFRIN(D) ;STORE IN CHANNEL
MOVSI A,TUVEC ;MAKE SURE TYPE IS UNIFORM VECTOR
HLLM A,BUFRIN-1(D)
MOVEI A,177 ;SET ERASER TO RUBOUT
MOVEM A,ERASCH(B)
IFE ITS,[
MOVEI A,25
MOVEM A,KILLCH(B)
]
IFN ITS,[
SETZM KILLCH(B) ;NO KILL CHARACTER NEEDED
]
MOVEI A,33 ;BREAKCHR TO C.R.
MOVEM A,BRKCH(B)
MOVEI A,"\ ;ESCAPER TO \
MOVEM A,ESCAP(B)
MOVE A,[010700,,BYTPTR(E)] ;RELATIVE BYTE POINTER
MOVEM A,BYTPTR(B)
MOVEI A,14 ;BARF BACK CHARACTER FF
MOVEM A,BRFCHR(B)
MOVEI A,^D
MOVEM A,BRFCH2(B)
; SETUP DEFAULT TTY INTERRUPT HANDLER
PUSH TP,$TATOM
PUSH TP,MQUOTE CHAR,CHAR,INTRUP
PUSH TP,$TFIX
PUSH TP,[10] ; PRIORITY OF CHAR INT
PUSH TP,$TCHAN
PUSH TP,D
MCALL 3,EVENT ; 1ST MAKE AN EVENT EXIST
PUSH TP,A
PUSH TP,B
PUSH TP,$TSUBR
PUSH TP,[QUITTER] ; DEFAULT HANDLER IS QUITTER
MCALL 2,HANDLER
; BUILD A NULL STRING
MOVEI A,0
PUSHJ P,IBLOCK ; USE A BLOCK
MOVE D,T.CHAN+1(TB)
MOVEI 0,C.BUF
IORM 0,-2(D)
HRLI B,010700
SUBI B,1
MOVSI A,TCHSTR
MOVEM A,BUFSTR-1(D)
MOVEM B,BUFSTR(D)
MOVEI A,0
MOVE B,D ; CHANNEL TO B
JRST MAKION
; ROUTINE TO OPEN ITS CHANNEL WITHOUT .RCHST
IFN ITS,[
OPEN2: MOVEI A,S.DIR(C) ; POINT TO OPEN BLOCK
PUSHJ P,MOPEN ; OPEN THE FILE
JRST OPNLOS
MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK
MOVEM A,CHANNO(B) ; SAVE THE CHANNEL
JRST OPEN3
; FIX UP MODE AND FALL INTO OPEN
OPEN0: HRRZ A,S.DIR(C) ; GET DIR
TRNE A,2 ; SKIP IF NOT BLOCK
IORI A,4 ; TURN ON IMAGE
IORI A,2 ; AND BLOCK
PUSH P,A
PUSH TP,$TPDL
PUSH TP,C ; SAVE CRUFT TO CHECK FOR PRINTO, HA HA
MOVE B,T.CHAN+1(TB)
MOVE A,DIRECT-1(B)
MOVE B,DIRECT(B) ; THIS KLUDGE THE MESS OF NDR
PUSHJ P,STRTO6
MOVE C,(TP)
POP P,D ; THE SIXBIT FOR KLUDGE
POP P,A ; GET BACK THE RANDOM BITS
SUB TP,[2,,2]
CAME D,[SIXBIT /PRINAO/]
CAMN D,[SIXBIT /PRINTO/]
IORI A,100000 ; WRITEOVER BIT
HRRZ 0,FSAV(TB)
CAIN 0,NFOPEN
IORI A,10 ; DON'T CHANGE REF DATE
OPEN9: HRLM A,S.DIR(C) ; AND STORE IT
; ROUTINE TO ATTEMPT TO OPEN A REAL ITS CHANNEL
OPEN1: MOVEI A,S.DIR(C) ; POINT TO OPEN BLOCK
PUSHJ P,MOPEN
JRST OPNLOS
MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK
MOVEM A,CHANNO(B) ; CLOBBER INTO CHANNEL
DOTCAL RFNAME,[A,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]]
JFCL
; NOW CLOBBER THE TVP SLOT FOR THIS CHANNEL
OPEN3: MOVE A,S.DIR(C)
MOVEI 0,C.OPN+C.READ
TRNE A,1
MOVEI 0,C.OPN+C.PRIN
TRNE A,2
TRO 0,C.BIN
HRRM 0,-2(B)
MOVE A,CHANNO(B) ; GET CHANNEL #
ASH A,1
ADDI A,CHNL0 ; POINT TO SLOT
MOVEM B,1(A) ; NOT: TYPE ALREADY SETUP
; NOW GET STATUS WORD
DOSTAT: HRRZ A,CHANNO(B) ; NOW GET STATUS WORD
DOTCAL STATUS,[A,[2002,,STATUS]]
JFCL
POPJ P,
; HERE IF OPEN FAILS (CHANNEL IS IN A)
OPNLOS: JUMPL A,NOCHAN ; ALL CHANNELS ARE IN USE
LSH A,23. ; DO A .STATUS
IOR A,[.STATUS A]
XCT A ; STATUS TO A
MOVE B,T.CHAN+1(TB)
PUSHJ P,GFALS ; GET A FALSE WITH A MESSAGE
SUB P,[1,,1] ; EXTRA RET ADDR FLUSHED
JRST OPNRET ; AND RETURN
]
CGFALS: SUBM M,(P)
MOVEI B,0
IFN ITS, PUSHJ P,GFALS
IFE ITS, PUSHJ P,TGFALS
JRST MPOPJ
; ROUTINE TO CONS UP FALSE WITH REASON
IFN ITS,[
GFALS: PUSH TP,$TCHAN
PUSH TP,B
PUSH P,[SIXBIT / ERR/] ; SET UP OPEN TO ERR DEV
PUSH P,[3] ; SAY ITS FOR CHANNEL
PUSH P,A
.OPEN 0,-2(P) ; USE CHANNEL 0 FOR THIS
FATAL CAN'T OPEN ERROR DEVICE
SUB P,[3,,3] ; DONT WANT OPEN BLOCK NOW
IFN FNAMS, PUSH P,A
MOVEI A,0 ; PREPARE TO BUILD STRING ON STACK
EL1: PUSH P,[0] ; WHERE IT WILL GO
MOVSI B,(<440700,,(P)>) ; BYTE POINTER TO TOP OF STACK
EL2: .IOT 0,0 ; GET A CHAR
JUMPL 0,EL3 ; JUMP ON -1,,3
CAIN 0,3 ; EOF?
JRST EL3 ; YES, MAKE STRING
CAIN 0,14 ; IGNORE FORM FEEDS
JRST EL2 ; IGNORE FF
CAIE 0,15 ; IGNORE CR & LF
CAIN 0,12
JRST EL2
IDPB 0,B ; STUFF IT
TLNE B,760000 ; SIP IF WORD FULL
AOJA A,EL2
AOJA A,EL1 ; COUNT WORD AND GO
EL3:
IFN FNAMS,[
SKIPN (P)
SUB P,[1,,1]
PUSH P,A
.CLOSE 0,
PUSHJ P,CHMAK
PUSH TP,A
PUSH TP,B
SKIPN B,-2(TP)
JRST EL4
MOVEI A,0
MOVSI B,(<440700,,(P)>)
PUSH P,[0]
IRP XX,,[RDEVIC,RSNAME,RNAME1,RNAME2]YY,,[0,72,73,40]
IFSN YY,0,[
MOVEI 0,YY
JSP E,1PUSH
]
MOVE E,-2(TP)
MOVE C,XX(E)
HRRZ D,XX-1(E)
JSP E,PUSHIT
TERMIN
]
SKIPN (P) ; ANY CHARS AT END?
SUB P,[1,,1] ; FLUSH XTRA
PUSH P,A ; PUT UP COUNT
.CLOSE 0, ; CLOSE THE ERR DEVICE
PUSHJ P,CHMAK ; MAKE STRING
PUSH TP,A
PUSH TP,B
IFN FNAMS,[
EL4: POP P,A
PUSH TP,$TFIX
PUSH TP,A]
IFE FNAMS, MOVEI A,1
IFN FNAMS,[
MOVEI A,3
SKIPN B
MOVEI A,2
]
PUSHJ P,IILIST
MOVSI A,TFALSE ; MAKEIT A FALSE
IFN FNAMS, SUB TP,[2,,2]
POPJ P,
IFN FNAMS,[
1PUSH: MOVEI D,0
JRST PUSHI2
PUSHI1: PUSH P,[0]
MOVSI B,(<440700,,(P)>)
PUSHIT: SOJL D,(E)
ILDB 0,C
PUSHI2: IDPB 0,B
TLNE B,760000
AOJA A,PUSHIT
AOJA A,PUSHI1
]
]
; ROUTINE TO FILL IN THE "REAL" SLOTS FOR THE CHANNEL
FIXREA:
IFE ITS, HRLZS S.DEV(C) ; KILL MODE BITS
MOVE D,[-4,,S.DEV]
FIXRE1: MOVEI A,(D) ; COPY REL POINTER
ADD A,T.SPDL+1(TB) ; POINT TO SLOT
SKIPN A,(A) ; SKIP IF GOODIE THERE
JRST FIXRE2
PUSHJ P,6TOCHS ; MAKE INOT A STRING
MOVE C,RDTBL-S.DEV(D); GET OFFSET
ADD C,T.CHAN+1(TB)
MOVEM A,-1(C)
MOVEM B,(C)
FIXRE2: AOBJN D,FIXRE1
POPJ P,
IFN ITS,[
DOOPN: HRLZ A,A
HRR A,CHANNO(B) ; GET CHANNEL
DOTCAL OPEN,[A,-3(P),-2(P),-1(P),(P)]
SKIPA
AOS -1(P)
POPJ P,
]
;THIS ROUTINE CONVERTS MUDDLE CHARACTER STRINGS TO SIXBIT FILE NAMES
STRTO6: PUSH TP,A
PUSH TP,B
PUSH P,E ;SAVE USEFUL FROB
MOVEI E,(A) ; CHAR COUNT TO E
GETYP A,A
CAIE A,TCHSTR ; IS IT ONE WORD?
JRST WRONGT ;NO
CAILE E,6 ; SKIP IF L=? 6 CHARS
MOVEI E,6
CHREAD: MOVEI A,0 ;INITIALIZE OUTPUT WORD
MOVE D,[440600,,A] ;AND BYTE POINTER TO IT
NEXCHR: SOJL E,SIXDON
ILDB 0,B ; GET NEXT CHAR
CAIN 0,^Q ; CNTL-Q, QUOTES NEXT CHAR
JRST NEXCHR
JUMPE 0,SIXDON ;IF NULL, WE ARE FINISHED
PUSHJ P,A0TO6 ; CONVERT TO SIXBIT
IDPB 0,D ;DEPOSIT INTO SIX BIT
JRST NEXCHR ; NO, GET NEXT
SIXDON: SUB TP,[2,,2] ;FIX UP TP
POP P,E
EXCH A,(P) ;LEAVE RESULT ON P-STACK
JRST (A) ;NOW RETURN
;SUBROUTINE TO CONVERT SIXBIT TO ATOM
6TOCHS: PUSH P,E
PUSH P,D
MOVEI B,0 ;MAX NUMBER OF CHARACTERS
PUSH P,[0] ;STRING WILL GO ON P SATCK
JUMPE A,GETATM ; EMPTY, LEAVE
MOVEI E,-1(P) ;WILL BE BYTE POINTER
HRLI E,10700 ;SET IT UP
PUSH P,[0] ;SECOND POSSIBLE WORD
MOVE D,[440600,,A] ;INPUT BYTE POINTER
6LOOP: ILDB 0,D ;START CHAR GOBBLING
ADDI 0,40 ;CHANGET TOASCII
IDPB 0,E ;AND STORE IT
TLNN D,770000 ; SKIP IF NOT DONE
JRST 6LOOP1
TDNN A,MSKS(B) ; CHECK IF JUST SPACES LEFT
AOJA B,GETATM ; YES, DONE
AOJA B,6LOOP ;KEEP LOOKING
6LOOP1: PUSH P,[6] ;IF ARRIVE HERE, STRING IS 2 WORDS
JRST .+2
GETATM: MOVEM B,(P) ;SET STRING LENGTH=1
PUSHJ P,CHMAK ;MAKE A MUDDLE STRING
POP P,D
POP P,E
POPJ P,
MSKS: 7777,,-1
77,,-1
,,-1
7777
77
; CONVERT ONE CHAR
A0TO6: CAIL 0,141 ;IF IT IS GREATER OR EQUAL TO LOWER A
CAILE 0,172 ;BUT LESS THAN OR EQUAL TO LOWER Z
JRST .+2 ;THEN
SUBI 0,40 ;CONVERT TO UPPER CASE
SUBI 0,40 ;NOW TO SIX BIT
JUMPL 0,BAD6 ;CHECK FOR A WINNER
CAILE 0,77
JRST BAD6
POPJ P,
; SUBR TO TEST THE EXISTENCE OF FILES
MFUNCTION FEXIST,SUBR,[FILE-EXISTS?]
ENTRY
JUMPGE AB,TFA
PUSH TP,$TPDL
PUSH TP,P ; SAVE P-STACK BASE
ADD TP,[2,,2]
MOVSI E,-4 ; 4 THINGS TO PUSH
EXIST:
IFN ITS, MOVE B,@RNMTBL(E)
IFE ITS, MOVE B,@FETBL(E)
PUSH P,E
PUSHJ P,IDVAL1
POP P,E
GETYP 0,A
CAIE 0,TCHSTR ; SKIP IF WINS
JRST EXIST1
IFN ITS, PUSHJ P,STRTO6 ; CONVERT TO SIXBIT
IFE ITS,[
; PUSH P,E
; PUSHJ P,ADDNUL ; NOT NEEDED, SINCE CONSED INTO ONE STRING-TAA
; POP P,E
PUSH TP,A ; DEFAULT TYPE AND VALUE GIVEN BY USER
PUSH TP,B ; IN VALUE OF DEV, SNM, NM1, NM2
]
IFN ITS, JRST .+2
IFE ITS, JRST .+3
EXIST1:
IFN ITS, PUSH P,EXISTS(E) ; USE DEFAULT
IFE ITS,[
PUSH TP,FETYP(E) ; DEFAULT TYPE AND VALUE IF NO
PUSH TP,FEVAL(E) ; DEFAULT GIVEN BY USER
]
AOBJN E,EXIST
PUSHJ P,RGPRS ; PARSE THE ARGS
JRST TMA ; TOO MANY ARGUMENTS
IFN ITS,[
MOVE 0,-3(P) ; GET SIXBIT DEV NAME
MOVEI B,0
CAMN 0,[SIXBITS /DSK /]
MOVSI B,10 ; DONT SET REF DATE IF DISK DEV
.IOPUSH
DOTCAL OPEN,[B,[17,,-3],[17,,-2],[17,,-1],[17,,0]]
JRST .+3
.IOPOP
JRST FDLWON ; WON!!!
.STATUS 0,A ; FIND THE STATUS OF CHANNEL BEFORE POPING
.IOPOP
JRST FDLST1]
IFE ITS,[
MOVE B,TB
SUBI B,10 ; GET B TO POINT CORRECTLY TO ARGS
PUSHJ P,STSTK ; GET FILE NAME IN A STRING
HRROI B,1(E) ; POINT B TO THE STRING
MOVSI A,100001
GTJFN
JRST TDLLOS ; FILE DOES NOT EXIST
RLJFN ; FILE EXIST SO RETURN JFN
JFCL
JRST FDLWON ; SUCCESS
]
IFN ITS,[
EXISTS: SIXBITS /DSK INPUT > /
]
IFE ITS,[
FETBL: SETZ IMQUOTE NM1
SETZ IMQUOTE NM2
SETZ IMQUOTE DEV
SETZ IMQUOTE SNM
FETYP: TCHSTR,,5
TCHSTR,,3
TCHSTR,,3
TCHSTR,,0
FEVAL: 440700,,[ASCIZ /INPUT/]
440700,,[ASCIZ /MUD/]
440700,,[ASCIZ /DSK/]
0
]
; SUBR TO DELETE AND RENAME FILES
MFUNCTION RENAME,SUBR
ENTRY
JUMPGE AB,TFA
PUSH TP,$TPDL
PUSH TP,P ; SAVE P-STACK BASE
GETYP 0,(AB) ; GET 1ST ARG TYPE
IFN ITS,[
CAIN 0,TCHAN ; CHANNEL?
JRST CHNRNM ; MUST BE RENAME WHILE OPEN FOR WRITING
]
IFE ITS,[
PUSH P,[100000,,-2]
PUSH P,[377777,,377777]
]
MOVSI E,-4 ; 4 THINGS TO PUSH
RNMALP: MOVE B,@RNMTBL(E)
PUSH P,E
PUSHJ P,IDVAL1
POP P,E
GETYP 0,A
CAIE 0,TCHSTR ; SKIP IF WINS
JRST RNMLP1
IFN ITS, PUSHJ P,STRTO6 ; CONVERT TO SIXBIT
IFE ITS,[
PUSH P,E
PUSHJ P,ADDNUL
EXCH B,(P)
MOVE E,B
]
JRST .+2
RNMLP1: PUSH P,RNSTBL(E) ; USE DEFAULT
AOBJN E,RNMALP
IFN ITS,[
PUSHJ P,RGPRS ; PARSE THE ARGS
JRST RNM1 ; COULD BE A RENAME
; HERE TO DELETE A FILE
DELFIL: MOVE A,(P) ; AND GET SNAME
.SUSET [.SSNAM,,A]
DOTCAL DELETE,[[17,,-3],[17,,-2],[17,,-1],[17,,0]]
JRST FDLST ; ANALYSE ERROR
FDLWON: MOVSI A,TATOM
MOVE B,IMQUOTE T
JRST FINIS
]
IFE ITS,[
MOVE A,(AB)
MOVE B,1(AB)
PUSHJ P,ADDNUL
MOVE A,(TP) ; GET BASE OF PDL
MOVEI A,1(A) ; POINT TO CRAP
CAMGE AB,[-3,,] ; SKIP IF DELETE
HLLZS (A) ; RESET DEFAULT
PUSH P,[0]
PUSH P,[0]
PUSH P,[0]
GTJFN ; GET A JFN
JRST TDLLOS ; LOST
ADD AB,[2,,2] ; PAST ARG
MOVEM AB,ABSAV(TB)
JUMPL AB,RNM1 ; GO TRY FOR RENAME
MOVE P,(TP) ; RESTORE P STACK
MOVEI C,(A) ; FOR RELEASE
DELF ; ATTEMPT DELETE
JRST DELLOS ; LOSER
RLJFN ; MAKE SURE FLUSHED
JFCL
FDLWON: MOVSI A,TATOM
MOVE B,IMQUOTE T
JRST FINIS
RNMLOS: PUSH P,A
MOVEI A,(B)
RLJFN
JFCL
DELLO1: MOVEI A,(C)
RLJFN
JFCL
POP P,A ; ERR NUMBER BACK
TDLLOS: MOVEI B,0
PUSHJ P,TGFALS ; GET FALSE WITH REASON
JRST FINIS
DELLOS: PUSH P,A ; SAVE ERROR
JRST DELLO1
]
;TABLE OF REANMAE DEFAULTS
IFN ITS,[
RNMTBL: IMQUOTE DEV
IMQUOTE NM1
IMQUOTE NM2
IMQUOTE SNM
RNSTBL: SIXBIT /DSK _MUDS_> /
]
IFE ITS,[
RNMTBL: SETZ IMQUOTE DEV
SETZ IMQUOTE SNM
SETZ IMQUOTE NM1
SETZ IMQUOTE NM2
RNSTBL: -1,,[ASCIZ /DSK/]
0
-1,,[ASCIZ /_MUDS_/]
-1,,[ASCIZ /MUD/]
]
; HERE TO DO A RENAME
RNM1: JUMPGE AB,TMA ; IF ARGS EXHAUSTED, MUST BE TOO MUCH STRING
GETYP 0,(AB)
MOVE C,1(AB) ; GET ARG
CAIN 0,TATOM ; IS IT "TO"
CAME C,IMQUOTE TO
JRST WRONGT ; NO, LOSE
ADD AB,[2,,2] ; BUMP PAST "TO"
MOVEM AB,ABSAV(TB)
JUMPGE AB,TFA
IFN ITS,[
MOVEM P,T.SPDL+1(TB) ; SAVE NEW P-BASE
MOVEI 0,4 ; FOUR DEFAULTS
PUSH P,-3(P) ; DEFAULT DEVICE IS CURRENT
SOJN 0,.-1
PUSHJ P,RGPRS ; PARSE THE NEXT STRING
JRST TMA
MOVE A,-7(P) ; FIX AND GET DEV1
MOVE B,-3(P) ; SAME FOR DEV2
CAME A,B ; SAME?
JRST DEVDIF
POP P,A ; GET SNAME 2
CAME A,(P)-3 ; SNAME 1
JRST DEVDIF
.SUSET [.SSNAM,,A]
POP P,-2(P) ; MOVE NAMES DOWN
POP P,-2(P)
DOTCAL RENAME,[[17,,-4],[17,,-3],[17,,-2],A,[17,,-1],(P)]
JRST FDLST
JRST FDLWON
; HERE FOR RENAME WHILE OPEN FOR WRITING
CHNRNM: ADD AB,[2,,2] ; NEXT ARG
MOVEM AB,ABSAV(TB)
JUMPGE AB,TFA
MOVE B,-1(AB) ; GET CHANNEL
SKIPN CHANNO(B) ; SKIP IF OPEN
JRST BADCHN
MOVE A,DIRECT-1(B) ; CHECK DIRECTION
MOVE B,DIRECT(B)
PUSHJ P,STRTO6 ; TO 6 BIT
POP P,A
CAME A,[SIXBIT /PRINT/]
CAMN A,[SIXBIT /PRINTB/]
JRST CHNRN1
CAMN A,[SIXBIT /PRINAO/]
JRST CHNRN1
CAME A,[SIXBIT /PRINTO/]
JRST WRONGD
; SET UP .FDELE BLOCK
CHNRN1: PUSH P,[0]
PUSH P,[0]
MOVEM P,T.SPDL+1(TB)
PUSH P,[0]
PUSH P,[SIXBIT /_MUDL_/]
PUSH P,[SIXBIT />/]
PUSH P,[0]
PUSHJ P,RGPRS ; PARSE THESE
JRST TMA
SUB P,[1,,1] ; SNAME/DEV IGNORED
MOVE AB,ABSAV(TB) ; GET ORIG ARG POINTER
MOVE B,1(AB)
MOVE A,CHANNO(B) ; ITS CHANNEL #
DOTCAL RENMWO,[A,[17,,-1],(P)]
JRST FDLST
MOVE A,CHANNO(B) ; ITS CHANNEL #
DOTCAL RFNAME,[A,[2017,,-4],[2017,,-3],[2017,,-2],[2017,,-1]]
JFCL
MOVE A,-3(P) ; UPDATE CHANNEL
PUSHJ P,6TOCHS ; GET A STRING
MOVE C,1(AB)
MOVEM A,RNAME1-1(C)
MOVEM B,RNAME1(C)
MOVE A,-2(P)
PUSHJ P,6TOCHS
MOVE C,1(AB)
MOVEM A,RNAME2-1(C)
MOVEM B,RNAME2(C)
MOVE B,1(AB)
MOVSI A,TCHAN
JRST FINIS
]
IFE ITS,[
PUSH P,A
MOVE A,(AB)
MOVE B,1(AB)
PUSHJ P,ADDNUL
MOVE A,(TP) ; PBASE BACK
PUSH A,[400000,,0]
MOVEI A,(A)
GTJFN
JRST TDLLOS
POP P,B
EXCH A,B
MOVEI C,(A) ; FOR RELEASE ATTEMPT
RNAMF
JRST RNMLOS
MOVEI A,(B)
RLJFN ; FLUSH JFN
JFCL
MOVEI A,(C) ; MAKE SURR OTHER IS FLUSHED
RLJFN
JFCL
JRST FDLWON
ADDNUL: PUSH TP,A
PUSH TP,B
MOVEI A,(A) ; LNTH OF STRING
IDIVI A,5
JUMPN B,NONUAD ; DONT NEED TO ADD ONE
PUSH TP,$TCHRS
PUSH TP,[0]
MOVEI A,2
PUSHJ P,CISTNG ; COPY OF STRING
POPJ P,
NONUAD: POP TP,B
POP TP,A
POPJ P,
]
; HERE FOR LOSING .FDELE
IFN ITS,[
FDLST: .STATUS 0,A ; GET STATUS
FDLST1: MOVEI B,0
PUSHJ P,GFALS ; ANALYZE IT
JRST FINIS
]
; SOME .FDELE ERRORS
DEVDIF: ERRUUO EQUOTE DEVICE-OR-SNAME-DIFFERS
; HERE TO RESET A READ CHANNEL
MFUNCTION FRESET,SUBR,RESET
ENTRY 1
GETYP A,(AB)
CAIE A,TCHAN
JRST WTYP1
MOVE B,1(AB) ;GET CHANNEL
SKIPN IOINS(B) ; OPEN?
JRST REOPE1 ; NO, IGNORE CHECKS
IFN ITS,[
MOVE A,STATUS(B) ;GET STATUS
ANDI A,77
JUMPE A,REOPE1 ;IF IT CLOSED, JUST REOPEN IT, MAYBE?
CAILE A,2 ;SKIPS IF TTY FLAVOR
JRST REOPEN
]
IFE ITS,[
MOVE A,CHANNO(B)
CAIE A,100 ; TTY-IN
CAIN A,101 ; TTY-OUT
JRST .+2
JRST REOPEN
]
CAME B,TTICHN+1
CAMN B,TTOCHN+1
JRST REATTY
REATT1: MOVEI B,DIRECT-1(B) ;POINT TO DIRECTION
PUSHJ P,CHRWRD ;CONVERT TO A WORD
JFCL
CAME B,[ASCII /READ/]
JRST TTYOPN
MOVE B,1(AB) ;RESTORE CHANNEL
PUSHJ P,RRESET" ;DO REAL RESET
JRST TTYOPN
REOPEN: PUSH TP,(AB) ;FIRST CLOSE IT
PUSH TP,(AB)+1
MCALL 1,FCLOSE
MOVE B,1(AB) ;RESTORE CHANNEL
; SET UP TEMPS FOR OPNCH
REOPE1: PUSH P,[0] ; WILL HOLD DIR CODE
PUSH TP,$TPDL
PUSH TP,P
IRP A,,[DIRECT,RNAME1,RNAME2,RDEVIC,RSNAME,ACCESS]
PUSH TP,A-1(B)
PUSH TP,A(B)
TERMIN
PUSH TP,$TCHAN
PUSH TP,1(AB)
MOVE A,T.DIR(TB)
MOVE B,T.DIR+1(TB) ; GET DIRECTION
PUSHJ P,CHMOD ; CHECK THE MODE
MOVEM A,(P) ; AND STORE IT
; NOW SET UP OPEN BLOCK IN SIXBIT
IFN ITS,[
MOVSI E,-4 ; AOBN PNTR
FRESE2: MOVE B,T.CHAN+1(TB)
MOVEI A,@RDTBL(E) ; GET ITEM POINTER
GETYP 0,-1(A) ; GET ITS TYPE
CAIE 0,TCHSTR
JRST FRESE1
MOVE B,(A) ; GET STRING
MOVE A,-1(A)
PUSHJ P,STRTO6
FRESE3: AOBJN E,FRESE2
]
IFE ITS,[
MOVE B,T.CHAN+1(TB)
MOVE A,RDEVIC-1(B)
MOVE B,RDEVIC(B)
PUSHJ P,STRTO6 ; RESULT ON STACK
HLRZS (P)
]
PUSH P,[0] ; PUSH UP SOME DUMMIES
PUSH P,[0]
PUSH P,[0]
PUSHJ P,OPNCH ; ATTEMPT TO DO THEOPEN
GETYP 0,A
CAIE 0,TCHAN
JRST FINIS ; LEAVE IF FALSE OR WHATEVER
DRESET: MOVE A,(AB)
MOVE B,1(AB)
SETZM CHRPOS(B) ;INITIALIZE THESE PARAMETERS
SETZM LINPOS(B)
SETZM ACCESS(B)
JRST FINIS
TTYOPN:
IFN ITS,[
MOVE B,1(AB)
CAME B,TTOCHN+1
CAMN B,TTICHN+1
PUSHJ P,TTYOP2
PUSHJ P,DOSTAT
DOTCAL RSSIZE,[CHANNO(B),[2000,,C],[2000,,D]]
.LOSE %LSSYS
MOVEM C,PAGLN(B)
MOVEM D,LINLN(B)
]
JRST DRESET
IFN ITS,[
FRESE1: CAIE 0,TFIX
JRST BADCHN
PUSH P,(A)
JRST FRESE3
]
; INTERFACE TO REOPEN CLOSED CHANNELS
OPNCHN: PUSH TP,$TCHAN
PUSH TP,B
MCALL 1,FRESET
POPJ P,
REATTY: PUSHJ P,TTYOP2
IFE ITS, SKIPN DEMFLG ; SKIP IF DEMONFLAG IS ON
SKIPE NOTTY
JRST DRESET
MOVE B,1(AB)
JRST REATT1
; FUNCTION TO LIST ALL CHANNELS
MFUNCTION CHANLIST,SUBR
ENTRY 0
MOVEI A,N.CHNS-1 ;MAX # OF REAL CHANNELS
MOVEI C,0
MOVEI B,CHNL1 ;POINT TO FIRST REAL CHANNEL
CHNLP: SKIPN 1(B) ;OPEN?
JRST NXTCHN ;NO, SKIP
HRRE E,(B) ; ABOUT TO FLUSH?
JUMPL E,NXTCHN ; YES, FORGET IT
MOVE D,1(B) ; GET CHANNEL
HRRZ E,CHANNO-1(D) ; GET REF COUNT
PUSH TP,(B)
PUSH TP,1(B)
ADDI C,1 ;COUNT WINNERS
SOJGE E,.-3 ; COUNT THEM
NXTCHN: ADDI B,2
SOJN A,CHNLP
SKIPN B,CHNL0+1 ;NOW HACK LIST OF PSUEDO CHANNELS
JRST MAKLST
CHNLS: PUSH TP,(B)
PUSH TP,(B)+1
ADDI C,1
HRRZ B,(B)
JUMPN B,CHNLS
MAKLST: ACALL C,LIST
JRST FINIS
; ROUTINE TO RESTORE A CLOSED CHANNEL TO ITS PREVIOUS STATE
REOPN: PUSH TP,$TCHAN
PUSH TP,B
SKIPN CHANNO(B) ; ONLY REAL CHANNELS
JRST PSUEDO
IFN ITS,[
MOVSI E,-4 ; SET UP POINTER FOR NAMES
GETOPB: MOVE B,(TP) ; GET CHANNEL
MOVEI A,@RDTBL(E) ; GET POINTER
MOVE B,(A) ; NOW STRING
MOVE A,-1(A)
PUSHJ P,STRTO6 ; LEAVES SIXBIT ON STACK
AOBJN E,GETOPB
]
IFE ITS,[
MOVE A,RDEVIC-1(B)
MOVE B,RDEVIC(B)
PUSHJ P,STRTO6 ; GET DEV NAME IN SIXBIT
]
MOVE B,(TP) ; RESTORE CHANNEL
MOVE A,DIRECT-1(B)
MOVE B,DIRECT(B)
PUSHJ P,CHMOD ; CHECK FOR A VALID MODE
IFN ITS, MOVE E,-3(P) ; GET DEVICE IN PROPER PLACE
IFE ITS, HLRZS E,(P)
MOVE B,(TP) ; RESTORE CHANNEL
IFN ITS, CAMN E,[SIXBIT /DSK /]
IFE ITS,[
CAIE E,(SIXBIT /PS /)
CAIN E,(SIXBIT /DSK/)
JRST DISKH ; DISK WINS IMMEIDATELY
CAIE E,(SIXBIT /SS /)
CAIN E,(SIXBIT /SRC/)
JRST DISKH ; DISK WINS IMMEIDATELY
]
IFN ITS, CAMN E,[SIXBIT /TTY /] ; NO NEED TO RE-OPEN THE TTY
IFE ITS, CAIN E,(SIXBIT /TTY/)
JRST REOPD1
IFN ITS,[
AND E,[777700,,0] ; COULD BE "UTn"
MOVE D,CHANNO(B) ; GET CHANNEL
ASH D,1
ADDI D,CHNL0 ; DON'T SEEM TO BE OPEN
SETZM 1(D)
SETZM CHANNO(B)
CAMN E,[SIXBIT /UT /]
JRST REOPD ; CURRENTLY, CANT RESTORE UTAPE CHANNLES
CAMN E,[SIXBIT /AI /]
JRST REOPD ; CURRENTLY CANT RESTORE AI CHANNELS
CAMN E,[SIXBIT /ML /]
JRST REOPD ; CURRENTLY CANT RESTORE ML CHANNELS
CAMN E,[SIXBIT /DM /]
JRST REOPD ; CURRENTLY CANT RESTORE DM CHANNELS
]
PUSH TP,$TCHAN ; TRY TO RESET IT
PUSH TP,B
MCALL 1,FRESET
IFN ITS,[
REOPD1: AOS -4(P)
REOPD: SUB P,[4,,4]
]
IFE ITS,[
REOPD1: AOS -1(P)
REOPD: SUB P,[1,,1]
]
REOPD0: SUB TP,[2,,2]
POPJ P,
IFN ITS,[
DISKH: MOVE C,(P) ; SNAME
.SUSET [.SSNAM,,C]
]
IFE ITS,[
DISKH: MOVEM A,(P) ; SAVE MODE WORD
PUSHJ P,STSTK ; STRING TO STACK
MOVE A,(E) ; RESTORE MODE WORD
PUSH TP,$TPDL
PUSH TP,E ; SAVE PDL BASE
MOVE B,-2(TP) ; CHANNEL BACK TO B
]
MOVE C,ACCESS(B) ; GET CHANNELS ACCESS
TRNN A,2 ; SKIP IF NOT ASCII CHANNEL
JRST DISKH1
HRRZ D,ACCESS-1(B) ; IF PARTIAL WORD OUT
IMULI C,5 ; TO CHAR ACCESS
JUMPE D,DISKH1 ; NO SWEAT
ADDI C,(D)
SUBI C,5
DISKH1: HRRZ D,BUFSTR-1(B) ; ANY CHARS IN MUDDLE BUFFER
JUMPE D,DISKH2
TRNN A,1 ; SKIP IF OUTPUT CHANNEL
JRST DISKH2
PUSH P,A
PUSH P,C
MOVEI C,BUFSTR-1(B)
PUSHJ P,BYTDOP ; FIND LENGTH OF WHOLE BUFFER
HLRZ D,(A) ; LENGTH + 2 TO D
SUBI D,2
IMULI D,5 ; TO CHARS
SUB D,BUFSTR-1(B)
POP P,C
POP P,A
DISKH2: SUBI C,(D) ; UPDATE CHAR ACCESS
IDIVI C,5 ; BACK TO WORD ACCESS
IFN ITS,[
IORI A,6 ; BLOCK IMAGE
TRNE A,1
IORI A,100000 ; WRITE OVER BIT
PUSHJ P,DOOPN
JRST REOPD
MOVE A,C ; ACCESS TO A
PUSHJ P,GETFLN ; CHECK LENGTH
CAIGE 0,(A) ; CHECK BOUNDS
JRST .+3 ; COMPLAIN
PUSHJ P,DOACCS ; AND ACESS
JRST REOPD1 ; SUCCESS
MOVE A,CHANNO(B) ; CLOSE THE G.D. CHANNEL
PUSHJ P,MCLOSE
JRST REOPD
DOACCS: PUSH P,A
HRRZ A,CHANNO(B)
DOTCAL ACCESS,[A,(P)]
JFCL
POP P,A
POPJ P,
DOIOTO:
DOIOTI:
DOIOT:
PUSH P,0
MOVSI 0,TCHAN
MOVE PVP,PVSTOR+1
MOVEM 0,BSTO(PVP) ; IN CASE OF INTERRUPT
ENABLE
HRRZ 0,CHANNO(B)
DOTCAL IOT,[0,A]
JFCL
DISABLE
MOVE PVP,PVSTOR+1
SETZM BSTO(PVP)
POP P,0
POPJ P,
GETFLN: MOVE 0,CHANNO(B) ; GET CHANNEL
.CALL FILBLK ; READ LNTH
.VALUE
POPJ P,
FILBLK: SETZ
SIXBIT /FILLEN/
0
402000,,0 ; STUFF RESULT IN 0
]
IFE ITS,[
MOVEI A,CHNL0
ADD A,CHANNO(B)
ADD A,CHANNO(B)
SETZM 1(A) ; MAY GET A DIFFERENT JFN
HRROI B,1(E) ; TENEX STRING POINTER
MOVSI A,400001 ; MAKE SURE
GTJFN ; GO GET IT
JRST RGTJL ; COMPLAIN
MOVE D,-2(TP)
HRRZM A,CHANNO(D) ; COULD HAVE CHANGED
MOVE P,(TP) ; RESTORE P
MOVEI B,CHNL0
ASH A,1 ; MUNG ITS SLOT
ADDI A,(B)
MOVEM D,1(A)
HLLOS (A) ; MARK CHANNEL NOT TO BE RELOOKED AT
MOVE A,(P) ; MODE WORD BACK
MOVE B,[440000,,200000] ; FLAG BITS
TRNE A,1 ; SKIP FOR INPUT
TRC B,300000 ; CHANGE TO WRITE
MOVE A,CHANNO(D) ; GET JFN
OPENF
JRST ROPFLS
MOVE E,C ; LENGTH TO E
SIZEF ; GET CURRENT LENGTH
JRST ROPFLS
CAMGE B,E ; STILL A WINNER
JRST ROPFLS
MOVE A,CHANNO(D) ; JFN
MOVE B,C
SFPTR
JRST ROPFLS
SUB TP,[2,,2] ; FLUSH PDL POINTER
JRST REOPD1
ROPFLS: MOVE A,-2(TP)
MOVE A,CHANNO(A)
CLOSF ; ATTEMPT TO CLOSE
JFCL ; IGNORE FAILURE
SKIPA
RGTJL: MOVE P,(TP)
SUB TP,[2,,2]
JRST REOPD
DOACCS: PUSH P,B
EXCH A,B
MOVE A,CHANNO(A)
SFPTR
JRST ACCFAI
POP P,B
POPJ P,
]
PSUEDO: AOS (P) ; ASSUME SUCCESS FOR NOW
MOVEI B,RDEVIC-1(B) ; SEE WHAT DEVICE IS
PUSHJ P,CHRWRD
JFCL
JRST REOPD0 ; NO, RETURN HAPPY
IFN 0,[ CAME B,[ASCII /E&S/] ; DISPLAY ?
CAMN B,[ASCII /DIS/]
SKIPA B,(TP) ; YES, REGOBBLE CHANNEL AND CONTINUE
JRST REOPD0 ; NO, RETURN HAPPY
PUSHJ P,DISROP
SOS (P) ; DISPLAY DID NOT REOPEN, UNDO ASSUMPTION OF SUCCESS
JRST REOPD0]
;THIS PROGRAM CLOSES THE SPECIFIED CHANNEL
MFUNCTION FCLOSE,SUBR,[CLOSE]
ENTRY 1 ;ONLY ONE ARG
GETYP A,(AB) ;CHECK ARGS
CAIE A,TCHAN ;IS IT A CHANNEL
JRST WTYP1
MOVE B,1(AB) ;PICK UP THE CHANNEL
HRRZ A,CHANNO-1(B) ; GET REF COUNT
SOJGE A,CFIN5 ; NOT READY TO REALLY CLOSE
CAME B,TTICHN+1 ; CHECK FOR TTY
CAMN B,TTOCHN+1
JRST CLSTTY
MOVE A,[JRST CHNCLS]
MOVEM A,IOINS(B) ;CLOBBER THE IO INS
MOVE A,RDEVIC-1(B) ;GET THE NAME OF THE DEVICE
MOVE B,RDEVIC(B)
PUSHJ P,STRTO6
IFN ITS, MOVE A,(P)
IFE ITS, HLRZS A,(P)
MOVE B,1(AB) ; RESTORE CHANNEL
IFN 0,[
CAME A,[SIXBIT /E&S /]
CAMN A,[SIXBIT /DIS /]
PUSHJ P,DISCLS]
MOVE B,1(AB) ; IN CASE CLOBBERED BY DISCLS
SKIPN A,CHANNO(B) ;ANY REAL CHANNEL?
JRST REMOV ; NO, EITHER CLOSED OR PSEUDO CHANNEL
MOVE A,DIRECT-1(B) ; POINT TO DIRECTION
MOVE B,DIRECT(B)
PUSHJ P,STRTO6 ; CONVERT TO WORD
POP P,A
IFN ITS, LDB E,[360600,,(P)] ; FIRST CHAR OD DEV NAME
IFE ITS, LDB E,[140600,,(P)] ; FIRST CHAR OD DEV NAME
CAIE E,'T ; SKIP IF TTY
JRST CFIN4
CAME A,[SIXBIT /READ/] ; SKIP IF WINNER
JRST CFIN1
IFN ITS,[
MOVE B,1(AB) ; IN ITS CHECK STATUS
LDB A,[600,,STATUS(B)]
CAILE A,2
JRST CFIN1
]
PUSH TP,$TCHSTR
PUSH TP,CHQUOTE CHAR
PUSH TP,(AB)
PUSH TP,1(AB)
MCALL 2,OFF ; TURN OFF INTERRUPT
CFIN1: MOVE B,1(AB)
MOVE A,CHANNO(B)
IFN ITS,[
PUSHJ P,MCLOSE
]
IFE ITS,[
TLZ A,400000 ; FOR JFN RELEASE
CLOSF ; CLOSE THE FILE AND RELEASE THE JFN
JFCL
MOVE A,CHANNO(B)
]
CFIN: LSH A,1
ADDI A,CHNL0+1 ;POINT TO THIS CHANNELS LSOT
SETZM CHANNO(B)
SETZM (A) ;AND CLOBBER IT
HLLZS BUFSTR-1(B)
SETZM BUFSTR(B)
HLLZS ACCESS-1(B)
CFIN2: HLLZS -2(B)
MOVSI A,TCHAN ;RETURN THE CHANNEL
JRST FINIS
CLSTTY: ERRUUO EQUOTE ATTEMPT-TO-CLOSE-TTY-CHANNEL
REMOV: MOVEI D,CHNL0+1 ;ATTEMPT TO REMOVE FROM PSUEDO CHANNEL LIST
REMOV0: SKIPN C,D ;FOUND ON LIST ?
JRST CFIN2 ;NO, JUST IGNORE THIS CLOSED CHANNEL
HRRZ D,(C) ;GET POINTER TO NEXT
CAME B,(D)+1 ;FOUND ?
JRST REMOV0
HRRZ D,(D) ;YES, SPLICE IT OUT
HRRM D,(C)
JRST CFIN2
; CLOSE UP ANY LEFTOVER BUFFERS
CFIN4:
; CAME A,[SIXBIT /PRINTO/]
; CAMN A,[SIXBIT /PRINTB/]
; JRST .+3
; CAME A,[SIXBIT /PRINT/]
; JRST CFIN1
MOVE B,1(AB) ; GET CHANNEL
HRRZ A,-2(B) ;GET MODE BITS
TRNN A,C.PRIN
JRST CFIN1
GETYP 0,BUFSTR-1(B) ; IS THERE AN OUTPUT BUFFER
SKIPN BUFSTR(B)
JRST CFIN1
CAIE 0,TCHSTR
JRST CFINX1
PUSHJ P,BFCLOS
IFE ITS,[
MOVE A,CHANNO(B)
MOVEI B,7
SFBSZ
JFCL
CLOSF
JFCL
]
HLLZS BUFSTR-1(B)
SETZM BUFSTR(B)
CFINX1: HLLZS ACCESS-1(B)
JRST CFIN1
CFIN5: HRRM A,CHANNO-1(B)
JRST CFIN2
;SUBR TO DO .ACCESS ON A READ CHANNEL
;FORM: <ACCESS CHANNEL FIX-NUMBER>
;POSITIONS CHANNEL AT CHARACTER POSN FIX-NUMBER
;H. BRODIE 7/26/72
MFUNCTION MACCESS,SUBR,[ACCESS]
ENTRY 2 ;ARGS: CHANNEL AND FIX-NUMBER
;CHECK ARGUMENT TYPES
GETYP A,(AB)
CAIE A,TCHAN ;FIRST ARG SHOULD BE CHANNEL
JRST WTYP1
GETYP A,2(AB) ;TYPE OF SECOND
CAIE A,TFIX ;SHOULD BE FIX
JRST WTYP2
;CHECK DIRECTION OF CHANNEL
MOVE B,1(AB) ;B GETS PNTR TO CHANNEL
; MOVEI B,DIRECT-1(B) ;GET DIRECTION OF CHANNEL
; PUSHJ P,CHRWRD ;GRAB THE CHAR STRNG
; JFCL
; CAME B,[<ASCII /PRINT/>+1]
HRRZ A,-2(B) ; GET MODE BITS
TRNN A,C.PRIN
JRST MACCA
MOVE B,1(AB)
SKIPE C,BUFSTR(B) ;SEE IF WE MUST FLUSH PART BUFFER
PUSHJ P,BFCLOS
JRST MACC
MACCA:
; CAMN B,[ASCIZ /READ/]
; JRST .+4
; CAME B,[ASCIZ /READB/] ; READB CHANNEL?
; JRST WRONGD
; AOS (P) ; SET INDICATOR FOR BINARY MODE
;CHECK THAT THE CHANNEL IS OPEN
MACC: MOVE B,1(AB) ;GET BACK PTR TO CHANNEL
HRRZ E,-2(B)
TRNN E,C.OPN
JRST CHNCLS ;IF CHNL CLOSED => ERROR
;COMPUTE ACCESS PNTR TO ACCESS WORD CHAR IS IN
;REMAINDER IS NUMBER OF TIMES TO INCR BYTE POINTER
ADEVOK: SKIPGE C,3(AB) ;GET CHAR POSN
ERRUUO EQUOTE NEGATIVE-ARGUMENT
MACC1: MOVEI D,0
TRNN E,C.BIN ; SKIP FOR BINARY FILE
IDIVI C,5
;SETUP THE .ACCESS
TRNN E,C.PRIN
JRST NLSTCH
HRRZ 0,LSTCH-1(B)
MOVE A,ACCESS(B)
TRNN E,C.BIN
JRST LSTCH1
IMULI A,5
ADD A,ACCESS-1(B)
ANDI A,-1
LSTCH1: CAIG 0,(A)
MOVE 0,A
MOVE A,C
IMULI A,5
ADDI A,(D)
CAML A,0
MOVE 0,A
HRRM 0,LSTCH-1(B) ; UPDATE "LARGEST"
NLSTCH: MOVE A,CHANNO(B) ;A GETS REAL CHANNEL NUMBER
IFN ITS,[
DOTCAL ACCESS,[A,C]
.LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS
]
IFE ITS,[
MOVE B,C
SFPTR ; DO IT IN TENEX
JRST ACCFAI
MOVE B,1(AB) ; RESTORE CHANNEL
]
; POP P,E ; CHECK FOR READB MODE
TRNN E,C.READ
JRST ACCOUT ; PRINT TYPE CHANNEL, GO DO IT
SKIPE BUFSTR(B) ; IS THERE A READ BUFFER TO FLUSH
JRST .+3
SETZM LSTCH(B) ; CLEAR OUT POSSIBLE EOF INDICATOR
JRST DONADV
;NOW FORCE GETCHR TO DO A .IOT FIRST THING
MOVEI C,BUFSTR-1(B) ; FIND END OF STRING
PUSHJ P,BYTDOP"
SUBI A,2 ; LAST REAL WORD
HRLI A,010700
MOVEM A,BUFSTR(B)
HLLZS BUFSTR-1(B) ; CLOBBER CHAR COUNT
SETZM LSTCH(B) ;CLOBBER READ'S HIDDEN CHARACTER
;NOW DO THE APPROPRIATE NUM OF BYTE ADVANCEMENTS
JUMPLE D,DONADV
ADVPTR: PUSHJ P,GETCHR
MOVE B,1(AB) ;RESTORE IN CASE CLOBBERED
SOJG D,ADVPTR
DONADV: MOVE C,3(AB) ;FIXUP ACCESS SLOT IN CHNL
HLLZS ACCESS-1(B)
MOVEM C,ACCESS(B)
MOVE A,$TCHAN ;TYPE OF RESULT = "CHANNEL"
JRST FINIS ;DONE...B CONTAINS CHANNEL
IFE ITS,[
ACCFAI: ERRUUO EQUOTE ACCESS-FAILURE
]
ACCOUT: SKIPN C,BUFSTR(B) ; FIXUP BUFFER?
JRST ACCOU1
HRRZ F,BUFSTR-1(B)
ADD F,[-BUFLNT*5-4]
IDIVI F,5
ADD F,BUFSTR(B)
HRLI F,010700
MOVEM F,BUFSTR(B)
MOVEI F,BUFLNT*5
HRRM F,BUFSTR-1(B)
ACCOU1: TRNE E,C.BIN ; FINISHED FOR BINARY CHANNELS
JRST DONADV
JUMPE D,DONADV ; THIS CASE OK
IFE ITS,[
MOVE A,CHANNO(B) ; GET LAST WORD
RFPTR
JFCL
PUSH P,B
MOVNI C,1
MOVE B,[444400,,E] ; READ THE WORD
SIN
JUMPL C,ACCFAI
POP P,B
SFPTR
JFCL
MOVE B,1(AB) ; CHANNEL BACK
MOVE C,[440700,,E]
ILDB 0,C
IDPB 0,BUFSTR(B)
SOS BUFSTR-1(B)
SOJG D,.-3
JRST DONADV
]
IFN ITS, ERRUUO EQUOTE CANT-ACCESS-ASCII-ON-ITS
;WRONG TYPE OF DEVICE ERROR
WRDEV: ERRUUO EQUOTE NON-DSK-DEVICE
; BINARY READ AND PRINT ROUTINES
MFUNCTION PRINTB,SUBR
ENTRY
PBFL: PUSH P,. ; PUSH NON-ZERONESS
MOVEI A,-7
JRST BINI1
MFUNCTION READB,SUBR
ENTRY
PUSH P,[0]
MOVEI A,-11
BINI1: HLRZ 0,AB
CAILE 0,-3
JRST TFA
CAIG 0,(A)
JRST TMA
GETYP 0,(AB) ; SHOULD BE UVEC OR STORE
CAIE 0,TSTORAGE
CAIN 0,TUVEC
JRST BINI2
CAIE 0,TCHSTR
CAIN 0,TBYTE
JRST BYTOK
JRST WTYP1 ; ELSE LOSE
BINI2: MOVE B,1(AB) ; GET IT
HLRE C,B
SUBI B,(C) ; POINT TO DOPE
GETYP A,(B)
PUSHJ P,SAT" ; GET ITS ST.ALOC.TYPE
CAIE A,S1WORD
JRST WTYP1
BYTOK: GETYP 0,2(AB)
CAIE 0,TCHAN ; BETTER BE A CHANNEL
JRST WTYP2
MOVE B,3(AB) ; GET IT
; MOVEI B,DIRECT-1(B) ; GET DIRECTION OF
; PUSHJ P,CHRWRD ; INTO 1 WORD
; JFCL
; MOVNI E,1
; CAMN B,[ASCII /READB/]
; MOVEI E,0
; CAMN B,[<ASCII /PRINT/>+1]
HRRZ A,-2(B) ; MODE BITS
TRNN A,C.BIN ; IF NOT BINARY
JRST WRONGD
MOVEI E,0
TRNE A,C.PRIN
MOVE E,PBFL
; JUMPL E,WRONGD ; LOSER
CAME E,(P) ; CHECK WINNGE
JRST WRONGD
MOVE B,3(AB) ; GET CHANNEL BACK
SKIPN A,IOINS(B) ; OPEN?
PUSHJ P,OPENIT ; LOSE
CAMN A,[JRST CHNCLS]
JRST CHNCLS ; LOSE, CLOSED
JUMPN E,BUFOU1 ; JUMP FOR OUTPUT
MOVEI C,0
CAML AB,[-5,,] ; SKIP IF EOF GIVEN
JRST BINI5
MOVE 0,4(AB)
MOVEM 0,EOFCND-1(B)
MOVE 0,5(AB)
MOVEM 0,EOFCND(B)
CAML AB,[-7,,]
JRST BINI5
GETYP 0,6(AB)
CAIE 0,TFIX
JRST WTYP
MOVE C,7(AB)
BINI5: SKIPE LSTCH(B) ; INDICATES IF EOF HIT
JRST BINEOF
GETYP 0,(AB) ; BRANCH BASED ON BYTE SIZE
CAIE 0,TCHSTR
CAIN 0,TBYTE
JRST BYTI
MOVE A,1(AB) ; GET VECTOR
PUSHJ P,PGBIOI ; READ IT
HLRE C,A ; GET COUNT DONE
HLRE D,1(AB) ; AND FULL COUNT
SUB C,D ; C=> TOTAL READ
ADDM C,ACCESS(B)
JUMPGE A,BINIOK ; NOT EOF YET
SETOM LSTCH(B)
BINIOK: MOVE B,C
MOVSI A,TFIX ; RETURN AMOUNT ACTUALLY READ
JRST FINIS
BYTI:
IFE ITS,[
MOVE A,1(B)
RFBSZ
FATAL RFBSZ-LOST
PUSH P,B
LDB B,[300600,,1(AB)]
SFBSZ
FATAL SFBSZ-LOST
MOVE B,3(AB)
HRRZ A,(AB) ; GET BYTE STRING LENGTH
MOVNS A
MOVSS A ; MAKE FUNNY BYTE POINTER
HRR A,1(AB)
ADDI A,1
PUSH P,C
HLL C,1(AB) ; GET START OF BPTR
MOVE D,[SIN]
PUSHJ P,PGBIOT
HLRE C,A ; GET COUNT DONE
POP P,D
SKIPN D
HRRZ D,(AB) ; AND FULL COUNT
ADD D,C ; C=> TOTAL READ
LDB E,[300600,,1(AB)]
MOVEI A,36.
IDIVM A,E
IDIVM D,E
ADDM E,ACCESS(B)
SKIPGE C ; NOT EOF YET
SETOM LSTCH(B)
MOVE A,1(B)
POP P,B
SFBSZ
FATAL SFBSZ-LOST
MOVE C,D
JRST BINIOK
]
BUFOU1: SKIPE BUFSTR(B) ; ANY BUFFERS AROUND?
PUSHJ P,BFCLS1 ; GET RID OF SAME
MOVEI C,0
CAML AB,[-5,,]
JRST BINO5
GETYP 0,4(AB)
CAIE 0,TFIX
JRST WTYP
MOVE C,5(AB)
BINO5: MOVE A,1(AB)
GETYP 0,(AB) ; BRANCH BASED ON BYTE SIZE
CAIE 0,TCHSTR
CAIN 0,TBYTE
JRST BYTO
PUSH P,C
PUSHJ P,PGBIOO
POP P,C
JUMPE C,.+3
HLRE C,1(AB)
MOVNS C
ADDM C,ACCESS(B)
BYTO1: MOVE A,(AB) ; RET VECTOR ETC.
MOVE B,1(AB)
JRST FINIS
BYTO:
IFE ITS,[
MOVE A,1(B)
RFBSZ
FATAL RFBSZ-FAILURE
PUSH P,B
LDB B,[300600,,1(AB)]
SFBSZ
FATAL SFBSZ-FAILURE
MOVE B,3(AB)
HRRZ A,(AB) ; GET BYTE SIZE
MOVNS A
MOVSS A ; MAKE FUNNY BYTE POINTER
HRR A,1(AB)
ADDI A,1 ; COMPENSATE FOR PGBIOT DOING THE WRONG THING
HLL C,1(AB) ; GET START OF BPTR
MOVE D,[SOUT]
PUSHJ P,PGBIOT
LDB D,[300600,,1(AB)]
MOVEI C,36.
IDIVM C,D
HRRZ C,(AB)
IDIVI C,(D)
ADDM C,ACCESS(B)
MOVE A,1(B)
POP P,B
SFBSZ
FATAL SFBSZ-FAILURE
JRST BYTO1
]
BINEOF: PUSH TP,EOFCND-1(B)
PUSH TP,EOFCND(B)
PUSH TP,$TCHAN
PUSH TP,B
MCALL 1,FCLOSE ; CLOSE THE LOSER
MCALL 1,EVAL
JRST FINIS
OPENIT: PUSH P,E
PUSHJ P,OPNCHN ;TRY TO OPEN THE LOSER
JUMPE B,CHNCLS ;FAIL
POP P,E
POPJ P,
; THESE SUBROUTINES BY NDR 9/16/73 TO FACILITATE THE
; TYPES OF IO NECESSARY TO MAKE MORE EFFICIENT USE OF
; THE NETWORK AND DO RELATED FILE TRANSFER TYPE OF JOBS.
R1CHAR: SKIPN A,LSTCH(B) ; CHAR READING ROUTINE FOR FCOPY
PUSHJ P,RXCT
TLO A,200000 ; ^@ BUG
MOVEM A,LSTCH(B)
TLZ A,200000
JUMPL A,.+2 ; IN CASE OF -1 ON STY
TRZN A,400000 ; EXCL HACKER
JRST .+4
MOVEM A,LSTCH(B) ; SAVE DE-EXCLED CHAR
MOVEI A,"!
JRST .+2
SETZM LSTCH(B)
PUSH P,C
HRRZ C,DIRECT-1(B)
CAIE C,5 ; IF DIRECTION IS 5 LONG THEN READB
JRST R1CH1
AOS C,ACCESS-1(B)
CAMN C,[TFIX,,1]
AOS ACCESS(B) ; EVERY FIFTY INCREMENT
CAMN C,[TFIX,,5]
HLLZS ACCESS-1(B)
JRST .+2
R1CH1: AOS ACCESS(B)
POP P,C
POPJ P,
W1CHAR: CAIE A,15 ; CHAR WRITING ROUTINE, TEST FOR CR
JRST .+3
SETOM CHRPOS(B)
AOSA LINPOS(B)
CAIE A,12 ; TEST FOR LF
AOS CHRPOS(B) ; IF NOT LF AOS CHARACTE5R POSITION
CAIE A,14 ; TEST FOR FORM FEED
JRST .+3
SETZM CHRPOS(B) ; IF FORM FEED ZERO CHARACTER POSITION
SETZM LINPOS(B) ; AND LINE POSITION
CAIE A,11 ; IS THIS A TAB?
JRST .+6
MOVE C,CHRPOS(B)
ADDI C,7
IDIVI C,8.
IMULI C,8. ; FIX UP CHAR POS FOR TAB
MOVEM C,CHRPOS(B) ; AND SAVE
PUSH P,C
HRRZ C,-2(B) ; GET BITS
TRNN C,C.BIN ; SIX LONG MUST BE PRINTB
JRST W1CH1
AOS C,ACCESS-1(B)
CAMN C,[TFIX,,1]
AOS ACCESS(B)
CAMN C,[TFIX,,5]
HLLZS ACCESS-1(B)
JRST .+2
W1CH1: AOS ACCESS(B)
PUSH P,A
PUSHJ P,WXCT
POP P,A
POP P,C
POPJ P,
R1C: SUBM M,(P) ;LITTLE ENTRY FOR COMPILED STUFF
; PUSH TP,$TCHAN ;SAVE THE CHANNEL TO BLESS IT
; PUSH TP,B
; MOVEI B,DIRECT-1(B)
; PUSHJ P,CHRWRD
; JFCL
; CAME B,[ASCIZ /READ/]
; CAMN B,[ASCII /READB/]
; JRST .+2
; JRST BADCHN
HRRZ A,-2(B) ; GET MODE BITS
TRNN A,C.READ
JRST BADCHN
SKIPN IOINS(B) ; IS THE CHANNEL OPEN
PUSHJ P,OPENIT ; NO, GO DO IT
PUSHJ P,GRB ; MAKE SURE WE HAVE A READ BUFFER
PUSHJ P,R1CHAR ; AND GET HIM A CHARACTER
JRST MPOPJ ; THATS ALL FOLKS
W1C: SUBM M,(P)
PUSHJ P,W1CI
JRST MPOPJ
W1CI:
; PUSH TP,$TCHAN
; PUSH TP,B
PUSH P,A ; ASSEMBLER ENTRY TO OUTPUT 1 CHAR
; MOVEI B,DIRECT-1(B)
; PUSHJ P,CHRWRD ; INTERNAL CALL TO W1CHAR
; JFCL
; CAME B,[ASCII /PRINT/]
; CAMN B,[<ASCII /PRINT/>+1]
; JRST .+2
; JRST BADCHN
; POP TP,B
; POP TP,(TP)
HRRZ A,-2(B)
TRNN A,C.PRIN
JRST BADCHN
SKIPN IOINS(B) ; MAKE SURE THAT IT IS OPEN
PUSHJ P,OPENIT
PUSHJ P,GWB
POP P,A ; GET THE CHAR TO DO
JRST W1CHAR
; ROUTINES TO REPLACE XCT IOINS(B) FOR INPUT AND OUTPUT
; THEY DO THE XCT THEN CHECK OUT POSSIBLE SCRIPTAGE--BLECH.
WXCT:
RXCT: XCT IOINS(B) ; READ IT
SKIPN SCRPTO(B)
POPJ P,
DOSCPT: PUSH TP,$TCHAN
PUSH TP,B
PUSH P,A ; AND SAVE THE CHAR AROUND
SKIPN SCRPTO(B) ; IF ZERO FORGET IT
JRST SCPTDN ; THATS ALL THERE IS TO IT
PUSH P,C ; SAVE AN ACCUMULATOR FOR CLEANLINESS
GETYP C,SCRPTO-1(B) ; IS IT A LIST
CAIE C,TLIST
JRST BADCHN
PUSH TP,$TLIST
PUSH TP,[0] ; SAVE A SLOT FOR THE LIST
MOVE C,SCRPTO(B) ; GET THE LIST OF SCRIPT CHANNELS
SCPT1: GETYP B,(C) ; GET THE TYPE OF THIS SCRIPT CHAN
CAIE B,TCHAN
JRST BADCHN ; IF IT ISN'T A CHANNEL, COMPLAIN
HRRZ B,(C) ; GET THE REST OF THE LIST IN B
MOVEM B,(TP) ; AND STORE ON STACK
MOVE B,1(C) ; GET THE CHANNEL IN B
MOVE A,-1(P) ; AND THE CHARACTER IN A
PUSHJ P,W1CI ; GO TO INTERNAL W1C, IT BLESSES GOODIES
SKIPE C,(TP) ; GET THE REST OF LIST OF CHANS
JRST SCPT1 ; AND CYCLE THROUGH
SUB TP,[2,,2] ; CLEAN OFF THE LIST OF CHANS
POP P,C ; AND RESTORE ACCUMULATOR C
SCPTDN: POP P,A ; RESTORE THE CHARACTER
POP TP,B ; AND THE ORIGINAL CHANNEL
POP TP,(TP)
POPJ P, ; AND THATS ALL
; SUBROUTINE TO COPY FROM INCHAN TO OUTCHAN UNTIL EOF HIT
; ON THE INPUT CHANNEL
; CALL IS <FILECOPY IN OUT> WHERE DEFAULTS ARE INCHAN AND OUTCHAN
MFUNCTION FCOPY,SUBR,[FILECOPY]
ENTRY
HLRE 0,AB
CAMGE 0,[-4]
JRST WNA ; TAKES FROM 0 TO 2 ARGS
JUMPE 0,.+4 ; NO FIRST ARG?
PUSH TP,(AB)
PUSH TP,1(AB) ; SAVE IN CHAN
JRST .+6
MOVE A,$TATOM
MOVE B,IMQUOTE INCHAN
PUSHJ P,IDVAL
PUSH TP,A
PUSH TP,B
HLRE 0,AB ; CHECK FOR SECOND ARG
CAML 0,[-2] ; WAS THERE MORE THAN ONE ARG?
JRST .+4
PUSH TP,2(AB) ; SAVE SECOND ARG
PUSH TP,3(AB)
JRST .+6
MOVE A,$TATOM ; LOOK UP OUTCHAN AS DEFAULT
MOVE B,IMQUOTE OUTCHAN
PUSHJ P,IDVAL
PUSH TP,A
PUSH TP,B ; AND SAVE IT
MOVE A,-3(TP)
MOVE B,-2(TP) ; INPUT CHANNEL
MOVEI 0,C.READ ; INDICATE INPUT
PUSHJ P,CHKCHN ; CHECK FOR GOOD CHANNEL
MOVE A,-1(TP)
MOVE B,(TP) ; GET OUT CHAN
MOVEI 0,C.PRIN ; INDICATE OUT CHAN
PUSHJ P,CHKCHN ; CHECK FOR GOOD OUT CHAN
PUSH P,[0] ; COUNT OF CHARS OUTPUT
MOVE B,-2(TP)
PUSHJ P,GRB ; MAKE SURE WE HAVE READ BUFF
MOVE B,(TP)
PUSHJ P,GWB ; MAKE SURE WE HAVE WRITE BUFF
FCLOOP: INTGO
MOVE B,-2(TP)
PUSHJ P,R1CHAR ; GET A CHAR
JUMPL A,FCDON ; IF A NEG NUMBER WE GOT EOF
MOVE B,(TP) ; GET OUT CHAN
PUSHJ P,W1CHAR ; SPIT IT OUT
AOS (P) ; INCREMENT COUNT
JRST FCLOOP
FCDON: SUB TP,[2,,2] ; POP OFF OUTCHAN
MCALL 1,FCLOSE ; CLOSE INCHAN
MOVE A,$TFIX
POP P,B ; GET CHAR COUNT TO RETURN
JRST FINIS
CHKCHN: PUSH P,0 ; CHECK FOR GOOD TASTING CHANNEL
PUSH TP,A
PUSH TP,B
GETYP C,A
CAIE C,TCHAN
JRST CHKBDC ; GO COMPLAIN IN RIGHT WAY
; MOVEI B,DIRECT-1(B)
; PUSHJ P,CHRWRD
; JRST CHKBDC
; MOVE C,(P) ; GET CHAN DIRECT
HRRZ C,-2(B) ; MODE BITS
TDNN C,0
JRST CHKBDC
; CAMN B,CHKT(C)
; JRST .+4
; ADDI C,2 ; TEST FOR READB OR PRINTB ALSO
; CAME B,CHKT(C) ; TEST FOR CORRECT DIRECT
; JRST CHKBDC
MOVE B,(TP)
SKIPN IOINS(B) ; MAKE SURE IT IS OPEN
PUSHJ P,OPENIT ; IF ZERO IOINS GO OPEN IT
SUB TP,[2,,2]
POP P, ; CLEAN UP STACKS
POPJ P,
CHKT: ASCIZ /READ/
ASCII /PRINT/
ASCII /READB/
<ASCII /PRINT/>+1
CHKBDC: POP P,E
MOVNI D,2
IMULI D,1(E)
HLRE 0,AB
CAMLE 0,D ; SEE IF THIS WAS HIS ARG OF DEFAULT
JRST BADCHN
JUMPE E,WTYP1
JRST WTYP2
; FUNCTIONS READSTRING AND PRINTSTRING WORK LIKE READB AND PRINTB,
; THAT IS THEY READ INTO AND OUT OF STRINGS. IN ADDITION BOTH ACCEPT
; AN ADDITIONAL ARGUMENT WHICH IS THE NUMBER OF CHARS TO READ OR PRINT, IF
; IT IS DESIRED FOR THIS TO BE DIFFERENT THAN THE LENGTH OF THE STRING.
; FORMAT IS <READSTRING .STRING .INCHANNEL .EOFCOND .MAXCHARS>
; AND BOTH SUBRS RETURN THE NUMBER OF CHARS READ OR WRITTEN
; FORMAT FOR PRINTSTRING IS <PRINTSTRING .STRING .OUTCHANNEL .MAXCHARS>
; THESE WERE CODED 9/16/73 BY NEAL D. RYAN
MFUNCTION RSTRNG,SUBR,READSTRING
ENTRY
PUSH P,[0] ; FLAG TO INDICATE READING
HLRE 0,AB
CAMG 0,[-1]
CAMG 0,[-9]
JRST WNA ; CHECK THAT IT HAS FROM 1 TO 4 ARGS
JRST STRIO1
MFUNCTION PSTRNG,SUBR,PRINTSTRING
ENTRY
PUSH P,[1] ; FLAG TO INDICATE WRITING
HLRE 0,AB
CAMG 0,[-1]
CAMG 0,[-7]
JRST WNA ; CHECK THAT IT HAS FROM 1 TO 3 ARGS
STRIO1: PUSH TP,[0] ; SAVE SLOT ON STACK
PUSH TP,[0]
GETYP 0,(AB)
CAIE 0,TCHSTR ; MAKE SURE WE GOT STRING
JRST WTYP1
HRRZ 0,(AB) ; CHECK FOR EMPTY STRING
SKIPN (P)
JUMPE 0,MTSTRN
HLRE 0,AB
CAML 0,[-2] ; WAS A CHANNEL GIVEN
JRST STRIO2
GETYP 0,2(AB)
SKIPN (P) ; SKIP IF PRINT
JRST TESTIN
CAIN 0,TTP ; SEE IF FLATSIZE HACK
JRST STRIO9
TESTIN: CAIE 0,TCHAN
JRST WTYP2 ; SECOND ARG NOT CHANNEL
MOVE B,3(AB)
HRRZ B,-2(B)
MOVNI E,1 ; CHECKING FOR GOOD DIRECTION
TRNE B,C.READ ; SKIP IF NOT READ
MOVEI E,0
TRNE B,C.PRIN ; SKIP IF NOT PRINT
MOVEI E,1
CAME E,(P)
JRST WRONGD ; MAKE SURE CHANNEL IS OPEN IN RIGHT MODE
STRIO9: PUSH TP,2(AB)
PUSH TP,3(AB) ; PUSH ON CHANNEL
JRST STRIO3
STRIO2: MOVE B,IMQUOTE INCHAN
MOVSI A,TCHAN
SKIPE (P)
MOVE B,IMQUOTE OUTCHAN
PUSHJ P,IDVAL
GETYP 0,A
SKIPN (P) ; SKIP IF PRINTSTRING
JRST TESTI2
CAIN 0,TTP ; SKIP IF NOT FLATSIZE HACK
JRST STRIO8
TESTI2: CAIE 0,TCHAN
JRST BADCHN ; MAKE SURE WE GOT A GOOD DEFAULT CHANNEL
STRIO8: PUSH TP,A
PUSH TP,B
STRIO3: MOVE B,(TP) ; GET CHANNEL
SKIPN E,IOINS(B)
PUSHJ P,OPENIT ; IF NOT GO OPEN
MOVE E,IOINS(B)
CAMN E,[JRST CHNCLS]
JRST CHNCLS ; CHECK TO SEE THAT CHANNEL ISNT ALREADY CLOSED
STRIO4: HLRE 0,AB
CAML 0,[-4]
JRST STRIO5 ; NO COUNT TO WORRY ABOUT
GETYP 0,4(AB)
MOVE E,4(AB)
MOVE C,5(AB)
CAIE 0,TCHSTR
CAIN 0,TFIX ; BETTER BE A FIXED NUMBER
JRST .+2
JRST WTYP3
HRRZ D,(AB) ; GET ACTUAL STRING LENGTH
CAIN 0,TFIX
JRST .+7
SKIPE (P) ; TEST FOR WRITING
JRST .-7 ; IF WRITING WE GOT TROUBLE
PUSH P,D ; ACTUAL STRING LENGTH
MOVEM E,(TB) ; STUFF HIS FUNNY DELIM STRING
MOVEM C,1(TB)
JRST STRIO7
CAML D,C ; MAKE SURE THE STRING IS LONG ENOUGH
JRST .+2 ; WIN
ERRUUO EQUOTE COUNT-GREATER-THAN-STRING-SIZE
PUSH P,C ; PUSH ON MAX COUNT
JRST STRIO7
STRIO5:
STRIO6: HRRZ C,(AB) ; GET CHAR COUNT
PUSH P,C ; AND PUSH IT ON STACK AS NO MAX COUNT GIVEN
STRIO7: HLRE 0,AB
CAML 0,[-6]
JRST .+6
MOVE B,(TP) ; GET THE CHANNEL
MOVE 0,6(AB)
MOVEM 0,EOFCND-1(B) ; STUFF IN SLOT IN CHAN
MOVE 0,7(AB)
MOVEM 0,EOFCND(B)
PUSH TP,(AB) ; PUSH ON STRING
PUSH TP,1(AB)
PUSH P,[0] ; PUSH ON CURRENT COUNT OF CHARS DONE
MOVE 0,-2(P) ; GET READ OR WRITE FLAG
JUMPN 0,OUTLOP ; GO WRITE STUFF
MOVE B,-2(TP) ; GET CHANNEL
PUSHJ P,GRB ; MAKE SURE WE HAVE BUFF
SKIPGE A,LSTCH(B) ; CHECK FOR EOF ALREADY READ PREVIOUSLY
JRST SRDOEF ; GO DOES HIS EOF HACKING
INLOP: INTGO
MOVE B,-2(TP) ; GET CHANNEL
MOVE C,-1(P) ; MAX COUNT
CAMG C,(P) ; COMPARE WITH COUNT DONE
JRST STREOF ; WE HAVE FINISHED
PUSHJ P,R1CHAR ; GET A CHAR
JUMPL A,INEOF ; EOF HIT
MOVE C,1(TB)
HRRZ E,(TB) ; DO WE HAVE A STRING TO WORRY US?
SOJL E,INLNT ; GO FINISH STUFFING
ILDB D,C
CAME D,A
JRST .-3
JRST INEOF
INLNT: IDPB A,(TP) ; STUFF IN STRING
SOS -1(TP) ; DECREMENT STRING COUNT
AOS (P) ; INCREMENT CHAR COUNT
JRST INLOP
INEOF: SKIPE C,LSTCH(B) ; IS THIS AN ! AND IS THERE A CHAR THERE
JRST .+3 ; YES
MOVEM A,LSTCH(B) ; NO SAVE THE CHAR
JRST .+3
ADDI C,400000
MOVEM C,LSTCH(B)
MOVSI C,200000
IORM C,LSTCH(B)
HRRZ C,DIRECT-1(B) ; GET THE TYPE OF CHAN
CAIN C,5 ; IS IT READB?
JRST .+3
SOS ACCESS(B) ; FIX UP ACCESS FOR READ CHANNEL
JRST STREOF ; AND THATS IT
HRRZ C,ACCESS-1(B) ; FOR A READB ITS WORSE
MOVEI D,5
SKIPG C
HRRM D,ACCESS-1(B) ; CHANGE A 0 TO A FIVE
SOS C,ACCESS-1(B)
CAMN C,[TFIX,,0]
SOS ACCESS(B) ; AND SOS THE WORD COUNT MAYBE
JRST STREOF
SRDOEF: SETZM LSTCH(B) ; IN CASE OF -1, FLUSH IT
AOJE A,INLOP ; SKIP OVER -1 ON PTY'S
SUB TP,[6,,6]
SUB P,[3,,3] ; POP JUNK OFF STACKS
PUSH TP,EOFCND-1(B)
PUSH TP,EOFCND(B) ; WHAT WE NEED TO EVAL
PUSH TP,$TCHAN
PUSH TP,B
MCALL 1,FCLOSE ; CLOSE THE LOOSING CHANNEL
MCALL 1,EVAL ; EVAL HIS EOF JUNK
JRST FINIS
OUTLOP: MOVE B,-2(TP)
OUTLP1: INTGO
MOVE A,-3(TP) ; GET CHANNEL
MOVE B,-2(TP)
MOVE C,-1(P) ; MAX COUNT TO DO
CAMG C,(P) ; HAVE WE DONE ENOUGH
JRST STREOF
ILDB D,(TP) ; GET THE CHAR
SOS -1(TP) ; SUBTRACT FROM STRING LENGTH
AOS (P) ; INC COUNT OF CHARS DONE
PUSHJ P,CPCH1 ; GO STUFF CHAR
JRST OUTLP1
STREOF: MOVE A,$TFIX
POP P,B ; RETURN THE LOOSER A COUNT OF WHAT WAS DONE
SUB P,[2,,2]
SUB TP,[6,,6]
JRST FINIS
GWB: SKIPE BUFSTR(B)
POPJ P,
PUSH TP,$TCHAN
PUSH TP,B ; GET US A WRITE BUFFER ON PRINTB CHAN
MOVEI A,BUFLNT
PUSHJ P,IBLOCK
MOVSI A,TWORD+.VECT.
MOVEM A,BUFLNT(B)
SETOM (B)
MOVEI C,1(B)
HRLI C,(B)
BLT C,BUFLNT-1(B)
MOVEI C,-1(B)
HRLI C,010700
MOVE B,(TP)
MOVEI 0,C.BUF
IORM 0,-2(B)
MOVEM C,BUFSTR(B)
MOVE C,[TCHSTR,,BUFLNT*5]
MOVEM C,BUFSTR-1(B)
SUB TP,[2,,2]
POPJ P,
GRB: SKIPE BUFSTR(B)
POPJ P,
PUSH TP,$TCHAN
PUSH TP,B ; GET US A READ BUFFER
MOVEI A,BUFLNT
PUSHJ P,IBLOCK
MOVEI C,BUFLNT-1(B)
POP TP,B
MOVEI 0,C.BUF
IORM 0,-2(B)
HRLI C,010700
MOVEM C,BUFSTR(B)
MOVSI C,TCHSTR
MOVEM C,BUFSTR-1(B)
SUB TP,[1,,1]
POPJ P,
MTSTRN: ERRUUO EQUOTE EMPTY-STRING
; INPUT UNBUFFERING ROUTINE. THIS DOES THE CHARACTER UNBUFFERING
; FOR INPUT. THE OPEN ROUTINE SETUPS A PUSHJ P, TO
; THIS ROUTINE AS THE IOINS FOR A CHANNEL OPEN TO A NON-TTY DEVICE.
; H. BRODIE 7/19/72
; CALLING SEQ:
; PUSHJ P,GETCHR
; B/ AOBJN PNTR TO CHANNEL VECTOR
; RETURNS NEXT CHARACTER IN AC A.
; ON ENCOUNTERING EITHER ^C OR NUL(^@) IT ASSUMES EOF AND
; TRANSMITS ONLY ^C ON SUCCESSIVE CALLS
GETCHR:
; FIRST GRAB THE BUFFER
; GETYP A,BUFSTR-1(B) ; GET TYPE WORD
; CAIN A,TCHSTR ; SKIPS IF NOT CHSTR (I.E. IF BAD BUFFER)
; JRST GTGBUF ; IS GOOD BUFFER...SKIP ERROR RETURN
GTGBUF: HRRZ A,BUFSTR-1(B) ; GET LENGTH OF STRING
SOJGE A,GTGCHR ; JUMP IF STILL MORE
; HERE IF THE BUFFER WAS EXHAUSTED (BYTE PNTR POINTS INTO DOPE WDS)
; GENERATE AN .IOT POINTER
;FIRST SAVE C AND D AS I WILL CLOBBER THEM
NEWBUF: PUSH P,C
PUSH P,D
IFN ITS,[
LDB C,[600,,STATUS(B)] ; GET TYPE
CAIG C,2 ; SKIP IF NOT TTY
]
IFE ITS,[
SKIPE BUFRIN(B)
]
JRST GETTTY ; GET A TTY BUFFER
PUSHJ P,PGBUFI ; RE-FILL BUFFER
IFE ITS, MOVEI C,-1
JUMPGE A,BUFGOO ;SKIPS IF IOT COMPLETED...FIX UP CHANNEL
IFN ITS,[
MOVEI C,1 ; MAKE SURE LAST EOF REALLY ENDS IT
ANDCAM C,-1(A)
]
MOVSI C,014000 ; GET A ^C
MOVEM C,(A) ;FAKE AN EOF
IFE ITS,[
HLRE C,A ; HOW MUCH LEFT
ADDI C,BUFLNT ; # OF WORDS TO C
IMULI C,5 ; TO CHARS
PUSH P,0
MOVEI 0,1
SKIPE C
ANDCAM 0,-1(1)
POP P,0
MOVE A,-2(B) ; GET BITS
TRNE A,C.BIN ; CAN'T HELP A BINARY CHANNEL
JRST BUFGOO
MOVE A,CHANNO(B)
PUSH P,B
PUSH P,D
PUSH P,C
PUSH P,[0]
PUSH P,[0]
MOVEI C,-1(P)
MOVE B,[2,,11] ; READ WORD CONTAINING BYTE SIZE
GTFDB
LDB D,[300600,,-1(P)] ; GET BYTE SIZE
MOVE B,(P)
SUB P,[2,,2]
POP P,C
CAIE D,7 ; SEVEN BIT BYTES?
JRST BUFGO1 ; NO, DONT HACK
MOVE D,C
IDIVI B,5 ; C IS NUMBER IN LAST WORD IF NOT EVEN
SKIPN C
MOVEI C,5
ADDI C,-5(D) ; FIXUP C FOR WINNAGE
BUFGO1: POP P,D
POP P,B
]
; RESET THE BYTE POINTER IN THE CHANNEL.
; BUILD ONE USING THE PTR TO BEG OF BUFFER SAVED IN D
BUFGOO: HRLI D,010700 ; GENERATE VIRGIN LH
SUBI D,1
MOVEM D,BUFSTR(B) ; STASH IN THE BUFFER BYTE PNTR SLOT
IFE ITS, HRRM C,LSTCH-1(B) ; SAVE IT
MOVEI A,BUFLNT*5-1
BUFROK: POP P,D ;RESTORE D
POP P,C ;RESTORE C
; HERE IF THERE ARE CHARS IN BUFFER
GTGCHR: HRRM A,BUFSTR-1(B)
ILDB A,BUFSTR(B) ; GET A CHAR FROM BUFFER
IFN ITS,[
CAIE A,3 ; EOF?
POPJ P, ; AND RETURN
LDB A,[600,,STATUS(B)] ; CHECK FOR TTY
CAILE A,2 ; SKIP IF TTY
]
IFE ITS,[
PUSH P,0
HRRZ 0,LSTCH-1(B)
SOJL 0,.+4
HRRM 0,LSTCH-1(B)
POP P,0
POPJ P,
POP P,0
MOVSI A,-1
SKIPN BUFRIN(B)
]
JRST .+3
RETEO1: HRRI A,3
POPJ P,
HRRZ A,BUFSTR(B) ; SEE IF RSUBR START BIT IS ON
HRRZ A,(A)
TRNN A,1
MOVSI A,-1
JRST RETEO1
IFN ITS,[
PGBUFO:
PGBUFI:
]
IFE ITS,[
PGBUFO: SKIPA D,[SOUT]
PGBUFI: MOVE D,[SIN]
]
SKIPGE A,BUFSTR(B) ; POINT TO CURRENT BUFFER POSIT
SUBI A,1 ; FOR 440700 AND 010700 START
SUBI A,BUFLNT-1 ; CALCULATE PNTR TO BEG OF BUFFER
HRLI A,-BUFLNT ; IOT (AOBJN) PNTR IN A
MOVSI C,004400
IFN ITS,[
PGBIOO:
PGBIOI: MOVE D,A ; COPY FOR LATER
MOVSI C,TUVEC ; PREPARE TO HANDDLE INTS
MOVE PVP,PVSTOR+1
MOVEM C,DSTO(PVP)
MOVEM C,ASTO(PVP)
MOVSI C,TCHAN
MOVEM C,BSTO(PVP)
; BUILD .IOT INSTR
MOVE C,CHANNO(B) ; CHANNEL NUMBER IN C
ROT C,23. ; MOVE INTO AC FIELD
IOR C,[.IOT 0,A] ; IOR IN SKELETON .IOT
; DO THE .IOT
ENABLE ; ALLOW INTS
XCT C ; EXECUTE THE .IOT INSTR
DISABLE
MOVE PVP,PVSTOR+1
SETZM BSTO(PVP)
SETZM ASTO(PVP)
SETZM DSTO(PVP)
POPJ P,
]
IFE ITS,[
PGBIOT: PUSH P,D
PUSH TP,$TCHAN
PUSH TP,B
PUSH P,C
HRRZS (P)
HRRI C,-1(A) ; POINT TO BUFFER
HLRE D,A ; XTRA POINTER
MOVNS D
HRLI D,TCHSTR
MOVE PVP,PVSTOR+1
MOVEM D,BSTO(PVP)
MOVE D,[PUSHJ P,FIXACS]
MOVEM D,ONINT
MOVSI D,TUVEC
MOVEM D,DSTO(PVP)
MOVE D,A
MOVE A,CHANNO(B) ; FILE JFN
MOVE B,C
HLRE C,D ; - COUNT TO C
SKIPE (P)
MOVN C,(P) ; REAL DESIRED COUNT
SUB P,[1,,1]
ENABLE
XCT (P) ; DO IT TO IT
DISABLE
MOVE PVP,PVSTOR+1
SETZM BSTO(PVP)
SETZM DSTO(PVP)
SETZM ONINT
MOVEI A,1(B)
MOVE B,(TP)
SUB TP,[2,,2]
SUB P,[1,,1]
JUMPGE C,CPOPJ ; NO EOF YET
HRLI A,(C) ; LOOK LIKE AN AOBJN PNTR
POPJ P,
FIXACS: PUSH P,PVP
MOVE PVP,PVSTOR+1
MOVNS C
HRRM C,BSTO(PVP)
MOVNS C
POP P,PVP
POPJ P,
PGBIOO: SKIPA D,[SOUT]
PGBIOI: MOVE D,[SIN]
HRLI C,004400
JRST PGBIOT
DOIOTO: PUSH P,[SOUT]
DOIOTC: PUSH P,B
PUSH P,C
EXCH A,B
MOVE A,CHANNO(A)
HLRE C,B
HRLI B,444400
XCT -2(P)
HRL B,C
MOVE A,B
DOIOTE: POP P,C
POP P,B
SUB P,[1,,1]
POPJ P,
DOIOTI: PUSH P,[SIN]
JRST DOIOTC
]
; OUTPUT BUFFERING ROUTINES SIMILAR TO INPUT BUFFERING ROUTINES OF PREV PAGE
PUTCHR: PUSH P,A
GETYP A,BUFSTR-1(B) ; CHECK TYPE OF ARG
CAIE A,TCHSTR ; MUST BE STRING
JRST BDCHAN
HRRZ A,BUFSTR-1(B) ; GET CHAR COUNT
JUMPE A,REBUFF ; PREV RESET BUFF, UNDO SAME
PUTCH1: POP P,A ; RESTORE CHAR
CAMN A,[-1] ; SPECIAL HACK?
JRST PUTCH2 ; YES GO HANDLE
IDPB A,BUFSTR(B) ; STUFF IT
PUTCH3: SOS A,BUFSTR-1(B) ; COUNT DOWN STRING
TRNE A,-1 ; SKIP IF FULL
POPJ P,
; HERE TO FLUSH OUT A BUFFER
PUSH P,C
PUSH P,D
PUSHJ P,PGBUFO ; SETUP AND DO IOT
HRLI D,010700 ; POINT INTO BUFFER
SUBI D,1
MOVEM D,BUFSTR(B) ; STORE IT
MOVEI A,BUFLNT*5 ; RESET COUNT
HRRM A,BUFSTR-1(B)
POP P,D
POP P,C
POPJ P,
;HERE TO DA ^C AND TURN ON MAGIC BIT
PUTCH2: MOVEI A,3
IDPB A,BUFSTR(B) ; ZAP OUT THE ^C
MOVEI A,1 ; GET BIT
IFE ITS,[
PUSH P,C
HRRZ C,BUFSTR(B)
IORM A,(C)
POP P,C
]
IFN ITS,[
IORM A,@BUFSTR(B) ; ON GOES THE BIT
]
JRST PUTCH3
; RESET A FUNNY BUF
REBUFF: MOVEI A,BUFLNT*5 ; 1ST COUNT
HRRM A,BUFSTR-1(B)
HRRZ A,BUFSTR(B) ; NOW POINTER
SUBI A,BUFLNT+1
HRLI A,010700
MOVEM A,BUFSTR(B) ; STORE BACK
JRST PUTCH1
; HERE TO FLUSH FINAL BUFFER
BFCLOS: HRRZ C,-2(B) ; THIS BUFFER FLUSHER THE WORK OF NDR
MOVEI A,0
TRNE C,C.TTY
POPJ P,
TRNE C,C.DISK
MOVEI A,1
PUSH P,A ; SAVE THE RESULT OF OUR TEST
JUMPN A,BFCLNN ; DONT HAVE TO CHECK NET STATE
PUSH TP,$TCHAN
PUSH TP,B ; SAVE CHANNEL
PUSHJ P,INSTAT ; GET CURRENT NETWORK STATE
MOVE A,(B) ; GET FIRST ELEMENT OF STATE UVECTOR WHICH IS CUR STATE
POP TP,B ; RESTORE B
POP TP,
CAIE A,5 ; IS NET IN OPEN STATE?
CAIN A,6 ; OR ELSE IS IT IN RFNM WAIT STATE
JRST BFCLNN ; IF SO TO THE IOT
POP P, ; ELSE FLUSH CRUFT AND DONT IOT
POPJ P, ; RETURN DOING NO IOT
BFCLNN: MOVEI C,BUFLNT*5 ; NEW BUFFER FLUSHER BY NDR
HRRZ D,BUFSTR-1(B) ; SO THAT NET ALSO WORKS RIGHT
SUBI C,(D) ; GET NUMBER OF CHARS
IDIVI C,5 ; NUMBER OF FULL WORDS AND REST
PUSH P,D ; SAVE NUMBER OF ODD CHARS
SKIPGE A,BUFSTR(B) ; GET CURRENT BUF POSITION
SUBI A,1 ; FIX FOR 440700 BYTE POINTER
IFE ITS,[
HRRO D,A
PUSH P,(D)
]
IFN ITS,[
PUSH P,(A) ; SAVE THE ODD WORD OF BUFFER
]
MOVEI D,BUFLNT
SUBI D,(C)
SKIPE -1(P)
SUBI A,1
ADDI D,1(A) ; FIX UP FOR POSSIBLE ODD CHARS
PUSH TP,$TUVEC
PUSH TP,D ; PUSH THE DOPE VECTOR ONTO THE STACK
JUMPE C,BFCLSR ; IN CASE THERE ARE NO FULL WORDS TO DO
HRL A,C
TLO A,400000
MOVE E,[SETZ BUFLNT(A)]
SUBI E,(C) ; FIX UP FOR BACKWARDS BLT
POP A,@E ; AMAZING GRACE
TLNE A,377777
JRST .-2
HRRO A,D ; SET UP AOBJN POINTER
SUBI A,(C)
TLC A,-1(C)
PUSHJ P,PGBIOO ; DO THE IOT OF ALL THE FULL WORDS
BFCLSR: HRRO A,(TP) ; GET IOT PTR FOR REST OF JUNK
SUBI A,1 ; POINT TO WORD BEFORE DOPE WORDS
POP P,0 ; GET BACK ODD WORD
POP P,C ; GET BACK ODD CHAR COUNT
POP P,D ; FLAG FOR NET OR DSK
JUMPN D,BFCDSK ; GO FINISH OFF DSK
JUMPE C,BFCLSD ; IF NO ODD CHARS FINISH UP
MOVEI D,7
IMULI D,(C) ; FIND NO OF BITS TO SHIFT
LSH 0,-43(D) ; SHIFT BITS TO RIGHT PLACE
MOVEM 0,(A) ; STORE IN STRING
SUBI C,5 ; HOW MANY CHAR POSITIONS TO SKIP
MOVNI C,(C) ; MAKE C POSITIVE
LSH C,17
TLC A,(C) ; MUNG THE AOBJN POINTER TO KLUDGE
PUSHJ P,PGBIOO ; DO IOT OF ODD CHARS
MOVEI C,0
BFCLSD: HRRZ A,(TP) ; GET PTR TO DOPE WORD
SUBI A,BUFLNT+1
JUMPLE C,.+3
SKIPE ACCESS(B)
MOVEM 0,1(A) ; LAST WORD BACK IN BFR
HRLI A,010700 ; AOBJN POINTER TO FIRST OF BUFFER
MOVEM A,BUFSTR(B)
MOVEI A,BUFLNT*5
HRRM A,BUFSTR-1(B)
SKIPN ACCESS(B)
JRST BFCLSY
JUMPL C,BFCLSY
JUMPE C,BFCLSZ
IBP BUFSTR(B)
SOS BUFSTR-1(B)
SOJG C,.-2
BFCLSY: MOVE A,CHANNO(B)
MOVE C,B
IFE ITS,[
RFPTR
FATAL RFPTR FAILED
HRRZ F,LSTCH-1(C) ; PREVIOUS HIGH
MOVE G,C ; SAVE CHANNEL
MOVE C,B
CAML F,B
MOVE C,F
MOVE F,B
HRLI A,400000
CLOSF
JFCL
MOVNI B,1
HRLI A,12
CHFDB
MOVE B,STATUS(G)
ANDI A,-1
OPENF
FATAL OPENF LOSES
MOVE C,F
IDIVI C,5
MOVE B,C
SFPTR
FATAL SFPTR FAILED
MOVE B,G
]
IFN ITS,[
DOTCAL RFPNTR,[A,[2000,,B]]
.LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS
SUBI B,1
DOTCAL ACCESS,[A,B]
.LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS
MOVE B,C
]
BFCLSZ: SUB TP,[2,,2]
POPJ P,
BFCDSK: TRZ 0,1
PUSH P,C
IFE ITS,[
PUSH TP,$TCHAN
PUSH TP,B
PUSH P,0 ; WORD OF CHARS
MOVE A,CHANNO(B)
MOVEI B,7 ; MAKE BYTE SIZE 7
SFBSZ
JFCL
HRROI B,(P)
MOVNS C
SKIPE C
SOUT
MOVE B,(TP)
SUB P,[1,,1]
SUB TP,[2,,2]
]
IFN ITS,[
MOVE D,[440700,,A]
DOTCAL SIOT,[CHANNO(B),D,C]
.LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS
]
POP P,C
JUMPN C,BFCLSD
BFCDS1: MOVNI C,1 ; INDICATE NOT TOHACK BUFFER
JRST BFCLSD
BFCLS1: HRRZ C,DIRECT-1(B)
MOVSI 0,(JFCL)
CAIE C,6
MOVE 0,[AOS ACCESS(B)]
PUSH P,0
HRRZ C,BUFSTR-1(B)
IDIVI C,5
JUMPE D,BCLS11
MOVEI A,40 ; PAD WITH SPACES
PUSHJ P,PUTCHR
XCT (P) ; AOS ACCESS IF NECESSARY
SOJG D,.-3 ; TO END OF WORD
BCLS11: POP P,0
HLLZS ACCESS-1(B)
HRRZ C,BUFSTR-1(B)
CAIE C,BUFLNT*5
PUSHJ P,BFCLOS
POPJ P,
; HERE TO GET A TTY BUFFER
GETTTY: SKIPN C,EXBUFR(B) ; SKIP IF BUFFERS BACKED UP
JRST TTYWAI
HRRZ D,(C) ; CDR THE LIST
GETYP A,(C) ; CHECK TYPE
CAIE A,TDEFER ; MUST BE DEFERRED
JRST BDCHAN
MOVE C,1(C) ; GET DEFERRED GOODIE
GETYP A,(C) ; BETTER BE CHSTR
CAIE A,TCHSTR
JRST BDCHAN
MOVE A,(C) ; GET FULL TYPE WORD
MOVE C,1(C)
MOVEM D,EXBUFR(B) ; STORE CDR'D LIST
MOVEM A,BUFSTR-1(B) ; MAKE CURRENT BUFFER
MOVEM C,BUFSTR(B)
HRRM A,LSTCH-1(B)
SOJA A,BUFROK
TTYWAI: PUSHJ P,TTYBLK ; BLOCKED FOR TTY I/O
JRST GETTTY ; SHOULD ONLY RETURN HAPPILY
;INTERNAL DEVICE READ ROUTINE.
;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT,
;CHECKS THAT THE RETURNED VALUE IS OF TYPE CHARACTER,
;AND RETURNS THAT AS THE NEXT CHARACTER IN THE "FILE"
;H. BRODIE 8/31/72
GTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B
PUSH TP,B
PUSH P,C ;AND SAVE THE OTHER ACS
PUSH P,D
PUSH P,E
PUSH P,0
PUSH TP,$TCHAN
PUSH TP,B
.MCALL 1,INTFCN-1(B)
GETYP A,A
CAIE A,TCHRS
JRST BADRET
MOVE A,B
INTRET: POP P,0 ;RESTORE THE ACS
POP P,E
POP P,D
POP P,C
POP TP,B ;RESTORE THE CHANNEL
SUB TP,[1,,1] ;FLUSH $TCHAN...WE DON'T NEED IT
POPJ P,
BADRET: ERRUUO EQUOTE INT-DEVICE-WRONG-TYPE-EVALUATION-RESULT
;INTERNAL DEVICE PRINT ROUTINE.
;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT,(FUNCTION, SUBR, OR RSUBR)
;TO THE CURRENT CHARACTER BEING "PRINTED".
PTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B
PUSH TP,B
PUSH P,C ;AND SAVE THE OTHER ACS
PUSH P,D
PUSH P,E
PUSH P,0
PUSH TP,$TCHRS ;PUSH THE TYPE "CHARACTER"
PUSH TP,A ;PUSH THE CHAR
PUSH TP,$TCHAN ;PUSH THE CHANNEL
PUSH TP,B
.MCALL 2,INTFCN-1(B) ;APPLY THE FUNCTION TO THE CHAR
JRST INTRET
; ROUTINE TO FLUSH OUT A PRINT BUFFER
MFUNCTION BUFOUT,SUBR
ENTRY 1
GETYP 0,(AB)
CAIE 0,TCHAN
JRST WTYP1
MOVE B,1(AB)
; MOVEI B,DIRECT-1(B)
; PUSHJ P,CHRWRD ; GET DIR NAME
; JFCL
; CAMN B,[ASCII /PRINT/]
; JRST .+3
; CAME B,[<ASCII /PRINT/>+1]
; JRST WRONGD
; TRNE B,1 ; SKIP IF PRINT
; PUSH P,[JFCL]
; TRNN B,1 ; SKIP IF PRINTB
; PUSH P,[AOS ACCESS(B)]
HRRZ 0,-2(B)
TRNN 0,C.PRIN
JRST WRONGD
; TRNE 0,C.BIN ; SKIP IF PRINT
; PUSH P,[JFCL]
; TRNN 0,C.BIN ; SKIP IF PRINTB
; PUSH P,[AOS ACCESS(B)]
; MOVE B,1(AB)
; GETYP 0,BUFSTR-1(B)
; CAIN 0,TCHSTR
; SKIPN A,BUFSTR(B) ; BYTE POINTER?
; JRST BFIN1
; HRRZ C,BUFSTR-1(B) ; CHARS LEFT
; IDIVI C,5 ; MULTIPLE OF 5?
; JUMPE D,BFIN2 ; YUP NO EXTRAS
; MOVEI A,40 ; PAD WITH SPACES
; PUSHJ P,PUTCHR ; OUT IT GOES
; XCT (P) ; MAYBE BUMP ACCESS
; SOJG D,.-3 ; FILL
BFIN2: PUSHJ P,BFCLOS ; WRITE OUT BUFFER
BFIN1: MOVSI A,TCHAN
JRST FINIS
; FUNCTION TO GET THE FILE LENGTH OF A READ CHANNEL
MFUNCTION FILLNT,SUBR,[FILE-LENGTH]
ENTRY 1
GETYP 0,(AB)
CAIE 0,TCHAN
JRST WTYP1
MOVE B,1(AB)
PUSHJ P,CFILLE
JRST FINIS
CFILLE:
IFN 0,[
MOVEI B,DIRECT-1(B) ; GET CHANNEL TYPE
PUSHJ P,CHRWRD
JFCL
CAME B,[ASCIZ /READ/]
JRST .+3
PUSH P,[5] ; MULTIPLICATIVE FACTOR FOR READ
JRST .+4
CAME B,[ASCII /READB/]
JRST WRONGD
PUSH P,[1] ; MULTIPLICATIVE FACTOR FOR READ
]
MOVE C,-2(B) ; GET BITS
MOVEI D,5 ; ASSUME ASCII
TRNE C,C.BIN ; SKIP IF NOT BINARY
MOVEI D,1
PUSH P,D
MOVE C,B
IFN ITS,[
.CALL FILL1
JRST FILLOS ; GIVE HIM A NICE FALSE
]
IFE ITS,[
MOVE A,CHANNO(C)
PUSH P,[0]
MOVEI C,(P)
MOVE B,[1,,11] ; READ WORD CONTAINING BYTE SIZE
GTFDB
LDB D,[300600,,(P)] ; GET BYTE SIZE
JUMPN D,.+2
MOVEI D,36. ; HANDLE "0" BYTE SIZE
SUB P,[1,,1]
SIZEF
JRST FILLOS
]
POP P,C
IFN ITS, IMUL B,C
IFE ITS,[
CAIN C,5
CAIE D,7
JRST NOTASC
]
YESASC: MOVE A,$TFIX
POPJ P,
IFE ITS,[
NOTASC: MOVEI 0,36.
IDIV 0,D ; BYTES PER WORD
IDIVM B,0
IMUL C,0
MOVE B,C
JRST YESASC
]
IFN ITS,[
FILL1: SETZ ; BLOCK FOR .CALL TO FILLEN
SIXBIT /FILLEN/
CHANNO (C)
SETZM B
FILLOS: MOVE A,CHANNO(C)
MOVE B,[.STATUS A] ;MAKE A CALL TO STATUS TO FIND REASON
LSH A,23. ;SHIFT THE CHANNEL NUMBER INTO RIGHT PLACE
IOR B,A ;FIX UP .STATUS
XCT B
MOVE B,C
PUSHJ P,GFALS
POP P,
POPJ P,
]
IFE ITS,[
FILLOS: MOVE B,C
PUSHJ P,TGFALS
POP P,
POPJ P,
]
; MCHAN LOW-LEVEL I/O GARBAGE (PDL)-ORIGINAL (LIM)-ADDITIONS
;CALLING ROUTINE: AC-A contains pointer to block of SIXBIT data
; DIR ? DEV ? FNM1 ? FNM2 ? SNM
;RETURNED VALUE : AC-A = <channel #, or -1 if no channel available>
IFN ITS,[
MOPEN: PUSH P,B
PUSH P,C
MOVE C,FRSTCH ; skip gc and tty channels
CNLP: DOTCAL STATUS,[C,[2000,,B]]
.LOSE %LSFIL
ANDI B,77
JUMPE B,CHNFND ; found unused channel ?
ADDI C,1 ; try another channel
CAIG C,17 ; are all the channels used ?
JRST CNLP
SETO C, ; all channels used so C = -1
JRST CHNFUL
CHNFND: MOVEI B,(C)
HLL B,(A) ; M.DIR slot
DOTCAL OPEN,[B,1(A),2(A),3(A),4(A)]
SKIPA
AOS -2(P) ; successful skip when returning
CHNFUL: MOVE A,C
POP P,C
POP P,B
POPJ P,
MIOT: DOTCAL IOT,[A,B]
JFCL
POPJ P,
MCLOSE: DOTCAL CLOSE,[A]
JFCL
POPJ P,
IMPURE
FRSTCH: 1
PURE
]
;THREE GENERALLY USEFUL ERROR ROUTINES FOR I/O
NOTNET:
BADCHN: ERRUUO EQUOTE BAD-CHANNEL
BDCHAN: ERRUUO EQUOTE BAD-INPUT-BUFFER
WRONGD: ERRUUO EQUOTE WRONG-DIRECTION-CHANNEL
CHNCLS: ERRUUO EQUOTE CHANNEL-CLOSED
BAD6: ERRUUO EQUOTE NON-6-BIT-CHARACTER-IN-FILE-NAME
DISLOS: MOVE C,$TCHSTR
MOVE D,CHQUOTE [DISPLAY NOT AVAILABLE]
PUSHJ P,INCONS
MOVSI A,TFALSE
JRST OPNRET
NOCHAN: ERRUUO EQUOTE ITS-CHANNELS-EXHAUSTED
MODE1: 232020,,202020
MODE2: 232023,,330320
END
Reference in New Issue View Git Blame Copy Permalink