perm filename FTP.OLD[S,NET]1 blob
sn#693169 filedate 1983-01-04 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00077 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00016 00002 TITLE TELNET
C00022 00003 ac1 ac2 ac3 ac4 ac5 ac6 ac7 ac8 ac9 ac10 ac11 rsock ssock p NPOGS ACTBIT NEWBIT pln NUMARG CBITS CTRL1 FCSF ECHOF SPCIN SPCOUT OUTDON LSTCR NOTSNT CRLFF NOTYPE DPY DDDPY BEEPC SLOWF SLOWC SLOWIT DIRFLC TYOBLN TYOBUF TYOBP TYOCNT LOCKCT TRANSM PTYQUO EXTARQ EXTAOK LUKTTY CONSCK HOSTNO ITSFLG NWPTCM INSCNT DAMFLG ECREPY ECREPN NWPTEX RECHOF NEARLY intb conecb TRANSP NOPAR GENPAR DMDPY NOEDT WAKFLG WAKCNT ECHCNT CONCHR SPDNAM SPDTYP NOEXFL EXSCMD NEXCMD DMSIMF DMLSCR DMIGCR LUPPRV siu ccs sys nla ilb idd gmm se nop datam break ip ao ayt ec el ga sb will wont do dont iac CR
C00030 00004 More definitions
C00033 00005 stloc lsloc wfloc bsloc fsloc hloc terblk anyc rfcs rfcr clss clsr sttblk dislin ddlin DMLIN PTYLIN IMPBIT spcbrk FULTWX xon
C00035 00006 ttdpt isiii tthpos ttvpos ttvlst ttyorq ddfwrd ddpwrd iipwrd ttyobk ttbufb ttyoip ttpwrd ttbuft DPTOPC
C00038 00007 GRFON GNOTOK GINITF GRFSOK LSOCK GPSAVE GERMSV OLDFF GMSKSV GPCSAV GIBUF GOBUF GLEFT GMLEFT GUSED GOWAIT KLUCNT KLUPTR KLUWRD GBEGZR GNAME GADR GCNT GBITS DPYPTR GFREEW TXTFRE GIMSTT GALLOC GPDL GPIOWD INTPDL INTIOWD GACSAV TACSAV
C00042 00008 FLUCTL DILGET DILSTA DILDIL AREA DILNUM DILHNG BAREA BNUM ACODPT TTYINI TTYDEV LOGBUF LOGBFI NEWLOG TTYAOB RETRYF
C00044 00009 DILCOD DB MAXCOD DLRSTS DOH NDLRST DILERR DSTATE DSTATP DSTAT2 DSTATF DILCNI RDIALH RDIALE ERRSTP ERRST1 ERRCON ERRTTY
C00051 00010 LINE CHAR PTYCHR
C00052 00011 brktab bsactt ttybrk RSCCNT SYSMOD HSTBUF PAT PATCH NHPBRF
C00054 00012 TSTART START RSTART RSTRT0 NONETH rstrt1 rstrt2
C00060 00013 INRESC NOTLET NOAREA NODASH GOBLF dilgo GOBLF1 NEXTTY RETTY NOTHGH NODLRS LOWDIL NLOW HIDIL NHIGH TTYNAM lotsa defspd SKIPBR SKIPB TTYSIX TTYSX1 TTYSX2 STRIPC STRIP2 STRIP1 ILLDEV ILLNUM ILLSPD NUMIN NUMIN0 DILSPD SPEEDS NSPDS SPDNUM SIXPNT GETTNO GETTN2 INITTY NOTWRD INILUZ LOGDIL MADLOG MADCOP MADNUL MADLO2 LOGDL1 NODLOG DLTIME DLG4DE DLG3DE DLG2DE DLGDEC DLGDE1 DLDATE DLG6 DLG6A DLG63 DLG63A DLGSIX DLGOCT DLGOC1 DLGSTR DLGST1 DLGPUT DLGMON DLGNAM DLGEXT DLGPPN SETSPD TTYNA1 INITED INITE1
C00085 00014 PRPR PRPR1 PRJLP ENDPRJ
C00087 00015 namesc OPTRET GOTHDB NOTITS GOTST1 gotsite SLURPU SLURPA SLURPG SLURPF SLURPH SLURPE OPTXT OPTXTL OPTXTN OPTXTF OPTXTT OPTXTP OPTXTH OPTXTC OPTXTM OPTXTR OPTXBP OPTXOK OPTXNX OPTXCH OPTXDZ OPTXZR OPTXDN OPTCHR OPTCH1 NOOPTT
C00098 00016 loginj
C00101 00017 conini
C00103 00018 conwat
C00105 00019 NOSYNC
C00108 00020 cloop lockok nolock cloop1 SKPKLU crl2 PTYOUT NOFLU ININS1 NOTRBO skpout nodplf trytty trytt2 ttyhld chktty ttych TRANSI TTYSR5 nochr gtchr GTCH1 EATLF TYOUTS noochr wait WAIDIA watins CHKSLO
C00124 00021 notesc notes9 CHOUT1 chout cho NOTBUK notcr CHO1
C00127 00022 DMSNDD DMCLER DMSET DMSET2 DMSET1 DMRST DMSETL DMCURZ DMCLR DMSIM DMSIM0 DMSIM2 DMNOWR DMSIMT DMESC DMTAB DMALPH DMPI DMHOME DMBS DMBS1 DMLF DMLF1 DMLF2 DMLF3 DMFF DMFF3 DMCR DMCR1 DMBO DMDLE DMFS DMFS3 DMFS2 DMFS1 DMSUB DMSIMC DMSIMX DMSUB1 DMETB DMET1 DMCAN DMGS DMRS DMDSP DMSTOR DMBPTR DMCHK DMCURD DMCHK2 DMCHK1 DMDLIN DMLHDR DMERCU DMCYST DMCHK3 DMROL DMROL1 DMSROL DMSIMI DMRSHF DMRSH2 DMRSH1 DMLSHF DMLSH2 DMLSH1 DMDROW DMDRO1 DMAROW DMARO1 DMARO2
C00147 00023 DMHDR DMPROG DMBUF DMXLIN XCUR YCUR LYCUR DMHDRE DMPRGE DMCHDR DMCURP DMUPD DMUPDF DMALL DMCURC DMROLL DMDLMD
C00150 00024 ttyout ttydpb ttyowr TTYOCC ttyotb ttyobs ttyocr ttyoig ttyofs ttyohu ttyohd ttyolf ttyoup ttyocp ttyoc3 ttyoc1 ttyoc2 ttyocl ttyoc4 TTYOABS DPTGET tbufin
C00157 00025 INAGN impget impout impou1 NOOCON ZERPAR impouu impoug impodb impod1 outagn allocs OUTERR INPERR
C00164 00026 contch CONTC1 CONTC2 intcnc intcng
C00167 00027 notnum cmtbl cmdsp
C00170 00028 MC MC2 QUOTE CTLMOD FFOUT TYPEIT TYPEI1 echo setech noecho setnoe setesc NOTRAN escchr BEEPX setdpt gotfre clrdpt ttppib BUCKLF
C00177 00029 quit
C00179 00030 inpolp sndint ayto breako aborto proto setlm setfcm setfcs setlmb setlmt sndncr
C00182 00031 spcchr spcnoe spceco spcagn spcnxt spcnx1 nwpttb spchr spchds spcdm spcdn spcdo spcwi spcwo spcexs nwwi nwwi1 nwwi2 nwwo nwwo1 nwex1 nwdo nwdn nwdo2 nwex DOEXTA DOEXT2 DOEXT3 WOEXTA WOEXT2 WOEXT3 NGEXTA
C00190 00032 SLOW STBAUD STBAUL STBAUE STBAUS STBAUX ETRANS LTRANS DOPAR ifile ifilec spinc spincl EATLFC spic icf
C00201 00033 ofile spcook ofilec ofilc1 spoutc xtend xtend2 xtend1 socmsg socms1 socmsx socsiy socsix
C00205 00034 term tloop isalpn lcheck rjust rjloop
C00207 00035 rdfile rdppm errspc winxit errlf rstx
C00209 00036 POCT poctl
C00210 00037 clschk inpskp
C00212 00038 intdsp intend DIACL2 DIACL4 DIACL3 DIACLK DIACL5 inunlk insr inttst insflg inrflg IMPCHG GFINTS GCLOSE GIMPERR
C00217 00039 getsite getnn getsl getsil
C00218 00040 snfnd fnlop ambig sucex cpopj2 cpopj1 cpopj
C00220 00041 rdsite rdsit1 RDSNOH numonly sitnum nonum nonum1 rdsit2 bdchr rdsit3 getsock alt rdlf endsit
C00225 00042 lntab sntab ntab mtab nm
C00227 00043 rsfail inuse ssfail noinit intbts intbt concls
C00229 00044 gayskt unserr logbts
C00231 00045 noconn nosock norscn NOGRCV NOGSND nosscn norswc inperr outerr noconn norscn outerr
C00233 00046 GRFINI
C00236 00047 GRFKIL
C00237 00048 IMPLTB GRFSER GRFSE1 GRFSE2 GFIRST GLOOP UNKNOP INQUI INQUI2
C00241 00049 SGOPTB SGOPN SGCLS SGPOS SGUNP SGKIL ENDUP ENDUP2 ENDUP3 ENDUP4 ENDUP5 SGVEC SGTXT SGTXT1 SGTXT2 RDSGNA RDSGN2 RDSGN3 RDSGN4 MORCOR MORCO2 prtpog TYPOCT typoc2 typoc3
C00252 00050 GINCHS NOINP GINCHW GWAIT GICNT
C00255 00051 GOBCNT USEMES
C00257 00052 GOBYTE notgrf GOBYT2 EMPCHK MORLFT RETRY2 EMPTY RETRY
C00260 00053 GIMPOUT ALLUSED
C00262 00054 GO32BY GO8STR GO8ST2 GOCNT
C00264 00055 NUMPR NUMPR1 DON0 DATGEN NODA1 NODATE NOTIME NOZON MONTAB PDDATE PSDATE DTKIND
C00267 00056 FTPACT DIACTV DOACTV XACTV DIBUF DOBUF FIBUF FOBUF LDOSOC LDISOC FDISOC FDOSOC SVOTYP DTYPE DRTYPE IMODES FMODES SVBS DBS DHOST CNIBTS OUTCON SAVP CHAR1 SNDMOD SNDTYP SNDBYT MAILNG ACTION GIVELF PKUNAM PKUEXT PKURNM HAIRY HAIRBP HAIRBF HAIRLS HAIRRS HAIRPT HAIRLR HASCII HSTEND USRSTR ACCSTR PASSTR HOST6 OPOPEN OTBUF TYPTAB FNBUF FNBUF2 FNBPT
C00273 00057 OCDISP OCS
C00276 00058 FQUIT TTCINK STAT PXCWD WIDENT TTCIWT TTCIW1 QWAIT HELP IDENT IDENT1 IDENT2 RPLX PASS PASS2 PUSER USER USER1
C00281 00059 HAGGLE HAGASC BY10OK HAGLUZ ASCOK BY36OK IMGOK HAGTYP STREAM
C00285 00060 ASCSET IMGSET LCLSET TYPE TYPEUN TYPEOK TYPINC BYSTET BADTYP BDTYMS WHICHA WHICHB DFCOM COMOUT BYTE BYTE1 BYTE2 BYTE3 BADARG BADBYT BDBYMS BYTOUT DECOUT SNDPAR STYP SBYT BYTTYP PICKUP PKUNU1 PKUNUL PKUERR
C00296 00061 MAILIT From MAIL1 NOEND EOMAIL QUOTE LINOUT RLNOUT LINOLF CHAROUT WRTSIX WRSXLP SJSX
C00299 00062 TEMPA PLIST LIST TTY PRETR RETR TRETR RETR0 RETR1 RETRLP RETNPK RETPKF TYPWRT SAFASK SAFEOK TYPFIL RETRL1 SAFLKF SAFAOS SAFAUT SAFAU1 SAFEAA SAFEA1 SAFEAB CCR SAFENM TYPSIX RETRLX TYPNLS RETLX1 SAFX0 RET1ST RETRST NLSTST DIDOXX DIDOX1 DIDOXY DIDOLZ DIDOLZ SAFX1 MLFL PSTOR STOR STOR0 STORLP STORL1 STONPK STOPKF TYPREA STO1DO STORDO UFDPPN NOUFD UFDIN UFDIN1 FLUSCS SCANTO MLCHK SV2INC ERRWAT ERRWA1 GOWAIT LPPN RPPN DEBG
C00320 00063 TTSTROUT STROUT STROU1 STROUF TTCHROUT DOCHRO GETTTY CRGETY RGETTY GETTT1 GETTT2 FAKELF SPCRD SPCRDE GETCAP SXACTV
C00323 00064 FTPINI RESET FTLOOP FTLOP1 FTLOP3 FTLOP2 FTLCHK TTESCI ESCI ESCI1 INSBLK ILEVEL ILEVE1 IORSET RESET1 UFDOPN UBUF
C00330 00065 SAVACX SAVACS GETACS
C00332 00066 TTDISP TTREEN TTWAIT CHKABO TTACS TTP TTHUNG TTPDL TTROUT TTROU1 HAIREX DOHAIR HGETSP HGETL HAIRTY HDELIM HGETS2 HGETR HFOO HGETR1 HNEED2 HNOEQU TWOARR NUTTIN HAIRDO HAIRD1 OTPASS ANONYM INFRE1 INFREE NOACCT HAIRNO HAIRCR HAIRBY HAIRFN
C00343 00067 CIDISP CIREEN CIWAIT CIACS CIP CIHUNG CIPDL CINUM CIGAG CIINIT CIFLAG CIDEBG CIGRQ HYPHEN CISVG CIHYNO MSGPTR MSGSTK MSGCNT GAG200 SOCKFL SOCKET CISOCK CIROUT CIROXX CIROU0 CIROU6 CIROU1 CIROU4 CIRO41 CIROU3 CIROU2 CIRO22 CIROU7 CIROUX CIRO81 CIROU9 CIROU8 CIROSK SOCKIN SOCKLF
C00353 00068 DIDISP DIREEN DIWAIT DIACS DIP DIHUNG DIPDL DISTART DIROUT DIROU1 DIEOF DIEOF1 BAUD NOTBAU BAUDWT
C00358 00069 DODISP DOREEN DOWAIT DOACS DOP DOHUNG DOPDL DOSTART DOROUT DOROU1 DOROU2 DOTERM
C00361 00070 GETOC GETOX1 GETOX0 GETOC1 GETOCC GETOCQ SPCRDL GETOC9 GETOCA GETOC7 GETOC2 POP32 EMPTYL GETOCN GETOC3 GETOC4 GETOC5 GETOC6 GETOC0 SPCFTC XIND SPCFTI SPCFTE SPCFTN
C00368 00071 GETFIL GETFI0 GETFI1 GETFI2 GETFI3 GETFI4 GETFI5 GETFI6 GETFI7 GETF71 GETFI8 FOBTSL FOWORD FOBPT FOTEMP FOMASK GETDAT GETDA1 GETDA2 GETDA3 GETDA4 GETDA5 GETDA6
C00375 00072 PUTDAT PUTDA1 PUTFIL PUTFI0 PUTFI1 PUTFI2 COREOK CORLUZ PUTFI3 PUTFI4 PUTFI5 FIBTSL FIWORD FIBPT
C00379 00073 IDCON IDCONZ IDCONI IDCONC IDCONW IDCONX IDCONY IDCONS IDCONB IDCON0 IDFUCK IDCOS0 IDCON2 IDCON1 IDCO11 IDCOND IDCONA IDCONP IDCONF IMPIBF IMPOBF
C00384 00074 ILDDEV ILDDO ILDDSH ILDDE ILDDE2 ILDDL ILDDL2 ILDSSZ ILDSS1 ILDSS2 LEERR LEERRX LEETAB ILDD ILDDIO DSKIBF DSKOBF FASTAB
C00390 00075 FNREAD FNREA1 FNSEND FNSEN1 FNSPPL FNSENP FNSE10 FNSE11 FNSE12 FNSEN2 FNSEN3 FNSEN4 GFNY GFN GFNX GFNY1 NXTSKP NXTTOK GOTTOK TNONUL GFNLUZ PKUALT SYNBAD SAFOPT DEVICE ITSNM1 EXTNXT ITSNM2 NULDOT T20VER SETFIL TNXPPN PPNNXT PPNZB PPNLZ1 PPNXIT PPNLUZ GETPNM GETPN1 SEMICL GFNEOL GFNEO1 GFNEO2 EQUALS GFNDUN SKIPS1 SKIPSP SKIPS2 LETTS3 LETTST LETTS0 LETTS1 LETTS5 LETTS2 LETTS6 LETTS4 GETSI4 GETSIX ANCHR6 GETSI1 GETSI2 GETSI3
C00406 00076 OPRINT OPRINN DPRINT DPRINN DPRIN0 DPRIN1 DPRIN2 DPRIN3 DPRIN4 SIZE NCHRS RADIX
C00408 00077 SYSINI SYSINH HAIRSP HAIRT HAIRA HAIRSW HAIRQ HAIRR HAIRL HAIRX HAIRIN HAIRIM NOHAIR SYSIN0 SYSRST SYSSIX SYSSX1 SYSSX2 SYSSX3 SYSSXE
C00413 ENDMK
C⊗;
; TITLE TELNET
; THIS PROGRAM IS NOT TELNET, DESPITE ITS NAME. TELNET IS ON [NET,MRC].
IFN 0,<
.INSERT NAMES[NET,SYS]
>;OLD HOST TABLE R.I.P.
PRINTS /FTPSW(0),DIALSW(0),PTYSW(0),RSEXEC(0),LIMRIK(0),NEWPRO(0),DEBMOD(0)
/
PRINTS /GRFPRO(0),DPTSWT(0),DMFLG(1),FTVDIL(1)
/
.INSERT TTY:
IFNDEF FTVDIL,<FTVDIL←←1> ;If nonzero, use Vadic dialer
BUFOUT←←1
IFNDEF BUFOUT,< BUFOUT←←0 > ;-1 = Do output as OUTSTR of buffer instead of
; with OUTCHR
IFDEF FTP,<FTPCOM←←FTP> ;IN CASE YOU GUESS WRONG ABOUT SWITCH NAME.
IFDEF FTPSW,<FTPCOM←←FTPSW> ; "
IFNDEF FTPCOM,<
FTPCOM ←← 0 ;SET TO ZERO TO COMPILE TALKER
;SET TO ONE TO COMPILE FTP USER
>
IFNDEF RSEXEC,<↓RSEXEC←←0>;SPECIAL VERSION TO CONNECT TO BBN#247 (now isi#247--GFF)
IFNDEF LIMRIK,<↓LIMRIK←←0>;SPECIAL VERSION TO CONNECT TO CCA#21 (NOW SRI#17--BH)
;NOW NOWHERE -- COLONEL RUSSELL DOESN'T LIKE THEM. --MRC
IFN RSEXEC!LIMRIK!FTPCOM,<DIALSW←←0>
IFNDEF DIALSW,<DIALSW←←0>
DEFINE ISDIAL<IFN DIALSW>
DEFINE NODIAL<IFE DIALSW>
DIALOG←←1
IFNDEF DIALOG,<DIALOG←←0>
IFNDEF PTYSW,<PTYSW←←0>
DEFINE ISPTY<IFN PTYSW>
DEFINE NOPTY<IFE PTYSW>
ISPTY,<SYSCOM←←0>
IFNDEF NEWPRO,<NEWPRO←←0> ;NEW TELNET PROTOCOL
ISDIAL,<NEWPRO←←0>
DEFINE ISNEWP<IFN NEWPRO>
DEFINE NONEWP<IFE NEWPRO>
IFNDEF DEBMOD,<↓DEBMOD←←0>
DEFINE DEB<IFN DEBMOD>
DEFINE NODEB<IFE DEBMOD>
IFNDEF GRFPRO,<GRFPRO←←0>
DEFINE NGP<IFN GRFPRO>
DEFINE NONGP<IFN GRFPRO>
NGP,<NEWPRO←←1>
IFNDEF BUCKSW,< ;Send bucky bits if PTY or new protocol (TVR Sep75)
IFN NEWPRO+PTYSW,<BUCKSW←←1; > BUCKSW←←0
>;IFNDEF BUCKSW
DEFINE ISBUCKY<IFN BUCKSW>
DEFINE NOBUCKY<IFE BUCKSW>
ifndef impbug,<↓impbug←←0> ;System inserts spurious nulls, kludge around this
NODIAL,<
NOPTY,<
IFE FTPCOM,<
title TALKER
subttl Telnet program for ARPA net
>;FTPCOM
IFN FTPCOM,<
TITLE FTP
SUBTTL FTP USER PROGRAM
>;FTPCOM
>;NOPTY
ISPTY,<
TITLE PTYJOB
SUBTTL PROGRAM TO USE TELNET FEATURES ON PTY
>;ISPTY
>;NODIAL
ISDIAL,<
TITLE DIAL
SUBTTL PHONE DIALING PROGRAM
PRINTS/Assembling the DIAL program.
/
>;ISDIAL
IFN RSEXEC+LIMRIK,<↓SPCL←←1;>↓SPCL←←0
IFN SPCL,<SYSCOM←←0> ;NOT FOR RSEXEC OR LIMRIK
IFNDEF SYSCOM<SYSCOM←←1> ;ENABLE RESCAN OF SYSTEM COMMANDS FEATURE
↓SYSCOM←←SYSCOM
DEFINE ISSYS<IFN SYSCOM>
DEFINE NOSYS<IFE SYSCOM>
IFN FTPCOM,<
LOC 124 ;JOBREN
JRST TTESCI ;SIMULATE ESC-I
RELOC
>;FTPCOM
ISSYS,<
LOC 137
JRST TSTART
RELOC
IFN FTPCOM,<
DEFINE EPILOG(ACC)<
SOS RSCCNT
>
>;FTPCOM
IFE FTPCOM,<
DEFINE EPILOG(ACC)<
SOSL RSCCNT
PUSHJ P,[CAIN ACC,";"
MOVEI ACC,12
CAIN ACC,"$"
MOVEI ACC,175
POPJ P,]
>
>;NOT FTPCOM
>;ISSYS
NOSYS,< DEFINE EPILOG(ACC)<> >
DEFINE READW(AC)<
INCHWL AC
EPILOG(AC)
>
DEFINE READS(AC,FAIL)<
INCHSL AC
FAIL
EPILOG(AC)
>
IFNDEF DMFLG,<DMFLG←←-1>
IFN FTPCOM,<DMFLG←←0>
;ENABLE DATAPOINT SIMULATOR (FOR MIT and UCB)
IFNDEF DPTSWT<DPTSWT←←-1>
IFNDEF DPTABS<DPTABS←←-1> ;Add absolute cursor positioning to Datapoint
;(TVR May76)
IFN FTPCOM+GRFPRO<DPTSWT←←0> ;FTP and Graphics protocol incompatable with DPT
DEFINE DPT<IFN DPTSWT>
DEFINE NODPT<IFE DPTSWT>
ife spcl,<1;TELNET>ifn rsexec,<=247;>ifn limrik,<=17>
IFN FTPCOM,<ICPSOK←←3>
IFE FTPCOM,<
ICPSOK←←1 ;NORMAL FOR TELNET
ISNEWP,<ICPSOK←←27>
NGP,<ICPSOK←←51>
IFN RSEXEC,<ICPSOK←←=247> ;AT ISI
IFN LIMRIK,<ICPSOK←←=17> ;AT SRI
>;IFE FTPCOM
IFN FTPCOM,<
NBUFS←←23 ;optimum number of disk buffers (one more than one tk)
>;IFN FTPCOM
;ac1 ac2 ac3 ac4 ac5 ac6 ac7 ac8 ac9 ac10 ac11 rsock ssock p NPOGS ACTBIT NEWBIT pln NUMARG CBITS CTRL1 FCSF ECHOF SPCIN SPCOUT OUTDON LSTCR NOTSNT CRLFF NOTYPE DPY DDDPY BEEPC SLOWF SLOWC SLOWIT DIRFLC TYOBLN TYOBUF TYOBP TYOCNT LOCKCT TRANSM PTYQUO EXTARQ EXTAOK LUKTTY CONSCK HOSTNO ITSFLG NWPTCM INSCNT DAMFLG ECREPY ECREPN NWPTEX RECHOF NEARLY intb conecb TRANSP NOPAR GENPAR DMDPY NOEDT WAKFLG WAKCNT ECHCNT CONCHR SPDNAM SPDTYP NOEXFL EXSCMD NEXCMD DMSIMF DMLSCR DMIGCR LUPPRV siu ccs sys nla ilb idd gmm se nop datam break ip ao ayt ec el ga sb will wont do dont iac CR
;AC DEFINTIONS, VARIABLE STORAGE, RANDOM DEFINITIONS
↓ac1←2 ↓A ←← AC1
↓ac2←3 ↓B ←← AC2
↓ac3←4 ↓C ←← AC3
ac4←5 ↓D ←← AC4
ac5←6 E ←← AC5
ac6←7 F ←← AC6
ac7←10
ac8←11 T ←← AC8
ac9←12 ↓T1 ←← AC9
ac10←13 ↓T2 ←← AC10
ac11←14 ↓T3 ←← AC11
;AC10,AC11 USED BY SITE-NAME-TO-NUMBER ROUTINES, ONLY (?)
;T,T1 USED BY NUMBER PRINTING ROUTINES (OPRINT, ETC.)
rsock←15
ssock←16
↓p←17
NGP,<
↓NPOGS←←20 ;Number of pieces of glass
↓ACTBIT←←1B0
↓NEWBIT←←1B1
>
pln←←20
array pdl[pln],obuf[3],ibuf[3]
NUMARG: 0 ;NUMERIC ARGUMENT ACCUMULATED HERE
CBITS: 0 ;CONTROL AND META BITS COLLECTED HERE
CTRL1: 0 ;-1 → CTRL-1 BIT SET IN TYPEIN
FCSF: 0 ;-1 → ACTIVATE ON ALL INPUT CHARACTERS
ECHOF: -1 ;-1 → ECHO LOCALLY, 0 → INHIBIT ECHOING
SPCIN: 0 ;-1 → TAKE INPUT FROM DISK
SPCOUT: 0 ;-1 → OUTPUT TO DISK AS WELL AS TTY
OUTDON: 0 ;-1 → HAVE DONE A SPCOUT AT SOME POINT
LSTCR: 0 ;-1 → LAST CHARATER TYPED IN WAS CR
NOTSNT: 0 ;NUMBER OF CHARACTERS IN BUFFER NOT SENT OUT YET
CRLFF: 0 ;-1 → LAST NET CHAR WAS A CR
NOTYPE: 0 ;-1 → SUPRESS ALL TYPEOUT
DPY: 0 ;NON ZERO IF DATA DISC OR DATAMEDIA OR III (LINE CHARACTERISTICS)
DDDPY: 0 ;NON ZERO IF DATA DISC
BEEPC: -1 ;-1 → BEEP FOR π
ISDIAL,<
SLOWF: 0 ;-1 → DO SLOW-MODE DISK INPUT
SLOWC: 0 ; LAST CHARACTER INPUT
SLOWIT: 0 ; -1 → WAIT FOR THAT CHARACTER TO BE ECHOED
>
DIRFLC: 0 ;COUNTER FOR FLUSHING EXTRA DIRECTORY ENTRIES
IFN BUFOUT,<
TYOBLN←←3
TYOBUF: BLOCK TYOBLN ;BUFFER FOR ACCUMULATING OUTPUT CHARACTERS
0 ;MAKE IT ASCIZ
TYOBP: 440700,,TYOBUF
TYOCNT: TYOBLN*5
>;BUFOUT
NOPTY,<
LOCKCT: 0 ;≤ 0 → TIME TO LOCK IN TTY LOOP
>
;Changed from ISPTY to ISBUCKY to allow send bucky bits on net (TVR Sep75)
ISBUCKY,<
TRANSM: 0 ;-1 → SEND CONTROL AND META CHARACTERS THROUGH
PTYQUO: 0 ;-1 → LAST CHAR WAS META Z OR CTRL-META Z
ISNEWP,<
EXTARQ: 0 ;-1 → We've asked to send bucky bits (Extended-ASCII)
EXTAOK: 0 ;-1 → We're granted permission to send bucky bits
>;ISNEWP
>;ISBUCKY
NOPTY,<
NODIAL,<
LUKTTY: 0 ;-1 → JUST GOT TTY INPUT INTERRUPT, DO INCHRS IN CLOOP
CONSCK: 0 ;SOCKET NUMBER WE WILL CONNECT TO
HOSTNO: 0 ;FOREIGN HOST NUMBER TO CONNECT TO
ITSFLG: 0 ;-1 IF CONNECTING TO AN ITS
ISNEWP,<
NWPTCM: 0 ;-1 → NEXT IMP INPUT CHAR IS PART OF A NEW PROTOCOL COMMAND
INSCNT: 0 ;COUNT OF INSs RECEIVED
DAMFLG: 0 ;-1 → DATA MARK HAS BEEN SEEN
ECREPY: 0 ;-1 → EXPECTING WILL ECHO REPLY
ECREPN: 0 ;-1 → EXPECTING WONT ECHO REPLY
NWPTEX: -1 ;INDEX INTO NWPTTB FOR WILL, WONT, DO, DONT
RECHOF: 0 ;-1 → REMOTE HOST IS ECHOING
>;ISNEWP
NEARLY: 0 ;-1 → OUTPUT TO IMP NEARLY BLOKCKED
intb: 11
block 2
conecb: block 7
>;NODIAL
>;NOPTY
ISDIAL,<
TRANSP: 0 ;-1 if in transparent mode
NOPAR: 0 ;-1 if want no parity generation, positive if want it generated
GENPAR: -1 ;-1 to tell IMPOUT to generate parity
DMDPY: 0 ;non zero if DM in transparent mode
NOEDT: 0 ;non zero if noedit display in transparent mode
WAKFLG: 0 ;SET TO -1 BY INT ROUTINE TO CAUSE MAIN PROG WAKEUP
WAKCNT: 0 ;COUNTED DOWN BY INT ROUTINE TO DETERMINE IF ENUF CHARS FOR WAKEUP
ECHCNT: 0 ;SET TO # CHARS WE ARE EXPECTING FOR ECHO
CONCHR: 0 ;SET TO -1 IF SNEAKS SKIPS AT INT LEVEL
SPDNAM: -1 ;SET TO TTYSET INDEX OF SPEED IF USER SPECIFIES ONE
IFN FTVDIL,<
SPDTYP: 0 ;negative if "V" specified in speed name, for Vadic modem
>;IFN FTVDIL
NOEXFL: 0 ;-1 → NO EXIST THE TTY UPON CLOSE
EXSCMD: 72400,,1 ;TTYSET command to EXIST the tty whose number gets stuffed in
NEXCMD: 72400,,0 ;TTYSET cmd to NO EXIST the tty ...
>;ISDIAL
IFN DMFLG,<
DMSIMF: 0 ;-1 IF SIMULATING DATAMEDIA
DMLSCR: 0 ;-1 IF LAST CHAR WAS CR
DMIGCR: 0 ;-1 IF LAST CHAR CAUSED WRAPAROUND
>;DMFLG
;PRIVILEGE BITS (LEFT HALF)
LUPPRV←←1 ;LOCAL USER PRIVILEGE
IFN 0,<;GODDAM BAGBITING ASSEMBLER!
NOPTY,<
NODIAL,<
; MTAPE error codes
siu←←1
ccs←←2
sys←←3
nla←←4
ilb←←5
idd←←6
gmm←←7
>;NODIAL
>;NOPTY
>;IFN 0
;new protocol telnet command codes
ISNEWP,<
se←←360
nop←←361
datam←←362
break←←363
ip←←364
ao←←365
ayt←←366
ec←←367
el←←370
ga←←371
sb←←372
will←←373
wont←←374
do←←375
dont←←376
iac←←377
>;ISNEWP
CR: BYTE (7) 15,12 ;ASCIZ /<CARRAIGE RETURN>/
; More definitions
external jobapr,jobcni,jobtpc
imp←←1
NGP,< ↓GIMP ←← 2 ;Channel for graphics >
log←←3
infl←←4
outfl←←5
DOMP ←← 6 ;DATA OUT CONNECTIONS ON CHANNEL 6 (FTP)
DIMP ←← 7 ;DATA IN CONNECTIONS ON CHANNEL 7 (FTP)
FOMP ←← 10 ;LOCAL FILE SYSTEM CHANNEL, FOR USE WITH DOMP
FIMP ←← 11 ;LOCAL FILE SYSTEM CHANNEL, FOR USE WITH DIMP
;NOTE: FIMP=DIMP+2, FOMP=DOMP+2. THIS FACT USED BY ILDDEV SUBR.
UFDC ←← 12 ;FOR READING UFD FOR MULTIPLE SEND
MFDC ←← 13 ;FOR READING MFD FOR DITTO WITH WILDCARD PPN
;BITS IN JOBAPR
inttty←←<020000,,0>
intclk←←<000200,,0>
NODIAL,<
ISPTY,<
INTPTO←←<010000,,0>
intpti←←<001000,,0>
>;ISPTY
IFN 0,<;GODDAM BAGBITING ASSEMBLER!
NOPTY,<
intinr←←<000100,,0>
intins←←<000040,,0>
intims←←<000020,,0>
intinp←←<000010,,0>
>;NOPTY
>;IFN 0
>;NODIAL
inttti←←<000004,,0>
;BITS IN IOS
; IO error bits
errbts←←0
IFN PTYSW!DIALSW,<
define X (bit,val) <
bit←←val
errbts←←errbts!val
>
>;IFN PTYSW!DIALSW
IFE PTYSW!DIALSW,<
DEFINE X (BIT,VAL) <
ERRBTS←←ERRBTS!VAL
>
>;IFE PTYSW!DIALSW
NOPTY,<
NODIAL,<
x(tmo,200) ; Internal timeout
x(rset,400) ; Host sent us a reset
x(ctrov,1000) ; Host overflowed our allocation
x(hdead,2000) ; Host is dead
>;NODIAL
>;NOPTY
x(iodend,020000) ; End of file
x(iobktl,040000) ; Block too large
x(iodter,100000) ; Data error
x(ioderr,200000) ; Device error
x(ioimpm,400000) ; Improper mode
UFDN←←20 ;NUMBER OF WORDS IN A DIRECTORY ENTRY
;stloc lsloc wfloc bsloc fsloc hloc terblk anyc rfcs rfcr clss clsr sttblk dislin ddlin DMLIN PTYLIN IMPBIT spcbrk FULTWX xon
; Positions in MTAPE block
NOPTY,<
NODIAL,<
stloc←←1 ; Status bits returned here
lsloc←←2 ; Local socket
wfloc←←3 ; Wait flag
bsloc←←4 ; Byte size location
fsloc←←5 ; Foreign socket
hloc←←6 ; Host number
terblk: 3 ; Terminate block
0 ; Status bits
. ; Local socket loc
0 ; Don't wait
; Bits in LH of state word in IMPSTB
anyc←←400000 ; Any change of state
IFN 0,<;GODDAM BAGBITING ASSEMBLER!
rfcs←←<200000,,0> ; RFC has been sent
rfcr←←<100000,,0> ; RFC has been received
clss←←<040000,,0> ; CLS sent
clsr←←<020000,,0> ; CLS received
>
sttblk: 2
block 2
>;NODIAL
>;NOPTY
; Bits in LH of line status word (GETLIN UUO)
dislin←←400000 ; III display
ddlin←←20000 ; Data Disc display
DMLIN←←40000 ; Datamedia-type display
PTYLIN←←4000 ; THIS IS A PTY
IMPBIT←←1000 ; IMP PTY
spcbrk←←100 ; Enter special activation mode
FULTWX←←4 ; ON FOR HALF DUPLEX
xon←←2 ; don't generate lf after CR
;ttdpt isiii tthpos ttvpos ttvlst ttyorq ddfwrd ddpwrd iipwrd ttyobk ttbufb ttyoip ttpwrd ttbuft DPTOPC
;DATAPOINT SIMULATOR VARIABLES
DPT,{
;vars for datapoint simulation.
ttdpt: 0 ;-1 when datapoint simulation enabled.
isiii: 0 ;-1 if running on III
tthpos: 0 ;horiz. pos. on datapoint screen (0 to 71.)
ttvpos: 0 ;vert. pos. (0 to 25.)
ttvlst: 0 ;vert pos of last upgiot
ttyorq: 0 ;-1 if screen has changed since last written out.
;data disk function word
ddfwrd: byte (8)46,46,46 (3)1,1,1,4 ;set function code.
;first line to display on on data disk
ddflin←←2 ;in char lines
;data disk position word
ddpwrd: byte (8) 2,ddflin⊗-1,<ddflin⊗2>&17 (3)3,4,5,4 ;set column, high order line, low order.
;first line to display on on III
iiflin←←600
;III position word
iipwrd: byte (11)<-1000>,iiflin(3)0,2(2)1,2(4)6
;DEFINITIONS OF BUFFER PARAMETERS
linpag←←=37 ;lines per page
chrlin←←=82 ;chars per line
ttvpml←←(chrlin+2+4)/5 ;words per line including chars per line and crlf
wrdpag←←ttvpml*linpag ;words per page
tbufbi←←0 ;index for ttbufb
tpwrdi←←1 ;index for ttpwrd
wrdset←←2 ;# of setup words
tbufti←←wrdset ;index for ttbuft
tbufsz←←wrdset+wrdpag+1 ;total size of buffer needed for display including 0 at end
tzwrdi←←tbufsz ;zero word is last word
ttyobk:
ttbufb: trn 0 ;block for upgiot addr fixed up to beginning of buffer
tbufsz ;prog size
ttyoip: 0 ;nonzero if transfer in progress.
ttpwrd: 0 ;pointer to position word
ttbuft: (ac2) ;fixed up to firxt word of text part of buffer
IFN DPTABS,<
DPTOPC: 0 ;Saved PC for abs. cursor positioning (TVR May76)
>;IFN DPTABS
};DPT
;GRFON GNOTOK GINITF GRFSOK LSOCK GPSAVE GERMSV OLDFF GMSKSV GPCSAV GIBUF GOBUF GLEFT GMLEFT GUSED GOWAIT KLUCNT KLUPTR KLUWRD GBEGZR GNAME GADR GCNT GBITS DPYPTR GFREEW TXTFRE GIMSTT GALLOC GPDL GPIOWD INTPDL INTIOWD GACSAV TACSAV
; Graphics data area:
NGP,<
GRFON: BLOCK 1 ;Graphics started
GNOTOK: BLOCK 1 ;Graphics ¬OK
GINITF: BLOCK 1 ;-1 if Graphics connected but not initialized
GRFSOK: BLOCK 1 ;Foreign Socket number
LSOCK: BLOCK 1 ;Local socket number saved here
GPSAVE: BLOCK 1 ;AC1 saved here during interrupt which enters user mode
GERMSV: BLOCK 1 ;Error message saved here over DEBREAK
OLDFF: BLOCK 1 ;Copy of JOBFF
;The following two locations must be kept together for INTJEN to work
GMSKSV: BLOCK 1 ;Interrupt mask saved here
GPCSAV: BLOCK 1 ;PC of interrupted code saved here
; Buffer headers
GIBUF: BLOCK 3
GOBUF: BLOCK 3
; Information about whether an OUT will wait
GLEFT: BLOCK 1 ;Number of bytes left
GMLEFT: BLOCK 1 ;Number of message left
GUSED: BLOCK 1 ;Number of bytes used
GOWAIT: BLOCK 1 ;Flag indicating graphics's is waiting to send
; The following kludge is necessitated by Sproull not having requested an option
; code for graphics yet. We have to look for string *GCIP*<socket number>. The
; following locations are needed by that kludge:
KLUCNT: BLOCK 1
KLUPTR: BLOCK 1
KLUWRD: BLOCK 1
GBEGZR:: ;Beginning of area zeroed by GRFINI
; The following tables represent where each segment is kept
GNAME: BLOCK 2*NPOGS ;Name of segment
GADR: BLOCK 2*NPOGS ;Address of segment
GCNT: BLOCK 2*NPOGS ;Word count of segment
GBITS: BLOCK NPOGS ;Status of each segment
DPYPTR: BLOCK 1 ;Byte pointer for text, also for vectors
GFREEW: BLOCK 1 ;Number of words left
TXTFRE: BLOCK 1 ;Number of characters left in word
GENDZR←←.-1 ;End of area zeroed by GRFINI
; Last known IMP status kept here
GIMSTT: BLOCK 2 ;One for each side
GALLOC: =14 ;Mtape block for allocations
block 10
; Graphics's private PDL
GPDL: BLOCK 100
GPIOWD: IOWD .-GPDL,GPDL
; Interrupt level PDL
INTPDL: BLOCK 100
INTIOWD:IOWD .-INTPDL,INTPDL
; AC blocks
GACSAV: BLOCK 20 ;Where graphics ACs are kept
TACSAV: BLOCK 20 ;Where TELNET ACs are kept
>;NGP
;FLUCTL DILGET DILSTA DILDIL AREA DILNUM DILHNG BAREA BNUM ACODPT TTYINI TTYDEV LOGBUF LOGBFI NEWLOG TTYAOB RETRYF
;DIALER DATA AND DEFINITIONS
ISDIAL,<
FLUCTL: 0 ;-1 DON'T TYPE OUT CODES 1-10, 16-37, AND 177
DILGET: 0,,0 ;get dialer
DILSTA: 0,,1 ;get dialer status
DILDIL: 0,,2 ;dial number
AREA: 0 ;area code goes here
DILNUM: 0 ;dial area code bit, 103-type bit, and phone number
DILHNG: 0,,3 ;hang up dialer's phone
BAREA: POINT 4,AREA,17 ;STARTING POINTER TO AREA CODE
BNUM: POINT 4,DILNUM,7;STARTING POINTER TO NUMBER
ACODPT: POINT 1,DILNUM,6 ;byte pointer to dial-area-code bit
TTYINI: 410 ;CHARACTER-AT-A-TIME IMAGE MODE, ERROR FROM LOSING INIT
TTYDEV: 'TTY37 ' ;name of TTY being dialed goes here
OBUF,,IBUF
IFN DIALOG,<
LOGBUF: BLOCK 3 ;OUTPUT BUFFER HEADER
LOGBFI: BLOCK 3 ;INPUT BUFFER HEADER
NEWLOG: 0 ;FLAG FOR IDENTIFYING NEW LOG FILE
TTYAOB: 0 ;remembered AOBJN count for going on to next tty
RETRYF: 0 ;nonzero if dialing should be retried on next tyy
>;IFN DIALOG
;DILCOD DB MAXCOD DLRSTS DOH NDLRST DILERR DSTATE DSTATP DSTAT2 DSTATF DILCNI RDIALH RDIALE ERRSTP ERRST1 ERRCON ERRTTY
;DIALER ERROR ROUTINES
[ASCIZ/Unknown dialer error/] ;-1 (locally set)
DILCOD: [ASCIZ/Illegal dialer number/] ;0
[ASCIZ/Dialer in use/] ;1
[ASCIZ/Dialout TTY not inited (not supposed to happen)/];2
[ASCIZ/Attempt to dial while dialer busy/] ;3
DB←←4 ;special error code may indicate redial on next tty
[ASCIZ/Dialing error/] ;4
[ASCIZ/Couldn't get DDB for dialer-adapter's tty (system error)
/] ;5
[ASCIZ/Dialer-adapter's tty output buffer overflowed (system error)
/] ;6
[ASCIZ/Illegal digit in phone number/] ;7
[ASCIZ/Dialer not responding--timed out (hardware error)./] ;10
MAXCOD←←.-DILCOD
IFN FTVDIL,<
DLRSTS: [ASCIZ/No dialing attempted/] ;0
[ASCIZ/Timed out, no response from dialer-adapter/] ;100
[ASCIZ/Call completed successfully/] ;101
[ASCIZ/Call failed (e.g., busy, no answer, or no carrier)/] ;102
[ASCIZ/Unused dialer status code 103/] ;103
[ASCIZ/Data framing error in dial string/] ;104
[ASCIZ/Parity error in dial string/] ;105
[ASCIZ/RAM overflow -- dial string too long/] ;106
DOH←←107 ;special error code indicating redial on next tty
[ASCIZ/Originating modem's phone is busy (off hook)/] ;107
[ASCIZ/Unexpected status code (out of range)/] ;code out of range
NDLRST←←.-DLRSTS
>;IFN FTVDIL
;Here from Dialer Get or Dialer Dial failure.
DILERR:
IFN FTVDIL,<
SETOM RETRYF ;assume will automatically retry next tty
>;IFN FTVDIL
PUSHJ P,DSTATE ;type dialer error and status
IFN FTVDIL,<
MOVE AC1,TTYAOB ;get aobjn ptr to find next tty
AOSE RETRYF ;did we get an error that suggests next tty?
JRST RSTART ;give up
OUTSTR [ASCIZ/
Will re-dial automatically on next available line.
/]
JRST RETTY ;yes, go on to next tty, if any
>;IFN FTVDIL
IFE FTVDIL,<
JRST RSTART ;give up
>;IFE FTVDIL
DSTATE: CAIL AC1,MAXCOD
MOVEI AC1,-1
IFN FTVDIL,<
OUTSTR [ASCIZ/ /]
>;IFN FTVDIL
OUTSTR @DILCOD(AC1) ;ERROR TYPE
IFN FTVDIL,<
OUTSTR [ASCIZ/ -- /]
CAIE AC1,DB ;is this is special error?
SETZM RETRYF ;no, don't redial
>;IFN FTVDIL
DSTATP: MOVEI AC1,DILSTA
DIAL AC1, ;get dialer status
JRST DSTATF
IFN FTVDIL,<
CAIE AC1,DOH ;dialer off hook error?
SETZM RETRYF ;no, don't redial
JUMPE AC1,DSTAT2
CAIL AC1,100
CAILE AC1,100+NDLRST-2
SKIPA AC1,[NDLRST-1]
SUBI AC1,100-1
DSTAT2: OUTSTR @DLRSTS(AC1)
OUTSTR [ASCIZ/.
/]
>;IFN FTVDIL
IFE FTVDIL,<
OUTSTR [ASCIZ/, dialer status:
Current --
/]
PUSHJ P,DILCNI
OUTSTR[ASCIZ/At last interrupt --
/]
MOVSS AC1
PUSHJ P,DILCNI
>;IFE FTVDIL
POPJ P,
DSTATF: OUTSTR[ASCIZ/.
Dialer status UUO failed.
/]
SETZM RETRYF ;don't redial, not supposed to have gotten here
POPJ P,
IFE FTVDIL,<
DILCNI: TRNE AC1,40
OUTSTR[ASCIZ/ Power failure.
/]
TRNE AC1,1000
OUTSTR[ASCIZ/ Line connected.
/]
TRNN AC1,400
OUTSTR[ASCIZ/ Timed out (no answer).
/]
TRNE AC1,200
OUTSTR[ASCIZ/ Dataset connected.
/]
TRNE AC1,4000
OUTSTR[ASCIZ/ Dataset answered.
/]
TRNE AC1,2000
OUTSTR[ASCIZ/ Dataset hung-up.
/]
POPJ P,
>;IFE FTVDIL
RDIALH: OUTSTR[ASCIZ/Error trying to hang up.
/]
CAIA
RDIALE: OUTSTR[ASCIZ/Error on re-dialing.
/]
PUSHJ P,DSTATE
JRST ERRST1
ERRSTP: PUSH P,AC1
GETSTS IMP,AC1
TRNN AC1,IODERR ;DEVICE (DIALER) ERROR?
JRST ERRTTY ;NO
IFE FTVDIL,<
PUSHJ P,DSTATP
>;IFE FTVDIL
ERRST1: OUTSTR[ASCIZ/Continue to dial number again and try to go on.
/]
EXIT 1,
MOVEI AC1,DILHNG
DIAL AC1, ;HANG UP
JRST RDIALH
MOVEI AC1,DILDIL
DIAL AC1, ;DIAL NUMBER AGAIN
JRST RDIALE
OUTSTR[ASCIZ/Re-dialed ok.
/]
ERRCON: POP P,AC1
SETSTS IMP,@TTYINI
POPJ P,
ERRTTY: OUTSTR[ASCIZ/, Not dialer error.
Continue to try to go on.
/]
EXIT 1,
JRST ERRCON
>;ISDIAL
;LINE CHAR PTYCHR
;PTYJOB DATA STORAGE
ISPTY,<
LINE: 0
CHAR: 0
PTYCHR: -1
>;ISPTY
;brktab bsactt ttybrk RSCCNT SYSMOD HSTBUF PAT PATCH NHPBRF
; Break table, other random things
brktab: -1
-1
-1
-1,,600000
bsactt: -1
-1
-1
-1,,600020 ;backspace activates
ttybrk: -1,,777760 ;control characters 0-37
0
0
1,,0 ;alt mode
ISSYS,<
RSCCNT: 0 ; COUNT OF NUMBER OF CHARS RESCANED
SYSMOD: 0 ; -1 IF STARTED BY SYSTEM COMMAND
>;ISSYS
IFN 1,<
HSTBUF: BLOCK 10 ;ASCIZ HOST NAME
>
PAT:
PATCH: BLOCK 40
NOPTY,<
NODIAL,<
IFE FTPCOM,< ;NETWORK USERS CAN RUN FTP
NHPBRF: ASCIZ/
You are logged into SAIL over the ARPAnet. It is a waste of SAIL's
limited system resources (jobs, network links, etc.) to go back again
over the same network. It also greatly slows down response to you
and increases the chances of lossage due to a system or network failure.
You should not do this unless you have a good reason to do so. If you
have any questions or if you have a real need to "net-hop", please
contact MRC and LES for more information. Thank you for your co-operation.
/
>;IFE FTPCOM
IFN 1,<
HSTTAB←←1 ; SELECT THE MARVELOUS HOST TABLE SCANNER
.INSERT NETWRK.FAI[SUB,SYS]
>
>;NODIAL
>;NOPTY
;TSTART START RSTART RSTRT0 NONETH rstrt1 rstrt2
; Startup and initialization
ISSYS,<
TSTART: CLRBFI
>;ISSYS
START:
ISDIAL,<
MOVNI AC1,1
SETPRV AC1,
TLNN AC1,LUPPRV ;local user priviledge?
EXIT ; no - only local users can dial
IFE FTVDIL,<
OUTSTR [ASCIZ/Aren't you glad you use DIAL?
/] ; garply!
>;IFE FTVDIL
>;ISDIAL
ISSYS,<
MOVE P,[IOWD PLN,PDL] ; PICK UP A PUSHDOWN LIST
PUSHJ P,SYSINI ;INIT FOR SYSTEM MODE
>;ISSYS
JRST RSTRT0
RSTART: UNLOCK
ISSYS,<
PUSHJ P,SYSRST ;CLEAR ANYTHING LEFT FROM SSYTEM COMMAND
>
RSTRT0: RESET ; CLEAR THE SYSTEM'S WORLD
; MOVNI AC1,1 ; See if we are on TTY or DPY
; GETLIN AC1
; MOVE AC2,AC1
; TLNE AC2,PTYLIN
; TDZA AC2,AC2
hrroi ac2,[3000,,ac2] ;Get only our line characteristics into ac2
ttyset ac2, ;This doesn't get display bit of pty owner
NGP,< JUMPGE AC2,[ OUTSTR [ASCIZ/
Boy if you don't use a III and expect to hack graphics are you ever gonna lose.
/]
EXIT] ;GOOD-BYE CRUEL PROGRAM
>;NGP
NOPTY,<
NODIAL,<
IFE FTPCOM,< ;NETWORK USERS CAN RUN FTP
TLNN AC2,IMPBIT
JRST NONETH
OUTSTR NHPBRF
MOVEI NONETH
SETDDT
EXIT
NONETH:
>;IFE FTPCOM
>;NODIAL
>;NOPTY
AND AC2,[DDLIN!DISLIN!DMLIN,,]
MOVEM AC2,DPY
TLZ AC2,DISLIN!DMLIN ;Leave only DD bit
MOVEM AC2,DDDPY
; MOVE AC2,DPY
; TLZ AC2,DISLIN!DDLIN ;Leave only DM bit
; MOVEM AC2,DMDPY
MOVEI AC7,36 ; default escape character for non display
MOVEM AC7,ESCCHR
ISDIAL,<SETOM GENPAR ;generate parity by default
SETZM NOPAR ;haven't diddled parity handling yet
>;ISDIAL
NOPTY,<
NODIAL,<
IFE FTPCOM,<
skipn dpy
jrst rstrt1
HRROI AC1,[2000,,SPCBRK] ;Turn off this bit
TTYSET AC1,
setact [brktab]
jrst rstrt2
rstrt1: setact [ttybrk] ;line at a time break table for ttys
HRROI AC1,[1000,,SPCBRK] ;Turn on this bit
TTYSET AC1,
rstrt2: ptjobx [0 ↔ sixbit /DON/]
>;IFE FTPCOM
>;NODIAL
>;NOPTY
move p,[iowd pln,pdl] ; Pick up a pushdown list
IFN BUFOUT,<
MOVE AC1,[440700,,TYOBUF]
MOVEM AC1,TYOBP
MOVEI AC1,TYOBLN*5
MOVEM AC1,TYOCNT
>;BUFOUT
setzm spcout ; Start out with no dump output
setzm outdon
setom numarg
setzm fcsf ; line mode
setom echof ; local echoing
setzm lstcr ; last char typed in not a cr
setzm crlff ; last char from outside world not a cr
setzm spcin ; no dump input
setzm cbits ; Clear control bits
setzm notype ; Allow typeout
setzm notsnt ; # of chars in buffer not sent (for FCS mode)
setom beepc ; start out beeping π
NOPTY,<
setzm lockct ;lock in core next time at cloop
>
ISNEWP,<
setzm nwptcm ; not doing new prot command now
setzm insflg
setzm inrflg
setzm inscnt
setzm damflg
setzm ecrepy
setzm ecrepn
setom nwptex
setzm rechof
>;ISNEWP
NGP,< SETZM GRFON ; Graphics off
>;NGP
DPT,{ setzm ttdpt ; Initialize with datapoint off
setzm ttpwrd ; Clear a free storage pointer
};DPT
ISBUCKY,<
setzm transm
setzm ptyquo
>
ISNEWP,<
SETZM EXTARQ
SETZM EXTAOK
>
IFN DMFLG,<
SETZM DMDSP
SETZM DMSIMF
SETZM DMLSCR
>;DMFLG
NOPTY,<
NODIAL,<
SETZM LUKTTY
MOVEI AC2,ICPSOK
movem ac2,consck ;connect here
>;NODIAL
>;NOPTY
ISDIAL,<
SETZM ECHCNT
SETOM SPDNAM ;NO SPEED SPECIFIED BY USER YET
SETZM SPDTYP ;NO "V" speed SPECIFIED BY USER YET
setzm noexfl ; don't NO EXIST this tty
>;ISDIAL
;INRESC NOTLET NOAREA NODASH GOBLF dilgo GOBLF1 NEXTTY RETTY NOTHGH NODLRS LOWDIL NLOW HIDIL NHIGH TTYNAM lotsa defspd SKIPBR SKIPB TTYSIX TTYSX1 TTYSX2 STRIPC STRIP2 STRIP1 ILLDEV ILLNUM ILLSPD NUMIN NUMIN0 DILSPD SPEEDS NSPDS SPDNUM SIXPNT GETTNO GETTN2 INITTY NOTWRD INILUZ LOGDIL MADLOG MADCOP MADNUL MADLO2 LOGDL1 NODLOG DLTIME DLG4DE DLG3DE DLG2DE DLGDEC DLGDE1 DLDATE DLG6 DLG6A DLG63 DLG63A DLGSIX DLGOCT DLGOC1 DLGSTR DLGST1 DLGPUT DLGMON DLGNAM DLGEXT DLGPPN SETSPD TTYNA1 INITED INITE1
;READ TTY NAME AND DIAL DIALER IF NECESSARY
ISDIAL,< ;whole page
ISSYS,< SKIPG RSCCNT >
OUTSTR [ASCIZ /TTY name or phone number:/]
ISSYS,<
SKIPLE RSCCNT
JRST INRESC ;STILL IN RESCAN (AC4 CONTAINS CHAR)
READW(AC4)
INRESC:
>;ISSYS
PUSHJ P,SKIPB ;ALLOW BLANKS HERE
CAIL AC4,"A"
CAILE AC4,"z"
JRST NOTLET ;Not letter
CAIGE AC4,"a"
CAIG AC4,"Z"
JRST TTYNAM ;We have a letter, look for TTYnnn or special name
REPEAT 0,<
CAIE AC4,"t"
CAIN AC4,"T" ;START OF TTY NAME?
JRST TTYNAM ;YES
CAIE AC4,"l" ;El grande de grosse abortion
CAIN AC4,"L" ; (for DIAL LSI)
JRST TTYNAM ;YES
>;REPEAT 0
NOTLET: CAIN AC4,"/" ;SLASH?
JRST DILSPD ;YES, SET SPEED
CAIE AC4,"(" ;AREA CODE?
JRST [ SETZ AC2,
DPB AC2,BNUM ;CLEAR AREA CODE BIT
JRST NOAREA]
MOVNI AC2,1
SETPRV AC2, ;GET CURRENT JOB'S PRIVILEGES
TLNN AC2,LUPPRV
JRST ILLNUM ;ONLY LOCAL USERS CAN DIAL OUT OF AREA
MOVE AC2,BAREA ;AREA CODE BYTE POINTER
MOVEI AC3,3 ;3 DIGITS
PUSHJ P,NUMIN ;READ A NUMBER
READW(AC4)
CAIE AC4,")" ;JUST FOR GOOD FORM
JRST ILLNUM
MOVEI AC4,2 ;DIAL AREA CODE BIT
DPB AC4,BNUM ;AT FRONT OF NUMBER
PUSHJ P,SKIPBR ;ALSO HERE
NOAREA: MOVE AC2,BNUM ;NUMBER BYTE POINTER
MOVEI AC3,3 ;3 DIGITS BEFORE DASH
PUSHJ P,NUMIN0 ;ALREADY HAVE FIRST CHAR
PUSHJ P,SKIPBR ;ALLOW BLANKS HERE
CAIE AC4,"-" ;DON'T REQUIRE DASH
JRST NODASH
PUSHJ P,SKIPBR
NODASH: MOVEI AC3,4 ;4 MORE DIGITS
PUSHJ P,NUMIN0
GOBLF: READW(AC4)
PUSHJ P,SKIPB
CAIN AC4,15
JRST GOBLF
CAIN AC4,"/"
JRST GOBLF1 ;SPEED AFTER NUMBER
CAIE AC4,12
JRST ILLNUM
dilgo:
GOBLF1:
IFE FTVDIL,<
MOVE AC3,['TTY37 ']
PUSHJ P,INITTY ;INIT the tty
JRST INILUZ
>;IFE FTVDIL
IFN FTVDIL,<
MOVE AC1,[-NLOW,,LOWDIL] ;aobjn ptr to low-speed dialable ttys
MOVE AC3,SPDNAM ;see if high speed requested
SKIPL SPDTYP ;skip if Vadic requested (requires high speed)
CAILE AC3,3 ;skip unless high speed
MOVE AC1,[-NHIGH,,HIDIL] ;high speed
NEXTTY: MOVE AC3,(AC1) ;get tty number in RH in sixbit
HRLI AC3,'TTY' ;make it device name of tty
PUSHJ P,INITTY ;open the tty
RETTY: AOBJN AC1,NEXTTY ;failed, try next tty
JUMPGE AC1,NODLRS ;jump if all of them failed
MOVEM AC1,TTYAOB ;remember where we were, in case of busy modem err
HLRZ AC1,(AC1) ;get dialer number
HRLM AC1,DILGET ;store dialer number
HRLM AC1,DILSTA ;store dialer number
HRLM AC1,DILDIL ;store dialer number
HRLM AC1,DILHNG ;store dialer number
>;IFN FTVDIL
MOVEI AC1,DILGET
DIAL AC1, ;TRY TO GET DIALER
JRST DILERR
IFN FTVDIL,<
OUTSTR [ASCIZ/ Dialing out on /]
PUSH P,AC2
MOVE AC2,TTYDEV ;get name of tty we actually got
PUSHJ P,SIXPNT ;print tty name
POP P,AC2
OUTSTR [ASCIZ/.
/]
MOVSI AC1,2000 ;103-type bit for dialing (includes Bell 1200)
IORM AC1,DILNUM ;assume 103-type modem
; MOVE AC1,SPDNAM ;see if high speed requested
; CAIG AC1,3 ;skip if high speed
; JRST NOTHGH ;not high speed
MOVSI AC1,2000
SKIPGE SPDTYP ;skip unless "V" specified in speed name
ANDCAM AC1,DILNUM ;clear 103-type bit, use vadic mode dialing
>;IFN FTVDIL
NOTHGH: MOVEI AC1,DILDIL
DIAL AC1, ;DIAL NUMBER
JRST DILERR
IFN DIALOG,<
PUSH P,AC4
PUSHJ P,LOGDIL
POP P,AC4
>;IFN DIALOG
CAIN AC4,"/"
JRST DILSPD ;SPEED AFTER NUMBER
JRST INITED
IFN FTVDIL,<
NODLRS: OUTSTR [ASCIZ/No dial-able lines currently available for given speed./]
EXIT
;TTYs dialable at low speed: dialer number,,tty name in sixbit
;These tables must match the system's for tty number versus dialer number.
;These modems must have their speed switches in LOW position on back.
;(The "interleaving" of ttys between low- and hi-speed dialouts prevents users
; dialing in from busying up all of one group of dialers and none of the other.)
LOWDIL:
0,,'37 ' ;dialer 0, tty37
2,,'27 '
4,,'25 '
6,,'23 '
NLOW←←.-LOWDIL
;TTYs dialable at high speed: dialer number,,tty name in sixbit
;These tables must match the system's for tty number versus dialer number
;These modems must have their speed switches in HI position on back.
HIDIL:
1,,'36 ' ;dialer 1, tty36
3,,'26 '
5,,'24 '
NHIGH←←.-HIDIL
>;IFN FTVDIL
TTYNAM: PUSHJ P,TTYSIX ;READ SIXBIT TTY NAME
PUSHJ P,SKIPB ;skip blanks (tabs and spaces)
CAIN AC4,"/"
JRST TTYNA1
CAIE AC4,12
JRST ILLNUM
camn ac3,[sixbit/LOTS/]
jrst [outstr [asciz/I assume you mean LOTSA.
/]
lotsa: move 1,[byte (4) 0,0,4,9,7,9,0,2,1]
movem 1,dilnum
;Set default speed 1200, Vadic mode
defspd: move 1,[400000,,5]
hrrzm 1,spdnam
movem 1,spdtyp
jrst dilgo]
camn ac3,[sixbit/LOTSA/]
jrst lotsa
camn ac3,[sixbit/LOTSB/]
jrst [move 1,[byte (4) 0,0,3,2,2,5,7,7,1]
movem 1,dilnum
jrst defspd]
CAMN ac3,[SIXBIT/CIT/]
jrst [move 1,[byte (4) 0,0,4,9,7,0,5,5,1]
movem 1,dilnum
jrst dilgo]
CAMN ac3,[SIXBIT/GSB/]
jrst [move 1,[byte (4) 0,0,4,9,7,0,0,1,1]
movem 1,dilnum
jrst dilgo]
CAMN ac3,[SIXBIT/CCRMA/]
jrst [move 1,[byte (4) 0,0,4,9,3,1,7,8,7]
movem 1,dilnum
jrst dilgo]
CAMN ac3,[SIXBIT/TYMNET/]
jrst [move 1,[byte (4) 0,0,8,5,6,9,0,8,0]
movem 1,dilnum
jrst dilgo]
CAMN ac3,[SIXBIT/TELENE/]
jrst [move 1,[byte (4) 0,0,8,5,6,9,9,3,0]
movem 1,dilnum
jrst dilgo]
;Now a dial-up
CAMN AC3,[SIXBIT/TI990/]
MOVE AC3,[SIXBIT/TTY33/]
CAMN AC3,[SIXBIT/CANON/]
MOVE AC3,[SIXBIT/TTY57/]
PUSHJ P,INITTY
JRST INILUZ ;init failed
JRST INITED
SKIPBR: READW(AC4)
SKIPB: CAIE AC4,40
CAIN AC4,11
JRST SKIPBR
POPJ P,
TTYSIX: MOVE AC2,[POINT 6,AC3] ; read SIXBIT tty name, return name in AC3
SETZ AC3,
JRST TTYSX2
TTYSX1: READW(AC4)
TTYSX2: CAIN AC4,15
JRST TTYSX1 ;ignore CR (quit on LF following it)
CAIL AC4,140
SUBI AC4,40 ;Upper case, even for funny chars
CAIL AC4,"0"
CAILE AC4,"Z"
POPJ P, ;not digit nor letter, quit, answer in AC3
CAILE AC4,"9"
CAIL AC4,"A"
CAIA
POPJ P, ;not digit nor letter, quit, answer in AC3
SUBI AC4,40 ;Make sixbit
TLNE AC2,770000 ;Stop at end of one sixbit word
IDPB AC4,AC2 ;Store sixbit in word (in AC3)
JRST TTYSX1
STRIPC: ANDI AC4,177 ;make sure no bucky bits hide the real char
CAIN AC4,12 ; flush the characters from the command line
JRST STRIP1
CAIN AC4,175
JRST STRIP2
INCHSL AC4 ;read to end of line
JRST STRIP2 ;nothing left
JRST STRIPC
STRIP2: OUTSTR CR
STRIP1: POPJ P,
ILLDEV: PUSHJ P,STRIPC
OUTSTR[ASCIZ/Error in TTY name, device "/]
MOVE AC2,TTYDEV
PUSHJ P,SIXPNT
OUTSTR[ASCIZ/" doesn't exist.
/]
JRST RSTART
ILLNUM: PUSHJ P,STRIPC ; flush characters from command line
OUTSTR[ASCIZ/Error in phone number.
/]
JRST RSTART
ILLSPD: PUSHJ P,STRIPC ; flush characters from command line
OUTSTR[ASCIZ/Unrecognized baud-rate switch.
/]
JRST RSTART
NUMIN: READW(AC4)
NUMIN0: CAIL AC4,"0"
CAILE AC4,"9"
JRST ILLNUM
IDPB AC4,AC2 ;LOW ORDER 4 BITS ONLY
SOJG AC3,NUMIN
POPJ P,
DILSPD: PUSHJ P,SKIPBR ;SKIP THE SLASH AND BLANKS
PUSHJ P,TTYSIX
TLNE AC3,7700 ;KLUDGE, MAKE /XX INTO /XX0, skip if only 1 digit
TLO AC3,' 0' ;'0' IS ONLY 1 BIT SO THIS ISN'T AS BAD AS IT LOOKS
MOVSI AC2,-NSPDS ;FIND IT IN THE TABLE
CAME AC3,SPEEDS(AC2)
AOBJN AC2,.-1
JUMPGE AC2,ILLSPD ;jump if no match
MOVE AC3,SPDNUM(AC2)
HRRZM AC3,SPDNAM ;remember speed's value as needed in uuo
MOVEM AC3,SPDTYP ;remember speed type (negative if "V" seen)
PUSHJ P,SKIPB
CAIE AC4,12
CAIN AC4,175
JRST INITED ;DONE IF END OF LINE
JRST INRESC
DEFINE SPDXXX <
XXX 110,0
XXX 11,0
XXX 1,0
XXX 150,2
XXX 15,2
XXX 5,2
XXX 300,3
XXX 30,3
XXX 3,3
XXX 600,4
XXX 60,4
XXX 6,4
XXX 1200,5
XXX 120,5
XXX 12,5
XXX 2,5
XXX V110,0,400000
XXX V11,0,400000
XXX V1,0,400000
XXX V150,2,400000
XXX V15,2,400000
XXX V5,2,400000
XXX V300,3,400000
XXX V30,3,400000
XXX V3,3,400000
XXX V600,4,400000
XXX V60,4,400000
XXX V6,4,400000
XXX V1200,5,400000
XXX V120,5,400000
XXX V12,5,400000
XXX V2,5,400000
XXX V,5,400000
>;SPDXXX
;table of sixbit speed names.
DEFINE XXX(A,B,C) <SIXBIT/A/>
SPEEDS: SPDXXX
NSPDS←←.-SPEEDS
;table parallel to SPEEDS above, specifies speed number for TTYSET UUO.
;sign bit means use Vadic 1200/1200 protocol ("non-103 type").
DEFINE XXX(A,B,C) <C,,B>
SPDNUM: SPDXXX
SIXPNT: JUMPE AC2,CPOPJ
SETZ AC1,
LSHC AC1,6
ADDI AC1,40
OUTCHR AC1
JRST SIXPNT
;GETTNO
;call MOVE AC3,[SIXBIT/<ttyname>/]
; <success, AC2 has TTY number in octal>
;
GETTNO: PUSH P,AC1
HRLZ AC1,AC3 ;Copy sixbit TTY number
MOVEI AC2,0 ;Collect number in AC2
LSH AC1,3 ;Shift out nonsense
ROTC AC1,3 ;Put octal digit into low part of AC2
JUMPE AC1,GETTN2 ;Jump if no more digits
LSH AC1,3 ;More nonsense
ROTC AC1,3 ;Second octal digit into AC2
JUMPE AC1,GETTN2 ;Jump if no more digits
LSH AC1,3 ;Nonsense
ROTC AC1,3 ;Third digit
GETTN2: POP P,AC1
POPJ P,
INITTY: MOVEM AC3,TTYDEV ;STORE IN DEVICE BLOCK
CAME AC3,[SIXBIT/TTY57/] ; Canon
JRST NOTWRD ;not weird, don't force TTY EXIST
SETOM NOEXFL ;FLAG TO TTY NO EXIST ON CLOSE
PUSHJ P,GETTNO ; Get nnn in AC2 from SIXBIT/TTYnnn/ in AC3
DPB AC2,[POINT 8,EXSCMD,17] ;STUFF TTY NUMBER IN TTYSET CMD
DPB AC2,[POINT 8,NEXCMD,17] ;Stuff number in NO EXIST cmd for later
HRROI AC2,EXSCMD ;ONE CMD TO EXIST THE TTY
TTYSET AC2, ;TTY EXIST
NOTWRD: OPEN IMP,TTYINI ;OPEN IT
POPJ P, ;failed
MOVSI AC3,700 ;7 BIT BYTES for input
MOVEM AC3,IBUF+1
MOVSI AC3,1100 ;9-bit bytes for output, we generate parity
MOVEM AC3,OBUF+1
INBUF IMP,3
OUTBUF IMP,3
JRST CPOPJ1
INILUZ: MOVE AC2,TTYDEV
DEVUSE AC2,
LDB AC2,[221200,,AC2] ;JOB NUMBER OF OWNER
SKIPN AC2
JRST ILLDEV
MOVEI AC1,211 ;PRJPRG
PEEK AC1,
ADDI AC1,(AC2)
PEEK AC1,
OUTSTR [ASCIZ/Don't you wish /]
MOVSI AC2,(AC1)
PUSHJ P,SIXPNT
OUTSTR [ASCIZ/ didn't?
/]
JRST RSTART
IFN DIALOG,<
LOGDIL: INIT LOG,0
'DSK '
LOGBUF,,LOGBFI
POPJ P,
MADLOG: ACCTIM A,
MOVEM A,SAVTIM#
HLRZ A,A ;SYSTEM DATE
IDIVI A,=31
IDIVI A,=12 ;B←MONTH-1
MOVE A,DLGNAM
HRLZ B,DLGMON(B)
MOVEM B,DLGEXT
MOVEI C,0
MOVE D,DLGPPN
LOOKUP LOG,A
JRST NODLOG
LDB B,[POINT 3,B,20] ;GET HIGH ORDER DATE BITS
DPB B,[POINT 3,C,23] ;AND PUT NEXT TO LOW ORDER DATE BITS
ANDI C,77777 ;FLUSH NON-DATE BITS
ADDI C,2*=31 ;SEE IF IT HAS BEEN 2 MONTHS SINCE FILE LAST WRITTEN
HRLZ C,C ;DATE INTO LH
SETZM NEWLOG ;Assume not new log file
CAMG C,SAVTIM
CLOSE LOG, ;INHIBIT READ ALTER MODE IN ORDER TO CREATE NEW FILE
CAMG C,SAVTIM
SETOM NEWLOG ;New log file, don't read final old record
MOVE A,DLGNAM
MOVE B,DLGEXT
MOVEI C,0
MOVE D,DLGPPN
ENTER LOG,A
POPJ P, ;CAN'T ENTER IT, FORGET IT
UGETF LOG,A ;GO TO EOF
;Now avoid using a whole record in log file for each log entry.
SKIPE NEWLOG ;Skip unless file is new
JRST MADLO2 ;New file
USETI LOG,-1(A) ;Read last record of file so we can append
IN LOG, ; to the text within that record
CAIA ;OK
JRST MADLO2 ;Shouldn't happen
USETO LOG,-1(A) ;Position for re-writing record we just read
MADCOP: ILDB B,LOGBFI+1 ;Get char from final record
JUMPE B,MADNUL ;Ignore nulls
PUSHJ P,DLGPUT ;Copy back to output buffer
MADNUL: SOSLE LOGBFI+2 ;Don't go beyond one record's worth
JRST MADCOP ;Copy next char
MADLO2: MOVE A,SAVTIM ;TODAY'S DATE,,SECONDS AFTER MIDNIGHT
PUSH P,A
HLRZ A,A
PUSHJ P,DLDATE
MOVEI A,[ASCIZ / /]
PUSHJ P,DLGSTR
POP P,A
HRRZ A,A ;TIME IN SECONDS AFTER MIDNIGHT
PUSHJ P,DLTIME
MOVEI A,[ASCIZ / Job /]
PUSHJ P,DLGSTR
PJOB A,
PUSHJ P,DLGDEC
MOVEI A,[ASCIZ /. /]
PUSHJ P,DLGSTR
GETPPN A,
PUSH P,A
HLLZ A,A
PUSHJ P,DLG63
MOVEI B,","
PUSHJ P,DLGPUT
POP P,A
HRLZ A,A
PUSHJ P,DLG63
MOVEI A,[ASCIZ / /]
PUSHJ P,DLGSTR
MOVEI A,0
GETNAM A,
PUSHJ P,DLG6
MOVEI A,[ASCIZ / Number: /]
LDB A,ACODPT ;GET AREA CODE BIT
JUMPE A,[ MOVEI A,=415
JRST LOGDL1 ] ;NO AREA CODE SPECIFIED
MOVE B,BAREA
ILDB A,B
IMULI A,=100
ILDB C,B
IMULI C,=10
ADD A,C
ILDB C,B
ADD A,C
LOGDL1: MOVEI B,"("
PUSHJ P,DLGPUT
PUSHJ P,DLG3DE
MOVEI A,[ASCIZ /) /]
PUSHJ P,DLGSTR
MOVE B,BNUM
ILDB A,B
IMULI A,=100
ILDB C,B
IMULI C,=10
ADD A,C
ILDB C,B
ADD A,C
PUSH P,B
PUSHJ P,DLG3DE
MOVEI B,"-"
PUSHJ P,DLGPUT
POP P,B
ILDB A,B
IMULI A,=1000
ILDB C,B
IMULI C,=100
ADD A,C
ILDB C,B
IMULI C,=10
ADD A,C
ILDB C,B
ADD A,C
PUSHJ P,DLG4DE
MOVEI A,[ASCIZ/ /]
PUSHJ P,DLGSTR
MOVE A,TTYDEV ;TTY name
PUSHJ P,DLGSIX ;print sixbit name
MOVEI A,[BYTE (7)15,12]
PUSHJ P,DLGSTR
RELEASE LOG,
POPJ P,
NODLOG: HRRZ B,B ;LOOKUP ERROR CODE
JUMPN B,CPOPJ ;PROBABLY FILE BUSY
MOVE A,DLGNAM
MOVE B,DLGEXT
MOVEI C,0
MOVE D,DLGPPN
ENTER LOG,A ;CREATE THE FILE
POPJ P, ;GIVE UP
CLOSE LOG,
JRST MADLOG
DLTIME: IDIVI A,=60
PUSH P,B ;SAVE SECONDS
IDIVI A,=60
PUSH P,B ;SAVE MINUTES
PUSHJ P,DLG2DE
MOVEI B,":"
PUSHJ P,DLGPUT
POP P,A
PUSHJ P,DLG2DE
MOVEI B,":"
PUSHJ P,DLGPUT
POP P,A
JRST DLG2DE
DLG4DE: MOVEI B,"0"
CAIGE A,=1000
PUSHJ P,DLGPUT
DLG3DE: MOVEI B,"0"
CAIGE A,=100
PUSHJ P,DLGPUT
DLG2DE: MOVEI B,"0"
CAIGE A,=10
PUSHJ P,DLGPUT
DLGDEC: IDIVI A,=10
JUMPE A,DLGDE1
HRLM B,(P)
PUSHJ P,DLGDEC
HLRZ B,(P)
DLGDE1: ADDI B,"0"
JRST DLGPUT
DLDATE: IDIVI A,=31
PUSH P,A
MOVEI A,1(B) ;DAY
PUSHJ P,DLGDEC
MOVEI B,"-"
PUSHJ P,DLGPUT
POP P,A
IDIVI A,=12
PUSH P,A
MOVE A,DLGMON(B)
PUSHJ P,DLGSIX
MOVEI B,"-"
PUSHJ P,DLGPUT
POP P,A
ADDI A,=64
JRST DLGDEC
DLG6: MOVEI C,6
DLG6A: MOVEI B,0
ROTC A,6
ADDI B,40
PUSHJ P,DLGPUT
SOJG C,DLG6A
POPJ P,
DLG63: MOVEI C,3
DLG63A: MOVEI B,0
ROTC A,6
ADDI B,40
PUSHJ P,DLGPUT
SOJG C,DLG63A
POPJ P,
DLGSIX: JUMPE A,CPOPJ
MOVEI B,0
ROTC A,6
JUMPE B,DLGSIX
ADDI B,40
PUSHJ P,DLGPUT
JRST DLGSIX
DLGOCT: IDIVI A,10
JUMPE A,DLGOC1
HRLM B,(P)
PUSHJ P,DLGOCT
HLRZ B,(P)
DLGOC1: ADDI B,"0"
JRST DLGPUT
DLGSTR: HRLI A,440700
DLGST1: ILDB B,A
JUMPE B,CPOPJ
PUSHJ P,DLGPUT
JRST DLGST1
DLGPUT: SOSG LOGBUF+2
OUT LOG,
CAIA
POPJ P,
IDPB B,LOGBUF+1
POPJ P,
DLGMON: 'JAN'
'FEB'
'MAR'
'APR'
'MAY'
'JUN'
'JUL'
'AUG'
'SEP'
'OCT'
'NOV'
'DEC'
DLGNAM: 'DIAL '
DLGEXT: 0
DLGPPN: ' DACT'
>;IFN DIALOG
;Set tty's speed from code in AC2 RH, skip unless can't figure out TTY nbr.
SETSPD: MOVEI AC3,IMP ;FIND OUT WHICH TTY WE'RE ON
DEVNUM AC3,
POPJ P, ;SPEED BUT NO NAME OR NUMBER
IORI AC3,440000 ;TTYSET INDEX AND EXPLICIT TTY FLAG
HRLI AC2,(AC3) ;MERGE WITH SPEED NUMBER
HRROI AC3,AC2
TTYSET AC3, ;DO IT
JRST CPOPJ1
TTYNA1: PUSHJ P,INITTY
JRST INILUZ ;init failed
CAIN AC4,"/"
JRST DILSPD
INITED: SKIPGE AC2,SPDNAM ;GET SPEED IF ANY
JRST INITE1 ;NONE
PUSHJ P,SETSPD ;set speed for tty, skip if OK
JRST ILLNUM ;couldn't get tty number, shouldn't happen
INITE1: PUSHJ P,SETFCS ;TRY TO LOOK LIKE TELETYPE
PUSHJ P,SETNOE
OUTSTR[ASCIZ/Ready.
/]
>;ISDIAL
;PRPR PRPR1 PRJLP ENDPRJ
;GET A PTY AND SETUP DEFAULT MODES
ISPTY,<
PTYGET LINE ;GET US A PTY
JRST [ OUTSTR[ASCIZ/Sorry, no PTYs available.
/]
EXIT 1,
JRST RSTART]
SKIPE DPY ;Tell dpy users what to type for EOF
OUTSTR [ASCIZ /Type CTL-META-LF for EOF; CTL-Z will send a tilde.
/]
PUSHJ P,SETLMB ;LINE MODE
PUSHJ P,SETNOE ;FOREIGN ECHO
PTGETL LINE
MOVSI AC1,XON!DMLIN ;Don't accidentally turn us into a DM!
ANDCAM AC1,CHAR
PTSETL LINE
hrroi ac1,[1000,,SPCBRK] ;Turn on this bit
skipn dpy ; if not a display
ttyset ac1,
MOVSI T1,(<ASCII /L />)
MOVE C,[260700,,T1]
GETPPN D,
HLRZ E,D
PUSHJ P,[
PRPR: MOVE F,[220600,,E]
PRPR1: ILDB T,F
JUMPE T,PRPR1
ADDI T,40
IDPB T,C
TLNE F,770000
JRST PRPR1
POPJ P,]
MOVEI T,"."
IDPB T,C
HRRZ E,D
PUSHJ P,PRPR
MOVEI T,15
IDPB T,C
MOVEI T,0
IDPB T,C
MOVE C,[440700,,T1]
PRJLP: ILDB T,C
JUMPE T,ENDPRJ
MOVEM T,CHAR
PTWR1W LINE
JRST PRJLP
ENDPRJ: SETOM PTYCHR ;FLAG NO SAVED INPUT CHAR
>;ISPTY
;namesc OPTRET GOTHDB NOTITS GOTST1 gotsite SLURPU SLURPA SLURPG SLURPF SLURPH SLURPE OPTXT OPTXTL OPTXTN OPTXTF OPTXTT OPTXTP OPTXTH OPTXTC OPTXTM OPTXTR OPTXBP OPTXOK OPTXNX OPTXCH OPTXDZ OPTXZR OPTXDN OPTCHR OPTCH1 NOOPTT
; Here we try to get the name of the site he wants to talk to
NOPTY,<
NODIAL,<
namesc:
IFE SPCL,<
ISSYS,{ SKIPG RSCCNT }
outstr [asciz /Host = /]
pushj p,rdsite
jrst [ outstr [asciz /
Illegal character
/]
ISSYS,< PUSHJ P,SYSRST >
jrst namesc]
IFN FTPCOM,<
MOVE AC4,HSTEND
CAIN AC4,"↑"
JRST OPTXT ;READ OPTION.TXT IF NEEDED
OPTRET:
>;FTPCOM
IFN 0,< ;ALL DONE BY NETWRK
movei ac4,0 ; If site was directly typed,
jumpn ac3,gotsite ; don't bother to look up.
pushj p,getsite ; Look up what he typed in the table
jrst [ movei ac1,[asciz /Site name not found
/]
cain ac3,1
movei ac1,[asciz /Ambiguous name
/]
outstr (ac1)
outstr [asciz /Please type "R HOST" for host names
/]
ISSYS,{ PUSHJ P,SYSRST }
jrst namesc]
>;IFN 0
IFN 1,< MOVEM AC3,HOSTNO
PUSHJ P,MAPHST ;BRING HOSTS1 IN
SKIPE HOSTNO
JRST [ MOVE HOSTNO ;GOING BY THE NUMBERS,
PUSHJ P,HSTNUM ;SO GET HDB THE OTHER WAY
JRST GOTHDB]
MOVEI HSTBUF ;POINTER TO NAME STRING
PUSHJ P,HSTNAM ;GET HDB
JRST [ OUTSTR [ASCIZ/No such host
/]
PUSHJ P,UNMHST ;UNMAP HOST TABLE
ISSYS,{PUSHJ P,SYSRST}
JRST NAMESC]
JRST [ OUTSTR [ASCIZ/Ambiguous host name
/]
PUSHJ P,UNMHST ;UNMAP HOST TABLE
ISSYS,{PUSHJ P,SYSRST}
JRST NAMESC]
; GOT AN HDB, NOW PLAY WITH IT
GOTHDB: tlz 0,777000
MOVEM HOSTNO
IFN FTPCOM,<MOVEM DHOST>
SETZ AC3,
SETZM ITSFLG
HLRZ 1 ;NUMSYS
MOVE @ ;GET O.S. NAME
CAME [ASCII/ITS/]
JRST NOTITS
TRO AC3,EFCSM
SETOM ITSFLG
NOTITS: HRRZ 2 ;NUMMCH
MOVE @
CAMN [ASCII/PDP10/]
TRO AC3,NOEB
TLNE 2,400000 ;NUMBTS
TRO AC3,SRVR
MOVEM AC3,HOSTMODE#
PUSHJ P,UNMHST
GOTST1:
>;IFN 1
>;¬SPCL
IFN SPCL,<
move ac3,nm ;get site directly
setzb ac2,ac4 ;no special bits or anything
tro ac4,noeb ;BH 11/16/74 REMOTE ECHO FOR RSEXEC
>;SPCL
IFN 0,<;NETWRK SAYS THIS NOW
gotsite:hrrzm ac3,hostno ; Save host number
IFN FTPCOM,<
hrrzm ac3,dhost
>;FTPCOM
SETZM ITSFLG ;BH 4/4/76 DO THIS RIGHT ONCE AND FOR ALL
MOVEI AC3,(AC3)
CAIE AC3,=134 ;AI
CAIN AC3,=198 ;ML
SETOM ITSFLG
CAIE AC3,=236 ;MC (11/28/76: used to be =108, so much for once andfor all!)
CAIN AC3,=70 ;DM
SETOM ITSFLG
movem ac4,hostmode# ; Save host mode bits
>
IFN FTPCOM,<
SKIPN HAIRY ;BH 11/27/77 HAIRY ONE-LINE TRANSFER?
JRST LOGINJ ;NO
MOVE AC1,HSTEND ;YES, GET DELIM AFTER HOST NAME
CAIN AC1,"↑"
JRST SLURPH ;ALREADY GOT THIS STUFF FROM OPTION.TXT
SETZM USRSTR
SETZM ACCSTR
SETZM PASSTR
CAIE AC1,"/" ;ENDS WITH SLASH?
JRST SLURPH ;NO, GO SLURP REST OF COMMAND LINE
MOVE AC3,[POINT 7,USRSTR]
SLURPU: READW(AC1) ;YES, SLURP THE USER NAME (S)HE WANTS
;{
CAIE AC1,"}" ;END HERE
CAIN AC1,15 ; OR HERE
JRST SLURPG
CAIE AC1,12 ;END OF LINE
CAIN AC1,175
JRST SLURPF
CAIN AC1,"/"
JRST SLURPA ;SLURP ACCOUNT
IDPB AC1,AC3
JRST SLURPU
SLURPA: MOVEI AC4,0
IDPB AC4,AC3 ;FINISH OFF USER ID
MOVE AC3,[POINT 7,ACCSTR]
SKIPN ACCSTR ;CAN'T HAVE TWO ACCTS
JRST SLURPU
OUTSTR [ASCIZ /? Too many fields in host specification.
/]
EXIT ;F**K IT
SLURPG: READW(AC1)
SLURPF: MOVEI AC4,0
IDPB AC4,AC3
JRST SLURPE
SLURPH: CAIE AC1,12
CAIN AC1,175
JRST SLURPE
READW(AC1) ;YES, GET THE REST OF THE LINE
;{
CAIN AC1,"}"
JRST SLURPH ;TO DEAL WITH {HOST↑} CASE
SLURPE: IDPB AC1,HAIRBP ;(WE'VE CLEVERLY OMITTED THE HOST NAME)
CAIE AC1,12 ;GO TO END OF LINE
CAIN AC1,175
JRST LOGINJ
JRST SLURPH
OPTXT:
IFN 0,<;BH DIDN'T CONSULT ME BEFORE HE DID THIS
MOVEM AC1,HOST6
MOVEM AC2,HOST6+1
>
JUMPN AC3,[ OUTSTR [ASCIZ /? No OPTION.TXT with numeric host.
/]
EXIT]
OPEN FOMP,OPOPEN ;OPEN A DISK TO READ OPTION.TXT
JRST NOOPTT ;CAN'T
MOVE T,['OPTION']
HRLZI T1,'TXT'
GETPPN T3, ;USE PPN NOT ALIAS (BETTER NOT BE JACCT!)
LOOKUP FOMP,T ;READ OPTION.TXT
JRST NOOPTT ;NOOP!
PUSH P,JOBFF ;GET SOME BUFFER SPACE
MOVEI T,DSKOBF
MOVEM T,JOBFF
INBUF FOMP,2 ;NOT SO MANY FOR THIS SMALL FILE
POP P,JOBFF
OPTXTL: PUSHJ P,OPTCHR ;HERE AT BEGINNING OF LINE
JRST NOOPTT
CAIE AC1,"F" ;VERY COMPLEX SCANNER
CAIN AC1,"f"
JRST OPTXTF
OPTXTN: CAIE AC1,14 ;NOT OUR LINE, SKIP TO END
CAIN AC1,12
JRST OPTXTL
PUSHJ P,OPTCHR
JRST NOOPTT
JRST OPTXTN
OPTXTF: PUSHJ P,OPTCHR
JRST NOOPTT
CAIE AC1,"T"
CAIN AC1,"t"
JRST OPTXTT
JRST OPTXTN
OPTXTT: PUSHJ P,OPTCHR
JRST NOOPTT
CAIE AC1,"P"
CAIN AC1,"p"
JRST OPTXTP
JRST OPTXTN
OPTXTP: PUSHJ P,OPTCHR
JRST NOOPTT
CAIE AC1,":"
JRST OPTXTN
OPTXTH: PUSHJ P,OPTCHR ;FOUND LINE, LOOK FOR A HOST
JRST NOOPTT
CAIE AC1,14 ;MAYBE EOL
CAIN AC1,12
JRST OPTXTL
CAIE AC1,"{" ;}
JRST OPTXTH
IFN 0,< MOVE AC3,[POINT 6,HOST6]> ;COMPARE THIS ENTRY TO WHAT (S)HE TYPED
IFN 1,< MOVE AC3,[440700,,HSTBUF]>
OPTXTC: PUSHJ P,OPTCHR
JRST NOOPTT
CAIE AC1,14
CAIN AC1,12
JRST OPTXTL
ILDB AC2,AC3 ;TYPED CHAR
JUMPE AC2,OPTXTM ;END OF NAME, IT'S A MATCH MAYBE
CAIL AC1,140
SUBI AC1,40 ;LC TO UC
IFN 0,< CAIN AC1,40(AC2)> ;COMPARING ASCII TO SIXBIT
IFN 1,< CAMN AC1,AC2> ;COMPARING ASCII TO ASCII
JRST OPTXTC ;SAME, KEEP READING
JRST OPTXTH ;NOT SAME, LOOK FOR ANOTHER
OPTXTM: CAIN AC1,"/" ;FILE NAME END WITH SLASH?
JRST OPTXOK ;YES, USE EXISTING HOST NAME
CAIE AC1,":" ;NO, WHAT ABOUT COLON?
JRST OPTXTH ;NO, LOOK FOR ANOTHER ENTRY
IFN 0,< ;NOT WITH NETWRK YOU DON'T
SETZM HOST6 ;YES, REPLACE HOST NAME FROM OPTION.TXT
SETZM HOST6+1
MOVE AC2,[POINT 6,HOST6]
>
IFN 1,< ;DO IT RIGHT THIS TIME
SETZM HSTBUF
MOVE AC2,[HSTBUF,,HSTBUF+1]
BLT AC2,HSTBUF+7
MOVE AC2,[440700,,HSTBUF]
>
OPTXTR: PUSHJ P,OPTCHR
JRST NOOPTT
CAIE AC1,14
CAIN AC1,12
JRST OPTXTL
CAIE AC1,"/" ;DONE WITH NAME?
;{
CAIN AC1,"}"
JRST OPTXOK ;YES
CAIL AC1,140 ;NO, CONVERT CHAR TO SIXBIT
SUBI AC1,40
IFN 0,< SUBI AC1,40>
IDPB AC1,AC2
JRST OPTXTR
OPTXBP: POINT 7,USRSTR
POINT 7,ACCSTR
POINT 7,PASSTR
OPTXLN←←.-OPTXBP
OPTXOK: HRLZI AC3,-OPTXLN ;POINT TO 0TH ENTRY
OPTXNX: ;{
CAIN AC1,"}"
JRST OPTXDN ;DONE AT RT BRACE
MOVE AC2,OPTXBP(AC3)
OPTXCH: PUSHJ P,OPTCHR ;COPY INTO PROPER FIELD
JRST OPTXDZ
CAIE AC1,14
CAIN AC1,12
JRST OPTXDZ
;{
CAIN AC1,"}"
JRST OPTXDZ
CAIN AC1,"/"
JRST OPTXZR
IDPB AC1,AC2
JRST OPTXCH
OPTXDZ: MOVEI AC3,0 ;PREVENT AOBJN FROM LOOPING
OPTXZR: MOVEI AC1,0
IDPB AC1,AC2
AOBJN AC3,OPTXNX
OPTXDN: RELEAS FOMP,
IFN 0,< ;NOT WITH NETWRK
MOVE AC1,HOST6
MOVE AC2,HOST6+1
>
MOVEI AC3,0
JRST OPTRET ;FINITO
OPTCHR: SOSG OTBUF+2
IN FOMP,
JRST OPTCH1
POPJ P,
OPTCH1: ILDB AC1,OTBUF+1
JRST CPOPJ1
NOOPTT: OUTSTR [ASCIZ /Can't find your host name in OPTION.TXT
/]
EXIT ;EXEUNT
>;FTPCOM
;loginj
; Try to initiate connection
loginj:
init log,17
sixbit /IMP/
0
jrst noinit
setzm conecb
setom conecb+lsloc
move ac3,hostno
movem ac3,conecb+hloc
setom conecb+wfloc
movei ac3,40
movem ac3,conecb+bsloc
move ac3,consck
trnn ac3,1
jrst gayskt ; only heterosocketuals can win!
movem ac3,conecb+fsloc
mtape log,[
=15
byte (6) 2,24,0,7,7
] ; Time out CLS, RFNM, RFC, and INPut
mtape log,conecb
move rsock,conecb+lsloc
move ssock,rsock
addi ssock,1
move ac1,conecb+stloc ; Pick up status bits
trnn ac1,77 ; Error code?
statz log,errbts
jrst noconn ; No connection to logger
tlc ac1,(<rfcr!rfcs>)
tlne ac1,(<rfcr!rfcs>)
jrst noconn
DEB,< outstr [asciz / We got the logger
/]
>;DEB
; Here we got the logger. Try to get the socket number.
input log,[ iowd 1,frs#
0]
statz log,errbts
jrst nosock ; Got logger but didn't get socket from him
DEB,< outstr [asciz / We got a socket number: /] >
move ac3,frs
lsh ac3,-4
movem ac3,frs
DEB,<
move t,ac3
pushj p,oprint
outstr cr
>;DEB
addi ac3,1
movem ac3,fss#
IFN FTPCOM,<
addi ac3,1
movem ac3,fdisoc ;FOREIGN DATA IN SOCKET (WE SEND TO IT)
addi ac3,1
movem ac3,fdosoc ;FOREIGN DATA OUT SOCK. (IT SENDS TO US)
>;FTPCOM
addi rsock,2
movem rsock,lrs#
addi ssock,2
movem ssock,lss#
IFN FTPCOM,<
move ac1,ssock
addi ac1,1
movem ac1,ldisoc
addi ac1,1
movem ac1,ldosoc
>;FTPCOM
move ac1,conecb+lsloc
movem ac1,terblk+lsloc
mtape log,terblk ; Release logger
;conini
; Here we got a socket from the logger, let us open it
conini: init imp,0
sixbit /IMP/
xwd obuf,ibuf
jrst noinit
mtape imp,[
=15
byte (6) 5,24,0,7,0
] ; Time out CLS, RFNM, and RFC
inbuf imp,2
outbuf imp,2
movei ac1,10
dpb ac1,[point 6,ibuf+1,11]
dpb ac1,[point 6,obuf+1,11]
movem rsock,conecb+lsloc
move ac3,hostno
movem ac3,conecb+hloc
setzm conecb+wfloc
movei ac3,10
movem ac3,conecb+bsloc
move ac3,fss
movem ac3,conecb+fsloc
mtape imp,conecb ; make receive side connection
move ac1,conecb+stloc
trne ac1,-1
jrst rsfail
statz imp,errbts
jrst norscn ; Can't connect receive side
output imp, ; Dummy output to set up buffer header
aos obuf+2 ; don't get out of sync at impout
DEB,<
move ac1,obuf+1
movem ac1,debptr#
>;DEB
pushj p,clschk ; check to see if world has been closed
jrst intbts
aos conecb+lsloc
sos conecb+fsloc
movei ac3,10
movem ac3,conecb+bsloc
mtape imp,conecb ; make send side connection
move ac1,conecb+stloc
trne ac1,-1
jrst ssfail
statz imp,errbts
jrst nosscn ; Can't connect to send side
pushj p,clschk ; check to see we haven't been closed
jrst intbts
;conwat
; Connection has been requested, now wait for them to complete
conwat: movei ac3,4
movem ac3,conecb
mtape imp,conecb ; wait for send side to connect
move ac1,conecb+stloc
tlc ac1,300000
tlcn ac1,300000
tlne ac1,060000
jrst intbts
statz imp,errbts
jrst norswc
DEB,<
outstr [asciz / We got send side open
/]
>;DEB
sos conecb+lsloc
pushj p,clschk
jrst intbts
mtape imp,conecb ; wait for receive side to connect
move ac1,conecb+stloc
tlc ac1,300000
tlcn ac1,300000
tlne ac1,060000
jrst intbts
statz imp,errbts
jrst norswc ; Lost while waiting for receive side to connect
DEB,<
outstr [asciz / We got receive side open
/]
>;DEB
pushj p,clschk
jrst intbts
mtape imp,[15 ↔ 3] ;allocate
>;NODIAL
>;NOPTY
;NOSYNC
; Here we clean up everything, turn on interrupts and such STILL IFN 0
NOPTY,<
NODIAL,<
close log,
releas log,
>;NODIAL
>;NOPTY
IFN FTPCOM,< jrst ftpini >
IFE FTPCOM,<
NOPTY,<
NODIAL,<
ISSYS,<
SKIPE SYSMOD ;STARTED IN SYSTEM MODE?
SKIPG RSCCNT ;YES, ANY CHARS LEFT TO TYPE AT HOST?
JRST NOSYNC ;NO
SKIPN ITSFLG ;ITS?
JRST NOSYNC ;NO
OUTSTR[ASCIZ/SYNCHRONIZING WITH LOSING ITS!/]
MOVEI AC1,2
SLEEP AC1,
OUTSTR[ASCIZ/
/]
NOSYNC:
>;ISSYS
>;NODIAL
>;NOPTY
movei ac1,intdsp
movem ac1,jobapr
ISNEWP,<intmsk [INTTTY!intclk!intins!intinr]>
NONEWP,<
NOPTY,<
NODIAL,<
intmsk [INTTTY!intclk]
>
>
>
IFN PTYSW!DIALSW,<
intmsk [0]
>
ISPTY,<
MOVSI AC1,(<INTPTO!INTPTI!INTTTY>)
>
ISDIAL,<MOVSI AC1,(<INTTTY>) >
NOPTY,<
NODIAL,<
movsi ac1,(<intinp!intims!ISNEWP,<intinr!intins!>NGP,<INTIMS!>INTTTY>)
>;NODIAL
>;NOPTY
intenb ac1,
NOPTY,<
NODIAL,<
move ac3,hostmode ; Pick up host mode bits
trne ac3,noeb ; Echo?
pushj p,setnoe ; No, turn off echoing
ISNEWP,<
move ac3,hostmode ; Pick up host mode bits
trnn ac3,noeb
pushj p,setech
>;ISNEWP
NGP,< SETOM KLUCNT ; Reset Sproull's kludge
SETOM KLUPTR
SETZM OLDFF ; Clear old copy of JOBFF
ifn impbug,< setzm imphak# >
>;NGP
move ac3,hostmode ; Pick up host mode bits
trne ac3,efcsm ; Full character set mode?
pushj p,setfcs ; Yes
>;NODIAL
>;NOPTY
;cloop lockok nolock cloop1 SKPKLU crl2 PTYOUT NOFLU ININS1 NOTRBO skpout nodplf trytty trytt2 ttyhld chktty ttych TRANSI TTYSR5 nochr gtchr GTCH1 EATLF TYOUTS noochr wait WAIDIA watins CHKSLO
; Main tty-imp loop, CLOOP, GTCHR
cloop:
NOPTY,<
sosl lockct ;skip if time to relock
jrst nolock
lock
lockok: movei ac1,=2000
movem ac1,lockct
nolock:
>;NOPTY
NOPTY,<
NODIAL,<
clkint =20*=60 ;reset clkint to 20 seconds
>;NODIAL
>;NOPTY
ISNEWP,<
skipn insflg ;skip if we've gotten an ins
jrst cloop1
setzm insflg
skipn damflg
aosa inscnt
setzm damflg ;have seen data mark already
>;ISNEWP
cloop1:
NOPTY,<
NGP,< PUSHJ P,GRFSER > ; Handle graphics
pushj p,inpskp ; Any IMP input waiting for us?
jrst chktty ; No, see if any TTY input
skipe notsnt ; let loser type over solid output barfage
pushj p,impouu ; empty buffer - this shouldn't hang
ISNEWP,<
skipe damflg
jrst chktty ; have data mark but no ins, can't do any more inp
>;ISNEWP
pushj p,impget ; Yes, get some
NGP,<
; The following kludge is necessitated by Sproull not having requested an option
; code for graphics yet. We have to look for string *GCIP*<socket number>
JUMPE AC1,SKPKLU
SKIPE GRFON ;In graphics mode?
JRST SKPKLU ;Don't look for "*GICP*"
SKIPN KLUPTR ;Reading socket number?
JRST [ CAIN AC1,"*" ;'*'?
JRST .+1 ;Not a socket number
SOSGE KLUCNT ;More digits left?
JRST SKPKLU ;No, skip it
CAIL AC1,"0" ;Is it an octal digit?
CAILE AC1,"7"
JRST [ SETOM KLUCNT ;No, stop looking for socket number
JRST SKPKLU ]
MOVE AC2,GRFSOK ;More to add to socket number
LSH AC2,3
ADDI AC2,-"0"(AC1)
MOVEM AC2,GRFSOK
PUSH P,AC1 ;Save character
SKIPN KLUCNT ;Last digit?
PUSHJ P,GRFINI ;Yes, initialize graphics
POP P,AC1
JRST SKPKLU ]
SOSL KLUCNT ;More possible characters in "*GICP*"?
IDPB AC1,KLUPTR ;Yes, remember them
CAIE AC1,"*" ;Delimiter?
JRST SKPKLU ;No, skip rest
MOVE AC2,[ASCII/GICP*/] ;Is it "*GICP*"?
CAMN AC2,KLUWRD
SKIPE KLUCNT ;Can it be?
JRST [ MOVEI AC2,5 ;No, assume it's leading "*"
MOVEM AC2,KLUCNT ;Init. count
MOVE AC2,[POINT 7,KLUWRD] ;And pointer
MOVEM AC2,KLUPTR
JRST SKPKLU ]
MOVEI AC2,=11 ;Yes, it is! A socket number is an
MOVEM AC2,KLUCNT ;eleven digit octal number
SETZM KLUPTR ;We are no longer looking for "*GICP*"
SETZM GRFSOK
SKPKLU:
>;NGP
ISNEWP,<
skipe nwptcm
jrst spcnxt ; got next telnet command
>;ISNEWP
NODIAL,<
trne ac1,200
jrst spcchr
ISNEWP,<
skipg inscnt
jrst crl2
setzm crlff
jrst trytty
>;ISNEWP
crl2: jumpe ac1,cloop
aosn crlff
caie ac1,12
caia
jrst trytty
>;NODIAL
>;NOPTY
ISPTY,<
PTRD1S LINE
JRST CHKTTY
PTYOUT: MOVE AC1,CHAR
>;ISPTY
skipe spcout
pushj p,spoutc
ISDIAL,<
PUSHJ P,CHKSLO ; Character to output--update slow mode stuff
SKIPN FLUCTL ;FLUSHING CONTROL CHARS ON OUTPUT?
JRST NOFLU
CAILE AC1,10 ;IF LESS OR EQUAL TO 10
CAIN AC1,177 ;OR 177
JRST TRYTTY ;THEN FLUSH
CAIGE AC1,40 ;NOW IF LESS THAN 40
CAIG AC1,15 ;AND GREATER THAN 15
JRST NOFLU
JRST TRYTTY ;THEN FLUSH
NOFLU:
>;ISDIAL
skipe notype
jrst skpout
movni ac2,1
skipe beepc ;skip if not beeping π today
caie ac1,"π" ;skip if need to beep
caia
beep ac2,
IFN DMFLG,<
SKIPN DMSIMF
JRST ININS1
SKIPE DMDSP
JRST @DMDSP
JRST DMSIM
ININS1:
>;DMFLG
DPT,<
skipe ttdpt
jrst notrbo
>;DPT
IFN BUFOUT,<
JUMPE AC1,NOTRBO ;PMF- Shouldn't put null's in outstr string.
IDPB AC1,TYOBP ;PUT IN THE BUFFER
SOSG TYOCNT
PUSHJ P,TYOUTS ;TIME TO DO OUTSTR
SKIPE DDDPY ;SKIP IF NOT DATA DISC
CAIE AC1,177
JRST NOTRBO
IDPB AC1,TYOBP
SOSG TYOCNT
PUSHJ P,TYOUTS
>;BUFOUT
IFE BUFOUT,<
OUTCHR AC1
SKIPE DDDPY ;SKIP IF NOT DATA DISC
CAIE AC1,177
JRST NOTRBO
OUTCHR AC1
>;NOT BUFOUT
NOTRBO:
DPT,<
skipn ttdpt
jrst skpout
pushj p,ttyout
jrst trytty ;no auto lf after cr on dpt
>;DPT
skpout:
NODIAL,<
NOPTY,<
caie ac1,15
jrst trytty
movei ac1,12
setom crlff
skipe spcout
pushj p,spoutc
SKIPE NOTYPE ;SUPPRESSING ALL OUTPUT?
JRST TRYTTY ;YES
DPT,<
skipn ttdpt
jrst nodplf
pushj p,ttyout
jrst trytty
>;DPT
nodplf:
IFN BUFOUT,<
IDPB AC1,TYOBP
SOSG TYOCNT
PUSHJ P,TYOUTS
>;BUFOUT
IFE BUFOUT,<
OUTCHR AC1
>;NOT BUFOUT
>;NOPTY
>;NODIAL
trytty:
NOPTY,<
NODIAL,<
skipe nearly
jrst ttyhld ;output blocked. avoid deadly embrace
>;NODIAL
>;NOPTY
trytt2: pushj p,gtchr
jrst cloop
jrst ttych
NOPTY,<
NODIAL,<
ttyhld: mtape imp,allocs
move ac3,allocs+10 ;msg alloc
move ac2,allocs+7 ;bit alloc
caile ac2,2*=36
caig ac3,2
jrst cloop ;try for more imp input
setzm nearly
jrst trytt2 ;things have eased up a little
>;NODIAL
>;NOPTY
chktty:
IFN BUFOUT,<
MOVE AC1,TYOCNT
CAIE AC1,TYOBLN*5
PUSHJ P,TYOUTS
>;BUFOUT
ISPTY,<
MOVNI AC1,1
EXCH AC1,PTYCHR ; CHECK FOR CHAR WE COULDN'T SEND BEFORE
JUMPGE AC1,CHOUT ; TRY TO TYPE IT OUT NOW
>;ISPTY
pushj p,gtchr
jrst nochr
ttych:
ISDIAL,<
AOS ECHCNT ;PROBABLY WILL GET ECHO, SO TYPE IMMEDIATELY
AOS ECHCNT
SKIPE TRANSP ; skip if not transparent mode
JRST TRANSI ; process transparent mode char
>;ISDIAL
camn ac1,escchr ; check for escape character
skipe dpy
jrst notesc
movei ac1,200
addb ac1,cbits
jumpl ac1,cloop
move ac1,fcsf
iori ac1,400000
hrlm ac1,cbits
skipn fcsf
pushj p,setfcs
ptjobx [0 ↔ sixbit /DOFF/]
jrst cloop
ISDIAL,<
TRANSI: ANDCMI AC1,400 ; zap image-mode bit
SKIPN NOEDT ; skip if noedit display -- flush parity bit
SKIPN DMDPY ; skip if DM-type display (has edit key)
ANDI AC1,177 ; flush the parity bit (no EDIT key)
CAME AC1,ESCCHR
JRST CHOUT ; not escape character
INCHRW AC1
ANDCMI AC1,400 ; turn off image-mode bit
SKIPN NOEDT ; skip if noedit display -- flush parity bit
SKIPN DMDPY ; skip if DM-type display (has edit key)
ANDI AC1,177 ; flush the parity bit (no EDIT key)
CAMN AC1,ESCCHR ; escape quotes itself
JRST CHOUT ; send esc char itself
ANDCMI AC1,200 ; clear EDIT bit
CAIE AC1,"-" ; command off?
JRST TTYSR5 ; no, this is cmd char, do positive cmd (β-char)
INCHRW AC1 ; yes, get cmd char
TROA AC1,600 ; form αβcharacter
TTYSR5: IORI AC1,400 ; form βcharacter
JRST NOTES9 ; go handle command char
>;ISDIAL
nochr: skipe spcin
pushj p,spinc
jrst noochr
came ac1,escchr
jrst notesc
movei ac1,200
addm ac1,cbits
jrst cloop
gtchr:
NOPTY,<
NODIAL,<
SKIPN LUKTTY
POPJ P, ;NO INPUT FROM TTY YET
>
>
sneaks ac1, ; Don't clear <escape>O
JRST GTCH1
READS(AC1,<JRST GTCH1>)
PUSHJ P,EATLF
JRST GTCHR
JRST CPOPJ1
GTCH1:
NOPTY,<
NODIAL,<
; OUTCHR ["π"]
SETZM LUKTTY
IMSKST [INTTTY]
>
>
POPJ P,
EATLF: aosn lstcr
caie ac1,12
caia
POPJ P,
cain ac1,15
setom lstcr
aos (p)
popj p,
IFN BUFOUT,<
TYOUTS: PUSH P,AC1
MOVEI AC1,0
IDPB AC1,TYOBP
OUTSTR TYOBUF
MOVE AC1,[440700,,TYOBUF]
MOVEM AC1,TYOBP
MOVEI AC1,TYOBLN*5
MOVEM AC1,TYOCNT
POP P,AC1
POPJ P,
>;BUFOUT
noochr:
NOPTY,<
skipe fcsf
skipn ac1,notsnt ;ANY CHARS THAT NEED SENDING?
jrst wait
pushj p,impouu ;empty buffer
>;NOPTY
wait:
NOPTY,<
pushj p,inpskp
caia
jrst cloop
>;NOPTY
ISNEWP,<
intmsk [NGP,<INTIMS!>intclk] ;turn intinr and intins back off
skipe insflg
jrst watins
>;ISNEWP
DPT,< skipe ttyorq ;don't forget to update screen
pushj p,ttyowr ;before hanging.
>;DPT
IFN DMFLG,<
PUSHJ P,DMCHK
>;DMFLG
ISPTY,< IMSTW [INTPTO!INTPTI!INTTTY]>
ISDIAL,<
MOVEI AC1,=15
SKIPE ECHCNT
MOVEI AC1,0 ;EXPECTING ECHO, WAKE UP RIGHT AWAY
MOVEM AC1,WAKCNT ;WAKE UP AFTER THIS MUCH INPUT
imstw [intclk!inttty]
AOSE WAKFLG ;SKIP IF WE'RE REALLY SUPPOSED TO WAKE UP
JRST .-2
SKIPE CONCHR
JRST WAIDIA
SOSGE ECHCNT
SETZM ECHCNT
WAIDIA:
>;ISDIAL
NOPTY,<
NODIAL,<
IMSTW [ISNEWP,<INTINR!INTINS!>INTCLK!INTIMS!INTINP!INTTTY]
mtape imp,sttblk
move ac1,sttblk+1
ior ac1,sttblk+2
tlne ac1,(<clss!clsr>)
jrst concls
>;NODIAL
>;NOPTY
jrst cloop
ISNEWP,<
watins: intmsk [NGP,<INTIMS!>intclk!intins!intinr!inttty]
jrst cloop
>;ISNEWP
ISDIAL,<
CHKSLO: SKIPN SLOWIT ; Waiting for a character?
POPJ P,
CAMN AC1,SLOWC ; Yes, is this it?
SETZM SLOWIT ; Yes. We're not waiting any more.
POPJ P,
>
;notesc notes9 CHOUT1 chout cho NOTBUK notcr CHO1
; Get here if the character is not an escape character
notesc: add ac1,cbits
jumpge ac1,notes9
push p,ac1
tlnn ac1,1 ;skip if were in fcs at the time
pushj p,setlmb ;back to line mode
pop p,ac1
andi ac1,777
notes9: setzm cbits
trne ac1,600
jrst contch ; Control character
ISBUCKY,<
CHOUT1: setzm ptyquo
>
chout:
cho:
ISPTY,<
MOVEM AC1,CHAR
PTWR1S LINE
JRST [ MOVEM AC1,PTYCHR; SAVE CHAR WE WANT TO TYPE INTO PTY
PTRD1S LINE ; CAN'T TYPE IN, SEE IF HE IS TYPING OUT
CAIA
JRST PTYOUT
MOVEI AC1,1
SLEEP AC1, ; WAIT A LITTLE BIT
SETO AC1,
EXCH AC1,PTYCHR
JRST CHOUT]
>;ISPTY
NOPTY,<
ISBUCKY,<
SKIPN TRANSM ; Transparent mode? (TVR Sep75)
JRST NOTBUK ; Handle specially
; Send bucky bits (Extended-ASCII) if available (TVR Sep75)
; Note: ALTMODE, etc., are not being hacked!!!
SKIPN EXTAOK ;Do we have permission?
JRST NOTBUK ; Not available, forget it
PUSH P,AC1 ;Save character
MOVEI AC1,IAC ;Send special command sequence
PUSHJ P,IMPOUT
MOVEI AC1,SB ;Subnegotiation kludge
PUSHJ P,IMPOUT
MOVEI AC1,17 ;Code for Extended-ASCII
PUSHJ P,IMPOUT
LDB AC1,[POINT 1,(P),35-8] ;First, the high order part (400 bit)
PUSHJ P,IMPOUT
POP P,AC1 ;Then remaining low order part
PUSHJ P,IMPOUT
MOVEI AC1,IAC
PUSHJ P,IMPOUT
MOVEI AC1,SE
NOTBUK:
>;ISBUCKY
pushj p,impout
NODIAL,<
caie ac1,15
jrst notcr
movei ac1,12
pushj p,impout
notcr: skipn nearly ; is our output nearly blocked??
jrst chktty ; no, try to gobble more ttychrs
>;NODIAL
>;NOPTY
IFN PTYSW!DIALSW!BUCKSW,<
CHO1: SKIPN SPCIN ; IF INPUT FROM TTY
JRST CHKTTY ; PREFER TTY
>;PTYSW!DIALSW!BUCKSW
jrst cloop ; CHECK FOR MORE INPUT (FROM NET, ETC.)
>;¬FTPCOM
;DMSNDD DMCLER DMSET DMSET2 DMSET1 DMRST DMSETL DMCURZ DMCLR DMSIM DMSIM0 DMSIM2 DMNOWR DMSIMT DMESC DMTAB DMALPH DMPI DMHOME DMBS DMBS1 DMLF DMLF1 DMLF2 DMLF3 DMFF DMFF3 DMCR DMCR1 DMBO DMDLE DMFS DMFS3 DMFS2 DMFS1 DMSUB DMSIMC DMSIMX DMSUB1 DMETB DMET1 DMCAN DMGS DMRS DMDSP DMSTOR DMBPTR DMCHK DMCURD DMCHK2 DMCHK1 DMDLIN DMLHDR DMERCU DMCYST DMCHK3 DMROL DMROL1 DMSROL DMSIMI DMRSHF DMRSH2 DMRSH1 DMLSHF DMLSH2 DMLSH1 DMDROW DMDRO1 DMAROW DMARO1 DMARO2
;DATAMEDIA SIMULATION -- DMSNDD DMCLER DMSET DMSET2 DMSET1 DMRST DMSETL DMCURZ DMCLR DMSIM DMSIM0 DMSIM2 DMNOWR DMSIMT DMESC DMTAB DMALPH DMPI DMHOME DMBS DMBS1 DMLF DMLF1 DMLF2 DMLF3 DMFF DMFF3 DMCR DMCR1 DMBO DMDLE DMFS DMFS3 DMFS2 DMFS1 DMSUB DMSIMC DMSIMX DMSUB1 DMETB DMET1 DMCAN DMGS DMRS DMDSP DMSTOR DMBPTR DMCHK DMCURD DMCHK2 DMCHK1 DMDLIN DMLHDR DMERCU DMCYST DMCHK3 DMROL DMROL1 DMSROL DMSIMI DMRSHF DMRSH2 DMRSH1 DMLSHF DMLSH2 DMLSH1 DMDROW DMDRO1 DMAROW DMARO1 DMARO2
;IF YOU DIDDLE THIS SIMULATOR, REMEMBER TO FIX THE ONE IN IMSSS[NET,SYS].
IFN DMFLG,<
IFNDEF DMHGT,<DMHGT←←=24>
DMCHAR←←=80
DMWIDW←←2+DMCHAR/5+1+1 ;NUMBER OF WORDS IN A LINE
DEFINE DDCMD(O1,D1,O2,D2,O3,D3) <
BYTE (8) D1,D2,D3 (3) O1,O2,O3,4
>
DMSNDD: OUTSTR [ASCIZ /Sorry, Datamedia simulator implemented for data disc only.
/]
JRST CLOOP
DMCLER: PUSHJ P,DMCLR
JRST CLOOP
DMSET: SKIPE CTRL1 ;SKIP IF META Y
JRST DMCLER ;CONTROL META Y
SKIPN DDDPY
JRST DMSNDD ;NOT DATA DISK
PPACT 0 ;FLUSH PP0 FOR A WHILE
SKIPN FCSF
JRST DMSET1 ;PUT LINE EDITOR DOWNSTAIRS IF IN LINE MODE
LEYPOS 2000 ;OFF SCREEN
DMSET2: DDUPG DMHDRE
PUSHJ P,DMRST
SETOM DMSIMF
SETZM DMUPDF
SETZM DMALL
SETZM DMDLMD
SETZM XCUR
SETZM YCUR
SETOM LYCUR
DDUPG DMHDR
JRST CLOOP
DMSET1: LEYPOS -540
JRST DMSET2
DMRST: MOVE E,[ASCID / /]
MOVEM E,DMBUF
MOVE A,[DMBUF,,DMBUF+1]
BLT A,DMBUF+DMBUFL-1
MOVE B,[<BYTE (7) 15,12>+1]
MOVEI C,0
MOVEI D,1
MOVEI A,DMHGT ;LOOP FOR EACH LINE
DMSETL: MOVEM D,DMBUF(C)
MOVEM D,DMBUF+1(C)
MOVEM B,DMBUF+DMWIDW-2(C)
MOVEM D,DMBUF+DMWIDW-1(C)
ADDI C,DMWIDW
SETZM DMUPD-1(A)
SOJG A,DMSETL
MOVEM D,DMXLIN
MOVEM D,1+DMXLIN
MOVEM E,2+DMXLIN
MOVE A,[2+DMXLIN,,2+DMXLIN+1]
BLT A,DMXLIN+DMWIDW-2-1
MOVEM B,DMXLIN+DMWIDW-2
MOVEM D,DMXLIN+DMWIDW-1
DMCURZ: MOVEI A,2 ;BLANK GRAPHICS WORD
MOVEM A,DMCURP+2
MOVE A,[DMCURP+2,,DMCURP+3]
BLT A,DMCURP+2+=16-1
POPJ P,
DMCLR: SKIPN DMSIMF
POPJ P,
SETZM DMSIMF
SKIPE DDDPY ;SKIP IF NOT DATA DISC
DDUPG DMHDRE ;ERASE THE DD SCREEN
LEYPOS 0 ;BACK ON SCREEN
PPACT 400000 ;GET PP0 BACK
HRROI A,[4000,,400+"P"] ;BREAK P
TTYSET A,
POPJ P,
;GET HERE FROM MAIN LOOP WITH NEW CHARACTER IN A
DMSIM: CAIGE A,40
JRST @DMSIMT(A) ;DISPATCH ON CHARACTER
DMSIM0: AOS DMLSCR ;LAST CHARACTER WAS NOT CR
CAIN A,176 ;ASCII TILDE
MOVEI A,"~" ;BECOMES STANFORD TILDE
CAIN A,175 ;ASCII RIGHT BRACE
MOVEI A,176 ;BECOMES STANFORD RIGHT BRACE
CAIN A,177
MOVEI A,"⊗" ;PRINT RANDOM CHAR FOR RUBOUT
SKIPE DMDLMD ;SKIP IF NOT IN INSERT/DELETE MODE
JRST DMSIMI ;INSERT PRINTING CHARACTER AT CURSOR
DMSIM2: PUSH P,XCUR
PUSHJ P,DMSTOR
POP P,A
CAMN A,XCUR
JRST DMFS2 ;NOW WE HAVE WRAPPED AROUND
DMNOWR: SETZM DMIGCR ;LAST CHAR DIDN'T WRAP AROUND
JRST TRYTTY
DMSIMT: TRYTTY ;0
DMALPH ;1
400000,,DMHOME ;2
DMALPH ;3
DMALPH ;4
DMALPH ;5
DMALPH ;6
DMPI ;7
DMBS ;10
DMTAB ;11
DMLF ;12
DMALPH ;13
400000,,DMFF ;14
DMCR ;15
DMBO ;16
DMALPH ;17
DMDLE ;20
DMALPH ;21
DMALPH ;22
DMALPH ;23
DMALPH ;24
DMALPH ;25
DMALPH ;26
DMETB ;27
400000,,DMCAN ;30
DMALPH ;31
DMSUB ;32
DMESC ;33
DMFS ;34
DMGS ;35
400000,,DMRS ;36
400000,,DMRS ;37
DMESC: JSR DMDSP ;GET NEXT CHAR
SETZM DMDSP
JRST DMSIM0 ;NOW DISPLAY THIS (PERHAPS CONTROL) CHAR
DMTAB: MOVEI A,7
IORM A,XCUR ;TO NEXT TAB STOP (PERMANENT TAB STOPS)
JRST DMFS3
DMALPH: JRST TRYTTY ;THIS IS A NO-OP CHAR
DMPI: MOVNI A,1
BEEP A,
JRST TRYTTY
DMHOME: SETZM XCUR
SETZM YCUR
SETZM DMDLMD
JRST DMSIMC
DMBS: SKIPE DMDLMD
JRST DMBS1
SOSGE XCUR
SETZM XCUR
JRST DMSIMC
DMBS1: PUSHJ P,DMLSHF ;SHIFT THE LINE LEFT
JRST DMSIMX
DMLF: SETZM DMIGCR ;HAVEN'T JUST WRAPPED AROUND NOW
SKIPE DMDLMD
JRST DMLF3
AOSN DMLSCR
JRST TRYTTY
DMLF1: SETOM DMCURC
AOS A,YCUR
CAIGE A,DMHGT
JRST TRYTTY
SKIPN DMROLL
JRST DMLF2
SOS YCUR
PUSHJ P,DMROL
JRST TRYTTY
DMLF2: SETZM YCUR
JRST TRYTTY
DMLF3: PUSHJ P,DMAROW
JRST DMSIMX
;ABSOLUTE POSITIONING HACK
DMFF: JSR DMDSP ;READ THE NEXT CHARACTER
JUMPE A,DMFF ;FLUSH NULLS
SETZM DMDSP
CAIGE A,40
SKIPL DMSIMT(A)
CAIA
JRST @DMSIMT(A) ;THIS CHAR INTERRUPTS POSITIONING SEQUENCE
XORI A,140
CAIL A,DMCHAR
MOVEI A,0
MOVEM A,XCUR
DMFF3: JSR DMDSP ;GET THE Y POSITION
JUMPE A,DMFF3
SETZM DMDSP
CAIGE A,40
SKIPL DMSIMT(A)
CAIA
JRST @DMSIMT(A) ;THIS CHAR INTERRUPTS POSITIONING SEQUENCE
XORI A,140
CAIL A,DMHGT
MOVEI A,0
MOVEM A,YCUR
JRST DMSIMC
DMCR: AOSN DMIGCR ;DID WE JUST WRAP AROUND?
JRST TRYTTY ;YES, IGNORE THIS CR
DMCR1: SETZM XCUR
SETOM DMLSCR
JRST DMLF1
DMBO: JRST TRYTTY ;IGNORE BLINK ON
DMDLE: SETOM DMDLMD ;SET INSERT/DELETE MODE
JRST TRYTTY
DMFS: SKIPE DMDLMD
JRST DMFS1
DMFS3: SETOM DMCURC
AOS A,XCUR
CAIGE A,DMCHAR
JRST DMNOWR
DMFS2: SETOM DMIGCR ;IGNORE NEXT CHAR IF CR
JRST DMCR1 ;NOW GENERATE AUTO LF
DMFS1: PUSHJ P,DMRSHF ;SHIFT THE LINE RIGHT
JRST DMSIMX
DMSUB: SKIPE DMDLMD
JRST DMSUB1
SOSGE YCUR
SETZM YCUR
DMSIMC: SETOM DMCURC
DMSIMX: SETZM DMIGCR
AOS DMLSCR
JRST TRYTTY
DMSUB1: PUSHJ P,DMDROW ;DELETE A ROW
JRST DMSIMX
;ERASE TO END OF LINE
DMETB: PUSH P,XCUR
DMET1: MOVEI A,40
PUSH P,XCUR
PUSHJ P,DMSTOR
POP P,A
CAME A,XCUR
JRST DMET1
POP P,XCUR
JRST TRYTTY
;LEAVE ALL MODES (INCLUDING ROLL AND INSERT/DELETE)
DMCAN: SETZM DMROLL
SETZM DMDLMD
JRST TRYTTY
;ROLL ON
DMGS: SETOM DMROLL
JRST TRYTTY
;RESET SCREEN
DMRS: SETZM XCUR
SETZM YCUR
SETZM DMDLMD
PUSHJ P,DMRST
SETOM DMALL
JRST DMSIMX
DMDSP: 0
JRST TRYTTY
;STORE CHARACTER IN A AT CURSOR POSITION SPECIFIED BY XCUR AND YCUR
DMSTOR: MOVE B,YCUR ;LINE NUMBER
SETOM DMUPD(B) ;INDICATE SOMETHING HAS CHANGED ON THIS LINE
SETOM DMUPDF ;AND THAT SOMETHING HAS CHANGED AT ALL
IMULI B,DMWIDW ;NUMBER OF WORDS PER LINE
MOVE C,XCUR
IDIVI C,5
ADDI B,2+DMBUF(C)
DPB A,DMBPTR(D)
AOS B,XCUR
CAIL B,DMCHAR
SOS XCUR
POPJ P,
DMBPTR: POINT 7,(B),6
POINT 7,(B),13
POINT 7,(B),20
POINT 7,(B),27
POINT 7,(B),34
DMCHK: AOSE DMALL
JRST DMCHK2
SETZM DMUPDF
SETZM DMUPD
MOVE A,[DMUPD,,DMUPD+1]
BLT A,DMUPD+DMHGT-1
DDUPG DMHDR ;POOT OUT THE WHOLE THING
DMCURD: PUSHJ P,DMERCU ;ERASE PREVIOUS CURSOR
MOVE A,XCUR ;HORIZONTAL CHARACTER POSITION
IMULI A,6 ;HORIZONTAL BIT POSITION
ADDI A,2 ;FUDGE FOR GRAPHICS MODE
IDIVI A,=32
MOVN B,B
MOVSI C,740000
LSH C,(B)
LDB D,[POINT 3,C,34]
ROT D,-3
ANDCMI C,17
IORI C,2
IORI D,2
MOVEM C,DMCURP+2(A)
MOVEM D,DMCURP+3(A)
MOVE A,YCUR
MOVEM A,LYCUR
PUSHJ P,DMCYST ;GENERATE Y POSITION FOR CURSOR
DDUPG DMCHDR ;CLEAR THE PREVIOUS CURSOR
POPJ P,
DMCHK2: AOSE DMUPDF
JRST DMCHK3
MOVSI A,-DMHGT
DMCHK1: SKIPE DMUPD(A)
PUSHJ P,DMDLIN ;OUTPUT THIS LINE
AOBJN A,DMCHK1
JRST DMCURD
DMDLIN: SETZM DMUPD(A)
HRRZ B,A ;LINE NUMBER
IMULI B,DMWIDW
ADDI B,DMBUF ;ADDRESS OF BEGINNING OF THE LINE
HRRM B,DMLHDR
MOVEM B,DMLHDR+3
HRRZ C,A
IMULI C,=12
ADDI C,=36+=12+=12 ;STARTING RASTER NUMBER FOR THIS LINE
MOVE D,[DDCMD(1,46,4,0,5,0)]
DPB C,[POINT 4,D,23] ;STORE LOW 4 BITS OF LINE ADDRESS
LSH C,-4
DPB C,[POINT 5,D,15] ;STORE HIGH 5 BITS OF LINE ADDRESS
MOVEM D,(B)
MOVE D,[DDCMD(3,2,3,2,3,2)] ;GO TO COLUMN 2
MOVEM D,1(B)
SETZM DMWIDW-1(B) ;CLEAR EXTRA WORD AT END OF LINE
DDUPG DMLHDR
MOVEI D,1
MOVEM D,(B)
MOVEM D,1(B)
AOS DMWIDW-1(B) ;PUT IT BACK AS 5 NULLS
POPJ P,
DMLHDR: 200000,,0
DMWIDW
0
0 ;CLOBBERED BY DMDLIN
;ERASE THE PREVIOUS CURSOR
DMERCU: PUSHJ P,DMCURZ ;CLEAR THE CURSOR LINE
SKIPGE A,LYCUR
POPJ P, ;THERE WAS NO PREVIOUS CURSOR
PUSHJ P,DMCYST ;SET UP DISPLAY PROGRAM Y POSITION
DDUPG DMCHDR ;CLEAR THE PREVIOUS CURSOR
POPJ P,
DMCYST: IMULI A,=12
ADDI A,=36+=12+=12+=10
DPB A,[POINT 4,DMCURP+1,23]
LSH A,-4
DPB A,[POINT 5,DMCURP+1,15]
POPJ P,
DMCHK3: AOSE DMCURC
POPJ P,
JRST DMCURD
;ROLL THE SCREEN UP BY ONE
DMROL: MOVE A,[DMBUF+DMWIDW,,DMBUF]
BLT A,DMBUF+DMBUFL-DMWIDW-1
MOVE A,[ASCID / /]
MOVEI B,DMCHAR/5
DMROL1: MOVEM A,DMBUF+DMBUFL-DMWIDW+2-1(B)
SOJG B,DMROL1
SETOM DMALL ;REDISPLAY WHOLE SCREEN
POPJ P,
DMSROL: SKIPN CTRL1
SETOM DMROLL
SKIPE CTRL1
SETZM DMROLL
JRST CLOOP
DMSIMI: PUSH P,A
PUSHJ P,DMRSHF ;SHIFT LINE RIGHT STARTING AT CURSOR
POP P,A
JRST DMSIM2 ;STOR CHARACTER AT CURSOR AND BUMP CURSOR
;RIGHT SHIFT LINE YCUR STARTING FROM XCUR. PUT BLANK IN HOLE.
DMRSHF: MOVE A,YCUR
IMULI A,DMWIDW
MOVE D,A
ADDI D,DMBUF+DMWIDW-3 ;ADDRESS OF LAST TEXT WORD IN THE LINE
MOVE B,XCUR
IDIVI B,5
ADDI A,DMBUF+2(B) ;ADDRESS OF WORD CONTAINING CURSOR
LDB B,[POINT 7,(A),34] ;FIRST CHAR FOR NEXT WORD
LDB E,[ POINT 28,(A),27
POINT 21,(A),27
POINT 14,(A),27
POINT 7,(A),27
POINT 0,(A),27 ](C)
DPB E,[ POINT 28,(A),34
POINT 21,(A),34
POINT 14,(A),34
POINT 7,(A),34
POINT 0,(A),34 ](C)
MOVEI E,40
DPB E,[ POINT 7,(A),6
POINT 7,(A),13
POINT 7,(A),20
POINT 7,(A),27
POINT 7,(A),34 ](C)
JRST DMRSH1
;EACH TIME AROUND THE LOOP B HAS CHAR FROM PREV WORD, A HAS ADDR OF NEXT WORD
DMRSH2: MOVE C,B
LDB B,[POINT 7,(A),34] ;FIRST CHAR FOR NEXT WORD
DPB C,[POINT 7,(A),35]
MOVE C,(A)
ROT C,-7
IORI C,1
MOVEM C,(A)
DMRSH1: CAME A,D ;AT LAST ADDRESS YET?
AOJA A,DMRSH2 ;NO
SETOM DMUPDF
MOVE A,YCUR
SETOM DMUPD(A)
POPJ P,
;LEFT SHIFT LINE YCUR STARTING FROM XCUR. PUT BLANK IN COLUMN 80.
DMLSHF: MOVE A,YCUR
IMULI A,DMWIDW
MOVE D,A
ADDI D,DMBUF+DMWIDW-3 ;ADDRESS OF LAST TEXT WORD IN THE LINE
MOVE B,XCUR
IDIVI B,5
ADDI A,DMBUF+2(B) ;ADDRESS OF WORD CONTAINING CURSOR
LDB E,[ POINT 28,(A),34
POINT 21,(A),34
POINT 14,(A),34
POINT 7,(A),34
POINT 0,(A),34 ](C)
DPB E,[ POINT 28,(A),27
POINT 21,(A),27
POINT 14,(A),27
POINT 7,(A),27
POINT 0,(A),27 ](C)
JRST DMLSH1
;EACH TIME AROUND THE LOOP A HAS ADDR OF NEXT WORD
DMLSH2: LDB B,[POINT 7,(A),6] ;LAST CHAR FOR PREVIOUS WORD
DPB B,[POINT 7,-1(A),34]
LDB B,[POINT 28,(A),34]
DPB B,[POINT 28,(A),27]
DMLSH1: CAME A,D ;AT LAST ADDRESS YET?
AOJA A,DMLSH2 ;NO
MOVEI B,40
DPB B,[POINT 7,(A),34] ;BLANK IN COLUMN 80
SETOM DMUPDF
MOVE A,YCUR
SETOM DMUPD(A)
POPJ P,
;DELETE THE ROW AT THE CURSOR. MOVE EXTRA LINE IN AT BOTTOM.
DMDROW: MOVE A,YCUR
CAIN A,DMHGT-1 ;SKIP UNLESS ON BOTTOM LINE
JRST DMDRO1 ;ON BOTTOM, JUST COPY EXTRA LINE IN
IMULI A,DMWIDW
ADDI A,DMBUF ;ADDRESS OF FIRST WORD OF LINE CONTAINING CURSOR
MOVEI B,(A)
ADDI B,DMWIDW ;ADDRESS OF NEXT LINE
HRLI A,(B) ;MAKE A BLT POINTER
BLT A,DMBUF+(DMHGT-1)*DMWIDW-1 ;COPY THE LINES
DMDRO1: MOVE A,[DMXLIN,,DMBUF+(DMHGT-1)*DMWIDW]
BLT A,DMBUF+DMHGT*DMWIDW-1
MOVE A,[ASCID / /]
MOVEM A,2+DMXLIN
MOVE A,[2+DMXLIN,,2+DMXLIN+1]
BLT A,DMXLIN+DMWIDW-3
SETOM DMALL ;REDISPLAY ALL
POPJ P,
;ADD A ROW AT THE CURSOR. MOVE EXTRA LINE IN AT BOTTOM.
DMAROW: MOVE A,[DMBUF+(DMHGT-1)*DMWIDW,,DMXLIN]
BLT A,DMXLIN+DMWIDW-1 ;COPY LAST LINE TO EXTRA LINE
MOVE A,YCUR
CAIN A,DMHGT-1 ;SKIP UNLESS ON BOTTOM LINE
JRST DMARO2 ;ON BOTTOM, JUST COPY LAST LINE INTO EXTRA LINE
IMULI A,DMWIDW
ADDI A,DMBUF ;ADDRESS OF FIRST WORD OF LINE CONTAINING CURSOR
MOVE B,[DMBUF+(DMHGT-2)*DMWIDW,,DMBUF+(DMHGT-1)*DMWIDW]
DMARO1: MOVE C,B
BLT C,DMWIDW-1(B) ;COPY ONE LINE
SUB B,[DMWIDW,,DMWIDW]
CAIE A,(B)
JRST DMARO1
DMARO2: MOVE B,[ASCID / /]
MOVEM B,2(A)
MOVEI B,DMWIDW-2-1(A)
ADDI A,3
HRLI A,-1(A)
BLT A,(B)
SETOM DMALL
POPJ P,
>;DMFLG
;DMHDR DMPROG DMBUF DMXLIN XCUR YCUR LYCUR DMHDRE DMPRGE DMCHDR DMCURP DMUPD DMUPDF DMALL DMCURC DMROLL DMDLMD
;DATAMEDIA DATA AREA
IFN DMFLG,<
DMBUFL←←DMHGT*(DMCHAR/5+4) ;+1 FOR CR LF +1 FOR NULLS OR HALT +2 FOR HEADER
DMHDR: 200000,,DMPROG ;TWO FIELD MODE
DMPRGL
0
DMPROG
DMPROG: DDCMD(1,46,4,2,5,4) ;LINE ADDRESS 44 ( = 2⊗4+4) OCTAL (=36)
DDCMD(3,=30,3,=30,3,=30);GO TO COLUMN 30
ASCID /Datamedia Simulator
--------------------------------------------------------------------------------
/
DMBUF: BLOCK DMBUFL
ASCID /--------------------------------------------------------------------------------
/
0
DMPRGL←←.-DMPROG
DMXLIN: BLOCK 2+DMCHAR/5+1+1 ;EXTRA LINE AT END OF DISPLAY
XCUR: 0 ;CURSOR POSITION, 0 IS FIRST ROW
YCUR: 0 ;CURSOR POSITION, 0 IS FIRST COL
LYCUR: -1 ;LAST Y CURSOR POS
DMHDRE: DMPRGE ;ERASE THE SCREEN
DMPREL
0
0
DMPRGE: DDCMD(1,17,1,17,2,0) ;ERASE THE SCREEN
0
DMPREL←←.-DMPRGE
DMCHDR: DMCURP ;CURSOR
DMCURL
0
DMCURP+1
DMCURP: DDCMD(1,7,1,7,1,7)
DDCMD(3,1,4,0,5,0)
BLOCK =16 ;ALL GRAPHICS COLUMNS
DDCMD(0,0,1,46,1,46) ;EXECUTE
0
DMCURL←←.-DMCURP
DMUPD: BLOCK DMHGT ;-1 IF THIS LINE HAS CHANGED
DMUPDF: 0 ;-1 IF SOMETHING HAS CHANGED ANYWHERE
DMALL: 0 ;-1 IF UPDATE ENTIRE SCREEN
DMCURC: 0 ;-1 IF UPDATE CURSOR
DMROLL: -1 ;-1 FOR ROLLING 0 FOR WRAPAROUND
DMDLMD: 0 ;-1 FOR INSERT/DELETE MODE
>;DMFLG
;ttyout ttydpb ttyowr TTYOCC ttyotb ttyobs ttyocr ttyoig ttyofs ttyohu ttyohd ttyolf ttyoup ttyocp ttyoc3 ttyoc1 ttyoc2 ttyocl ttyoc4 TTYOABS DPTGET tbufin
;DATAPOINT OUTPUT ROUTINE
;output char in ac1 to tty. clobbers ac1 thru ac4 in datapoint simulation.
DPT,{
ttyout:
IFN DPTABS,<
SKIPE AC2,DPTOPC ;Do co-routining (TVR May76)
JRST (AC2)
>;IFN DPTABS
cain ac1,"π" ;pi rings da bell in datapoint sim mode
jrst [push p,↔seto↔beep↔pop p,↔popj p,]
caige ac1,40 ;control chars do special things.
jrst @ttyocc(ac1)
cain ac1,177
jrst ttyoign
move ac2,tthpos ;ordinary char: space forward.
caige ac2,chrlin-1
aos tthpos ;unless already at margin.
idivi ac2,5 ;figure out what word in ttbufb to mung.
move ac4,ttvpos
imuli ac4,ttvpml; times words per line
add ac2,ac4
cain ac1,40 ;don't display erasures
jrst ttydpb
move ac4,ttvpos
came ac4,ttvlst ;does this go to a new line?
skipe ttyoip
jrst ttydpb
pushj p,ttyowr ;output screen before going to new line
ttydpb: dpb ac1,ttyotb(ac3) ;store the char in ttbufb.
setom ttyorq ;say screen has been altered since written.
popj p,
ttyowr: setzm ttyorq
move ac4,ttvpos
movem ac4,ttvlst
upgiot ttyobk
popj p,
TTYOCC: repeat 10,<ttyoign>
ttyobs
ttyoign
ttyolf
ttyoign
ttyoign
ttyocr ;↑m
IFN DPTABS,< ;Add absolute cursor positioning (TVR May76)
ttyoign
ttyoabs ;↑O (Not really a datapoint command, see below)
repeat 130-"P",<ttyoign>
>;IFN DPTABS
IFE DPTABS,<
repeat 130-"N",<ttyoign>
>;IFE DPTABS
ttyofs ;30
ttyoign
ttyoup
ttyoign
ttyohd
ttyohu
ttyocl
ttyocp ;37
ttyotb: point 7,@ttbuft,6
point 7,@ttbuft,13
point 7,@ttbuft,20
point 7,@ttbuft,27
point 7,@ttbuft,34
ttyobs: sosge tthpos ;↑h -- move back unless at start of line.
ttyocr: setzm tthpos ;↑m -- move to start of line.
ttyoig: popj p,
ttyofs: move ac2,tthpos ;↑x -- move forward unless at end of line.
caige ac2,chrlin-1
aos tthpos
popj p,
ttyohu: setzm ttvpos ;↑] -- home up.
jrst ttyocr
ttyohd: movei ac2,linpag-1;↑\ -- home down.
movem ac2,ttvpos
jrst ttyocr
ttyolf: aos ac2,ttvpos ;↑j -- move down 1 line, wrapping around.
cain ac2,linpag
setzm ttvpos ;wrap at lines/page
popj p,
ttyoup: movei ac2,linpag-1;↑z -- move up, wrapping around at top.
sosge ttvpos
movem ac2,ttvpos
popj p,
ttyocp: push p,tthpos ;↑← -- clear to eof, not changing cursor pos.
push p,ttvpos
ttyoc3: move ac2,ttvpos ;when reach bottom of screen, finished.
cain ac2,linpag
jrst ttyoc1
pushj p,ttyocl ;else clear 1 more line
setzm tthpos ;and move down to the next.
aos ttvpos
jrst ttyoc3
ttyoc1: pop p,ttvpos
ttyoc2: pop p,tthpos
popj p,
ttyocl: push p,tthpos ;↑↑ -- clear to end of line, not changing pos.
ttyoc4: movei ac1,40 ;do it by writing spaces thru rest of line.
move ac2,tthpos
cail ac2,chrlin-1
jrst [ pushj p,ttyout ;clear last space
jrst ttyoc2] ;until get to right margin.
pushj p,ttyout
jrst ttyoc4
;Absolute cursor addressing for UCB's editor (TVR May76)
; ↑O <row>+40 <column>+40
IFN DPTABS,<
TTYOABS:
PUSHJ P,DPTGET ;Get row count
SUBI AC1,40
SKIPL AC1 ;Check number lines
CAILE AC1,LINPAG-1
MOVEI AC1,LINPAG-1 ;Use upper limit
MOVEM AC1,TTVPOS
PUSHJ P,DPTGET ;Get column count
SUBI AC1,40
SKIPL AC1 ;Check column number
CAIL AC1,CHRLIN-1
MOVEI AC1,CHRLIN-1 ;Use upper limit
MOVEM AC1,TTHPOS ;Set column position
SETZM DPTOPC ;No longer co-routining
POPJ P,
;Fake co-routines
DPTGET: POP P,DPTOPC ;Where to continue
POPJ P, ;Return to main control flow
>;IFN DPTABS
;initialize buffer
tbufin: hrrz ac2,ttbuft ;get loc of first text line
move ac1,[<byte(7)40,40,40,15,12>+1]
movem ac1,ttvpml-1(ac2) ;store spaces and crlf in last word of line
move ac1,[ascid/ /] ;5 spaces
movem ac1,(ac2)
movei ac1,1(ac2)
hrl ac1,ac2
blt ac1,ttvpml-2(ac2) ;fill line with spaces
hrrz ac2,ttbuft ;get text buffer pointer
movei ac1,ttvpml(ac2)
hrl ac1,ac2
blt ac1,tbufsz-wrdset-1(ac2) ;fill whole buffer with blank lines
popj p,
};DPT
;INAGN impget impout impou1 NOOCON ZERPAR impouu impoug impodb impod1 outagn allocs OUTERR INPERR
; IMP single character input and output, IMPGET, IMPOUT
NOPTY,<
ISDIAL,<
INAGN: AOS IBUF+2 ;BUGGER FOR TEST
>;ISDIAL
impget: sosg ibuf+2
in imp,
caia
jrst inperr
ildb ac1,ibuf+1
ISNEWP,<
skipe nwptcm
popj p, ;don't mung char if it is part of a command
>;ISNEWP
IFN DMFLG,<
SKIPE DMSIMF ;Don't do any conversion yet if simulating a DM
POPJ P, ;DMSIM DOES ITS OWN CHAR CONVERSION
>;DMFLG
ISDIAL,<
SKIPE TRANSP ;no conversion in transparent mode
POPJ P,
>;ISDIAL
cain ac1,176
movei ac1,"~"
cain ac1,175
movei ac1,"{ }"&177
cain ac1,33
movei ac1,175
; cain ac1,177 ; SOMEONE IS SENDING A BACK-SPACE?
; movei ac1,"β" ; CHANGE IT TO SOMETHING HARMLESS
IFN FTPCOM,<
SKIPE CIDEBG ;BH 12/10/77 TYPE ALL INPUT IF DEBUGGING
OUTCHR AC1
>;FTPCOM
popj p,
impout: sosg obuf+2 ; OUTPUT CHR IN AC1 ON IMP CONTROL CHANNEL
pushj p,impoug ; MAY ALSO CLOBBER AC2
impou1:
IFN FTPCOM,<
SKIPE CIDEBG ;BH 12/10/77 TYPE ALL INPUT IF DEBUGGING
OUTCHR AC1
>;FTPCOM
push p,ac1
ISDIAL,<
SKIPE TRANSP ;no conversion in transparent mode
JRST NOOCON ;no output conversion
>;ISDIAL
cain ac1,175 ; STANFORD ALT-MODE?
movei ac1,33 ; YES, MAKE IT CONVENTIONAL ALT-MODE
cain ac1,"{ }"&177 ;MAINTAIN BROKCT (SIGH)
movei ac1,175
cain ac1,"~"
movei ac1,176
ISDIAL,<
NOOCON: SKIPN GENPAR ;skip if want parity generated
JRST ZERPAR ;use zero parity
PUSH P,AC2
MOVE AC2,AC1 ;GENERATE EVEN PARITY BIT (MODEL 37)
IMULI AC2,200401 ;SEE PDP-10 SYSTEM REFERENCE MANUAL.
AND AC2,[ 11111111] ;FORM 8 COPIES OF ORIGINAL BITS
IMUL AC2,[ 11111111] ;ADD 8 BITS TOGETHER
TLNE AC2,10 ;TEST PARITY OF SUM
TRO AC1,200 ;PARITY IS ODD, MAKE IT EVEN
POP P,AC2
ZERPAR:
>;ISDIAL
idpb ac1,obuf+1
pop p,ac1
andi ac1,377 ; stop faking out cains (with 1000 bit)
IFE FTPCOM,<
aos ac2,notsnt ;check if we're going to hang if we send more
NODIAL,<
imuli ac2,10 ;eight bit bytes
mtape imp,allocs
sub ac2,allocs+7
movns ac2 ;bits left in allocation
setom nearly#
caig ac2,2*=36 ;leave room for couple of words
jrst impouu
move ac2,allocs+10 ;no. of messages
caig ac2,2 ;at least two
jrst impouu
setzm nearly
>;NODIAL
skipn spcin ;try to break every once in a while
skipn fcsf ;In line mode?
caia ;yes, maybe should send this stuff now
popj p, ;no, will activate when all chrs are eaten
cain ac1,175 ;altmode typed?
jrst impouu ;yes, send
NODIAL,<
caie ac1,15 ;if cr then there is a lf coming
>;NODIAL
caile ac1,37 ;but send all other ASCII ctrl chars right away
>;NOT FPTCOM--NB: CLOBBERING AC2 HERE WILL SCREW UP FNSEND
IFN FTPCOM,<
caie ac1,12 ;FTP is simple
>;FTPCOM
popj p,
NODIAL,<setom nearly>
impouu:
NODIAL,<
push p,ac2
push p,ac3
ldb ac2,[410300,,obuf+1] ;position field (0, 1, 2, or 3)
movei ac3,1
lsh ac3,(ac2)
subi ac3,1
iorm ac3,@obuf+1
pop p,ac3
pop p,ac2
>;NODIAL
impoug:
DEB,<
push p,ac1
push p,ac2
outstr [asciz / {/]
move ac1,notsnt
pushj p,[impdpt:idivi ac1,=10
hrlm ac2,(p)
skipe ac1
pushj p,impdpt
hlrz ac1,(p)
addi a,"0"
outchr a
popj p,]
SKIPN NOTSNT ;Anything to send?
JRST IMPOD1 ; No, don't print randomness (TVR May76)
outchr [":"]
impodb: ildb ac1,debptr
trne ac1,200
jrst [ outchr ["<"]
pushj p,impdpt
outchr [">"]
jrst impod1]
cain ac1,15
jrst [ outstr [asciz /<CR>/]
jrst impod1]
cain ac1,12
jrst [ outstr [asciz /<LF>
/]
jrst impod1]
outchr ac1
impod1: move ac1,debptr
came ac1,obuf+1
jrst impodb
outstr[asciz /} /]
pop p,ac2
pop p,ac1
>;DEB
setzm notsnt ;ok, we're sending everything
outagn: out imp,
aosa obuf+2
jrst outerr
DEB,<
push p,obuf+1
pop p,debptr#
>;DEB
popj p,
NODIAL,<
allocs: =14
block 10
>;NODIAL
ISDIAL,<
OUTERR: OUTSTR[ASCIZ/Output error/]
PUSHJ P,ERRSTP
JRST OUTAGN ;DRY OUTPUT WON'T HURT
INPERR: OUTSTR[ASCIZ/Input error/]
PUSHJ P,ERRSTP
JRST INAGN
>;ISDIAL
>;NOPTY
;contch CONTC1 CONTC2 intcnc intcng
; Special character dispatches CONTCH
IFE FTPCOM,<
contch: skipe echof ;echoing may have been turned off if escape
ptjobx [0 ↔ sixbit /DON/] ;char was typed on non-display
ISBUCKY,<
SKIPE PTYQUO
JRST CHOUT1
SKIPE TRANSM
JRST CONTC1 ;TRANSPARENT MODE
>;ISBUCKY
trne ac1,400
jrst intcnc ; <ctrl-1> means send control character
andi ac1,177
caie ac1,12
cain ac1,15
jrst chout
caig ac1,"z"
caige ac1,"a"
caia
subi ac1,"a"-"A"
SUBI AC1,100
JUMPLE AC1,CLOOP
IORI AC1,1000 ;FAKE OUT CAIN'S
JRST CHOUT
ISBUCKY,<
CONTC1: TRNN AC1,400
JRST CHOUT1 ;CTRL BUT NOT META IN TRANS MODE--JUST SEND CHR
LDB AC3,[000700,,AC1]
CAIL AC3,"a"
CAILE AC3,"z"
CAIA
SUBI AC3,40
CAIN AC3,"Z"
JRST CONTC2 ;SET PTYQUO
CAIN AC3,"M"
TRNN AC1,200
JRST CHOUT1 ;SEND CHARACTER RIGHT THROUGH AND CLEAR PTYQUO
SETZM TRANSM ;CTRL-META M
NONEWP,<
JRST CLOOP
>;NONEWP
ISNEWP,<
JRST MC2 ;Tell host we're not sending bucky bits (TVR May76)
>;ISNEWP
CONTC2: SETOM PTYQUO
JRST CHO1
> ;ISBUCKY
intcnc: setzm ctrl1 ;assume not CONTROL bit (just META)
trne ac1,200
setom ctrl1 ;flag indicating CONTROL bit on, for cmd routines
andi ac1,177
caig ac1,"z"
caige ac1,"a"
jrst intcng
subi ac1,"a"-"A"
intcng: cail ac1,"0" ; Is it a number?
caile ac1,"9"
jrst notnum ; No
skipge ac2,numarg
setz ac2,
lsh ac2,3
addi ac2,-"0"(ac1)
movem ac2,numarg
jrst cloop
;notnum cmtbl cmdsp
; <META> character not a number
notnum: seto ac2,
exch ac2,numarg
movsi ac3,-ncmds
came ac1,cmtbl(ac3)
aobjn ac3,.-1
jumpl ac3,@cmdsp(ac3)
jrst cloop
cmtbl:
ISNEWP,<"A" > ;abort output
ISDIAL,<"B" > ;set baud rate on tty
ISNEWP,<"B" > ;send break
NOPTY,< "C" > ;send INS
"D" ;output to file on or off
"E" ;set echo mode
"F" ;extend old output file
"G" ;beep for incoming π
"I" ;input from file on or off
ISDIAL,<"J" > ;wait for echo of last character before sending next
"L" ;set line mode
ISBUCKY,<"M" > ;send ctrl, meta chars through
"O" ;turn typeout on or off
ISDIAL,<"P" > ;diddle parity handling
"Q" ;terminate connection
IFN DMFLG,<"R" >
"S" ;send stuff now without numeric arg if non zero
ISDIAL,<"T" > ;enter or leave transparent mode
IFN DMFLG,<"V" > ;turn on or off DM simulator
ISNEWP,<"W" > ;ask "are you there?"
"X" ;set new escape character
DPT,< "Y" > ;datapoint simulation on or off
ISBUCKY,<"Z" > ;quote character (for ctrl-meta m)
ISPTY,< 12 > ;send ctl-meta-lf through to pty
14 ;put form feed in output file
177 ;send rubout through
ncmds←←.-cmtbl
cmdsp:
ISNEWP,<ABORTO > ;A
ISDIAL,<STBAUD > ;B
ISNEWP,<BREAKO > ;B
NOPTY,<NODIAL,<SNDINT;> ISDIAL,<CTLMOD;> >;NOPTY ;C
OFILE ;D
ECHO ;E
XTEND ;F
BEEPX ;G
IFILE ;I
ISDIAL,<SLOW > ;J
SETLM ;L
ISBUCKY,<MC > ;M
TYPEIT ;O
ISDIAL,<DOPAR > ;P diddle parity handling
QUIT ;Q
IFN DMFLG,<DMSROL > ;R
SNDNCR ;S
ISDIAL,<ETRANS > ;T diddle transparent mode
IFN DMFLG,<DMSET > ;V
ISNEWP,<AYTO > ;W
SETESC ;X
DPT,< SETDPT > ;Y
ISBUCKY,<QUOTE > ;Z
ISPTY,< BUCKLF > ;12
FFOUT ;14
CHO ;177
ifn .-cmdsp-ncmds,<error at cmtbl>
;MC MC2 QUOTE CTLMOD FFOUT TYPEIT TYPEI1 echo setech noecho setnoe setesc NOTRAN escchr BEEPX setdpt gotfre clrdpt ttppib BUCKLF
;Command execution
ISBUCKY,<
MC: skipn ctrl1
setom transm ;meta m - set transparent mode
ISNEWP,<
SKIPN EXTAOK ;OK to send bucky bits?
MC2: SKIPE EXTARQ ;Already asking?
JRST CLOOP ;Yes, just switch modes (see CHOUT also)
SETOM EXTARQ ;No, send request for extended ASCII
PUSHJ P,NGEXTA ;Negotiate before sending actual bucky bits
>;ISNEWP
jrst cloop
QUOTE: SETOM PTYQUO
JRST CLOOP
> ;ISBUCKY
;TURN ON OR OFF TYPEOUT OF CONTROL CHARS AND 177
ISDIAL,<
CTLMOD: MOVE AC1,CTRL1
MOVEM AC1,FLUCTL
JRST CLOOP
>;ISDIAL
FFOUT: MOVEI AC1,14
SKIPE SPCOUT
PUSHJ P,SPOUTC
JRST CLOOP
TYPEIT: SKIPE CTRL1
JRST TYPEI1
SETZM NOTYPE ;TURN ON TYPEOUT
JRST CLOOP
TYPEI1: SETOM NOTYPE ;TURN OFF TYPEOUT
JRST CLOOP
echo: skipe ctrl1
jrst noecho
pushj p,setech
jrst cloop
setech:
NONEWP,<
setom echof
ptjobx [0 ↔ sixbit /DON/]
NODIAL,<
NOPTY,<
movei ac1,203 ;tell foreign host to not echo
pushj p,impout
>;NOPTY
>;NODIAL
ISPTY,<
PTGETL LINE
MOVSI AC1,DMLIN
ANDCAM AC1,CHAR ;Don't turn us into a DM accidentally!
MOVSI AC1,FULTWX
IORM AC1,CHAR
PTSETL LINE
>;ISPTY
>;NONEWP
ISNEWP,<
skipn rechof ;send "dont echo" only if he is currently
popj p, ;echoing
setom ecrepn ;indicate expecting "wont echo" reply
movei ac1,iac
pushj p,impout
movei ac1,dont
pushj p,impout
movei ac1,1
pushj p,impout
>;ISNEWP
popj p,
noecho: pushj p,setnoe
jrst cloop
setnoe:
NONEWP,<
setzm echof
ptjobx [0 ↔ sixbit /DOFF/]
NODIAL,<
NOPTY,<
movei ac1,204
pushj p,impout ;tell foreign host to echo
>;NOPTY
>;NODIAL
ISPTY,<
PTGETL LINE
MOVSI AC1,FULTWX!DMLIN ;Don't accidentally turn us into a DM
ANDCAM AC1,CHAR
PTSETL LINE
>;ISPTY
>;NONEWP
ISNEWP,<
skipe rechof ;send "do echo" only if he is currently
popj p, ;not echoing
setom ecrepy ;indicate expecting "will echo" reply
movei ac1,iac
pushj p,impout
movei ac1,do
pushj p,impout
movei ac1,1
pushj p,impout
>;ISNEWP
popj p,
; Set the escape character
setesc: READW(ac1)
ISDIAL,<
SKIPN TRANSP ;skip if in transparent mode
JRST NOTRAN
ANDI AC1,377 ;flush the image mode bit
SKIPN NOEDT ;skip if noedit display -- flush parity bit
SKIPN DMDPY ;skip if EDIT-key dpy (include EDIT key in esc char)
ANDI AC1,177 ;flush the parity bit (no EDIT key)
NOTRAN:
>;ISDIAL
movem ac1,escchr
jrst cloop
escchr: 36 ; Escape character
BEEPX: SKIPN CTRL1
SETOM BEEPC
SKIPE CTRL1
SETZM BEEPC
JRST CLOOP
DPT,{
; complement state of datapoint simulation.
setdpt: skipe ctrl1
jrst clrdpt ;clear datapoint mode
seto ac2,
getlin ac2
aoje ac2,clrdpt ;not if detached
tlnn ac2,DISLIN!DDLIN ;only on III and DD
jrst clrdpt
setzm isiii
tlne ac2,DISLIN ;III or DD
setom isiii ;III
skipe ttpwrd ;any free storage yet?
jrst gotfre ;yes
move ac4,jobff↑
movei ac2,tbufsz-1(ac4) ;last word needed
core ac2, ;get enough core
jrst [ outstr[asciz/Not enough core for display buffer!
/]
jrst clrdpt]
movei ac2,tbufsz(ac4)
movem ac2,jobff
setzm tzwrdi(ac4) ;clear zero word
movei ac2,tbufbi(ac4) ;setup pointers into free space
hrrm ac2,ttbufb
movei ac2,tbufti(ac4)
hrrm ac2,ttbuft
movei ac2,tpwrdi(ac4)
movem ac2,ttpwrd
move ac2,ddfwrd
movem ac2,tbufbi(ac4)
pushj p,tbufin ;initialize buffer
gotfre: hrrz ac4,ttbufb ;get free pointer
skipn isiii
skipa ac2,ddpwrd ;DD
move ac2,iipwrd ;III
movem ac2,tpwrdi(ac4) ;to position word
setom ttdpt
setzm tthpos ;turning it on, cause screen to be cleared.
setzm ttvpos
setzm ttvlst
setzm ttyoip
setom ttyorq ;refresh display
ppact 0
ppinfo ttppib ;remember status of pp1 to restore at setdp1
dpysiz 1001 ;make page printer small
dpypos -740 ;and put it down at bottom.
jrst cloop
clrdpt: skipn ttdpt
jrst cloop ;already off!
setzm ttdpt
ppact 400000
hrrz ac2,ttppib+3
dpysiz (ac2)
hlrz ac2,ttppib+3
addi ac2,1000 ;ppinfo is relative to top of screen, but dpypos
;is relative to middle of screen
dpypos (ac2)
pgclr
jrst cloop
ttppib: block =24
};DPT
ISPTY,<
BUCKLF: MOVEI AC1,412 ;META-LF
SKIPE CTRL1
MOVEI AC1,612 ;CONTROL-META-LF
JRST CHO
>;ISPTY
;quit
> ;END OF {IFE FTPCOM, < ETC. >} - QUIT
; Terminate a connection gracefully
quit:
IFN DMFLG,<
PUSHJ P,DMCLR
>;DMFLG
close imp,
release imp,
releas outfl,
releas infl,
ISDIAL,<
PUSHJ P,CTRANS ; clear transparent mode, if in it
SKIPN NOEXFL ; do we want to detach this TTY
JRST NOEXS1 ; no, skip it
HRROI AC2,NEXCMD ; get the TTYSET command (created back at INITTY)
TTYSET AC2, ; no-exist this tty as we leave...
NOEXS1:
>;ISDIAL
IFN FTPCOM,<
RELEASE DIMP,
RELEASE DOMP,
RELEASE FIMP,3
RELEASE FOMP,3
>;FTPCOM
ISSYS,{ SKIPE SYSMOD
JRST [ PUSHJ P,SYSRST
EXIT]
};ISSYS
NOPTY,<
ife spcl,<jrst rstart>
ifn spcl,<exit> ;special guys just quit
>;NOPTY
ISPTY,< EXIT >
;inpolp sndint ayto breako aborto proto setlm setfcm setfcs setlmb setlmt sndncr
; Control-character dispatches
IFE FTPCOM, <
inpolp:
NOPTY,< pushj p,impouu > ; send all
jrst cloop
; <ctrl>C - send interrupt
NOPTY,<
NODIAL,<
sndint:
NONEWP,<
movei ac1,201
pushj p,impout
move ac1,lss
movem ac1,intb+lsloc
mtape imp,intb
movei ac1,200 ; Send X'80' also
pushj p,impout
jrst inpolp ; Do the output now
>;NONEWP
ISNEWP,<
movei ac1,iac
pushj p,impout
movei ac1,ip
pushj p,impout
move ac1,lss
movem ac1,intb+lsloc
mtape imp,intb ;send INS
movei ac1,iac
pushj p,impout
movei ac1,datam
pushj p,impout
jrst inpolp ;send it now
ayto: movei ac1,ayt
jrst proto
breako: skipa ac1,[break]
aborto: movei ac1,ao
proto: push p,ac1
movei ac1,iac
pushj p,impout
pop p,ac1
pushj p,impout
jrst inpolp ;send it now
>;ISNEWP
>;NODIAL
>;NOPTY
; <ctrl>L - line mode
setlm: skipe ctrl1
jrst setfcm
pushj p,setlmb
IFN DMFLG,<
SKIPE DMSIMF
LEYPOS -540
>;DMFLG
jrst cloop
setfcm: pushj p,setfcs
jrst inpolp
setfcs: setom fcsf
HRROI AC1,[1000,,SPCBRK] ;Turn on this bit
TTYSET AC1,
setact [bsactt] ;and make everything (including backspace) activate
popj p,
setlmb: setzm fcsf
skipn dpy
jrst setlmt ;set line mode on a tty
setact [brktab]
HRROI AC1,[2000,,SPCBRK] ;Turn off this bit
TTYSET AC1,
popj p,
setlmt: setact [ttybrk]
HRROI AC1,[1000,,SPCBRK] ;Turn on this bit
TTYSET AC1,
popj p,
; <meta><number><meta>S - send character code or send now
sndncr: skipl ac1,ac2 ;skip if no numeric argument
jrst chout ;send char code
jrst inpolp ;send now
;spcchr spcnoe spceco spcagn spcnxt spcnx1 nwpttb spchr spchds spcdm spcdn spcdo spcwi spcwo spcexs nwwi nwwi1 nwwi2 nwwo nwwo1 nwex1 nwdo nwdn nwdo2 nwex DOEXTA DOEXT2 DOEXT3 WOEXTA WOEXT2 WOEXT3 NGEXTA
; Special character handler
NOPTY,<
NODIAL,<
spcchr:
NONEWP,<
cain ac1,202 ; Check for no-op
jrst cloop
cain ac1,203
jrst spcnoe
cain ac1,204
jrst spceco
NODEB,< JRST CLOOP ;DCS 4-10-73, USER DON'T NEED TO KNOW.
>;NODEB
DEB,< outstr [asciz /Special char rec = /]
ldb ac2,[point 3,ac1,29]
addi ac2,"0"
outchr ac2
ldb ac2,[point 3,ac1,32]
addi ac2,"0"
outchr ac2
andi ac1,7
addi ac1,"0"
outchr ac1
outstr [asciz /
/]
jrst cloop
>;DEB
IFN RSEXEC,<SPCECO: ;BH 11/16/74 THOSE TURKEYS DO THIS RIGHT OFF>
spcnoe: ;outstr [asciz /
;*** Foreign host has turned off local echoing ***
;/]
setom ctrl1
jrst echo
IFE RSEXEC,<
spceco: ;outstr [asciz /
;*** Foreign host has turned on local echoing ***
;/]
setzm ctrl1
jrst echo
>;¬RSEXEC
>;NONEWP
ISNEWP,<
cain ac1,iac ;new prot command begins with iac
spcagn: setom nwptcm ;indicate that next imp input is part of command
jrst cloop
spcnxt: setzm nwptcm
skipl ac2,nwptex
jrst @nwpttb(ac2)
jumpe ac1,spcagn ;ignore nulls at this point
movsi ac2,-nspcrs
spcnx1: came ac1,spchr(ac2)
aobjn ac2,spcnx1
jumpl ac2,@spchds(ac2)
jrst cloop
nwpttb: nwwi
nwwo
nwdo
nwdn
spchr: datam
will
wont
do
dont
nspcrs←←.-spchr
spchds: spcdm
spcwi
spcwo
spcdo
spcdn
ifn .-spchds-nspcrs,<error at spchds>
spcdm: skipe inscnt
sosa inscnt
setom damflg
jrst cloop
spcdn: skipa ac1,[3]
spcdo: movei ac1,2
jrst spcexs
spcwi: tdza ac1,ac1
spcwo: movei ac1,1
spcexs: movem ac1,nwptex
setom nwptcm
jrst cloop
nwwi: caie ac1,1 ;skip if echo option
jrst nwex1
skipn ecrepy ;skip if expecting this reply
jrst nwwi1 ;they say they want to echo or refuse
setzm ecrepy ;to stop echoing
setom rechof
setzm echof
ptjobx [0 ↔ sixbit /DOFF/]
jrst nwex
nwwi1: skipn ecrepn ;skip if we wanted them to stop echoing
jrst nwwi2 ;but they dont want to
setzm ecrepn
outstr [asciz /
**Foreign host refuses to stop echoing**
/]
jrst nwex
nwwi2: movei ac1,iac ;they have spontaneously decided that they
pushj p,impout ;(don't) want to echo
movei ac1,dont
skipe rechof
movei ac1,do ;give right answer even though this shouldn't
pushj p,impout ;happen
movei ac1,1
pushj p,impout
jrst nwex
nwwo:
caie ac1,1 ;skip if echo option
jrst nwex1
skipn ecrepn ;skip if expecting this reply
jrst nwwo1
setzm ecrepn
setom echof
setzm rechof
ptjobx [0 ↔ sixbit /DON/]
jrst nwex
nwwo1: skipn ecrepy ;skip if expecting "wlii echo" but got "wont"
jrst nwwi2
setzm ecrepy
outstr [asciz /
**Foreign host refuses to echo**
/]
jrst nwex
nwex1: push p,ac1 ;whatever it is, we dont want him to do it
movei ac1,iac
pushj p,impout
movei ac1,dont
pushj p,impout
pop p,ac1
pushj p,impout
jrst nwex
nwdo:
ISBUCKY,<
CAIN AC1,17 ;Extended-ASCII? (TVR Sep75)
JRST DOEXTA ;Yes, think about it
JRST NWDO2 ;Otherwise, don't acknowledge it
>
nwdn:
ISBUCKY,<
CAIN AC1,17 ;Extended-ASCII? (TVR Sep75)
JRST WOEXTA ;Yes, think about it
nwdo2:
>
push p,ac1 ;whatever it is, we wont do it.
movei ac1,iac
pushj p,impout
movei ac1,wont
pushj p,impout
pop p,ac1
pushj p,impout
jrst nwex
nwex: setom nwptex
jrst cloop
ISBUCKY,<
;Host suggests/acknowledges that we can send bucky bits
DOEXTA: SKIPN EXTARQ ;Did we request Extended-ASCII?
JRST DOEXT2
SETZM EXTARQ ;Yes, now enable them
JRST DOEXT3
DOEXT2: MOVEI AC1,IAC ;Spontaneous offering, reply positively
PUSHJ P,IMPOUT
MOVEI AC1,WILL
PUSHJ P,IMPOUT
MOVEI AC1,17 ;(Extended-ASCII)
PUSHJ P,IMPOUT
DOEXT3: OUTSTR[ASCIZ/
*** Host will take bucky bits *** /]
SETOM EXTAOK
JRST CLOOP
;Host refuses to allow us to send bucky bits
WOEXTA: SKIPN EXTARQ ;Did we request Extended-ASCII?
JRST WOEXT2
SETZM EXTARQ ;Yes, now enable them
JRST WOEXT3
WOEXT2: PUSHJ P,NGEXTA ;Spontaneous offering, reply positively
WOEXT3: OUTSTR[ASCIZ/
*** Host not accepting bucky bits *** /]
SETZM EXTAOK
JRST CLOOP
;Send request/acknowledgement
NGEXTA: MOVEI AC1,IAC
PUSHJ P,IMPOUT
SKIPN AC1,TRANSM ;In bucky bit mode? (TVR May76)
SKIPA AC1,[WONT] ; No, say we won't send 'em
MOVEI AC1,WILL ; Yes, say we'll send 'em
PUSHJ P,IMPOUT
MOVEI AC1,17 ;(Extended-ASCII)
PUSHJ P,IMPOUT
POPJ P,
>;ISBUCKY
>;ISNEWP
>;NODIAL
>;NOPTY
;SLOW STBAUD STBAUL STBAUE STBAUS STBAUX ETRANS LTRANS DOPAR ifile ifilec spinc spincl EATLFC spic icf
; Start/stop slow mode (waiting for echo before sending next chr)
ISDIAL,<
SLOW: SKIPE CTRL1
JRST [SETZM SLOWF
SETZM SLOWIT ;just in case we stopped in the middle
JRST CLOOP]
SETOM SLOWF
JRST CLOOP
STBAUD: PTJOBX [0 ↔ SIXBIT /DON/] ;Get our echoing back
MOVE AC7,[-2,,[ 3000,,AC6 ;Save line characteristics in AC6
2000,,SPCBRK]] ;Then turn off these bits
TTYSET AC7,
OUTSTR [ASCIZ/Set baud rate: /]
MOVEI AC4,15 ;make TTYSIX read first character (ignores CR)
PUSHJ P,TTYSIX ;get baud rate into AC3, clobbers AC2,AC4
PUSHJ P,STRIPC ;skip to activation char, return it in AC4
CAIE AC4,12 ;abort unless LF is activator
JRST STBAUE
MOVEI AC2,NSPDS-1 ;index and counter for checking baud rates
STBAUL: CAMN AC3,SPEEDS(AC2) ;baud rate name match?
JRST STBAUS ;yes, set baud rate
SOJGE AC2,STBAUL ;end of table?
OUTSTR [ASCIZ/Bad baud rate.
/]
JRST STBAUX
STBAUE: OUTSTR [ASCIZ/aborted.
/]
JRST STBAUX
STBAUS: MOVE AC2,SPDNUM(AC2) ;get speed number for UUO
PUSHJ P,SETSPD ;set baud rate from AC2
OUTSTR [ASCIZ/(Unexpected error setting baud rate.)
/]
STBAUX: PUSHJ P,RSTX ;restore activation and echoing state (via AC6)
JRST CLOOP
; Enter transparent mode
ETRANS: SKIPE CTRL1 ; skip if βT -- enter transparent mode
JRST LTRANS ; αβT -- leave transparent mode
HRROI AC7,[3000,,AC6] ; get current line characteristics
TTYSET AC7,
CAMN AC6,[-1]
EXIT ; detached, give up
TLNE AC6,DISLIN!DDLIN ; no image mode on DDs and IIIs
JRST CLOOP ; DD or III
SETZM DMDPY ; assume not DM
HRROI AC7,[055000,,NOEDT]
TTYSET AC7, ; get NOEDIT flag (0 or 1)
SETOM TRANSP ; set transparent mode flag
HRROI AC7,[011000,,10]
TTYSET AC7, ; enter image mode
TLNN AC6,DMLIN ; skip if a DM
JRST CLOOP ; not a DM, don't worry about parity or esc char
SETOM DMDPY ; DM
SKIPE NOEDT ; skip unless noedit display
TDZA AC7,AC7 ; no EDIT key, make [NULL] the escape char
MOVEI AC7,200 ; make <EDIT>[NULL] the escape character
MOVEM AC7,ESCCHR ; remember DM's escape character
SKIPN NOEDT ; skip if no EDIT key
SKIPE NOPAR ; EDIT key, skip if haven't diddled parity handling
JRST CLOOP ; don't change parity handling
SETZM GENPAR ; don't generate parity, let EDIT key be it
JRST CLOOP
; Leave transparent mode
LTRANS: PUSHJ P,CTRANS ; clear transparent mode stuff
JRST CLOOP ; return to main activity loop
CTRANS: SKIPN TRANSP ; skip if were in transparent mode
POPJ P, ; nothing to do
SETZM TRANSP ; leave transparent mode
MOVE AC7,[-2,,[012000,,10 ↔ 004000,,"P"]]
TTYSET AC7, ; leave image mode and do [ESCAPE]P
SKIPE DMDPY ; don't diddle parity handling unless DM
SKIPE NOEDT ; and unless also has EDIT key
POPJ P, ; didn't diddle before, don't diddle now
SKIPN NOPAR ; skip if user specified explicit parity handling
SETOM GENPAR ; tell IMPOUT to resume generating parity
POPJ P,
;NOPAR/0 means its never been diddled, default to parity generation except
; in transparent mode on an EDIT-key display.
;NOPAR/negative means user said no parity generation, ever.
;NOPAR/positive means user said generate parity, always.
;GENPAR is nonzero iff IMPOUT should generate parity (else leave par bit alone).
;Here for βP or αβP to diddle parity handling
DOPAR: HRRZM P,NOPAR ; assume βP -- want parity generation
SETOM GENPAR ; assume want parity generated
SKIPN CTRL1 ; skip if αβP
JRST CLOOP
SETOM NOPAR ; αβP -- remember mode: no parity generation
SETZM GENPAR ; tell IMPOUT not to generate parity
JRST CLOOP
>;ISDIAL
; Start input from a file
ifile: skipe ctrl1
jrst ifilec
outstr [asciz /
Input file name: /]
pushj p,rdfile
jrst cloop
init infl,
sixbit /DSK/
ifbuf
0
lookup infl,lblock
jrst [ outstr [asciz /File not found
/]
jrst cloop]
inbuf infl,2
setom spcin
NOPTY,<
setzm lockct
>
jrst cloop
ifilec: pushj p,icf
jrst cloop
spinc:
ISDIAL,<SKIPE SLOWIT ; If a character is waiting,
POPJ P, ; don't get another one.
>
pushj p,spic
popj p, ; Nobody home
move ac2,@ifbuf+1 ; Pick up word this character is in
trnn ac2,1 ; Is it a line number?
jrst EATLFC ; No, give success exit (AFTER CHECKING LF)
movei ac2,6 ; Skip over this many characters
spincl: pushj p,spic
popj p,
sojg ac2,spincl
EATLFC: PUSHJ P,EATLF
JRST SPINC
ISDIAL,<SKIPE SLOWF ; If going slow, remember the character
JRST [SETOM SLOWIT
MOVEM AC1,SLOWC
JRST .+1]
>
SKIPE ECHOF ; IF NOT LOCAL ECHO,
SKIPE NOTYPE ; OR NOT TYPING OUT
JRST CPOPJ1 ; THEN RETURN NOW
DPT,< skipn ttdpt >
OUTCHR AC1
DPT,< PUSHJ P,TTYOUT >
JRST CPOPJ1
spic: sosg ifbuf+2
in infl,
jrst [ ildb ac1,ifbuf+1
jumpe ac1,spic
aos (p)
popj p,]
icf: setzm spcin
close infl,
releas infl,
popj p,
;ofile spcook ofilec ofilc1 spoutc xtend xtend2 xtend1 socmsg socms1 socmsx socsiy socsix
; Dump IMP input on a file
ofile: skipe ctrl1
jrst ofilec
skipn spcout
jrst spcook
outstr [asciz /
Output file already open.
Do you wish to take back that last command? /]
pushj p,rdfile
jrst spcook
move ac1,lblock
camn ac1,[sixbit /Y/]
jrst cloop
spcook: outstr[asciz /
Output file name: /]
pushj p,rdfile
jrst cloop
init outfl,
sixbit /DSK/
xwd ofbuf,0
0
move ac1,[lblock,,soblk]
blt ac1,soblk+3
enter outfl,lblock
jrst [ outstr [asciz /Can't ENTER file
/]
jrst ofilc1]
outbuf outfl,2
setom spcout
setom outdon
NOPTY,<
setzm lockct
>
jrst cloop
ofilec: skipe spcout
pushj p,[ outstr [asciz /Closing output file /]
jrst socmsg ]
skipn spcout
outstr [asciz /No file was open
/]
ofilc1: setzm spcout
close outfl,
releas outfl,
jrst cloop
spoutc: sosg ofbuf+2
out outfl,
idpb ac1,ofbuf+1
popj p,
xtend: skipe spcout
jrst [ outstr [asciz /
Output file already open
/]
jrst cloop]
skipn ctrl1 ;ask for new file name if ctrl-meta f
skipn outdon ;no skip if haven't done any file output this session
jrst xtend1
move ac1,[soblk,,lblock]
blt ac1,lblock+3
xtend2: init outfl,
sixbit /DSK/
ofbuf,,
0
lookup outfl,lblock
jrst [ outstr [asciz /
Can't lookup old output file /]
pushj p,socmsg
jrst ofilc1]
move ac1,[soblk,,lblock]
blt ac1,lblock+3
enter outfl,lblock
jrst [ outstr [asciz /
Can't enter /]
pushj p,socmsg
jrst ofilc1]
outstr [asciz /
Extending /]
pushj p,socmsg
outbuf outfl,2
setom spcout
setom outdon
ugetf outfl,ac1
NOPTY,<
setzm lockct
>
jrst cloop
xtend1: outstr [asciz /
File to extend: /]
pushj p,rdfile
jrst cloop
move ac1,[lblock,,soblk]
blt ac1,soblk+3
jrst xtend2
socmsg: move ac2,soblk
pushj p,socsix
hllz ac2,soblk+1
jumpe ac2,socms1
outchr ["."]
pushj p,socsix
socms1: skipn soblk+3
jrst socmsx
outchr ["["]
hllz ac2,soblk+3
pushj p,socsiy
outchr [","]
hrlz ac2,soblk+3
pushj p,socsiy
outchr ["]"]
socmsx: outstr [asciz /
/]
popj p,
socsiy: tlne ac2,770000
jrst socsix
lsh ac2,6
jrst socsiy
socsix: movei ac1,0
lshc ac1,6
jumpe ac1,cpopj
addi ac1,40
outchr ac1
jrst socsix
> ;END OF {IFE FTPCOM, < ETC. >}
;term tloop isalpn lcheck rjust rjloop
; File name reading program
array ifbuf[3],ofbuf[3],lblock[4],soblk[4]
term: setz ac1,
movei ac2,6
move ac3,[point 6,ac1]
tloop:
IFE FTPCOM,
< READW(ac4)
>;IFE FTPCOM
IFN FTPCOM,
<
MOVE AC4,AC1 ;GETTTY USES AC1
PUSHJ P,GETTTY ;TAKE COMMANDS FROM FILE, TOO
EXCH AC1,AC4
>;IFN FTPCOM
cail ac4,"a"
caile ac4,"z"
jrst lcheck
subi ac4,"a"-"A"
isalpn: subi ac4,"A"-'A'
sojl ac2,tloop
idpb ac4,ac3
jrst tloop
lcheck: caige ac4,"0"
popj p,
caig ac4,"9"
jrst isalpn
cail ac4,"A"
caile ac4,"Z"
popj p,
jrst isalpn
rjust: movei ac2,6
rjloop: trnn ac1,77
sojg ac2,[
lsh ac1,-6
jrst rjloop]
popj p,
;rdfile rdppm errspc winxit errlf rstx
; Program to read a file
rdfile: setzm lblock
setzm lblock+1
setzm lblock+2
setzm lblock+3
ptjobx [0 ↔ sixbit /DON/] ; Get our echoing back
MOVE AC7,[-2,,[ 3000,,AC6 ;Save line characteristics in AC6
2000,,SPCBRK]] ;Then turn off these bits
TTYSET AC7,
pushj p,term
movem ac1,lblock
cain ac4,15
jrst winxit
caie ac4,175
cain ac4,12
jrst winxit
caie ac4,"."
jrst rdppm
pushj p,term
movem ac1,lblock+1
cain ac4,15
jrst winxit
caie ac4,175
cain ac4,12
jrst winxit
rdppm: caie ac4,"["
jrst [
errspc: outstr [asciz /Illegal File specification
/]
jrst errlf]
pushj p,term
pushj p,rjust
hrlzm ac1,lblock+3
caie ac4,"."
cain ac4,","
caia
jrst errspc
pushj p,term
pushj p,rjust
hrrm ac1,lblock+3
CAIN AC4,15
JRST WINXIT ;Can omit right braket
CAIE AC4,12
cain ac4,"]"
JRST WINXIT
JRST ERRSPC
winxit: aos (p)
errlf: caie ac4,12
cain ac4,175
jrst rstx
IFE FTPCOM,
< READW(ac4)
>;IFE FTPCOM
IFN FTPCOM,
< PUSHJ P,GETTTY
MOVE AC4,AC1
>;IFN FTPCOM
jrst errlf
rstx: setlin ac6 ;put line characteristics back the way they were
skipn echof
ptjobx [0 ↔ sixbit /DOFF/] ;put echoing back
popj p,
;POCT poctl
; print octal
POCT: PUSH P,AC2
MOVE AC2,AC1
push p,ac3
movei ac3,=12
poctl: SETZ AC1,
LSHC AC1,3
ADDI AC1,"0"
OUTCHR AC1
sojg ac3,poctl
pop p,ac3
POP P,AC2
POPJ P,
;clschk inpskp
; CLSCHK - Skip if input present. INPSKP - Check if socket closed.
;SOMEBODY WAS AWFULLY CONFUSED IN THAT COMMENT ↑↑↑↑↑↑↑
; Routine to see if socket has been closed under us
NOPTY,<
NODIAL,<
clschk: mtape imp,sttblk
move ac1,sttblk+1
or ac1,sttblk+2
stato imp,errbts
tlne ac1,060000
JRST INPSKP ;WAS POPJ P, -- DON'T DIE IF INPUT WAITING
aos (p)
popj p,
>;NODIAL
; Great routine to skip if any IMP input present
inpskp: move ac1,ibuf+2
caile ac1,1
jrst cpopj1
hrrz ac1,ibuf
hrrz ac1,(ac1)
skipge (ac1)
jrst cpopj1
NODIAL,<mtape imp,[10] >
ISDIAL,<TTYSKP IMP, >
popj p,
jrst cpopj1
>;NOPTY
;intdsp intend DIACL2 DIACL4 DIACL3 DIACLK DIACL5 inunlk insr inttst insflg inrflg IMPCHG GFINTS GCLOSE GIMPERR
; INTDSP - Interrupts get to here
intdsp:
ISNEWP,<
move 1,jobcni
TLNE 1,(<INTTTY>)
SETOM LUKTTY
tlne 1,(<intins!intinr>) ;IMP interrupt by sender or receiver?
jrst insr
NGP,< TLNE 1,(<INTIMS>) ;IMP changed status?
JRST IMPCHG
>;NGP
>;ISNEWP
NODIAL,<
NOPTY,<
NONEWP,<
move 1,jobcni
TLNE 1,(<INTTTY>)
SETOM LUKTTY
>
tlne 1,(<intclk>)
jrst inunlk ;time to unlock
>
>
intend:
ISNEWP,<
move 1,[NGP,<INTIMS!>intclk!intins!intinr!inttty]
>;ISNEWP
ISPTY,<
movei 1,0
>;ISPTY
ISDIAL,<
SETZM CONCHR
MOVE 1,JOBCNI
TLNE 1,(<INTCLK>)
JRST DIACLK
DIACL2: TLNN 1,(<INTTTY>)
JRST DIACL3
SNEAKS 1,
CAIA
JRST DIACL5
CLKINT =60 ;RESET CLKINT TO 1 SECOND
SOSGE WAKCNT ;COUNT DOWN, WAKE UP IF NEGATIVE
DIACL4: SETOM WAKFLG
DIACL3: MOVEI 1,0
>;ISDIAL
NONEWP,<
NOPTY,<
NODIAL,<
movsi 1,(<intclk!inttty>)
skipe luktty
tlz 1,(<inttty>)
>
>
>
intmsk 1
dismis
ISDIAL,<
DIACLK: SETOM WAKFLG ;WAKE UP MAIN PROCESS IF CLK INT
CLKINT 0
JRST DIACL2
DIACL5: SETOM CONCHR
JRST DIACL4
>;ISDIAL
NOPTY,<
NODIAL,<
inunlk: unlock
movei 1,4 ;lock in again soon.
movem 1,lockct
clkint 0
jrst intend
>
>
ISNEWP,<
insr: uwait
intmsk [intclk!intins!intinr!inttty]
debreak
mtape imp,inttst ;find out about ins and inr
NGP,< IMSKST [INTIMS] ;Turn IMP change back on on
>;NGP
jrst 2,@jobtpc ;back to main program level
inttst: 14
insflg: 0
inrflg: 0
>;ISNEWP
NGP,<
; IMP changed status, see how
IMPCHG: SKIPN GRFON ;Graphics enabled?
DISMIS ;Ignore other channels for now
MOVEI AC1,2 ;Find out status of graphics channel
MTAPE GIMP,AC1
STATZ GIMP,ERRBTS ;Error?
JRST GIMPERR ;Yes, close connection
EXCH AC2,GIMSTT ;Save status and get back previous status
EXCH AC3,GIMSTT+1
ANDCA AC2,GIMSTT ;See which bits came om
ANDCA AC3,GIMSTT+1
TLNN AC2,(<CLSR>) ;Close recieved?
TLNE AC3,(<CLSR>)
JRST GCLOSE
TLNE AC2,(<RFCR>) ;Recieve side opened?
JSP AC1,GFINTS ;Count down to ready
TLNE AC3,(<RFCR>) ;Send side opened?
JSP AC1,GFINTS ;Count down to ready
DISMIS ;Ignore other bits.
GFINTS: SOSN GNOTOK ;Both sides connected?
SETOM GINITF ;Yes, mark as initialized.
JRST (AC1) ;Return
GCLOSE: TDZA 1,1
GIMPERR:MOVEI 1,[ASCIZ/*** IMP Error on graphics ***/]
MOVEM 1,GERMSV ;Save error message
SETOM GMSKSV ;Save interrupt mask
IMSKCR GMSKSV
UWAIT ;Get into user mode to do close
DEBREAK
MOVEM P,GPSAVE ;Save a PDL
PUSH P,AC1
MOVE P,INTIOWD ;Get interrupt PDL
MOVE AC1,JOBTPC ;Save PC
MOVEM AC1,GPCSAV
SETOM GNOTOK ;Turn on error
MOVE AC1,GERMSV ;Error message?
PUSHJ P,GRFKIL ;Kill graphics
POP P,AC1 ;Restore AC
MOVE P,GPSAVE
INTJEN GMSKSV ;Restore interrupt mask and return to interrupted
;program
>;NGP
;getsite getnn getsl getsil
IFN 0,< ;USING NETWRK NOW ; Site name to number
; Enter with name in AC1-AC2, returns site # in AC3
; Skips upon success
; Error returns 0 for not found, 1 for ambiguous in AC3
NOPTY,<
NODIAL,<
ife spcl,<
getsite:
setob ac5,ac6
movei ac7,=12
getnn: movei ac4,nnames-1
getsl: move ac8,sntab(ac4)
and ac8,ac5
camn ac8,ac1
jrst snfnd
movei ac10,(ac4)
lsh ac10,1
move ac8,lntab(ac10)
move ac9,lntab+1(ac10)
and ac8,ac5
and ac9,ac6
camn ac8,ac1
came ac9,ac2
jrst getsil
jrst snfnd
getsil: sojge ac4,getsl
lshc ac5,6
sojg ac7,getnn
setz ac3,
popj p,
;snfnd fnlop ambig sucex cpopj2 cpopj1 cpopj
; Here we have found a potential match. Check for ambiguities
snfnd: movei ac11,(ac4)
fnlop: sojl ac4,sucex
move ac8,sntab(ac4)
and ac8,ac5
camn ac8,ac1
JSP AC10,AMBIG
movei ac10,(ac4)
lsh ac10,1
move ac8,lntab(ac10)
move ac9,lntab+1(ac10)
and ac8,ac5
and ac9,ac6
camn ac8,ac1
came ac9,ac2
jrst fnlop
JSP AC10,AMBIG
JRST FNLOP ;HAD SAME NUM...ISN'T REALLY AMBIGUOUS
ambig: MOVE AC3,NTAB(AC11) ;HOST NUMBER OF HOST WE FOUND ON PREV PAGE
CAMN AC3,NTAB(AC4) ;SKIP IF HOST WE JUST FOUND HAS DIFFERENT NUM
JRST (AC10)
movei ac3,1
popj p,
sucex: move ac3,ntab(ac11)
move ac4,mtab(ac11) ; Put host mode bits in AC4
jrst cpopj1
>;¬spcl
>;NODIAL
>;NOPTY
>;IFN 0
cpopj2: aos (p)
cpopj1: aos (p)
cpopj: popj p,
;rdsite rdsit1 RDSNOH numonly sitnum nonum nonum1 rdsit2 bdchr rdsit3 getsock alt rdlf endsit
; Rdsite: READ A SITE NAME
; Routine to read 49 characters of a site name.
; Returns site name in HSTBUF, or site number in AC3 (rh)
; Skips on success, AC3 ≠0 means site # typed directly.
; Error codes in AC1, currently 2 is illegal character
ifn 0,<hstcln←←=12>
ifn 1,<hstcln←←=49>
NOPTY,<
NODIAL,<
ife spcl,<
rdsite:
IFN 1,< SETZM HSTBUF
MOVE AC3,[HSTBUF,,HSTBUF+1]
BLT AC3,HSTBUF+7>
IFN 0,< setzb ac1,ac2>
setzm skget
movei ac3,
IFN 0,< move ac6,[point 6,ac1]>
IFN 1,< MOVE AC6,[440700,,HSTBUF]>
MOVEI AC4,hstcln
rdsit1: READW(ac5)
caie ac5," "
cain ac5,11
jrst rdsit1
caie ac5,15
cain ac5,14
jrst rdsit1
cain ac5,175
jrst alt
IFN FTPCOM,<
SKIPN HAIRY
JRST RDSNOH
CAIE AC5,"/" ;{
CAIN AC5,"}"
JRST ENDSIT
CAIN AC5,"↑"
JRST ENDSIT ;FLAG TO READ OPTION.TXT
RDSNOH:
>;FTPCOM
cain ac5,12
jrst endsit
; added 4-3-73 dcs
cain ac5,"#" ;socket # specified?
jrst getsock ; yes
numonly:cail ac5,"0" ;if the character is a number,
caile ac5,"9" ; and if this is the first
jrst nonum ; non-blank character (ac4=12) or
sitnum: caie ac4,hstcln ; all previous non-blank characters
jumpe ac3,nonum1 ; were numbers (AC1≠0), then she's
imuli ac3,=10 ; typing in a site number, collect
addi ac3,-"0"(ac5) ; in AC1.
tlo ac3,700000
jrst rdsit1
nonum: jumpn ac3,bdchr ; after she starts a number, has to
; dcs ; finish it.
nonum1: caig ac5,"z"
caige ac5,"a"
jrst rdsit2
SUBI AC5,"a"-"A"
rdsit2:
IFN 0,< subi ac5,40
trnn ac5,-100
jumpg ac5,rdsit3>
IFN 1,< CAIG AC5,40
CAIG AC5,172
JRST RDSIT3>
bdchr: movei ac1,2
pushj p,rdlf
cain ac5,"#"
jrst rdlf
popj p,
rdsit3: idpb ac5,ac6
sojg ac4,rdsit1
pushj p,rdlf
caie ac5,"#"
jrst endsit
getsock:READW(ac5) ; now get connect socket number
setom skget#
movem ac3,nmsav#
movsi ac3,700000 ; getting numbers
movei ac4,11 ; allow up to 9 site digits, for grins
jrst numonly
alt: outstr [crlf: byte (7)15,12]
jrst cpopj1
rdlf:
IFN FTPCOM,< ;{
CAIN AC5,"}"
POPJ P,
>;FTPCOM
READW(ac5)
andi ac5,177
cain ac5,12
popj p,
cain ac5,"#"
popj p,
caie ac5,175
jrst rdlf
outstr crlf
popj p,
endsit:
IFN FTPCOM,<
MOVEM AC5,HSTEND ;SAVE HOST DELIMITER (SLASH OR RBRACE)
>;FTPCOM
skipn skget ; store socket, restore number if
jrst cpopj1 ; specific socket specified
tlz ac3,700000
movem ac3,consck
move ac3,nmsav
jrst cpopj1
>;¬spcl
;lntab sntab ntab mtab nm
; See file NAMES for site names and descriptions
; Name macros refer to these bits representing host echo conventions
noeb←←1 ; Host wants us to inhibit echoing
efcsm←←10 ; Host wants us to be in full activation mode
SRVR←←0 ;CONS UP A BIT HERE IF WE EVER USE THIS FEATURE
IFN 0,<;WITH NETWRK, LET THIS CRAP R.I.P.
; Now put useful information about sites into tables
ife spcl,<
define x (a,b,c,d) <zz←zz+1>
zz←←0
names
lntab: repeat 2*zz,<0
>
sntab: block zz
ntab: block zz
mtab: block zz
locpnt←←.
define x (a,b,c,d) <
reloc lntab+zz*2
sixbit /a/
reloc sntab+zz
sixbit /b/
reloc ntab+zz
=c
reloc mtab+zz
d
zz←←zz+1
>
zz←←0
names
reloc locpnt
nnames←←zz
>;¬spcl
ifn spcl,<
define x(a,b,c,d) <
ifn limrik,<
ifidn <b>,<SRI>,<=c>
>
ifn rsexec,<
ifidn <b>,<ISI>,<=c>
>>
nm: names
nnames←←1
>;spcl
>;IFN 0
;rsfail inuse ssfail noinit intbts intbt concls
; Error returns and such
rsfail: caie ac1,1 ; Socket in use
jrst norscn
inuse: outstr [asciz/System screwed up with gensym!/]
jrst 4,.
ssfail: caie ac1,1 ; Socket in use
jrst nosscn
sos ac1,conecb+lsloc
movem ac1,terblk+lsloc
mtape imp,terblk
jrst inuse
IFN FTPCOM,<NOIMP: >
noinit: outstr [asciz /Can't INIT the IMP
/]
EXIT
intbts: mtape imp,sttblk
getsts imp,ac2
intbt: move ac1,sttblk+1
or ac1,sttblk+2
tlne ac1,(<clss!clsr>)
concls:
ife limrik,<
ife rsexec,<
outstr [asciz /Connection has been closed
/]
>
trne ac2,rset
outstr [asciz /Reset received from host
/]
trne ac2,hdead
outstr [asciz /Host dead
/]
trne ac2,ctrov
outstr [asciz /Data quota overflow
/]
trne ac2,iodend
outstr [asciz /End of file
/]
>;¬limrik
close log,
release log,
close imp,
release imp,
release infl,
release outfl,
ife limrik,<
tlnn ac1,(<clss!clsr>)
trne ac2,rset!hdead!ctrov!iodend
>
EXIT
;gayskt unserr logbts
; Here we check for error returns from the CONNECT MTAPEs
ife limrik,<
move ac1,conecb+stloc
tdne ac1,[-100]
jrst unserr
cain ac1,siu
outstr [asciz /Socket in use
/]
cain ac1,ccs
outstr [asciz /Can't change sockets
/]
cain ac1,sys
outstr [asciz /System error
/]
cain ac1,nla
outstr [asciz /No links available
/]
cain ac1,ilb
outstr [asciz /Illegal byte size
/]
cain ac1,idd
jrst [ outstr [asciz /IMP dead
/]
calli 12]
cain ac1,gmm
gayskt: outstr [asciz/Homosocketuality is prohibited (the Anita Bryant feature)
/]
ife rsexec,<jrst rstart;>exit 1,
unserr: outstr [asciz /Host not responding
/]
exit 1,
>;¬limrik
logbts: mtape log,sttblk
getsts log,ac2
jrst intbt
;noconn nosock norscn NOGRCV NOGSND nosscn norswc inperr outerr noconn norscn outerr
; More error messages
ife limrik,<
noconn: outstr [asciz /Can't connect to logger
/]
jrst logbts
nosock: outstr [asciz /Didn't get socket number from logger
/]
jrst logbts
norscn: outstr [asciz /Can't connect to receive side
/]
jrst intbts
NGP,<
NOGRCV: outstr [asciz /*** Can't connect to receive side of graphics connection ***
/]
JRST GRFKIL
NOGSND: outstr [asciz /*** Can't connect to send side of graphics connection ***
/]
JRST GRFKIL
>;NGP
nosscn: outstr [asciz /Can't connect to send side
/]
jrst intbts
norswc: outstr [asciz /Error while waiting for receive side
/]
jrst intbts
inperr: outstr [asciz /Error on input
/]
jrst intbts
outerr: outstr [asciz /Error on output
/]
jrst intbts
>;¬limrik
ifn limrik,<
noconn: nosock:
outstr [asciz /The limerick generator is busy right now. /]
outstr [asciz /Try again somewhat later.
/]
jrst logbts
norscn: nosscn: norswc: inperr:
outstr [asciz /The limerick generator is busy right now. /]
outstr [asciz /Try again somewhat later.
/]
jrst intbts
outerr: outstr [asciz /You can't influence me.
/]
jrst intbts
>;limrik
>;NODIAL
>;NOPTY
;GRFINI
;GRFINI - Initialize for graphics
NGP,<
GRFINI:
init GIMP,0
sixbit /IMP/
xwd GOBUF,GIBUF
jrst noinit
mtape GIMP,[
=15
byte (6) 5,24,0,7,0
] ; Time out CLS, RFNM, and RFC
inbuf GIMP,2
outbuf GIMP,2
movei ac1,10
dpb ac1,[point 6,GIBUF+1,11]
dpb ac1,[point 6,GOBUF+1,11]
SETOM GRFON ; Indicate graphics started
MOVEI AC1,2 ; Count down for each connection complete
MOVEM AC1,GNOTOK
SETZM GOWAIT
SETZM CONECB ; Connect opcode
MOVE AC1,LSOCK
ADDI AC1,5
movem AC1,conecb+lsloc
move ac3,hostno
movem ac3,conecb+hloc
setzm conecb+wfloc
movei ac3,10
movem ac3,conecb+bsloc
move ac3,GRFSOK
movem ac3,conecb+fsloc
mtape GIMP,conecb ; make receive side connection
move ac1,conecb+stloc
trne ac1,-1
jrst NOGRCV
statz GIMP,errbts
jrst NOGRCV ; Can't connect receive side
output GIMP, ; Dummy output to set up buffer header
aos GOBUF+2 ; don't get out of sync at impout
; pushj p,clschk ; check to see if world has been closed
; jrst intbts
SKIPN GRFON
POPJ P,
sos conecb+lsloc
AOS conecb+fsloc
movei ac3,10
movem ac3,conecb+bsloc
mtape GIMP,conecb ; make send side connection
move ac1,conecb+stloc
trne ac1,-1
jrst NOGSND
statz GIMP,errbts
jrst NOGSND ; Can't connect to send side
MOVE AC1,GPIOWD ;Set up graphics PDL
SETZM GBEGZR ; Zero output graphics tables
MOVE 1,[XWD GBEGZR,GBEGZR+1]
BLT 1,GENDZR
PUSH AC1,[GFIRST] ;Where to start
MOVEM AC1,GACSAV+17
POPJ P,
>;NGP
;GRFKIL
;GRFKIL - Close graphics connection
NGP,<
; Destroys AC1 and preserves all others (see GIMPERR before changing this)
GRFKIL:
SKIPN GRFON ;Is it alreay closed?
POPJ P, ;Don't try to beat a dead dog
OUTSTR (AC1) ;Yes, output it.
OUTSTR[ASCIZ/
*** Graphics connection closed ***
/]↔ CLOSE GIMP, ;Close, but don't release (we might have been about to
;do I/O and would get I/O to unassigned channel instead
;of just an error return)
SKIPE AC1,OLDFF ;Give back core Graphics used
MOVEM AC1,JOBFF
SETZM GRFON
POPJ P,
>;NGP
;IMPLTB GRFSER GRFSE1 GRFSE2 GFIRST GLOOP UNKNOP INQUI INQUI2
;GRFSER - Graphics service
NGP,<
BEGIN GRFSER
;
; Define NGP opcodes
;
;
DEFINE NGPOP(OPCODE,VALUE,OPT,DESCR)
< OPCODE←←=VALUE ;OPT DESCR
>
DEFINE NGPDEF(OPCODE,VALUE,DESCR)
< OPCODE←←=VALUE ;OPT DESCR
>
DEFINE NGPINQ(OPCODE,VALUE,OPT,DESCR)
< OPCODE←←=VALUE ;OPT DESCR
>
XALL
.INSERT NGPOP.DEF[CSP,SYS]
LALL
;Generate table of implimented commands (macros expansion XLIST'ed out
;for your reading convenience)
DEFINE .IMPL $(X,Y)
< INQ.$X←←INQ.$X!1B$Y
>
OPTS←←0
XLIST
FOR @` I←0,7
< INQ.`I ←← 0
>
FOR I ⊂ ($INQUI,$INQRS)
< .IMPL(→I/=32,→I∧=31)
OPTS←←OPTS+1
>
LIST
IMPLTB: FOR @` I←0,7 < INQ.`I
>
POG ← 7 ;Currently active piece of glass
↑GRFSER:SKIPE GRFON ;Are we set?
SKIPE GNOTOK ;Are we ready?
POPJ P, ;No, return
SKIPE GOWAIT ;Are we waiting to output?
JRST [ PUSHJ P,GOBCNT ;How much left
JUMPG AC1,GRFSE2 ;Some, fill that space
POPJ P, ] ;None, return
SKIPE GINITF
JRST GRFSE1
PUSHJ P,GINCHS ;Character ready?
POPJ P, ;No, return
GRFSE1: MOVEM 1,GACSAV+1 ;Stuff character into graphics ACs
skipe notsnt ; let loser type over solid output barfage
pushj p,impouu ; empty buffer - this shouldn't hang
GRFSE2: MOVEM 17,TACSAV+17 ;Save TELNET ACs
MOVEI 17,TACSAV
BLT 17,TACSAV+16
MOVSI 17,GACSAV ;Restore Graphics AC's
BLT 17,17
POPJ P, ;Continue where we left off
↑GFIRST:MTAPE GIMP,[15 ↔ 1] ; Allocate system maximum, graphics must be fast!
SETZM GINITF
GLOOP: PUSHJ P,GINCHW
CAIN 1,$INQUI ;Is he asking a question?
JRST INQUI ;Yes, answer him
CAIL 1,MNSGOP ;Is it transform format command?
CAILE 1,MXSGOP
JRST UNKNOP ;No, unknown opcode
PUSHJ P,@SGOPTB-MNSGOP(1) ;Yes, execute one
JRST GLOOP
UNKNOP: OUTSTR[ASCIZ/*** Unknown graphics opcode /]
PUSH P,1
PUSHJ P,TYPOCT
OUTSTR[ASCIZ/***
/]↔ JRST GLOOP
;Other end inquired as to what we support.
INQUI: PUSH P,[[BYTE (8) $INQRS,2,$IIMPL]]
PUSHJ P,GO8STR ;Send opcode,count,option_table_header
;Send Table of implemented opcodes
MOVEI 1,=8*=4
PUSHJ P,GOCNT
MOVE 2,[POINT 8,IMPLTB]
MOVEI 3,=8*=4
INQUI2: ILDB 1,2
PUSHJ P,GOBYTE
SOJG 3,INQUI2
MOVEI 1,$ISCOR ;Screen coordinates
PUSHJ P,GOBYTE ;Send byte
MOVEI 1,4*4+1
PUSHJ P,GOCNT
HRREI 1,-1000
PUSHJ P,GO32BY ;Left edge
PUSHJ P,GO32BY ;Bottom edge
HRREI 1,1000
PUSHJ P,GO32BY ;Right edge
PUSHJ P,GO32BY ;Top edge
MOVEI 1,2 ;Two bytes/coordinate
PUSHJ P,GOBYTE
PUSHJ P,GIMPOUT
JRST GLOOP
;SGOPTB SGOPN SGCLS SGPOS SGUNP SGKIL ENDUP ENDUP2 ENDUP3 ENDUP4 ENDUP5 SGVEC SGTXT SGTXT1 SGTXT2 RDSGNA RDSGN2 RDSGN3 RDSGN4 MORCOR MORCO2 prtpog TYPOCT typoc2 typoc3
;SEGOPS - Transformed Format Commands
;(SeGment OPcode TaBle)
MNSGOP←←$SGOPN
SGOPTB: SGOPN ;$SGOPN - Segment Open
SGCLS ;$SGCLS - Segment Close
SGPOS ;$SGPOS - Segment Post
SGUNP ;$SGUNP - Segment Unpost
SGKIL ;$SGKIL - Segment Kill
ENDUP ;$ENDUP - End batch of updates
UNKNOP ;$SGAPP - Segment Append
SGVEC ;$SGDOT - Segment Dot
SGVEC ;$SGMOV - Segment Move
SGVEC ;$SGDRW - Segment Draw
SGTXT ;$SGTXT - Segment Text
MXSGOP←←.-SGOPTB+$SGOPN-1
;Segment Open
SGOPN: SKIPE POG ;Close any currently open segment first
PUSHJ P,SGCLS
PUSHJ P,RDSGNA ;Read segment name
EXCH 1,GNAME(POG) ;Get old name and save new
DEB,< outstr[asciz/Opening #/]
pushj p,prtpog
>;DEB
MOVEM 1,GNAME+NPOGS(POG) ;Save old, too
MOVE 1,JOBFF↑ ;Get pointer to end
EXCH 1,GADR(POG) ;Get old pointer to bottom, saving new
MOVEM 1,GADR+NPOGS(POG) ;Save old
SETZ 1, ;Count of zero for now
EXCH 1,GCNT(POG) ;Get old, saving new
MOVEM 1,GCNT+NPOGS(POG) ;Save old count
MOVE 1,JOBREL↑
SUB 1,JOBFF
SUBI 1,2 ;Two are used in header and other lossages
MOVEM 1,GFREEW ;Number of free words
MOVEI 1,5
MOVEM 1,TXTFRE
MOVEI 1,1 ;Fill rest of core with 1
MOVEM 1,@JOBFF
MOVE 1,JOBFF ;Make a byte pointer
HRLI 1,(<POINT 7,0>)
MOVEM 1,DPYPTR
HRL 1,JOBFF
ADDI 1,1
BLT 1,@JOBREL ;The big BLT!
POPJ P,
;Segment Close
SGCLS: MOVE 1,DPYPTR ;Get address of final word
DEB,< outstr[asciz/Closing #/]
pushj p,prtpog
>;DEB
TLZ 1,770000 ;Force byte increment to next word
IBP 1
SETZM @1 ;Stop in last word
HRRZI 1,1(1) ;First free word
MOVEM 1,JOBFF ;Set JOBFF
SUB 1,GADR(POG) ;Calculate number of words
MOVEM 1,GCNT(POG)
MOVSI 1,(NEWBIT) ;Mark it as ready for display
ORM 1,GBITS(POG)
SETZ POG, ;Forget segment number is active
POPJ P,
;Segment Post
SGPOS: PUSH P,POG ;Save current POG
PUSHJ P,RDSGNA ;Read name of segment to post
DEB,< outstr[asciz/Posting #/]
pushj p,prtpog
>;DEB
MOVSI 1,(ACTBIT) ;Mark it as visible
ORM 1,GBITS(POG)
POP P,POG ;Restore segment number
POPJ P, ;Kill it later
;Segment Unpost
SGUNP: PUSH P,POG ;Save current POG
PUSHJ P,RDSGNA ;Read name of segment to unpost
DEB,< outstr[asciz/Unposting #/]
pushj p,prtpog
>;DEB
MOVSI 1,(ACTBIT) ;Mark it as invisible
ANDCAM 1,GBITS(POG)
POP P,POG ;Restore segment number
POPJ P, ;Kill it later
;Segment Kill
SGKIL: SETZ 1, ;Zero name
DEB,< outstr[asciz/Killing #/]
pushj p,prtpog
>;DEB
EXCH 1,GNAME(POG)
MOVEM 1,GNAME(POG) ;and save old copy
SETZ 1, ;Zero address
EXCH 1,GADR(POG)
MOVEM 1,GADR(POG) ;and save old copy
SETZ 1, ;Zero count
EXCH 1,GADR(POG)
MOVEM 1,GADR(POG) ;and save old copy
MOVSI 1,(NEWBIT∨ACTBIT) ;Mark it for death
ANDCAM 1,GBITS(POG)
POPJ P, ;Kill it later
;End batch of update
ENDUP: MOVSI A,-NPOGS ;Loop thru all the POGs
SETZ B, ;Bit map of active pieces of glass
ENDUP2: ROT B,1 ;Next bit position
MOVE 1,GBITS(A) ;Pick up status
TLNN 1,(ACTBIT) ;Is this one active?
JRST ENDUP3 ;No, skip it
ORI B,1 ;Yes, turn its bit on in PGACT word
TLZN 1,(NEWBIT) ;Has it been put out yet?
JRST ENDUP3 ;Yes, don't put it up again
MOVEM 1,GBITS(A) ;Save status again
MOVE C,GADR(A) ;Make a buffer header for III
MOVE D,GCNT(A)
MOVE 1,[UPGIOT C]
DPB A,[POINT 4,1,12] ;Fill in piece of glass number
XCT 1 ;UPGIOT XXX,C
ENDUP3: AOBJN A,ENDUP2 ;Next, please
ROT B,=18-NPOGS ;Align for system
PGACT (B) ;Turn off/on appropriate POGs
IMUL A,[-1,,1] ;Make a new byte pointer of form [-NPOGS,,NPOGS]
ENDUP4: SKIPN GNAME(A) ;Anything there?
JRST ENDUP5 ;No, skip it
MOVE B,GCNT(A) ;Make a BLT pointer
HRLZ B,GADR(A)
ADD B,GADR(A)
MOVN C,GCNT(A) ;Final address needed too
ADD C,JOBREL
BLT B,(C) ;Copy newer stuff on top of old crufy segment
MOVN C,GCNT(A) ;Do relocation
ADDM C,DPYPTR
ADDM C,JOBFF
MOVSI B,-2*NPOGS ;Don't forget all those wonderful pointers!
ADDM C,GADR(B)
AOBJN B,.-1
SETZM GNAME(A) ;Forget olde segment now
SETZM GADR(A)
SETZM GCNT(A)
SETZM GFREEW ;Forget how much we had left, it may need to be cleard anyway
ENDUP5: AOBJN A,ENDUP4 ;Next, please
SKIPE GFREEW ;Did we change anything?
POPJ P, ;Done, finally
HRRZ 1,DPYPTR ;Now, figure how many words we have left
SUB 1,JOBREL
MOVNM 1,GFREEW
MOVEI 1,1 ;Now fill the rest with display no-ops
HRRZ A,DPYPTR
HRL A,A
ADD A,[XWD 1,2] ;There ought to be better ways of making BLT pointers!
MOVEM 1,-1(A)
BLT A,@JOBREL ;Done
POPJ P,
;Vectors
SGVEC: MOVE A,[126 ;Dot
146 ;Invisible vector
106]-$SGDOT(1) ;Visible vector
PUSHJ P,GINCHW ;Pack up vector with coordinate
DPB 1,[POINT 3,A,2] ;X high
PUSHJ P,GINCHW
DPB 1,[POINT 8,A,10] ;X low
PUSHJ P,GINCHW
DPB 1,[POINT 3,A,13] ;Y high
PUSHJ P,GINCHW
DPB 1,[POINT 8,A,21] ;Y low
SOSGE GFREEW ;Enough space for another word?
PUSHJ P,MORCOR ;No, get some more core
AOS DPYPTR ;Increment to next word
MOVEM A,@DPYPTR ;Store vector
MOVSI A,770000 ;Force high order character for next word
ANDCAM A,DPYPTR
MOVEI 1,5
MOVEM 1,TXTFRE
POPJ P,
;Text
SGTXT: PUSHJ P,GICNT ;Read count
MOVE A,1
SGTXT1: PUSHJ P,GINCHW ;Get a character
SOSL TXTFRE ;Enough space in word?
JRST SGTXT2 ;Yes
SOSGE GFREEW ;No, enough space in block?
PUSHJ P,MORCOR ;No, get another block
SGTXT2: IDPB 1,DPYPTR ;Put in into buffer
SOJG A,SGTXT1 ;Do it for each character in string
POPJ P,
;Read segment name
RDSGNA: PUSHJ P,GINCHW ;Read segment name
JUMPE 1,[MOVSI 1,-1
JRST .+1]
LSH 1,=8 ;Save as high order bits
MOVE POG,1
PUSHJ P,GINCHW ;Read low order bits of name
ADD 1,POG ;Make into 16 bit word
HRLZI POG,-NPOGS
RDSGN2: CAMN 1,GNAME(POG) ;Same name?
JRST RDSGN4 ;Yes, found
AOBJN POG,RDSGN2 ;No, try next
HRLZI POG,-NPOGS ;Find a free one
RDSGN3: SKIPN GNAME(POG) ;Free?
JRST RDSGN4 ;Yes, found
AOBJN POG,RDSGN3 ;No, try next
OUTSTR[ASCIZ/No free segments, stealing POG zero!
/]↔ SETZ POG, ;Use zero
RDSGN4: HRRZ POG,POG ;Flush AOBJN pointer half
POPJ P,
MORCOR: PUSH P,1
PUSH P,JOBREL
MORCO2: MOVE 1,JOBREL
ADDI 1,2000
CORE 1,
JRST [ OUTSTR[ASCIZ/Not enough core! /]
HALT MORCO2 ]
MOVE 1,JOBREL ;Update number of free words
SUB 1,(P)
ADDM 1,GFREEW
POP P,1
SETZM 1(1) ;Fill new core with 1's
AOS 1(1)
HRL 1,1
ADDI 1,1
BLT 1,@JOBREL
POP P,1
POPJ P,
DEB,<
;*** Print POG ****
prtpog: push p,pog
pushj p,typoct
pop p,(p)
popj p,
>;DEB
TYPOCT: push p,1
push p,2
pushj p,typoc2
pop p,2
pop p,1
outstr[asciz/ /]
popj p,
typoc2: lshc 1,-3
hllm 2,(p)
skipe 1
pushj p,typoc2
typoc3: LDB 2,[POINT 3,(p),2]
addi 2,"0"
outchr 2
popj p,
;GINCHS NOINP GINCHW GWAIT GICNT
SUBTTL GINCHS - Get graphics character, skip if successful
GINCHS: SOSG GIBUF+2 ;Any characters ready?
JRST [ MTAPE GIMP,[10] ;Any input ready?
JRST NOINP
IN GIMP, ;Try reading IMP
JRST .+1 ;Win.
;Interrupt level routine will catch the error
NOINP: AOS GIBUF+2 ;Fix count
POPJ P, ] ;Failure return
ILDB 1,GIBUF+1 ;Get character from buffer
ifn impbug,< jumpe 1,ginchs > ;flush spurius nulls!
IFE IMPBUG,<
; Separate real null from those generated by the system converting from
; byte count to word count back to byte count (stupid system).
JUMPE 1,[ PUSH P,2 ;If null, check if it's real
LDB 1,[POINT 6,GIBUF+1,5]
IDIVI 1,=8 ;Check ignore bit
LDB 1,[POINT 1,@GIBUF+1,35 ;(Using a table is
POINT 1,@GIBUF+1,34 ;more efficient here).
POINT 1,@GIBUF+1,33
POINT 1,@GIBUF+1,32](1)
POP P,2
JUMPN 1,GINCHS ;Try again if to be ignored
JRST .+1 ] ;It's good, use it!
>;IFE IMPBUG
AOS (P) ;Skip return means success
ifn impbug,<
skipe imphak ;Escape seen?
jrst [ setzm imphak ;Turn off
andi 1,177 ;flush high order bit
popj p,] ;and return
caie 1,1 ;escape?
POPJ P, ;no, return
sos (p) ;we haven't really got a character yet
setom imphak ;remember we saw an escape
jrst ginchs ;and try again
>;ifn impbug
POPJ P,
GINCHW: PUSHJ P,GINCHS ;Character ready?
SKIPA
POPJ P, ;Yes, return it
GWAIT: MOVEM 17,GACSAV+17 ;No, wait Graphics ACs
MOVEI 17,GACSAV
BLT 17,GACSAV+16
MOVSI 17,TACSAV ;Restore TELNET AC's
BLT 17,17
POPJ P,
GICNT: PUSHJ P,GINCHW ;Get first byte
CAIGE 1,200 ;Small number?
POPJ P, ;Yes, return
SUBI 1,200 ;This is the high order part
LSH 1,8
PUSH P,1
PUSHJ P,GINCHW ;Get low order part
ADD 1,(P) ;Now we have the whole thing
SUB P,[XWD 2,2]
JRST @1(P)
;GOBCNT USEMES
SUBTTL GOBCNT - Return number of bytes which we can send IMP without waiting
BEGIN GOBCNT
;
; PUSHJ P,GOBCNT
;
↑GOBCNT:MTAPE GIMP,GALLOC ;Get allocations
MOVE 1,GALLOC+10 ;Get number of messages left
MOVEM 1,GMLEFT
MOVE AC2,GALLOC+7 ;Get number of bits he has left
IDIVI AC2,=8096-=36 ;Divide by number of bits per message
;(assume we one word's worth to boundaries)
CAMLE AC2,1 ;Enough messages left?
JRST [ MOVEI AC2,=8096-=36 ;No, see how well we can do with
IMUL AC2,GALLOC+4 ;existing messages.
JRST USEMES ]
MOVE AC2,GALLOC+7 ;Get number of bits
USEMES: MOVEI 1,8
SUBI AC2,=36 ;Assume loss of one word to boundaries
IDIVM AC2,1 ;Divide by bytes to return number of bytes
POPJ P,
BEND GOBCNT
;GOBYTE notgrf GOBYT2 EMPCHK MORLFT RETRY2 EMPTY RETRY
SUBTTL GOBYTE - Send byte to IMP on graphics channel
BEGIN GOBYTE
;
; Called with:
;
; MOVE 1,<character>
; PUSHJ P,GOBYTE
;
; All other acs are preserved.
; If not enough space is left, then the process is delayed.
;
↑GOBYTE:
ifn impbug,<
trnn 1,376
jrst [ push p,1
movei 1,1 ;Sneak past escape test
pushj p,gobyt2
pop p,1
addi 1,200
pushj p,gobyt2
subi 1,200
popj p,]
notgrf:
>
GOBYT2: SOSGE GLEFT ;Enough space for one more?
JRST EMPCHK ;Maybe not, we'll see though
SOSG GOBUF+2 ;Decrement number of characters left
PUSHJ P,GIMPOUT ;Do output
IDPB 1,GOBUF+1
AOS GUSED ;Remember that we used this byte
JFCL ;Space for OUTCHR 1
POPJ P,
;Our count of the number of bytes left is exhausted. See if the system has
;moved any since we checked last.
EMPCHK: PUSH P,AC2 ;Save all this wonderful stuff
PUSH P,AC3
PUSH P,1
PUSHJ P,GOBCNT ;Look again and see how much is left in system
SUB 1,GUSED ;less that in our buffer
JUMPLE 1,EMPTY ;It really is empty
MORLFT: MOVEM 1,GLEFT ;Remember number for fast access
RETRY2: POP P,1
POP P,AC3
POP P,AC2
JRST GOBYT2
EMPTY:
PUSHJ P,GIMPOUT ;Output what's in our buffers before waiting
PUSH P,A ;Counter for timeout and deciding how long to wait
RETRY:
;;; We underestimate to be sure, so negative is OK.
; SKIPE 1 ;Better be zero
; PUSHJ P,DRYROT ;Lose big!
SETOM GOWAIT ;(Waiting for output)
PUSHJ P,GWAIT ;Wait 'til later to try again
SETZM GOWAIT
PUSHJ P,GOBCNT ;Look again and see how much is left in system
SUB 1,GUSED ;less that in our buffer
JUMPLE 1,RETRY
POP P,A ;We got something, now we may proceed
JRST MORLFT
BEND GOBYTE
;GIMPOUT ALLUSED
SUBTTL GIMPOUT - Output buffer to IMP
BEGIN GIMPOUT
;
; Called with:
;
; PUSHJ P,GIMPOUT
;
; All other acs are preserved.
;
↑GIMPOUT:
PUSH P,AC2 ;Get an ac
PUSH P,AC3 ;Get another
LDB AC2,[POINT 6,GOBUF+1,5] ;Pick up position field
SUBI AC2,4 ;Turn on appropriate bits
JUMPLE AC2,ALLUSED
ASH AC2,-3 ;causing remaining bytes in word
MOVEI AC3,1 ;not to be sent
ASH AC3,(AC2)
SUBI AC3,1
MOVE AC2,GOBUF+1
ORM AC3,(AC2)
ALLUSED:SOSGE GMLEFT ;Is there a message left?
JRST [ PUSHJ P,GOBCNT ;Well, maybe it changed since
SKIPE GMLEFT ;We looked last
JRST ALLUSED ;Yes, we can try the output
SETOM GOWAIT ;Waiting for output
PUSHJ P,GWAIT ;No, wait and try again later
SETZM GOWAIT
JRST ALLUSED ]
OUT GIMP,
SKIPA
JRST [ MOVEI 1,[ASCIZ/*** Error on graphics output ***/]
PUSHJ P,GRFKIL
JRST GWAIT ]
SETZM GUSED ;Nothing in buffers now
POP P,AC3
POP P,AC2
POPJ P, ;Just in case it got fixed (fat chance)
BEND GIMPOUT
;GO32BY GO8STR GO8ST2 GOCNT
SUBTTL GO32BY - Send 32 bit byte to IMP on graphics channel
BEGIN GO32BY
;
; Called with:
;
; MOVE 1,[<32 bit byte>]
; PUSHJ P,GO32BY
;
; All other acs are preserved.
; If not enough space is left, then the process is delayed.
;
↑GO32BY:ROT 1,-=24 ;Position for first byte
PUSHJ P,GOBYTE
ROT 1,8
PUSHJ P,GOBYTE
ROT 1,8
PUSHJ P,GOBYTE
ROT 1,8
PUSHJ P,GOBYTE
POPJ P,
BEND GO32BY
SUBTTL GO8STR - Send 32 bit byte to IMP on graphics channel
BEGIN GO8STR
;
; Called with:
;
; MOVE 1,[<string of 8 bit bytes terminated with 0>]
; PUSHJ P,GO8STR
;
; All other acs are preserved.
; If not enough space is left, then the process is delayed.
;
↑GO8STR:MOVSI 1,(<POINT 8,0>)
HLLM 1,-1(P)
GO8ST2: ILDB 1,-1(P)
JUMPE 1,CPOPJ
PUSHJ P,GOBYTE
JRST GO8ST2
BEND GO8STR
SUBTTL GOCNT - Send count to IMP on graphics channel
;
; MOVE 1,[<count>]
; PUSHJ P,GOCNT
;
GOCNT: CAIGE 1,200 ;Fit in one byte?
JRST GOBYTE ;Yes, this one's easy
ROT 1,-8 ;No, output high order bits
ADDI 1,200 ;Plus high order bit as marker
PUSHJ P,GOBYTE
ANDCMI 1,377 ;Turn off high order bits
ROT 1,7 ;Get back low order bits
JRST GOBYTE ;And output them too
BEND GRFSER
>;NGP
;NUMPR NUMPR1 DON0 DATGEN NODA1 NODATE NOTIME NOZON MONTAB PDDATE PSDATE DTKIND
; DATGEN Date Generator c/o Datgen.fai[sls,dcs]
IFN FTPCOM,<
BEGIN DATGEN
DEFINE STROUT(X) <
MOVE C,[POINT 7,X]
PUSHJ P,TTSTROUT
>
DEFINE OUT1 (X) <
MOVE A,X
PUSHJ P,TTCHROUT
>
DEFINE PRNUM(X,N) <
IFN X-T2,<MOVE T2,X ;arranged to be ok for this routine,
; to clobber T2 whenever prnum called>
PUSHJ P,NUMPR ;ok to generate multiple words
N ; in PRNUM -- this is min width
>;PRNUM
NUMPR:PUSH P,T1
MOVE T1,@-1(P)
PUSHJ P,NUMPR1
POP P,T1
AOS (P)
POPJ P,
NUMPR1:IDIVI T2,=10
IORI T3,"0"
HRLM T3,(P)
SUBI T1,1
JUMPE T2,.+2
PUSHJ P,NUMPR1
JUMPLE T1,DON0
OUT1 (<["0"]>)
SOJG T1,.-1
DON0:HLRZ T2,(P)
OUT1 T2
POPJ P,
↑↑DATGEN:
DATE T1,
IDIVI T1,=31
ADDI T2,1
PRNUM (T2,0)
NODA1: IDIVI T1,=12
MOVEI T3,PDDATE
CAILE T2,3
CAILE T2,=9
MOVEI T3,PSDATE
MOVEM T3,DTKIND
MOVE T2,MONTAB(T2)
STROUT (T2) ;T3 HAS LH BYTE 0
MOVEI T2,=64(T1)
PRNUM (T2,2)
NODATE: STROUT (<[ASCIZ / /]>)
MSTIME T2,
IDIVI T2,=1000*=60
IDIVI T2,=60
MOVE T1,T3
PRNUM (T2,2)
MOVE T2,T1
PRNUM (T2,2)
NOTIME: STROUT (@DTKIND)
NOZON: POPJ P,
MONTAB: ASCII /-JAN-/
ASCII /-FEB-/
ASCII /-MAR-/
ASCII /-APR-/
ASCII /-MAY-/
ASCII /-JUN-/
ASCII /-JUL-/
ASCII /-AUG-/
ASCII /-SEP-/
ASCII /-OCT-/
ASCII /-NOV-/
ASCII /-DEC-/
PDDATE: ASCIZ / PDT/
PSDATE: ASCIZ / PST/
DTKIND: 0
BEND DATGEN
>;FTPCOM ONLY, FOR NOW
;FTPACT DIACTV DOACTV XACTV DIBUF DOBUF FIBUF FOBUF LDOSOC LDISOC FDISOC FDOSOC SVOTYP DTYPE DRTYPE IMODES FMODES SVBS DBS DHOST CNIBTS OUTCON SAVP CHAR1 SNDMOD SNDTYP SNDBYT MAILNG ACTION GIVELF PKUNAM PKUEXT PKURNM HAIRY HAIRBP HAIRBF HAIRLS HAIRRS HAIRPT HAIRLR HASCII HSTEND USRSTR ACCSTR PASSTR HOST6 OPOPEN OTBUF TYPTAB FNBUF FNBUF2 FNBPT
; The FTP
IFN FTPCOM, <
EXTERN JOBFF ;FOR PREALLOCATED BUFFERS
EXTERN JOBREL ;FOR STORING NLST OUTPUT ON TOP
FTPACT: 0 ;FLAG THAT FTP IS BEING INVOKED
DIACTV: 0 ;NON-ZERO MEANS DATA-IN CHANNEL IS ACTIVE
DOACTV: 0 ;NON-ZERO MEANS DATA-OUT CHANNEL IS ACTIVE
XACTV: 0 ;NON-ZERO MEANS DON'T GO INTO A WAIT STATE
DIBUF: BLOCK 3 ;BUFFER HEADER FOR DATA IN
DOBUF: BLOCK 3 ;BUFFER HEADER FOR DATA OUT
FIBUF: BLOCK 3 ;BUFFER HEADER FOR DATA IN (LOCAL FILE SYSTEM OUT)
FOBUF: BLOCK 3 ;BUFFER HEADER FOR DATA OUT (LOCAL FILE SYSTEM IN)
LDOSOC: 0 ;LOCAL DATA-OUT SOCKET NUMBER
LDISOC: 0 ;LOCAL DATA-IN SOCKET NUMBER
FDISOC: 0 ;FOREIGN DATA-IN SOCKET NUMBER
FDOSOC: 0 ;FOREIGN DATA-OUT SOCKET NUMBER
SVOTYP: 0 ;SAVE TYPE DURING MAILING
DTYPE: 1 ;0 - ASCII, 1-IMAGE, 2 - LOCAL BYTE
DRTYPE: 1 ;"REAL" TYPE: IF DIFFERENT FROM ABOVE CAN BE 3 (ASCII PRINT)
; ≡ 0 HERE, 1 IF IMAGE BYTE DIVIDES 36, OR 5 FOR LOCAL BYTE
; ON THIS END BUT IMAGE ON THAT END
IMODES: 0 ↔ 10 ↔ 10
FMODES: 0 ↔ 10 ↔ 10
SVBS: 0 ;SAVE BYTE SIZE DURING MAILING
DBS: =36
DHOST: 11
CNIBTS: 0 ;JOBCNI BITS OR'D INTO HERE AT INTERRUPT LEVEL
OUTCON: 0 ;ON IF DATA CONNECTION MADE FOR OUTPUT (STOR, ETC.)
;USED WHEN FLUSHING OUTPUT (RSTR COMMAND, INVALID
; STOR COMMAND, ETC.) TO DETERMINE WHETHER CONNECTION
; SHOULD BE TERMINATED
SAVP: 0 ;SAVE MAIN PROCESS PDL FOR RESET
CHAR1: 0 ;←-1 BEF. OPCODE SCAN, ←0 WHEN CHAR THERE, "*" CONTROL
SNDMOD: 0 ;MODE SENT TO SERVER
SNDTYP: 0 ;TYPE SENT TO SERVER
SNDBYT: 0 ;BYTE SENT TO SERVER
MAILNG: 0 ;ON IF MAILING, FOR TYPE RESTORATION LATER
ACTION: 0 ;-1 ALLOWS SENDING ABOR COMMAND EVEN IF NO DxACTV
GIVELF: 0 ;-1 TELLS GETTTY TO RETURN LF WITHOUT READING TTY
PKUNAM: 0 ;FILENAME FOR PICKUP COMMAND
PKUEXT: 0 ;EXT DITTO
PKURNM: 0 ;FN ACTUALLY USED FOR PICKUP (PHASE CONTROL)
HAIRY: 0 ;-1 IF HAIRY ONE-LINE TRANSFER MONITOR CMD
HAIRBP: 0 ;BPT INTO HAIRBF
HAIRBF: BLOCK 50 ;BUFFER TO HOLD THE COMMAND
HAIRLS: 0 ;BPT TO LOCAL SPEC
HAIRRS: 0 ;BPT TO REMOTE SPEC
HAIRPT: 0 ;-1 IF PUTTING (STOR)
HAIRLR: 0 ;-1 IF HOST NAME ON THE LEFT
HASCII: 0 ;-1 FOR /A (ASCII) TRANSFER
HSTEND: 0 ;DELIMITER WHICH ENDS HOST (RBRACE OR SLASH)
USRSTR: BLOCK 10 ;USER NAME FOR REMOTE HOST
ACCSTR: BLOCK 10 ;ACCT FOR REMOTE HOST
PASSTR: BLOCK 10 ;PASSWORD FOR REMOTE HOST
IFN 0,<
HOST6: BLOCK 2 ;SIXBIT HOST RETURNED BY RDSITE
0 ;SIXBIZ
>
OPOPEN: 0
'DSK '
OTBUF
OTBUF: BLOCK 3
TYPTAB: "A"
"I"
"L"
"P"
"E"
"I" ;CROCK MODE, LOCAL BYTE FOR US, IMAGE FOR THEM
FNBUF: BLOCK 30 ;BUFFER FOR FILE XFER COMMAND ARGS
FNBUF2: BLOCK 30 ;DITTO FOR INSTEAD FILE READ FOR SAFETY CHECK
FNBPT: POINT 7,FNBUF ;BYTE POINTER TO ABOVE
DEFINE MESSG (X)
< OUTSTR [ASCIZ ⊗X
⊗]>
DEFINE INTOFF <INTMSK 1,[0]>
DEFINE INTON <INTMSK 1,[-1]>
CLS ←← 60000
RFC ←← 300000
VERBOSE ←← 0
;OCDISP OCS
; FTP Opcode Definitions
DEFINE OCX <
X(USER,USER)
X(LOGI,PUSER) ;PSEUDONYM FOR USER
X(PASS,PASS) ;PASSWORD NOW GOBBLED BY USER COMMAND, this for CWD, etc.
x(ACCT,WIDENT)
X(XCWD,PXCWD) ;now looks for password just like USER
X(CWD,PXCWD)
X(ALIA,PXCWD)
X(TYPE,TYPE)
X(ASCI,ASCSET) ;TYPE A
X(IMAG,IMGSET) ;TYPE I
X(LOCA,LCLSET) ;TYPE L
; X(MODE,MODE) BH 3/17/75 Flush losing text mode, was all wrong anyway
X(BYTE,BYTE)
X(RETR,RETR)
X(GET,PRETR) ;TENEX RETR
X(TTY,TTY) ;BH 12/2/77 TTY IS SYNONYM OF RETR BUT TO DEVICE TTY
X(STOR,STOR)
X(PUT,PSTOR)
X(SEND,PSTOR) ;TENEX STOR
X(APPE,STOR)
X(MLFL,MLFL)
X(MAIL,MAILIT)
X(XSEN,MAILIT) ;SEND TO MIT
X(XSEM,MAILIT) ;SEND/Y TO MIT
X(XMAS,MAILIT) ;SEND/M TO MIT
X(LIST,LIST)
X(NLST,LIST)
X(DIRE,PLIST) ;"DIRECTORY" IS TENEX LIST
X(QUOT,QUOTE) ;WHO KNOWS WHAT THIS ONE DOES
X(HELP,HELP) ;THIS ONE NEVER GETS A REAL ANSWER MAYBE
X(STAT,STAT) ;WAITS FOR 200 END OF STATUS
X(RNFR,WIDENT)
X(RNTO,WIDENT)
X(DELE,WIDENT)
; X(RSTR,RSTR) FLUSHED AT LAST!!!
X(QUIT,FQUIT)
X(BYE,FQUIT)
X(DISC,FQUIT) ;TENEX BYE
X(XIND,XIND)
X(PICK,PICKUP) ;CONTINUE MULTIPLE XFER AFTER ERROR
X(LPPN,LPPN) ;BH 4/4/76 LOCAL PPN MODE
X(RPPN,RPPN) ; AND REMOTE PPN MODE
X(DEBG,DEBG) ;BH 12/10/77 TYPE OUT ALL IMP INPUT
X(DEBU,DEBG) ;MRC HOW CAN ANYBODY EVER REMEMBER DEBG?
>
DEFINE X!(A,B) <
..!A←←.-OCDISP
0+B↔>
OCDISP: OCX
NOCS ←← .-OCDISP
DEFINE X(A,B) <[ASCIZ /A/]↔>
OCS: OCX
;FQUIT TTCINK STAT PXCWD WIDENT TTCIWT TTCIW1 QWAIT HELP IDENT IDENT1 IDENT2 RPLX PASS PASS2 PUSER USER USER1
FQUIT: MOVE AC3,[POINT 7,[ASCIZ /BYE
/]]
PUSHJ P,TTSTROUT
CLKINT =3*=60 ;WAIT FOR TIMEOUT OR REPLY
PUSHJ P,TTCIWT ;WAIT FOR REPLY
JRST QUIT
TTCINK: MOVEI T1,MSGSTK ;CHECK FOR EARLY-ARRIVING MESSAGE
CAML T1,MSGPTR
JRST TTCIW1 ;NO, WE REALLY HAVE TO WAIT
MOVE T1,MSGSTK ;YES, GET A MESSAGE CODE
MOVEM T1,CIFLAG ;SAVE FOR CALLER
MOVE T1,[MSGSTK+1,,MSGSTK] ;FLUSH FROM STACK
BLT T1,MSGSTK+6
AOS MSGCNT
SOS MSGPTR
POPJ P,
STAT: SETOM ACTION ;STAT JUST LIKE WIDENT BUT ALLOWS ABORT
PUSHJ P,WIDENT
SETZM ACTION
POPJ P,
PXCWD: MOVEI AC2,..XCWD ;FOR "ALIAS" COMMAND, BECOMES XCWD
JRST USER ;XCWD acts like USER in looking for password
WIDENT: PUSHJ P,IDENT ;HERE TO FORWARD COMMAND AND WAIT FOR REPLY
TTCIWT: MOVEI T1,MSGSTK ;SYNCHRONIZE--IGNORE SAVED MESSAGES
MOVEM T1,MSGPTR
MOVEI T1,10
MOVEM T1,MSGCNT
TTCIW1: SETZM RPLY# ;SET BY CLOCK OR LF CONTROL STREAM
PUSHJ P,SXACTV ;MAKE SURE SOMETHING HAPPENS?
QWAIT: PUSHJ P,TTWAIT ;AND GO WAIT
SKIPN RPLY# ;CONTINUE DOING THAT UNTIL REPLY
JRST QWAIT ; OR TIMEOUT
POPJ P,
HELP: SETOM HELPER# ;BH 12/30/77 CATCH ERROR REPLY TO HELP
IDENT: MOVE T1,@OCS(AC2)
TRO T1,100 ;LOW CHAR " "
SKIPE T2,NOPAR ;ANY PARAMS TO SCAN?
MOVE T2,[BYTE (7)15,12] ;NO, SEND CRLF
MOVE AC3,[POINT 7,T1]
IDENT1: PUSHJ P,TTSTROUT ;send string pointed to by AC3 to IMP
SKIPE NOPAR
JRST RPLX
IDENT2: PUSHJ P,GETTTY
PUSHJ P,IMPOUT
ifn verbose, <
outchr ["<"]
outchr ac1
outchr [">"] >
CAIE AC1,12
JRST IDENT2
RPLX: POPJ P,
PASS: SKIPE NOPAR ;skip unless EOL at end of cmd
JRST PASS2
PUSHJ P,GETTTY ;read to end of command line, ignoring
CAIE AC1,12
CAIN AC1,175
JRST PASS2 ;now ask user for password
JRST PASS
PUSER: MOVEI AC2,..USER ;"LOGIN" COMMAND SAME AS USER
USER: PUSHJ P,IDENT ;USER COMMAND: FIRST SEND IT
PUSHJ P,TTCIWT ;NOW WAIT FOR RESPONSE
MOVE T1,CIFLAG ;GET THE RESPONSE CODE
CAIL T1,=300
CAILE T1,=399 ;DO THEY WANT PASSWORD?
JRST USER1 ;NO, THAT'S ALL (OR HAGGLE)
PASS2: MOVE AC3,[POINT 7,[ASCIZ /PASS /]]
PTJOBX [0↔3] ;NO ECHO
HRROI T1,[030000,,1] ;TTYSET NO PEEK INPUT BUFFER
TTYSET T1,
LEYPOS 1400 ;NO LINE EDITOR
OUTSTR [ASCIZ /Password=/] ;ASK FOR PASSWORD
SETZM GIVELF ;HOO HAH
SETZM TTCHSV
SETZM NOPAR ;make us read password from TTY
PUSHJ P,IDENT1 ;GET AND FORWARD PASSWORD
OUTSTR [ASCIZ /
/]
HRROI T1,[10000,,] ;Suppress Control-CR once only
TTYSET T1,
LEYPOS 0 ;RESTORE THE WORLD
PTJOBX [0↔4]
HRROI T1,[030000,,0] ;TTYSET OK PEEK INPUT BUFFER
TTYSET T1,
PUSHJ P,TTCIWT ;NOW HANG ON FOR THE PASS REPLY
MOVE T1,CIFLAG
USER1: CAIGE T1,=400 ;NO POINT IN RETRYING HAGGLE IF FAILED
SKIPE AGREED ;NEGOTIATE A BYTE SIZE
POPJ P, ; UNLESS WE ALREADY HAVE
; JRST HAGGLE
;HAGGLE HAGASC BY10OK HAGLUZ ASCOK BY36OK IMGOK HAGTYP STREAM
;HAGGLE
;FALLS THROUGH
HAGGLE: SETOM CIGRQ ;TELL CI NOT TO TYPE RESPONSES
SKIPE HASCII ;BH 11/27/77 WANT ASCII?
JRST HAGASC ;YES
MOVE AC3,[POINT 7,[ASCIZ /TYPE I
/]] ;PITTS JARVIS CORRECTION FEATURE
PUSHJ P,TTSTROUT ;SEND IMAGE REQUEST FIRST
PUSHJ P,TTCIWT
MOVE T1,CIFLAG ;DON'T ANALYZE RESPONSE NOW,
MOVEM T1,HAGIMX# ; SAVE IT FOR LATER
MOVEI T1,=36 ;TRY TO SET UP 36 BIT BYTE SIZE
MOVEM T1,NEWBYT
PUSHJ P,BYTOUT
PUSHJ P,TTCIWT ;SEE IF THEY BUY IT
MOVE T1,CIFLAG
CAIGE T1,=400
JRST BY36OK ;THEY BOUGHT IT
HAGASC: MOVEI T1,10 ;NO, HAVE TO USE 8
MOVEM T1,NEWBYT
PUSHJ P,BYTOUT ;MAKE THEM HAPPY
PUSHJ P,TTCIWT ;STILL GAGGING RESPONSES
MOVE T1,CIFLAG
CAIGE T1,=400
JRST BY10OK
SETZM CIGRQ
OUTSTR [ASCIZ /Unable to use either 36 or 8 bit bytesize with this host.
Please report this to Bug-FTP.
/]
POPJ P, ;I GIVE UP, WHAT'LL THEY TAKE?
BY10OK: MOVEI T1,10
MOVEM T1,SAVBYT
MOVEM T1,DBS
MOVE AC3,[POINT 7,[ASCIZ /TYPE A
/]]
PUSHJ P,TTSTROUT ;IF WE CAN'T HAVE 36 BITS,
PUSHJ P,TTCIWT ;ASCII MAKES MORE SENSE.
MOVE T1,CIFLAG
CAIGE T1,=400
JRST ASCOK
OUTSTR [ASCIZ /Host rejects ASCII type with 8-bit bytesize.
Please report this to Bug-FTP.
/]
HAGLUZ: SETZM HAIRY
SETZM HASCII
SETZM AUTOLF
SETZM AUTOAL ;no auto abort on overwrite, yet
POPJ P,
ASCOK: SKIPN HAIRY
OUTSTR [ASCIZ /Using 8-bit ASCII transfers.
/]
SETZM DTYPE
SETZM DRTYPE
JRST HAGTYP
BY36OK: SKIPE T1,HAGIMX ;BELT AND SUSPENDERS
CAIL T1,=400 ;GIVE 'EM ANOTHER CHANCE IF THEY
SKIPA AC3,[POINT 7,[ASCIZ /TYPE I
/]]
JRST IMGOK ; TOOK BYTE 36
PUSHJ P,TTSTROUT ;LET'S GET THE OTHER STUFF ORGANIZED
PUSHJ P,TTCIWT ;(IF WE CAN AGREE)
MOVE T1,CIFLAG ;NOT TOO IMPORTANT ABOUT TYPE AND MODE
CAIGE T1,=400
JRST IMGOK
OUTSTR [ASCIZ /Host rejects IMAGE type with 36-bit bytesize.
Please report this to Bug-FTP.
/]
SKIPE HAIRY
JRST HAGLUZ
JRST STREAM ;TRY FOR MODE ANYWAY
IMGOK: SKIPN HAIRY
OUTSTR [ASCIZ ⊗Using 36-bit IMAGE transfers.
⊗]
HAGTYP: SETOM SNDTYP ;DECLARE TYPE SENT
STREAM: MOVE AC3,[POINT 7,[ASCIZ /MODE S
/]]
PUSHJ P,TTSTROUT ;WE DON'T REPORT SUCCESS OF MODE S
PUSHJ P,TTCIWT ;BECAUSE EVERYBODY TAKES IT
MOVE T1,CIFLAG ;AND BESIDES,
CAIGE T1,=400
SETOM SNDMOD ;IF NOT, USER WILL FIND OUT IN TIME
SETZM CIGRQ
SETOM AGREED#
POPJ P,
;ASCSET IMGSET LCLSET TYPE TYPEUN TYPEOK TYPINC BYSTET BADTYP BDTYMS WHICHA WHICHB DFCOM COMOUT BYTE BYTE1 BYTE2 BYTE3 BADARG BADBYT BDBYMS BYTOUT DECOUT SNDPAR STYP SBYT BYTTYP PICKUP PKUNU1 PKUNUL PKUERR
; Type, Mode, Dfcom, Sndpar, COMOUT, BYTOUT, PICKUP
ASCSET: MOVEI C,0
JRST TYPEOK
IMGSET: MOVEI C,1
JRST TYPEOK
LCLSET: MOVEI C,2
JRST TYPEOK
TYPE: PUSHJ P,GETCAP
MOVE B,[POINT 7,[ASCIZ /AILPEX/]]
PUSHJ P,WHICHA
JUMPL C,BADTYP
JRST .+1(C)
JRST TYPEOK
JRST TYPEOK
JRST TYPEOK
JRST TYPEOK ;BH 3/17/75 ASCII Print is same as ASCII to the sender!
JRST TYPEUN
JRST TYPEOK ;THIS ISN'T A REAL TYPE. L FOR US AND I FOR THEM.
TYPEUN: OUTSTR [ASCIZ /Unimplemented type
/]
JRST FLUSCS
TYPEOK: PUSHJ P,FLUSCS
TYPINC: MOVEM C,NEWTYP# ;SAVE IT
MOVE A,TYPTAB(C) ;GET LETTER BACK
MOVE AC3,[POINT 7,[ASCII /TYPE/]]
PUSHJ P,COMOUT ;FORWARD TO NETWORK
PUSHJ P,TTCIWT ;WAIT FOR REPLY
MOVE C,CIFLAG ;GET REPLY
CAIL C,=400 ;ERROR?
POPJ P, ;YES, DO NOTHING HERE
MOVE C,NEWTYP ;NO, CHANGE OUR TYPE
MOVEM C,DRTYPE ;SAVE "REAL" TYPE NAME
SETZM MAILNG ;NO LONGER SAVING OLD TYPE
CAIN C,3 ;BH 3/17/75 CHANGE P TO A
MOVEI C,0
CAIN C,5 ;AND X TO L
MOVEI C,2
MOVEM C,DTYPE
SETOM SNDTYP
MOVEI B,10 ;NEW BYTE FOR ASCIINESS
JUMPE C,.+2
MOVE B,SAVBYT ;NEW BYTE FOR NON ASCIINESS
CAMN B,NEWBYT ;COMPARE TO LAST SENT
JRST BYSTET
MOVEM B,NEWBYT
PUSHJ P,BYTOUT
PUSHJ P,TTCIWT ;WAIT FOR ANSWER
MOVE B,CIFLAG ;GET ANSWER CODE
CAIL B,=400 ;ERROR?
OUTSTR [ASCIZ /They shouldn't have accepted ASCII but rejected BYTE 8!
Please report this to Bug-FTP.
/]
BYSTET: PUSHJ P,BYTTYP ;CHANGE IMAGE TO LOCAL BYTE MAYBE
POPJ P,
BADTYP: OUTSTR BDTYMS ;HARD TIMES!
JRST FLUSCS
BDTYMS: ASCIZ /Types are:
A - ASCII. Conversion is done to or from Stanford char set as necessary.
I - Image. Bits are sent or received contiguously. Good for 36-bit
machines, may or may not be best for 32-bit.
L - Local byte. Bytes are stored as convenient for each host. For us,
same as image except for byte sizes 8 and 32, in which the first 32
bits of each PDP-10 word correspond to one word of a 32-bit machine
and the last 4 bits of the PDP-10 word are unused.
P - ASCII print file. We treat this the same as ASCII; some hosts may
do formatting conversions such as replacing tabs with spaces.
E - EBCDIC. Not implemented here.
X - Not a real type; this tells the other end I but is treated as L on
this end. Use it if you are talking to a 32-bit machine and want L
but they refuse L.
/
WHICHA: ;CALL: MOVE B,[POINT 7,[ASCIZ /<CHARACTERS>/]]
; MOVE A,<ASCII CHARACTER>
; PUSHJ P,WHICHA
; RETURN HERE, C(C) = -1, OR # OF CHARACTER IN A
SETZ C,
WHICHB: ILDB D,B
JUMPE D,[SETO C, ↔ POPJ P,]
CAMN D,A
POPJ P,
AOJA C,WHICHB
DFCOM: ;DeFault COMmand - JUST PASS IT ON TO THE SERVER TELNET
;CALL: ;MOVE A,<ONE CHARACTER (EATEN FROM COMMAND STRING)>
; ;MOVE AC3,[POINT 7,[ASCII /<COMMAND>/]]
; ;PUSHJ P,DFCOM
; ; ACTION: ON THE CONTROL LINK, OUTPUT THE COMMAND,
; ; THEN A SPACE, THEN THE ONE CHARACTER, THEN
; ; CRLF, THEN JRST FLUSCS
PUSHJ P,COMOUT ;SEND THE COMMAND
JRST FLUSCS
;COMand OUT - Same as above, but no flushing
COMOUT: PUSH P,A ;SAVE THE FIRST CHARACTER ARGUMENT
PUSHJ P,TTSTROUT ;SEND OUT THE 1,2,3, OR 4 COMMAND CHARACTERS
MOVEI AC1," "
PUSHJ P,IMPOUT ;SEND OUT THE DELIMITING SPACE
POP P,A ;RETREIVE THE ARGUMENT CHARACTER
PUSHJ P,IMPOUT ;SEND IT OFF
MOVE AC3,[POINT 7,[BYTE (7) 15,12,0]]
JRST TTSTROUT
BYTE: SETZB B,D
SETZB E,F
MOVSI C,-3 ;AT MOST THREE CHARS IN ARGUMENT
BYTE1: PUSHJ P,GETTTY ;GET DIGIT
CAIN A,15 ;C.R.?
JRST BYTE2 ; YES
CAIL A,"0"
CAILE A,"9"
JRST BADARG
IMULI B,=10
ADDI B,-"0"(A)
AOBJN C,BYTE1
PUSHJ P,GETTTY ;GET C.R.
CAIE A,15 ;C.R.?
JRST BADARG ; NO
BYTE2: CAIE B,=8 ;MAKE SURE SIZE OK
CAIN B,=32 ;THESE TWO ARE SPECIAL
JRST BYTE3
MOVEI C,=36 ;ELSE MUST FACTOR 36.
IDIVI C,(B)
JUMPN D,BADBYT ;LOSES
BYTE3: MOVEM B,NEWBYT# ;SAVE NEW BYTE SIZE
PUSHJ P,MLCHK ;GET BACK THE RIGHT TYPE MAYBE
MOVE B,NEWBYT
PUSHJ P,BYTOUT ;SEND IT TO THEM
PUSHJ P,TTCIWT ;WAIT FOR ANSWER
MOVE B,CIFLAG ;GET ANSWER CODE
CAIL B,=400 ;ERROR?
JRST FLUSCS ;YES, FORGET IT
MOVE B,NEWBYT ;OTHERWISE SET OUR BYTE SIZE(S)
MOVEM B,SAVBYT# ;SAVE FOR TYPE COMMAND
MOVEM B,DBS
PUSHJ P,BYTTYP ;MAYBE CHANGE IMAGE TYPE TO LOCAL BYTE
JRST FLUSCS
BADARG: OUTSTR [ASCIZ /The argument to BYTE is a decimal integer.
/]
BADBYT: OUTSTR BDBYMS ;BEDDY-BYE MESSAGE?
JRST FLUSCS
BDBYMS: ASCIZ /The byte size must be 8, 32, or a factor of 36--one of
1, 2, 3, 4, 6, 9, 12, 18, or 36. As far as our end of the
connection is concerned, these are all equivalent in their effect to
either 32 (8 and 32) or 36 (all the rest), which are the most efficient
choices. Use the others only if needed to accomodate some strange
machine at the other end.
/
BYTOUT: MOVE AC3,[POINT 7,[ASCIZ /BYTE /]]
PUSHJ P,TTSTROUT
MOVE A,NEWBYT
PUSHJ P,DECOUT
MOVE AC3,[POINT 7,[BYTE (7) 15,12,0]]
JRST TTSTROUT
DECOUT: IDIVI A,=10
ORI B,"0"
HRLM B,(P)
JUMPE A,.+2
PUSHJ P,DECOUT
HLRZ A,(P)
JRST IMPOUT
SNDPAR: SKIPE SNDMOD
JRST STYP ;MODE ALREADY SENT
SETOM SNDMOD
MOVE AC3,[POINT 7,[ASCII /MODE/]]
MOVEI A,"S"
PUSHJ P,COMOUT ;SEND THE COMMAND
STYP: SKIPE SNDTYP
JRST SBYT ;MODE ALREADY SENT
SETOM SNDTYP
MOVE AC3,[POINT 7,[ASCII /TYPE/]]
MOVE A,DRTYPE
MOVE A,TYPTAB(A) ;MODE CHAR
PUSHJ P,COMOUT ;SEND THE COMMAND
SBYT: POPJ P,
BYTTYP: MOVE B,DRTYPE ;GET REAL TYPE
SOJN B,CPOPJ ;DO NOTHING UNLESS IMAGE TYPE
MOVEI B,=36
IDIV B,DBS ;IS BYTE SIZE FACTOR OF 36?
MOVEI B,1
JUMPN C,.+2
MOVEI B,2 ;IF SO, WE CAN USE LOCAL BYTE
MOVEM B,DTYPE
POPJ P,
PICKUP: SETOM NOWILD# ;PICKUP COMMAND TO CONTINUE MULTIPLE XFER
SETZM PKUAOS# ;FLAG USER WANTS ONE AFTER THIS IF ALT
SKIPE A,NOPAR ;SKIP IF ARG TO COMMAND
JRST PKUNUL ;NO FN, SEE IF WE HAVE ONE STORED
PUSHJ P,GFNY ;READ LOCAL FN TO RESTART WITH
JRST PKUERR
SKIPN BADSYN ;NO GOOD IF NOT LOCAL SYNTAX
SKIPE FNDLIM ; OR IF NOT THE ONLY ONE
JRST PKUERR
MOVEM E,PKUEXT ;OK, SAVE THE PARAMETERS
MOVE A,SAFDLM
PKUNU1: CAIN A,175
SETOM PKUAOS
MOVEM F,PKURNM
SETOM PKUSET# ;TELL TTROUT NOT TO CLOBBER IT
OUTSTR [ASCIZ /Retype the file transfer command.
/]
SKIPE PKUNAM ;MAYBE WE ALREADY HAVE A COMMAND
OUTSTR [ASCIZ /Type [RETURN] to use the previous command.
/]
POPJ P, ;COMMAND SCANNER WILL GOBBLE THE COMMAND.
PKUNUL: SKIPE F,PKUNAM
JRST PKUNU1 ;XFER COMMAND GAVE US A NAME
PKUERR: OUTSTR [ASCIZ /The PICKUP command takes a LOCAL pathname as argument.
The multiple transfer command to be resumed can be entered after the command.
/]
JRST FLUSCS
;MAILIT From MAIL1 NOEND EOMAIL QUOTE LINOUT RLNOUT LINOLF CHAROUT WRTSIX WRSXLP SJSX
; Mail, Quote. MAILIT, LINOUT, CHAROUT
MAILIT: MOVE AC2,@OCS(AC2) ;COMMAND -- MAIL OR XSEN ETC
TRO AC2,100 ;LOW ORDER SPACE
MOVEM AC2,COMBUF
MOVE AC3,[POINT 7,COMBUF]
PUSHJ P,TTSTROUT
PUSHJ P,LINOUT ;SEND OUT REST OF LINE
SETOM CIINIT ;WE WANT TO TYPE A 300 HERE
PUSHJ P,TTCIWT ;WAIT FOR RESPONSE
SETZM CIINIT ;UNWDGE CI LEST TTROUT GET HUNG
MOVE AC3,CIFLAG
CAIL AC3,=400
POPJ P, ;FAILED
SETOM ACTION ;SO ABORT WILL TAKE
MOVE AC3,[POINT 7,[ASCIZ /Date: /]]
PUSHJ P,TTSTROUT
PUSHJ P,DATGEN
MOVE AC3,[POINT 7,[ASCIZ /
From: /]]
PUSHJ P,TTSTROUT
MOVEI B, ;PRINT THE PPN
GETPPN B,
HRLZS B
PUSHJ P,WRTSIX
MOVE AC3,[POINT 7,[ASCIZ / at SAIL
/]]
PUSHJ P,TTSTROUT
MAIL1: PUSHJ P,RGETTY ;ARRIVE HERE FOR FIRST CHARACTER OF NEW LINE
CAIE A,"." ;LINE CONTAINING ".<CRLF>" TERMINATES MAIL.
JRST NOEND
PUSHJ P,RGETTY ; ., TEST CR
CAIN A,15
JRST EOMAIL
MOVE T1,A
MOVEI A,"."
PUSHJ P,TTCHROUT ; NOT END, WRITE .,
MOVE A,T1 ; THEN NEXT CHAR
NOEND: PUSHJ P,TTCHROUT ; FIRST (OR 2D) CHAR OF LINE
PUSHJ P,RLNOUT ;REST OF LINE
JRST MAIL1 ;BACK FOR MORE
EOMAIL: PUSHJ P,RGETTY ;GET THE LF
MOVE AC3,[POINT 7,[ASCIZ /-------
.
/]]
PUSHJ P,TTSTROUT
SETZM ACTION
JRST TTCIWT ;OK AFTER REPLY COMES
QUOTE:
LINOUT: SKIPE GIVELF
JRST LINOLF ;FAKE A CRLF ON ENTRY HERE WHEN WEDGED
RLNOUT: PUSHJ P,CHAROUT ;SEND OUT REST OF TTY INPUT LINE (ASSUMING CRLF)
CAIE A,12
JRST RLNOUT
POPJ P,
LINOLF: MOVEI A,15
PUSHJ P,TTCHROUT
MOVEI A,12
JRST TTCHROUT
CHAROUT:PUSHJ P,CRGETY ;GET CHARACTER FROM TTY
JRST TTCHROUT ;SEND IT OUT AND RETURN
WRTSIX: PUSH P,T3
MOVEI T3,6
WRSXLP: MOVEI A,
LSHC A,6
JUMPE A,SJSX
ADDI A,40
PUSHJ P,TTCHROUT
SJSX: SOJG T3,WRSXLP
POP P,T3
POPJ P,
;TEMPA PLIST LIST TTY PRETR RETR TRETR RETR0 RETR1 RETRLP RETNPK RETPKF TYPWRT SAFASK SAFEOK TYPFIL RETRL1 SAFLKF SAFAOS SAFAUT SAFAU1 SAFEAA SAFEA1 SAFEAB CCR SAFENM TYPSIX RETRLX TYPNLS RETLX1 SAFX0 RET1ST RETRST NLSTST DIDOXX DIDOX1 DIDOXY DIDOLZ DIDOLZ SAFX1 MLFL PSTOR STOR STOR0 STORLP STORL1 STONPK STOPKF TYPREA STO1DO STORDO UFDPPN NOUFD UFDIN UFDIN1 FLUSCS SCANTO MLCHK SV2INC ERRWAT ERRWA1 GOWAIT LPPN RPPN DEBG
TEMPA: SKIPE MAILNG
POPJ P,
MOVE C,DRTYPE
MOVEM C,SVOTYP
MOVEI C,0
PUSHJ P,SV2INC
SETOM MAILNG ;THIS MUST COME AFTER TYPINC CALL!
SETZM PKUNAM ;THESE COMMANDS DO NOT ADMIT OF PICKUP OPTION
POPJ P,
PLIST: MOVEI AC2,..LIST ;FOR "DIRECTORY" COMMAND
LIST: PUSHJ P,TEMPA ;LIST AND NLST JUST LIKE RETR BUT ASCII
SETOM LISTNG# ;NO LOCAL PATHNAME IMPLIES TTY
JRST RETR0
TTY: PUSH P,DRTYPE ;SAVE OLD TYPE
SETOM CIGRQ ;BH 8/20/80 Don't confuse the issue with replies
MOVEI C,0 ;(THIS WAY SINCE ASCSET EATS COMMAND!)
PUSHJ P,TYPINC ;DO IMPLICIT ASCII COMMAND
MOVEI AC2,..RETR ;TTY COMMAND IS RETR
SETOM TYPECM ; WITH DEFAULT OUTPUT DEVICE TTY
SETZM CIGRQ ;BH 8/20/80 Make sure no-such-file gets told
PUSHJ P,TRETR
POP P,C ;RESTORE OLD TYPE
SKIPE HAIRY ;BH 8/4/80 ONE-LINER?
POPJ P, ;YES, FINISHED.
JRST TYPEOK
PRETR: MOVEI AC2,..RETR ;FOR "GET" COMMAND
RETR: SETZM TYPECM
TRETR: PUSHJ P,MLCHK
SETZM LISTNG
SETZM PKUNAM ;NO PICKUP ALLOWED UNLESS MULTIPLE
RETR0: SETZM NOHACK# ;IMPLICIT LOCAL PATHNAME OK
SETZM NOWILD ;SO IS WILDCARD FN
MOVE AC2,@OCS(AC2) ;COMMAND -- LIST OR RETR
TRO AC2,100 ;LOW ORDER SPACE
MOVEM AC2,COMBUF
MOVEM AC2,PKUCMD#
PUSHJ P,GFN ;GET FILE NAME
POPJ P, ; DIDN'T GET ONE
MOVE B,FNDLIM ;GET DELIMITER
CAIN B,"→" ;ANYTHING BUT THIS OK
JRST GFNLUZ
JUMPN B,RETR1 ;IF NO DELIMITER (NO LOCAL PATHNAME),
SKIPN TYPECM# ; (BH 12/2/77 TYPE COMMAND)
SKIPE LISTNG ; AND COMMAND WAS LIST OR FRIENDS,
MOVSI C,'TTY' ; OUTPUT LISTING TO TTY
RETR1: SKIPN LISTNG ;IF COMMAND IS RETR,
SKIPN WILDCD ; AND WE HAVE WILD NAME,
JRST RET1ST ; THEN SPECIAL, ELSE GO DO ONE.
MOVEM C,WCDEV# ;SAVE THE LOCAL SPEC
MOVEM D,WCPPN#
MOVEM E,WCEXT#
MOVEM F,WCFIL#
MOVE B,[ASCII /NLST /] ;FIRST WE MUST DO NLST
MOVEM B,COMBUF
SETOM GAG200 ;FLUSH SOME CRUFTY MESSAGES
PUSHJ P,TEMPA
SETOM NLSTFL# ;FLAG WHERE THE RESPONSE GOES
MOVE B,JOBFF ;PREPARE BYTE PTR
HRLI B,440700 ;IDCON WON'T USE THIS JOBFF
MOVEM B,NLSBPT#
MOVEM B,NLSBP1# ;ALSO SAVE FOR LATER READING
SETZM WILDCD ;SO WE FLUSH ON FAILURE HERE
PUSHJ P,NLSTST ;DO IT!
SETOM WILDCD
PUSHJ P,MLCHK ;GET OUT OF ASCII
SETZM GAG200 ;BACK TO ALLOWING RESPONSES
MOVEI A,0
IDPB A,NLSBPT ;MARK END OF LIST
MOVE B,NLSBP1
MOVEM B,NLSBPT
MOVE B,[ASCII /RETR /]
MOVEM B,COMBUF
SETZM LPPNOW ;BH 4/4/76 DON'T PREVENT SENDING PPN BACK
RETRLP: MOVE B,NLSBPT ;THIS IS THE LOOP FOR EACH FILE
MOVEM B,FNBPT ;INIT LOCAL FN SCAN
ILDB A,B ;GET FIRST CHAR
JUMPE A,CPOPJ ;THIS IS THE VERY END TEST!!!
PUSHJ P,GFNX ;READ A FN
JRST RETRLX ;OOPS, COULDN'T HACK IT
MOVE C,WCDEV ;GET BACK OUR LOCAL SPEC
MOVE D,WCPPN
MOVE A,WCEXT
CAME A,['* ']
MOVE E,A
MOVE A,WCFIL
CAME A,['* ']
MOVE F,A
SKIPN PKURNM ;ARE WE IN PICKUP MODE?
JRST RETNPK ;NOPE
CAMN F,PKURNM ;YES, COMPARE FN AND EXT
CAME E,PKUEXT
JRST RETPKF ;NOT EQUAL
SETZM PKURNM ;FROM NOW ON WE DO EVERYTHING
SKIPE PKUAOS
JRST RETPKF ;IF HE TYPED ALTMODE WE SKIP THIS ONE TOO
RETNPK: PUSHJ P,TYPWRT
PUSHJ P,SAFX0 ;PRE-MESSAGE TELLING REMOTE FN
JRST SAFX1 ;FAILED
MOVE B,NLSBPT ;PTR TO BEGINNING OF THIS FN
MOVEM B,FNBPT ;SET UP FOR REMOTE SCAN
PUSHJ P,RETRST ;DO OUR BOOGEY
SKIPA B,FNBPT ;FNSEND HAS NICELY LEFT THIS
RETPKF: MOVE B,PKUBPT#
MOVEM B,NLSBPT ; POINTING TO THE LF
JRST RETRLP
TYPWRT: CAME C,['DSK ']
JRST CPOPJ2
SKIPE AUTOLF# ;FLAG TO NOT ASK EVER
JRST SAFAOS
MOVEM F,SAFENM ;PREPARE FOR SAFETY LOOKUP
MOVEM E,SAFENM+1
MOVEM D,SAFENM+3
LOOKUP UFDC,SAFENM
JRST SAFLKF ;LOOKUP FAILED, MAYBE OK
SAFASK: XCT @(P) ;FIRST HE SEES REMOTE NAME MAYBE
AOS (P)
SKIPE AUTOAL ;skip unless want to abort automatically
JRST SAFEAA ;abort since file exists
OUTSTR [ASCIZ /File already exists: /]
PUSHJ P,TYPFIL
OUTSTR [ASCIZ /Type <cr> to overwrite it, <lf> to overwrite this and all similar cases,
<alt> to abort this transfer, CONTROL-<alt> to abort this and similar cases,
or a filename to write: /]
MOVEM D,SAFENM+3 ;SAVE PPN AGAIN
CLOSE UFDC, ;DONE WITH THIS LOOKUP
PUSHJ P,GFNY
JRST SAFEAB ;LOSING LOCAL FN
SKIPLE A,SAFDLM ;JUST DELIMITER?
JRST SAFAUT ;YUP
SKIPN WILDCD ;DON'T ALLOW WILDCARD
SKIPE BADSYN ; OR FOREIGN SYNTAX
JRST GFNLUZ
SKIPE FNDLIM ;DONT ALLOW FOO=BAR EITHER
JRST GFNLUZ ;ELSE WE HAVE FN AND ACS ARE SET UP
SAFEOK: OUTSTR [ASCIZ /Writing /]
AOS (P) ;MADE IT
TYPFIL: MOVEM F,PKUNAM ;SAVE FOR PICKUP COMMAND
MOVEM E,PKUEXT
MOVE B,F ;TELL THE USER WHAT WE'RE WRITING
PUSHJ P,TYPSIX
SKIPN B,E
JRST RETRL1
OUTCHR ["."]
PUSHJ P,TYPSIX
RETRL1: OUTCHR ["["]
HLLZ B,D
PUSHJ P,TYPSIX
OUTCHR [","]
HRLZ B,D
PUSHJ P,TYPSIX
OUTSTR [ASCIZ /]
/]
POPJ P,
SAFLKF: HRRZ A,SAFENM+1 ;SAFETY LOOKUP FAILED, WHY?
SOJG A,SAFASK ;BAD REASON
SAFAOS: AOS (P) ;SKIP PRE-MESSAGE
JRST SAFEOK
SAFAUT: CAIE A,12 ;JUST A DELIMITER:
JRST SAFAU1
SETOM AUTOLF ;IF LF, LIKE CR BUT NEVER ASK AGAIN
OUTCHR CCR ;BACK TO THE BAYOU
SAFAU1: CAIN A,175
JRST SAFEA1 ;ABORT ON ALT
MOVSI C,'DSK' ;ELSE RESTORE OLD FN
MOVE D,SAFENM+3
HLLZ E,SAFENM+1
MOVE F,SAFENM
JRST SAFEOK
SAFEAA: OUTSTR [ASCIZ /Skipping file that already exists: /]
JRST TYPFIL ;type filename and take direct return
SAFEA1: SKIPN ALTBKY ;see CONTROL on the altmode?
JRST SAFEAB
SETOM AUTOAL ;yup, abort automatically hereafter
OUTSTR [ASCIZ /
OK, pre-existing files will now be skipped automatically./]
SAFEAB: OUTSTR [ASCIZ /
/] ;HE TYPED ALT, NO CRLF
CCR: POPJ P,15 ;NON SKIP RETURN
SAFENM: BLOCK 4
TYPSIX: JUMPE B,CPOPJ
MOVEI A,0
LSHC A,6
JUMPE A,TYPSIX
ADDI A,40
OUTCHR A
JRST TYPSIX
RETRLX: OUTSTR [ASCIZ / (Pathname from remote host: /]
PUSHJ P,TYPNLS
OUTSTR [ASCIZ /)
Error in file list, can't do multiple RETR.
/]
POPJ P,
TYPNLS: MOVE B,NLSBPT ;TYPE LOSING LINE
RETLX1: ILDB A,B
JUMPE A,CPOPJ
CAIE A,15
CAIN A,12
POPJ P,
OUTCHR A
JRST RETLX1
SAFX0: OUTSTR [ASCIZ /RETR of remote file /]
PUSHJ P,TYPNLS
OUTSTR [ASCIZ /
/]
POPJ P,
RET1ST: SETZM WILDCD ;SO "WILD" LIST WINS
SKIPN LISTNG
SKIPE FNDLIM
JRST RETRST
PUSHJ P,TYPWRT ;TELL USER WHAT FILE WE'RE WRITING IF NOT EXPLICIT
JFCL ;NO PRE-MESSAGE NEEDED
POPJ P, ;ALREADY EXISTS AND ABORTED
RETRST: MOVEI B,DIMP
PUSHJ P,ILDDEV ;INIT LOCAL DATA DEVICE
JRST FLUSCS ; DIDN'T INIT
MOVEM C,DIACS+C ;SAVE DEVICE NAME,
MOVEM D,DIACS+D ; PROJECT-PROGRAMMER NAME,
MOVEM E,DIACS+E ; EXTENSION,
MOVEM F,DIACS+F ; FILE NAME FOR DI ROUTINE
NLSTST: SETOM NOERRS# ;DON'T ALLOW I/O-TYPE ERROR MSGS UNTIL THEY OK IT
PUSHJ P,SNDPAR ;SEND MODE, TYPE, BYTE IF NEEDED
SETOM DIACTV ;START UP DI ROUTINE
SETZM WILDCD ;MAY HAVE BEEN SET BY TYPWRT SAFETY GFNY
DIDOXX: MOVE AC3,[POINT 7,COMBUF]
SETZM SOCKET ;OK, SO I'M PARANOID
SETZM BAUDOK# ;HOLD UP OUR MESSAGE UNTIL AFTER THEIRS
PUSHJ P,FNSEND
DIDOX1: PUSHJ P,TTCINK ;WAIT FOR REPLY, BUT MAYBE IT CAME EARLY
MOVE AC3,CIFLAG
CAIL AC3,=400
JRST DIDOLZ
; CAIN AC3,=255
; JRST DIDOX1 ;THIS WAS SOCK MESSAGE, NOT XFER START MSG
SETZM NOERRS ;ERRORS ARE REAL NOW
SKIPE TYPECM ;BH 8/20/80 If TTY command,
SETOM CIGRQ ;BH 8/20/80 don't confuse the issue with replies
PUSHJ P,TTCINK ;BY GOLLY THERE'S NO POINT IN OVERLAPPING!
SETOM BAUDOK ;OK TO END DX ROUTINE NOW (PUN, PRETTY FUNNY HUH)
DIDOXY: SKIPN DIACTV ;WE MUST GET BOTH ENDS FINISHED BEFORE
SKIPE DOACTV ; ACCEPTING ANY MORE COMMANDS.
JRST .+2
JRST SXACTV ;OK NOW
PUSHJ P,TTWAIT
JRST DIDOXY ;WAIT FOR INACTIVE HERE
REPEAT 0,< ;NOW THAT WE CAN PICKUP THERE IS NO REASON NOT TO STOP ON ERRORS
DIDOLZ: CAIE AC3,=433 ;NEED ACCT TO WRITE, MULTIPLE WILL KEEP LOSING
SKIPN WILDCD ;FILE OP LOST, MULTIPLE?
JRST RESET ;NO, FLUSH
JRST IORSET ;JUST FLUSH IO
>
DIDOLZ: JRST RESET
SAFX1: ILDB A,NLSBPT ;SKIP THE LOSING REMOTE FILE
JUMPE A,CPOPJ
CAIE A,12
JRST SAFX1
JRST RETRLP
MLFL: PUSHJ P,TEMPA ;TEMPORARY ASCII MODE, WILL BE RESTORED LATER
SETOM NOHACK ;MUST BE EXPLICIT LOCAL SPEC, NO WILDCARD
JRST STOR0
PSTOR: MOVEI AC2,..STOR ;"SEND" COMMAND
STOR: PUSHJ P,MLCHK
SETZM NOHACK
SETZM NOWILD
SETZM PKUNAM
STOR0: MOVE AC2,@OCS(AC2) ;COMMAND -- APPE OR STOR
TRO AC2,100 ;LOW ORDER SPACE
MOVEM AC2,[COMBUF: 0↔0]
MOVEM AC2,PKUCMD
PUSHJ P,GFN
POPJ P, ; NO FILE NAME
MOVE B,FNDLIM
CAIN B,"←" ;ANYTHING ELSE OK
JRST GFNLUZ
SKIPN WILDCD ;WILDCARD STOR?
JRST STO1DO ;NOPE, JUST DO IT
MOVEM C,WCDEV ;WILD, SAVE STUFF
MOVEM D,WCPPN
MOVEM E,WCEXT
MOVEM F,WCFIL
MOVEM D,UFDPPN ;PREPARE TO LOOK UP UFD
MOVE A,[' 1 1']
MOVEM A,UFDPPN+3 ;BOO, DEC
LOOKUP UFDC,UFDPPN
JRST NOUFD
STORLP: PUSHJ P,UFDIN ;LOOP THROUGH UFD
MOVEM A,GFNFIL ;SAVE FN (EVEN IF ZERO)
PUSHJ P,UFDIN ; AND EXT
HLLZM A,GFNEXT
MOVEI A,UFDN-2 ;FLUSH THE REST OF THE ENTRY
MOVEM A,DIRFLC
STORL1: PUSHJ P,UFDIN
SOSLE DIRFLC
JRST STORL1
SKIPN A,GFNFIL ;REALLY A FILE?
JRST STORLP ;NOPE
CAME F,['* '] ;MATCH TEMPLATE?
CAMN F,A
SKIPA A,GFNEXT ;YES, TRY EXT
JRST STORLP
CAME E,['* ']
CAMN E,A
JRST .+2
JRST STORLP
MOVE F,GFNFIL ;SET UP ILDDEV
MOVE E,GFNEXT
SKIPN PKURNM
JRST STONPK ;NOT DOING PICKUP
CAMN F,PKURNM
CAME E,PKUEXT
JRST STOPKF ;NOT A MATCH
SETZM PKURNM
SKIPE PKUAOS
JRST STOPKF ;IF HE TYPED ALTMODE WE SKIP THIS ONE TOO
STONPK: MOVE D,WCPPN
MOVE C,WCDEV
PUSHJ P,TYPREA
PUSH P,FNBPT ;SAVE THIS
PUSHJ P,STORDO ;DO IT!
POP P,FNBPT
STOPKF: MOVE F,WCFIL
MOVE E,WCEXT
JRST STORLP
TYPREA: CAME C,['DSK ']
POPJ P,
OUTSTR [ASCIZ /Reading /]
JRST TYPFIL
STO1DO: JUMPE B,STORDO
SKIPN NOHACK
PUSHJ P,TYPREA
STORDO: MOVEI B,DOMP ;INDICATE DIRECTION OF DATA FLOW
PUSHJ P,ILDDEV ;INITIALIZE LOCAL DATA DEFICE
JRST FLUSCS ; COULDN'T
MOVEM C,DOACS+C ;SAVE DEVICE NAME,
MOVEM D,DOACS+D ; PROJECT PROGRAMMER NAME,
MOVEM E,DOACS+E ; EXTENSION,
MOVEM F,DOACS+F ; FILE NAME FOR DO ROUTINE
SETOM NOERRS
PUSHJ P,SNDPAR ;SEND MODE, TYPE, BYTE IF NEEDED
SETOM DOACTV ;START UP DATA OUT ROUTINE
JRST DIDOXX ;**** JOIN RETR HERE
UFDPPN: 0
'UFD '
0
' 1 1'
NOUFD: OUTSTR [ASCIZ /Can't read UFD for multiple STOR.
/]
POPJ P,
UFDIN: SOSG UBUF+2 ;YE OLDE ROUTINE
IN UFDC, ; BUT WITH UPLEVEL RETURN
JRST UFDIN1
STATO UFDC,20000
OUTSTR [ASCIZ /Input error reading UFD for multiple STOR, quitting.
/]
CLOSE UFDC,
POP P,(P)
POPJ P,
UFDIN1: ILDB A,UBUF+1
POPJ P,
FLUSCS: SKIPE HAIRY ;BH 8/22/82 For error in one-liner,
POPJ P, ; avoid waiting forever for tty.
MOVEI B,12 ;SET CHARACTER SEARCH FOR LINE FEED
SCANTO: PUSHJ P,GETTTY
CAIE B,12 ;UNLESS WE ARE LOOKING FOR LF
CAIE A,"=" ; WE ACCEPT EQUAL SIGN FOR ANYTHING
CAMN A,B ;CHARACTER SAME AS ONE WE'RE SCANNING TO?
POPJ P, ; YES, EXIT
CAIE A,12 ;LINE FEED YET?
JRST SCANTO ; NO
OUTSTR [ASCIZ /ILLEGAL FORMAT
/]
POP P,A ; YES, RETURN UPLEVEL
POPJ P,
MLCHK: SKIPN MAILNG
POPJ P,
SETZM MAILNG
MOVE C,SVOTYP
SV2INC: PUSH P,AC2
PUSHJ P,TYPINC ;SEND TYPE AND BYTE
POP P,AC2
POPJ P,
;;ERRWAT -- USED TO WAIT UNTIL XFER IS APPROVED OR REJECTED BY SERVER
;;IT RETURNS AT ONCE IF NOERRS IS ZERO, OTHERWISE SETS A CLOCK INTERRUPT
;;(SO IF HE FLUSHED US WE FIND OUT) AND WAITS FOR NOERRS TO CLEAR.
;;IF THE XFER IS REJECTED, IT NEVER RETURNS, BUT GOES TO RESET INSTEAD.
;; PUSHJ P,ERRWAT
;; PUSHJ P,<DOWAIT OR DIWAIT>
;; RETURN HERE
;;GOWAIT -- VERSION OF ERRWAT WHICH DOES NOT ENABLE CLOCK INTERRUPT, USED
;;TO DELAY START OF ACTUAL DATA TRANSFER UNTIL ARRIVAL OF APPROVAL. CLOCK
;;IS NEEDED FOR ERROR MSG WAIT BECAUSE THE ERROR MIGHT MEAN WE HAVE BEEN
;;DESERTED AND WILL NEVER GET A MSG, BUT WE SHOULD WAIT FOREVER TO START
;;THE TRANSFER IF NECESSARY.
ERRWAT: SKIPN NOERRS
JRST CPOPJ1
CLKINT 5*=60
ERRWA1: XCT @(P)
GOWAIT: SKIPN NOERRS
JRST CPOPJ1
JRST ERRWA1
;;LPPN AND RPPN SET AND RESET THE LPPNON FLAG, WHICH DETERMINES WHETHER
;;A PPN IN A HERE-AND-THERE FILESPEC (NO = OR EQUIVALENT) IS A REMOTE
;;(NORMAL CASE, FLAG OFF) OR A LOCAL (FLAG ON) PPN.
LPPN: SETOM LPPNON
JRST FLUSCS
RPPN: SETZM LPPNON
JRST FLUSCS
;;DEBG SETS CIDEBG FLAG, SO THAT ALL IMP CONTROL LINK INPUT IS TYPED
;;INCLUDING THE MAGIC NUMBERS AND REGARDLESS OF CIGRQ AND FRIENDS
;;USEFUL FOR DEBUGGING.
DEBG: SETOM CIDEBG
JRST FLUSCS
;TTSTROUT STROUT STROU1 STROUF TTCHROUT DOCHRO GETTTY CRGETY RGETTY GETTT1 GETTT2 FAKELF SPCRD SPCRDE GETCAP SXACTV
; STROUT, TTSTROUT, TTCHROUT, GETTTY, GETCAP, SXACTV
; Small Utility Routines For FTP Program
TTSTROUT:
STROUT: ;OUTPUT CHR STRING ON IMP CONTROL CHANNEL
;CALL: MOVE AC3,<BYTE POINTER TO STRING>
; PUSHJ P,STROUT
; RETURN HERE, AC1,AC2,AC3 ALL CLOBBERED
ILDB AC1,AC3
JUMPE AC1,STROU1
PUSHJ P,IMPOUT
JRST STROUT
STROU1: POPJ P,
STROUF: -1 ;-1 IF STROUT ROUTINE IS AVAILABLE
TTCHROUT:
DOCHRO: PUSHJ P,IMPOUT
JRST STROU1
GETTTY: SKIPE GIVELF
JRST FAKELF
CRGETY: MOVEI A,0 ;ENTRY FROM LINOUT VIA CHAROUT
EXCH A,TTCHSV ;LOOK FOR SAVED TTY CHAR
JUMPN A,CPOPJ ;YES, RETURN IT
RGETTY: READS(AC1,< ;LINE AT A TIME ONLY!
JRST [ SKIPE SPCIN
JRST [ PUSHJ P,SPCRD
JRST GETTT1
JRST GETTT2 ]
GETTT1: PUSHJ P,TTWAIT
JRST RGETTY ]
>)
GETTT2: CAIN A,12
SETOM GIVELF ;LF, KEEP GIVING LF FROM NOW ON
POPJ P,
FAKELF: MOVEI A,12
POPJ P,
SPCRD: SOSG IFBUF+2
IN INFL,
JRST .+2
JRST SPCRDE
ILDB AC1,IFBUF+1
OUTCHR AC1
AOS (P)
POPJ P,
SPCRDE: SETZM SPCIN
POPJ P,
GETCAP: PUSHJ P,GETTTY ;SAME AS GETTTY, ONLY RETURNS CAPITAL ASCII
CAIL A,"a"
CAILE A,"z"
POPJ P,
SUBI A,"a"-"A"
POPJ P,
SXACTV: PUSH P,[-2] ;ROUTINE TO SET SACTV WITHOUT
POP P,XACTV ; CLOBBERING ACCMULATORS
POPJ P,
;FTPINI RESET FTLOOP FTLOP1 FTLOP3 FTLOP2 FTLCHK TTESCI ESCI ESCI1 INSBLK ILEVEL ILEVE1 IORSET RESET1 UFDOPN UBUF
; Ftpini, Reset, Ftloop, Ilevel -- locus of FTP control. ESCI, TTESCI.
FTPINI: MOVEM P,SAVP ;FOR RESET
OPEN UFDC,UFDOPN ;OPEN UFD/SAFETY LOOKUP CHANNEL
JRST 4,.-1
SKIPN HAIRY ;FTP/Q SETS AUTOLF
SETZM AUTOLF#
SETZM AUTOAL# ;no auto abort if file already exists
SETZM GIVELF
SETZM TTCHSV
SETZM CNIBTS
SETOM CIINIT
SETZM SOCKFL
SETZM SOCKET
MOVEI AC1,1
MOVEM AC1,DRTYPE
MOVEI AC1,2
MOVEM AC1,DTYPE
SETZM SNDTYP
SETZM SNDMOD
SETZM SNDBYT
SETZM MAILNG
SETZM AGREED ;-1 WHEN WE NEGOTIATE A BYTE SIZE
MOVEI AC1,=36
MOVEM AC1,DBS
MOVEM AC1,SAVBYT
MOVEI AC1,ILEVEL
MOVEM AC1,JOBAPR
MOVSI AC1,(<INTTTY!INTIMS!INTINP!INTTTI>)
INTENB AC1,
SETOM STROUF
;; HERE AFTER ERROR RETURN ON DATA TRANSFER CMND
RESET: PUSHJ P,IORSET ;RESET DO AND DI STUFF
MOVE P,SAVP
SETZM CINUM
SETZM CISVG
MOVEI AC1,4
MOVEM AC1,CIGAG
SETZM CIGRQ
SETZM HYPHEN
SETZM ESCIFL ;CLEAR ESC-I ABORT FLAG
SETZM ACTION ;FLAG TO ALLOW ABORT WITHOUT ACTIVE IO
SETZM TTHUNG
SETZM CIHUNG
SETZM NOERRS ;IDCON MAY COMPLAIN ABOUT LOSSAGE
SETZM PKURNM ;NOT JUST AFTER PICKUP
MOVEI C,MSGSTK ;FLUSH SAVED REPLY CODES
MOVEM C,MSGPTR
MOVEI C,10
MOVEM C,MSGCNT
MOVE AC1,[XWD -20,TTPDL]
MOVEM AC1,TTP
MOVE AC1,[XWD -20,CIPDL]
MOVEM AC1,CIP
;; CLRBFI
FTLOOP: MOVE AC1,CNIBTS
TLZE AC1,(<INTIMS>)
JRST FTLCHK ;CHECK STATUS OF CONNECTIONS
FTLOP1: TLZE AC1,(<INTTTI>)
PUSHJ P,ESCI ;USER WANTS TO ABORT
PUSHJ P,TTDISP
PUSHJ P,CIDISP
SKIPE DIACTV
PUSHJ P,DIDISP
SKIPE DOACTV
PUSHJ P,DODISP
INTMSK [0] ;DISABLE INTERRUPTS
AOSLE XACTV ;IS THERE STILL ACTION SOMEWHERE?
JRST FTLOP2
FTLOP3: INTMSK [-1] ;REENABLE
JRST FTLOOP
FTLOP2: SKIPN DIACTV
SKIPE DOACTV
JRST .+2
SKIPN SPCIN
IMSTW [-1] ;GO INTO WAIT, RE-MASKING INTERRUPTS ON
JRST FTLOP3
FTLCHK: MTAPE IMP,STTBLK
MOVE AC2,STTBLK+1
IOR AC2,STTBLK+2
TLNE AC2,(<CLSS!CLSR>)
JRST QUIT
MOVEM AC1,CNIBTS
JRST FTLOP1
TTESCI: PUSH P,AC1
MOVSI AC1,(<INTTTI>)
INTGEN AC1,
POP P,AC1
JRST 2,@130 ;JOBOPC
ESCI: MOVEM AC1,CNIBTS
SETZM TTIFLG
SKIPN DIACTV
SKIPE DOACTV
JRST ESCI1
SKIPE ACTION
JRST ESCI1 ;ALLOW ABORT IN SOME NON-IO SITUATIONS (STAT, MAIL)
OUTSTR [ASCIZ /
No transfer in progress.
/]
JRST RESET
ESCI1: SETZM DIACTV ;NO MORE DATA THRASHING ALLOWED
SETZM DOACTV
OUTSTR [ASCIZ /
Aborting transfer.
/]
MOVEI AC1,200 ;OLD PROTOCOL DATA MARK
PUSHJ P,IMPOUT
MOVEM SSOCK,INSBLK+2
MTAPE IMP,INSBLK ;SEND INS
MOVE AC3,[POINT 7,[ASCIZ /ABOR
/]]
PUSHJ P,STROUT ;SEND ABORT COMMAND
SETOM ESCIFL# ;THIS TELLS TT TO WAIT FOR ANSWER
POPJ P, ;TT IS NEXT IN LINE
INSBLK: 11↔0↔0
ILEVEL: MOVE AC1,JOBCNI
IORM AC1,CNIBTS
TLNE AC1,(<INTTTI>)
SETOM TTIFLG# ;SET FLAG FOR CI ROUTINE, SIGH
TLNN AC1,(<INTCLK>) ;DID YE OLD CLOCK TICK?
JRST ILEVE1
SETOM RPLY# ;YES, FEIGN A REPLY (SPCL PRPS, FOR QUIT)
MOVSI AC2,(<INTCLK>)
ANDCAM AC2,CNIBTS ;FLUSH IRRELEVANCY
INTACM AC2, ;WE ONLY TAKE ONE CLOCK INT PER ENABLING
ILEVE1:
IFN VERBOSE,<
outchr ["↑"]
tlne ac1,(<inttty>)
outchr ["t"]
tlne ac1,(<intims>)
outchr ["s"]
tlne ac1,(<intinp>)
outchr ["p"]
>;VERBOSE
MOVNI AC1,2
MOVEM AC1,XACTV
DISMIS
IORSET: SETZM DOACTV
SETZM DIACTV
SETZM DIHUNG
SETZM DOHUNG
SETZM GAG200 ;COULD BE LEFT SET BY ERROR IN NLST FOR MULT-RETR
MOVE C,LDOSOC ;CLEAR OUTPUT DATA CONNECTION
MOVEM C,DOTERM+2 ; IF THERE IS ONE
SKIPN OUTCON
JRST RESET1
CHNSTS DOMP,AC1 ;CAN GET HERE WITH OUTCON SET BUT NO CHANNEL
TRNE AC1,400000 ;THIS SKIPS IF NO CHANNEL
MTAPE DOMP,DOTERM ;TERMINATE CONNECTION
SETZM OUTCON
RESET1: RELEAS DIMP,3 ;RELEASE WITHOUT CLOSING
RELEAS FIMP,3
RELEAS DOMP,3
RELEAS FOMP,3
MOVE AC1,[XWD -20,DIPDL]
MOVEM AC1,DIP
MOVE AC1,[XWD -20,DOPDL]
MOVEM AC1,DOP
POPJ P,
UFDOPN: 10
'DSK '
UBUF
UBUF: BLOCK 3
;SAVACX SAVACS GETACS
; Process-switching AC Utility routines: SAVACS, GETACS
SAVACX: 0
SAVACS: ;CALL: PUSH P,[XWD 0,<ADDRESS OF 17 WORD BLOCK>]
; JRST SAVACS
; ROUTINE DOES NOT RETURN. THE ARGUMENT
; ON THE STACK IS POPPED OFF, AND THEN A POPJ
; IS PERFORMED.
MOVEM 0,@(P) ;SAVE AC0
MOVE 0,(P)
ADD 0,[XWD 1,16] ;C(0) = 1,,LOC+16
HRRZM 0,SAVACX
SUBI 0,15 ;C(0) = 1,,LOC+1
BLT 0,@SAVACX ;SAVE AC1-16
SUB P,[XWD 1,1] ;DELETE ARGUMENT FROM STACK
POPJ P, ;RETURN UPLEVEL
GETACS: ;CALL: PUSHJ P,GETACS
; XWD 1,<ADDRESS OF 17 WORD BLOCK>
; RETURN HERE ALWAYS
HRLZ 16,@(P) ;C(16) = XWD <ADDR>,0
BLT 16,15 ;RESTORE ACS 0-15
HRRZ 16,@(P)
MOVE 16,16(16) ;RESTORE AC16
JRST CPOPJ1 ;RETURN
;TTDISP TTREEN TTWAIT CHKABO TTACS TTP TTHUNG TTPDL TTROUT TTROU1 HAIREX DOHAIR HGETSP HGETL HAIRTY HDELIM HGETS2 HGETR HFOO HGETR1 HNEED2 HNOEQU TWOARR NUTTIN HAIRDO HAIRD1 OTPASS ANONYM INFRE1 INFREE NOACCT HAIRNO HAIRCR HAIRBY HAIRFN
; Ttdisp -- TTY Process Control. TTWAIT, TTROUT, CHKABO
TTDISP: SKIPE TTHUNG ;IS TT ROUTINE HUNG? (I.E., IS IT IN THE
; MIDDLE OF SOMETHING AND WAITING?)
JRST TTREEN ; YES, REENTER TT ROUTINE
EXCH P,TTP
PUSHJ P,CHKABO ;MAYBE AN ABORT
PUSHJ P,TTROUT ; NO, START AT BEGINNING OF TT ROUTINE
EXCH P,TTP ;SAVE TT PDL, GET OLD PDL
SETZM TTHUNG ;INDICATE THAT TT ROUTINE FINISHED NORMALLY
POPJ P, ;RETURN TO MAIN LOOP
TTREEN: PUSHJ P,GETACS
XWD 1,TTACS
EXCH P,TTP ;RETRIEVE TT PUSHDOWN POINTER
JRST CHKABO ;FIRST CHECK FOR ESC I THEN GO TO WAITING RTN
TTWAIT: SETOM TTHUNG ;PUSHJ TO HERE TO MAKE TT ROUTINE WAIT
EXCH P,TTP ;SAVE TT PDL, GET OLD PDL
PUSH P,[XWD 0,TTACS]
JRST SAVACS ;SAVE TT ACCUMULATORS, RETURN TO MAIN LOOP
CHKABO: SKIPN ESCIFL ;DID HE TYPE ESC I?
POPJ P, ;NO, NOTHING TO DO HERE
SETZM ESCIFL ;(THIS AVOIDS INFINITE LOOP AND PDLOV)
CLKINT 5*=60 ;MANY PEOPLE (MOST? ALL?) DON'T HACK ABORT
PUSHJ P,TTCIWT ;YES, WE WAIT FOR ANSWER TO ABORT
JRST RESET ;AND FLUSH THE WORLD WHEN WE GET IT
TTACS: BLOCK 17 ;STORAGE FOR TT ACCUMULATORS 0-16
TTP: XWD -20,TTPDL
TTHUNG: 0 ;NON ZERO MEANS TT ROUTINE IS WAITING
TTPDL: BLOCK 20
TTROUT: SKIPL CIINIT ;DO WE HAVE HERALD?
JRST TTROU1
PUSHJ P,TTCIWT ;NO, WAIT FOR IT
PUSHJ P,HAGGLE ;TRY TO NEGOTIATE A BYTE SIZE
JFCL ;WON'T WORK FOR MULTICS OF COURSE, NOTHING DOES
TTROU1: SKIPE HAIRY ;BH 11/27/77 HAIRY MODE?
JRST DOHAIR ;YES, ALL IN MONITOR COMMAND
PUSHJ P,GETOC ;C(AC1) ← OpCode IN ASCIZ (FROM TTY)
; PUSH P,AC1
; PUSHJ P,MLCHK ;RETURN STATE IF WAS MAILING
; POP P,AC1
PUSHJ P,GETOCN ;C(AC2) ← INDEX INTO OPCODE TABLE
POPJ P, ; UNKNOWN OR AMBIGUOUS OPCODE
HAIREX: SETZM PKUSET
PUSHJ P,@OCDISP(AC2) ;DISPATCH TO APPROPRIATE ROUTINE & RETURN
AOSE PKUSET ;IF IT WASN'T A PICKUP COMMAND
SETZM PKURNM ; WE CAN'T DO A PICKUP!
POPJ P,
DOHAIR: SKIPL HAIRY ;FIRST TIME HERE?
JRST HAIRBY ;NO, TIME TO FLUSH
MOVNS HAIRY ;YES. NEXT TIME GO AWAY
MOVE AC1,[POINT 7,HAIRBF]
SETZM HAIRLR
SKIPE TYPESW
JRST HAIRTY ;FTP/T SO PRETEND WE SAW ←
HGETSP: MOVE AC2,AC1
HGETL: ILDB T1,AC1 ;SCAN LEFT SPEC
CAIE T1,12
CAIN T1,175
JRST HNEED2 ;ERROR IF NO DIRECTION INDICATED
CAIN T1,"{" ;}
SETOM HAIRLR ;FLAG LEFT IS REMOTE (OR LOCAL IS RIGHT)
CAIN T1,"="
JRST HNOEQU ;= NOT ALLOWED
CAIE T1,"←"
CAIN T1,"→"
JRST HDELIM ;FOUND THE DELIMITER
CAIE T1,40
CAIN T1,11
JUMPN AC2,HGETSP
CAIN T1,"{" ;}
JUMPN AC2,HGETSP
JUMPE AC2,HGETL ;JUMP IF ALREADY SAVED INITIAL BPT
MOVEM AC2,HAIRLS ;SAVE BPT TO FIRST SIGNIFICANT CHAR
MOVEI AC2,0 ;DON'T SAVE AGAIN
JRST HGETL
HAIRTY: MOVEI T1,"←"
HDELIM: MOVE AC2,HAIRLR ;-1 IF BRACE SEEN
CAIN T1,"→"
MOVNI AC2,1(AC2) ;NOW -1 IF PUTTING (STOR)
MOVEM AC2,HAIRPT ;SAVE DIRECTION FOR LATER
HGETS2: MOVE AC2,AC1 ;NOW SCAN THE OTHER HALF
HGETR: ILDB T1,AC1
CAIE T1,12
CAIN T1,175
JRST HAIRDO ;OK, READY TO FLY
CAIN T1,"{" ;}
SKIPN HAIRLR
JRST HGETR1
OUTSTR [ASCIZ /Can't have remote host on both ends.
/]
HFOO: SETZM HAIRY
SETZM HASCII
SETZM AUTOLF
SETZM AUTOAL ;no auto abort if file already exists, yet
JRST TTROU1 ;FLUSH THE MODE
HGETR1: CAIN T1,"="
JRST HNOEQU ;STILL NOT ALLOWED
CAIE T1,"←"
CAIN T1,"→"
JRST TWOARR ;HUH? THREE FILES?
CAIE T1,40
CAIN T1,11
JUMPN AC2,HGETS2
CAIE T1,15
CAIN T1,"{" ;}
JUMPN AC2,HGETS2
JUMPE AC2,HGETR
MOVEM AC2,HAIRRS
MOVEI AC2,0
JRST HGETR
HNEED2: OUTSTR [ASCIZ /Must have two pathnames separated by arrow
indicating direction of transfer.
/]
JRST HFOO
HNOEQU: OUTSTR [ASCIZ /Pathnames must be separated by arrow, not =.
/]
JRST HFOO
TWOARR: OUTSTR [ASCIZ /Only two pathnames, not three.
/]
JRST HFOO
NUTTIN: OUTSTR [ASCIZ /No pathname specified.
/]
JRST HFOO
HAIRDO: MOVE AC2,HAIRLS
SKIPE HAIRLR
EXCH AC2,HAIRRS ;GET LOCAL/REMOTE RIGHT
MOVEM AC2,HAIRLS
JUMPN AC2,HAIRD1
SKIPN HAIRRS
JRST NUTTIN
HAIRD1: SETOM CIGRQ ;DON'T SHOW USER THIS NONSENSE
MOVE AC3,[POINT 7,[ASCIZ /USER /]]
PUSHJ P,TTSTROUT
SKIPN USRSTR ;GET REQUESTED USER NAME, IF ANY
JRST ANONYM ;NONE, BE ANONYMOUS
MOVE AC3,[POINT 7,USRSTR]
PUSHJ P,TTSTROUT
MOVE AC3,[POINT 7,[ASCIZ /
/]]
PUSHJ P,TTSTROUT
PUSHJ P,TTCIWT ;NOW WAIT FOR RESPONSE
MOVE T1,CIFLAG ;GET THE RESPONSE CODE
CAIL T1,=300
CAILE T1,=399 ;DO THEY WANT PASSWORD?
JRST INFREE ;NO, THAT'S ALL
SKIPE PASSTR
JRST OTPASS ;FOUND PASSWORD IN OPTION.TXT
MOVE AC3,[POINT 7,[ASCIZ /PASS /]]
PTJOBX [0↔3] ;NO ECHO
LEYPOS 1400 ;NO LINE EDITOR
OUTSTR [ASCIZ /Password=/] ;ASK FOR PASSWORD
SETZM GIVELF ;HOO HAH
SETZM TTCHSV
PUSHJ P,IDENT1 ;GET AND FORWARD PASSWORD
OUTSTR [ASCIZ /
/]
HRROI T1,[10000,,] ;Suppress Control-CR once only
TTYSET T1,
LEYPOS 0 ;RESTORE THE WORLD
PTJOBX [0↔4]
PUSHJ P,TTCIWT ;NOW HANG ON FOR THE PASS REPLY
JRST INFREE
OTPASS: MOVE AC3,[POINT 7,[ASCIZ /PASS /]]
PUSHJ P,TTSTROUT
MOVE AC3,[POINT 7,PASSTR]
PUSHJ P,TTSTROUT
MOVE AC3,[POINT 7,[ASCIZ /
/]]
JRST INFRE1
ANONYM: MOVE AC3,[POINT 7,[ASCIZ /ANONYMOUS
/]]
PUSHJ P,TTSTROUT
PUSHJ P,TTCIWT ;NOW WAIT FOR RESPONSE
MOVE T1,CIFLAG ;GET THE RESPONSE CODE
CAIL T1,=300
CAILE T1,=399 ;DO THEY WANT PASSWORD?
JRST INFREE ;NO, THAT'S ALL
MOVE AC3,[POINT 7,[ASCIZ /PASS SAIL
/]]
INFRE1: PUSHJ P,TTSTROUT
PUSHJ P,TTCIWT ;NEVER MIND WHAT THEY SAY
INFREE: SKIPN ACCSTR
JRST NOACCT ;(S)HE DIDN'T SUPPLY AN ACCT
MOVE AC3,[POINT 7,[ASCIZ /ACCT /]]
PUSHJ P,TTSTROUT
MOVE AC3,[POINT 7,ACCSTR]
PUSHJ P,TTSTROUT
MOVE AC3,[POINT 7,[ASCIZ /
/]]
PUSHJ P,TTSTROUT
PUSHJ P,TTCIWT
NOACCT: SETZM CIGRQ
MOVE AC2,[POINT 7,FNBUF] ;NOW SET UP FNBUF RIGHT
SKIPN AC1,HAIRLS ;IF EXPLICIT LOCAL, USE IT
JRST HAIRNO ;NOPE
PUSHJ P,HAIRFN ;COPY THE SPEC
SKIPN HAIRRS
JRST HAIRCR ;DONE IF NO REMOTE
MOVEI T1,"="
IDPB T1,AC2 ;AND AN EQUALS
HAIRNO: MOVE AC1,HAIRRS
PUSHJ P,HAIRFN
HAIRCR: MOVEI T1,15
IDPB T1,AC2
MOVEI T1,12
IDPB T1,AC2
SETOM PKUFLG ;FLAG CMD SHOULDN'T READ TTY
MOVEI AC2,..RETR ;PICK THE RIGHT COMMAND
SKIPE HAIRPT
MOVEI AC2,..STOR
SKIPE TYPESW
MOVEI AC2,..TTY
JRST HAIREX
HAIRBY: MOVEI AC2,..BYE
SETOM CIGRQ
JRST HAIREX
HAIRFN: ILDB T1,AC1 ;COPY PATHNAME INTO FNBUF
CAIE T1,15
CAIN T1,"{" ;}
JRST HAIRFN
CAIE T1,"←"
CAIN T1,"→"
POPJ P,
CAIN T1,12
POPJ P,
IDPB T1,AC2
JRST HAIRFN
;CIDISP CIREEN CIWAIT CIACS CIP CIHUNG CIPDL CINUM CIGAG CIINIT CIFLAG CIDEBG CIGRQ HYPHEN CISVG CIHYNO MSGPTR MSGSTK MSGCNT GAG200 SOCKFL SOCKET CISOCK CIROUT CIROXX CIROU0 CIROU6 CIROU1 CIROU4 CIRO41 CIROU3 CIROU2 CIRO22 CIROU7 CIROUX CIRO81 CIROU9 CIROU8 CIROSK SOCKIN SOCKLF
; Cidisp -- Control In Process Control. CIWAIT, CIFLAG
CIDISP: SKIPE CIHUNG ;IS CI ROUTINE HUNG? (I.E., IS IT IN THE
; MIDDLE OF SOMETHING AND WAITING?)
JRST CIREEN ; YES, REENTER CI ROUTINE
EXCH P,CIP
PUSHJ P,CIROUT ; NO, START AT BEGINNING OF TT ROUTINE
EXCH P,CIP ;SAVE TT PDL, GET OLD PDL
SETZM CIHUNG ;INDICATE THAT CI ROUTINE FINISHED NORMALLY
POPJ P, ;RETURN TO MAIN LOOP
CIREEN: PUSHJ P,GETACS
XWD 1,CIACS
EXCH P,CIP ;RETREIVE CI PUSHDOWN POINTER
POPJ P, ;AND RETURN TO WAITING CI ROUTINE.
CIWAIT: SETOM CIHUNG ;PUSHJ TO HERE TO MAKE CI ROUTINE WAIT
EXCH P,CIP ;SAVE CI PDL, GET OLD PDL
PUSH P,[XWD 0,CIACS]
JRST SAVACS ;SAVE CI ACCUMULATORS, RETURN TO MAIN LOOP
CIACS: BLOCK 17 ;STORAGE FOR CI ACCUMULATORS 0-16
CIP: XWD -20,CIPDL
CIHUNG: 0 ;NON ZERO MEANS CI ROUTINE IS WAITING
CIPDL: BLOCK 20
CINUM: 0 ;NUMBER FROM MESSAGE
CIGAG: 4 ;IF POSITIVE, # CHARS TO NOT TYPE. NEG = ∞.
CIINIT: -1 ;-1 UNTIL 300 HERALD SEEN. LATER 3XX NOT TYPED.
CIFLAG: -1 ;CINUM SAVED FROM MESSAGE JUST FINISHED
CIDEBG: 0 ;-1 TO DEBUG: TYPE EVERY CHAR FROM IMP
CIGRQ: 0 ;SETOM TO GAG ALL INCOMING MESSAGES
HYPHEN: 0 ;-1 IF FIRST CHAR AFTER DIGITS IS HYPHEN
CISVG: 0 ;SAVED CIGAG FOR 1ST CHAR OF NTH LINE
CIHYNO: 0 ;SAVED NUMBER FROM 1ST LINE OF MULTI-LINER
MSGPTR: MSGSTK
MSGSTK: BLOCK 10
MSGCNT: 10
GAG200: 0 ;-1 TO GAG 2XX MESSAGES
SOCKFL: 0 ;-1 DURING 255 SOCK MESSAGE
SOCKET: 0 ;SOCKET FROM 255 MESSAGE
CISOCK: 0 ;SOCKET IS ACCUMULATED HERE
CIROUT: PUSHJ P,INPSKP ;ANY IMP INPUT ?
JRST [PUSHJ P,CIWAIT ↔ JRST CIDISP]
PUSHJ P,IMPGET ; YES, GET IT
jumpe ac1,cirout
trne ac1,200 ;is it a protocol command?
jrst cirout ; yes
CAIE AC1,12
JRST CIROU1
SKIPE TTIFLG ;IF ABORT INTERRUPT WAITING,
PUSHJ P,CIWAIT ; GIVE IT A CHANCE (FOR STAT)
SKIPE SOCKFL
JRST SOCKLF ;SPECIAL FOR SOCK MESSAGE (255)
MOVE AC1,CINUM
CAIL AC1,=900 ;**** FIX FOR CRETINOUS SERVERS
SUBI AC1,=900 ;**** TURN ILLEGAL MESSAGES INTO OK ONES
SKIPN HYPHEN ;NOT DONE IF MULTI-LINER
CAIGE AC1,=200 ;IF THIS WASN'T A SERIOUS MESSAGE,
JRST CIROU0 ; DON'T SET READY FLAG FOR TT
SKIPE RPLY ;IF WE ARE WAITING FOR THIS MESSAGE,
SOSG MSGCNT ; OR THERE IS NO ROOM TO STORE IT,
JRST CIROXX ; WE JUST SET THE FLAG AND LEAVE
SKIPE HELPER ;BH 12/30/77 KLUDGE SO ERROR REPLY FROM HELP CMD
JRST CIROXX ; WON'T HANG AROUND AND MESS UP NEXT COMMAND
MOVEM AC1,@MSGPTR ;STACK THE MESSAGE CODE IN THE BUFFER
AOS MSGPTR ;THE NEXT TTCIWT WILL FIND IT W/O WAITING
CIROXX: SETOM RPLY# ;FLAG COMPLETE REPLY,
PUSHJ P,SXACTV ; GO ROUND THE MULBERRY BUSH,
MOVEM AC1,CIFLAG ; AND SAVE LAST MESSAGE TYPE FOR TT ROUTINE
CIROU0: SETZM CINUM ;NEXT CHAR FROM IMP WILL BE A NUMBER
SKIPN HYPHEN
SETZM CISVG
MOVEI AC1,4
EXCH AC1,CIGAG ;DON'T TYPE THE NUMBER
CIROU6: JUMPN AC1,CIROUT ;DON'T TYPE THE LF IF GAGGED
OUTCHR [12]
SKIPE CHAR1
OUTCHR ["*"] ;WE SCREWED UP A COMMAND PROMPT
JRST CIROUT
CIROU1: SKIPE SOCKFL
JRST SOCKIN ;255 SOCK MESSAGE SPECIAL
SKIPN CIGAG ;IS THIS BEGINNING OR SPECIAL?
JRST CIROU9 ;NO, JUST TYPE AND FORGET IT
SOSGE CIGAG ;YES, EITHER GAGGED MESSAGE OR REPLY NUMBER
JRST CIROUT ;GAGGED MESSAGE, DO NOTHING
SKIPN CIGAG
JRST CIROU4 ;SPACE OR HYPHEN
CAIL AC1,"0" ;NUMBER GOTTA BE NUMBER
CAILE AC1,"9"
JRST CIROUX ;OOPS, LOSING MESSAGE
SUBI AC1,"0" ;TURN INTO NUMBER
EXCH AC1,CINUM
IMULI AC1,12
ADDM AC1,CINUM ;ACCUMULATE DECIMAL NUMBER
JRST CIROUT
CIROU4: SKIPE HYPHEN ;LAST GAGGED CHAR OF LINE IS END OF NUMBER
JRST CIROU7
CIRO41: EXCH AC1,CINUM ;SAVE SPACE-OR-HYPHEN AND GET TYPE
CAIN AC1,=255
JRST CIROSK ;255 IS SOCK MESSAGE, GAG AND GOBBLE SOCKET
SKIPN CIDEBG ;BH 12/10/77 DEBUGGING, DON'T TYPE MSG TWICE
SKIPE CIGRQ ;IF TT REQUESTS GAGGING,
JRST CIROU3 ; DO IT
SKIPE GAG200 ;TT CAN REQUEST GAGGING 200 MESSAGES
CAIGE AC1,=200 ; JUST LIKE 300S
CAIL AC1,=300
CAILE AC1,=399 ;IF 3XX MESSAGE
JRST CIROU2
AOSN CIINIT ; AND NOT THE 300 HERALD,
JRST CIROU2
CIROU3: SETOM CIGAG ;GAG IT. (PASSWORD REQUEST)
CAIL AC1,=300
CAILE AC1,=399 ;IF 3XX MESSAGE
JRST CIRO22
AOS CIINIT ; MAKE SURE WE COUNT IT EVEN IF GAGGED
JRST CIRO22
CIROU2: OUTCHR ["<"] ;ELSE INDICATE MESSAGE FROM SERVER > (STUPID FAIL)
CIRO22: EXCH AC1,CINUM ;RESTORE TYPE AND NEW CHAR
CAIE AC1,"-" ;CHAR AFTER NUMBER
JRST CIROU1 ;IF NOT HYPHEN, JUST TYPE IT UNLESS GAGGED
SETOM HYPHEN ;HYPHEN FLAGS MULTI-LINE MESSAGE
MOVE AC1,CIGAG ;SAVE STATE OF GAGGAGE
MOVEM AC1,CISVG
MOVE AC1,CINUM ;SAVE ORIGINAL NUMBER
MOVEM AC1,CIHYNO
MOVEI AC1," " ;TYPE A SPACE ANYWAY
JRST CIROU1
CIROU7: CAIE AC1," " ;CHAR AFTER NUMBER ON NOT-1ST LINE
JRST CIROUX ; HAD BETTER BE SPACE OR WE IGNORE NUMBER
MOVE AC1,CINUM ;GET THE NUMBER ON THIS LINE
CAME AC1,CIHYNO ;IS IT THE SAME AS THE FIRST NUMBER?
JRST CIROU8 ;NO, AN INTERLOPER
SETZM HYPHEN ; NO MORE HYPHENIZATION
MOVEI AC1," " ;RESTORE SPACE FOR OUTPUT
CIROUX: PUSH P,CISVG ;LINE DOESN'T START WITH DIGIT
POP P,CIGAG ;SET GAGGAGE TO 0 (MAYBE NOT IF MULTI-LINER)
SKIPE CIGAG ;IF GAGGED (NON-1ST LINE OF 3XX MULTI),
JRST CIROUT ; DO NOTHING
CIRO81: OUTSTR [ASCIZ /< /] ;> STUPID FAIL
CIROU9: OUTCHR AC1 ; TYPE IT
JRST CIROUT
CIROU8: MOVEI AC1," "
SETZM CIGAG ;NEVR GAG AN INTERLOPER
JRST CIRO81 ;(SOUNDS LIKE "TO CATCH AN ELEPHANT...")
CIROSK: SETOM SOCKFL ;255 MESSAGE COMING IN, COLLECT SOCKET
SETZM SOCKET ;FLAG NO VALID SOCKET NOW
SETZM CISOCK ;ACCUMULATE SOCKET HERE
JRST CIROUT
SOCKIN: CAIL AC1,"0" ;CHAR IN 255 SOCK MESSAGE
CAILE AC1,"9"
JRST CIROUT ;IGNORE UNLESS DIGIT
SUBI AC1,"0" ;ADD INTO SOCKET NUMBER
EXCH AC1,CISOCK
IMULI AC1,=10
ADDM AC1,CISOCK
JRST CIROUT
SOCKLF: MOVE AC1,CISOCK ;END OF 255 SOCK MESSAGE
MOVEM AC1,SOCKET ;STUFF THE NUMBER WHERE TT CAN FIND IT
SETZM SOCKFL ;NO MORE SOCKET MESSAGE
SETZM CINUM ;STANDBY FOR NEW MESSAGE
MOVEI AC1,4
MOVEM AC1,CIGAG
JRST CIROUT ;DON'T RETURN TO WAITER
;DIDISP DIREEN DIWAIT DIACS DIP DIHUNG DIPDL DISTART DIROUT DIROU1 DIEOF DIEOF1 BAUD NOTBAU BAUDWT
; Didisp -- Data In (Imp) Process Control. DIWAIT, BAUD, BAUDWT
DIDISP: SKIPE DIHUNG ;IS DI ROUTINE HUNG? (I.E., IS IT IN THE
; MIDDLE OF SOMETHING AND WAITING?)
JRST DIREEN ; YES, REENTER DI ROUTINE
EXCH P,DIP
PUSHJ P,DISTART ; NO, START AT BEGINNING OF TT ROUTINE
EXCH P,DIP ;SAVE TT PDL, GET OLD PDL
SETZM DIHUNG ;INDICATE THAT DI ROUTINE FINISHED NORMALLY
POPJ P, ;RETURN TO MAIN LOOP
DIREEN: PUSHJ P,GETACS
XWD 1,DIACS
EXCH P,DIP ;RETREIVE DI PUSHDOWN POINTER
POPJ P, ;AND RETURN TO WAITING DI ROUTINE.
DIWAIT: SETOM DIHUNG ;PUSHJ TO HERE TO MAKE DI ROUTINE WAIT
EXCH P,DIP ;SAVE DI PDL, GET OLD PDL
PUSH P,[XWD 0,DIACS]
JRST SAVACS ;SAVE DI ACCUMULATORS, RETURN TO MAIN LOOP
DIACS: BLOCK 17 ;STORAGE FOR DI ACCUMULATORS 0-16
DIP: XWD -20,DIPDL
DIHUNG: 0 ;NON ZERO MEANS DI ROUTINE IS WAITING
DIPDL: BLOCK 20
DISTART:MOVEI B,DIMP
PUSHJ P,IDCON ;INITIALIZE DATA LINK CONNECTION
JRST RESET ;BOTH IDCON AND SERVER HAVE COMPLAINED BY NOW
PUSHJ P,GOWAIT ;WAIT FOR POSSIBLE REFUSAL BY SERVER
PUSHJ P,DIWAIT
CALLI C,22 ;TIME IN 60THS
MOVEM C,GOTIME#
SETZM WORDS#
DIROUT: HRROI C,-40 ;MAXIMUM 40 BYTES AT A TIME WITHOUT PAUSING
DIROU1: PUSHJ P,GETDAT ;GET DATA BYTE FROM IMP
JRST RESET
JRST DIEOF ;EOF ON IMP
AOS WORDS ;COUNT NO BITS XFERED
PUSHJ P,PUTFIL ;PUT DATA BYTE INTO LOCAL FILE SYSTEM
JRST RESET
AOJL C,DIROU1 ;LOOP FOR NEXT BYTE
PUSHJ P,SXACTV
PUSHJ P,DIWAIT
JRST DIROUT
DIEOF: MOVE T,DTYPE ;SPECIAL EOF FOR IMAGE TYPE
SOJN T,DIEOF1 ;ELSE JUST CLOSE EVERYTHING
MOVE A,FIWORD ;GET LAST PARTIAL WORD
PUSHJ P,PUTFI0
JRST RESET
DIEOF1: CLOSE DIMP,
CLOSE FIMP,
RELEASE DIMP,
RELEASE FIMP,
PUSHJ P,BAUDWT
PUSHJ P,DIWAIT
SKIPN TYPECM ;BH 8/20/80 No message to clutter file typeout
SKIPE NLSTFL ;SKIP THE POOP IF DOING
JRST NOTBAU ; NLST FOR A MULT-RETR
OUTSTR [ASCIZ /Input complete: /]
BAUD: MOVE T,WORDS
PUSHJ P,DPRINT
SKIPE DTYPE ;FIND TRANSFER BYTE SIZE
SKIPA T,DBS
MOVEI T,10
MOVEI T+1,[ASCIZ / words transfered (/]
CAIE T,=36
MOVEI T+1,[ASCIZ / bytes transferred (/]
OUTSTR (T+1)
CALLI T+1,22
SUB T+1,GOTIME
IMULI T+1,=100/=20
MOVE T,WORDS
IMULI T,=60/=20
SKIPE DTYPE
IMUL T,DBS
SKIPN DTYPE
LSH T,3 ;IMULI T,10
IDIV T,T+1
IDIVI T,=10
PUSH P,T+1
PUSHJ P,DPRINT
OUTCHR ["."]
POP P,T
ADDI T,"0"
OUTCHR T
OUTSTR [ASCIZ / Kbaud)
/]
NOTBAU: SETZM DIACTV ;FLAG ISN'T CLEARED TILL AFTER BAUD
SETZM DOACTV ; SO THE * WON'T GET BURIED
POPJ P,
BAUDWT: SKIPE BAUDOK
JRST CPOPJ1
PUSHJ P,SXACTV ;8/10/75 BH, MAYBE IT'LL FIX THE HANGING AT END
XCT @(P)
JRST BAUDWT
;DODISP DOREEN DOWAIT DOACS DOP DOHUNG DOPDL DOSTART DOROUT DOROU1 DOROU2 DOTERM
; Dodisp -- Data Out (Imp) Process Control. DOWAIT
DODISP: SKIPE DOHUNG ;IS DO ROUTINE HUNG? (I.E., IS IT IN THE
; MIDDLE OF SOMETHING AND WAITING?)
JRST DOREEN ; YES, REENTER DO ROUTINE
EXCH P,DOP
PUSHJ P,DOSTART ; NO, START AT BEGINNING OF TT ROUTINE
EXCH P,DOP ;SAVE TT PDL, GET OLD PDL
SETZM DOHUNG ;INDICATE THAT DO ROUTINE FINISHED NORMALLY
POPJ P, ;RETURN TO MAIN LOOP
DOREEN: PUSHJ P,GETACS
XWD 1,DOACS
EXCH P,DOP ;RETREIVE DO PUSHDOWN POINTER
POPJ P, ;AND RETURN TO WAITING DO ROUTINE.
DOWAIT: SETOM DOHUNG ;PUSHJ TO HERE TO MAKE DO ROUTINE WAIT
EXCH P,DOP ;SAVE DO PDL, GET OLD PDL
PUSH P,[XWD 0,DOACS]
JRST SAVACS ;SAVE DO ACCUMULATORS, RETURN TO MAIN LOOP
DOACS: BLOCK 17 ;STORAGE FOR DO ACCUMULATORS 0-16
DOP: XWD -20,DOPDL
DOHUNG: 0 ;NON ZERO MEANS DO ROUTINE IS WAITING
DOPDL: BLOCK 20
DOSTART:MOVEI B,DOMP
PUSHJ P,IDCON ;INITIALIZE DATA CONNECTION
JRST RESET
PUSHJ P,GOWAIT ;WAIT FOR SERVER TO APPROVE
PUSHJ P,DOWAIT
CALLI C,22 ;TIME IN 60THS
MOVEM C,GOTIME#
SETZM WORDS#
SETOM NOEDIR#
DOROUT: HRROI C,-40 ;MAXIMUM OF 40 BYTES OUT BEFORE PAUSING
DOROU1: PUSHJ P,GETFIL ;GET A BYTE FROM FILE SYSTEM
JRST RESET
JRST DOROU2 ;EOF ON INPUT FILE
AOS WORDS
PUSHJ P,PUTDAT ;PUT DATA BYTE OUT ON IMP
JRST RESET
AOJL C,DOROU1 ;LOOP FOR NEXT BYTE
PUSHJ P,SXACTV
PUSHJ P,DOWAIT
JRST DOROUT
DOROU2: PUSHJ P,PUTDA1 ;ONE FINAL OUTPUT
MOVE C,LDOSOC ;ARRIVE HERE ON EOF FROM LOCAL FILE SYSTEM
MOVEM C,DOTERM+2
MTAPE DOMP,DOTERM ;TERMINATE CONNECTION
CLOSE DOMP,
CLOSE FOMP,
RELEASE DOMP,
RELEASE FOMP,
PUSHJ P,BAUDWT
PUSHJ P,DOWAIT
OUTSTR [ASCIZ /Output complete: /]
SETZM OUTCON ;DATA CONNECTION COMPLETE
JRST BAUD
DOTERM: 3 ↔ 0 ↔ 000 ↔ 0
;GETOC GETOX1 GETOX0 GETOC1 GETOCC GETOCQ SPCRDL GETOC9 GETOCA GETOC7 GETOC2 POP32 EMPTYL GETOCN GETOC3 GETOC4 GETOC5 GETOC6 GETOC0 SPCFTC XIND SPCFTI SPCFTE SPCFTN
; Getoc -- Command Op Codes. XIND
GETOC: PUSH P,AC2
PUSH P,AC3
SETZ AC1,
SETZM GIVELF ;UNWEDGE GETTTY TO STOP GIVING FAKE LFS FOREVER
SETZM TTCHSV ;NO SAVED LOOKAHEAD CHAR
GETOX1: MOVE AC2,[POINT 7,AC1]
GETOX0: SKIPE CIGAG ;IF CIGAG IS ZERO WE ARE IN THE MIDST OF TYPING A
JRST GETOC1 ; SERVER REPLY, SO LET'S HOLD OFF ON THE *
PUSHJ P,TTWAIT
JRST GETOX0
GETOC1: OUTCHR ["*"]
SETOM CHAR1 ;IF A SERVER REPLY COMES LATER, I'LL GIVE ANOTHER *
SETZM NOPAR#
GETOCC: READS(AC3,<
JRST [ SKIPN DIACTV
SKIPE DOACTV
JRST GETOCQ ;I DON'T THINK THIS IS POSSIBLE ANYMORE
SKIPE SPCIN
JRST SPCFTI
GETOCQ: PUSHJ P,TTWAIT ;WAIT FOR WHOLE LINE
JRST GETOCC]
>)
SPCRDL: TRNE AC3,600
JRST SPCFTC
SETZM CHAR1
CAIE AC3,11
CAIN AC3," "
JRST GETOC2 ;DONE, PARAMS FOLLOW
CAIN AC3,175 ;ALTMODE ENDS IT
JRST GETOCA
CAIN AC3,12
JRST GETOC7 ;DONE, NO PARAMS FOLLOW
CAIN AC3,15
JRST GETOCC
CAIL AC3,"a"
CAILE AC3,"z"
CAIA
SUBI AC3,"a"-"A"
CAIL AC3,"0"
CAILE AC3,"Z"
JRST GETOC9 ;OUT OF RANGE CHAR STARTS PARAMS
CAILE AC3,"9"
CAIL AC3,"A"
CAIA ;ALPHAMERICS OK
JRST GETOC9 ;OTHERS ARE OUT OF RANGE
TLNE AC2,760000 ;JUST IGNORE EXTRA CHARS
IDPB AC3,AC2
JRST GETOCC
GETOC9: MOVEM AC3,TTCHSV# ;SAVE CHARACTER TO START PARAMS
JRST GETOC2
GETOCA: OUTSTR CRLF
GETOC7: JUMPE AC1,EMPTYL ;EMPTY LINE
MOVEM AC3,NOPAR ;EOL AT END OF COMMAND
SETOM GIVELF ;PREVENT FLUSCS AND FRIENDS FROM LOSING
GETOC2: JUMPE AC1,GETOCC
SETZM PKUFLG
POP32: SETZM HELPER ;BH 12/30/77. -1 FLUSHES ERR MSGS FROM HELP
POP P,AC3
POP P,AC2
ifn verbose, <
outstr [asciz /getoc returns /]
outstr ac1
outstr [byte (7) 15 12 0] >
POPJ P,
EMPTYL: SKIPE PKURNM ;EMPTY COMMAND LINE,
SKIPN PKUCMD
JRST GETOX1 ;IGNORE UNLESS AFTER PICKUP
SETOM PKUFLG# ;FLAG GFN SHOULDN'T READ FROM TTY
MOVE AC1,PKUCMD ;RETURN THE SAVED COMMAND
JRST POP32
GETOCN: TRZ AC1,377 ;**** TRUNCATE TO 4 CHARS FOR NOW *****
TLNN AC1,3760 ;AC1 CONTAINS AT LEAST 2 ASCII CHARACTERS?
JRST [HRLZI AC3,774000 ↔ JRST GETOC3] ; NO
TDNN AC1,[17700000] ;AC1 CONTAINS AT LEAST 3 ASCII CHARACTERS?
JRST [HRLZI AC3,777760 ↔ JRST GETOC3] ; NO
TRNN AC1,77400 ;AC1 CONTAINS AT LEAST 4?
JRST [HRROI AC3,700000 ↔ JRST GETOC3] ; NO
TRNN AC1,376 ;AC1 CONTAINS AT LEAST 5?
SKIPA AC3,[XWD -1,777400] ; NO
HRROI AC3,777776
GETOC3: ;AC3 IS NOW A MASK FOR ASCII OPCODES
HRLZI AC2,-NOCS
PUSH P,AC4
PUSH P,AC5
SETZ AC5,
GETOC4: MOVE AC4,@OCS(AC2) ;AC4←A LEGAL OPCODE IN ASCIZ(UP TO 5 CHRS)
AND AC4,AC3 ;MASK OUT ANY UNTYPED CHARACTERS
CAMN AC1,AC4 ;MATCH?
AOJA AC5,.+2 ; YES, INCREMENT # OF MATCHES
CAIA ; NO
HRL AC5,AC2 ; YES, SAVE NUMBER OF OPCODE
AOBJN AC2,GETOC4 ;JUMP TO EXAMINE NEXT OPCODE
JUMPE AC5,[MESSG (Unrecognized command) ↔ JRST GETOC6]
HLRZ AC2,AC5 ;AC2 ← INDEX OF A MATCH
TRNE AC5,777776 ;SKIP IF ONE AND ONLY ONE MATCH
JRST [MESSG (Ambiguous command) ↔ JRST GETOC6]
AOS -2(P) ;SET SKIP RETURN
GETOC5: POP P,AC5
POP P,AC4
POPJ P, ;RETURN
GETOC6: READS (AC3,JRST GETOC0) ;FLUSH REST OF COMMAND LINE
CAIE AC3,12
JRST GETOC6
SETOM GIVELF ;GETTTY WILL REPEAT THE LF FOREVER
GETOC0: AOJN AC1,GETOC5
POPJ P, ;AC1 WAS -1, GOT HERE VIA GETOC9 (???? -BH)
SPCFTC: CAIE AC3,400+"I"
CAIN AC3,400+"i"
JRST .+2
JRST GETOCC
OUTSTR [ASCIZ /Type input file name - /]
PUSH P,[GETOCC]
XIND: SETOM ECHOF
PUSH P,AC1
PUSH P,AC2
PUSHJ P,RDFILE
JRST [ SETZM GIVELF
SETZM TTCHSV
POP P,AC2
POP P,AC1
POPJ P,]
SETZM GIVELF
SETZM TTCHSV
POP P,AC2
POP P,AC1
INIT INFL,0
SIXBIT /DSK/
IFBUF
JRST 4,.
LOOKUP INFL,LBLOCK
JRST SPCFTN ;FILE NOT FOUND
SETOM SPCIN
POPJ P,
SPCFTI: SOSG IFBUF+2
IN INFL,
JRST .+2
JRST SPCFTE ;EOF
ILDB AC3,IFBUF+1
JUMPE AC3,SPCFTI
OUTCHR AC3
JRST SPCRDL
SPCFTE: SETZM SPCIN
RELEAS INFL,
outstr [asciz /
*** Closing input file ***
/]
JRST GETOCC
SPCFTN: OUTSTR [ASCIZ /File not found
/]
; JRST GETOCC
POPJ P,
;GETFIL GETFI0 GETFI1 GETFI2 GETFI3 GETFI4 GETFI5 GETFI6 GETFI7 GETF71 GETFI8 FOBTSL FOWORD FOBPT FOTEMP FOMASK GETDAT GETDA1 GETDA2 GETDA3 GETDA4 GETDA5 GETDA6
; Getfil -- Get data byte from local file system. GETDAT
GETFIL: MOVE A,DTYPE ;GETTING FROM FILE IS HAIRY
CAIN A,1 ; IF IMAGE TYPE
JRST GETFI3 ; ELSE DROP THROUGH TO STANDARD ROUTINE
GETFI0: SOSG FOBUF+2 ;DATA BYTE IN BUFFER?
JRST GETFI2 ; NO, DO AN INPUT
GETFI1: ILDB A,FOBUF+1 ; YES, GET DATA BYTE
JRST GETFI6 ; AND RETURN UNLESS ASCII
GETFI2: IN FOMP, ;DO AN INPUT
JRST GETFI1 ; INPUT WAS SUCCESSFUL
GETSTS FOMP,B ; EOF OR ERROR, GET STATUS BITS IN B
TRNE B,IODEND ;EOF?
JRST CPOPJ1 ; YES
OUTSTR [ASCIZ /Error reading local file./]
MOVSI B,(<INTTTI>)
INTGEN B, ;ABORT
JRST DOWAIT ;THIS WILL NEVER RETURN MAYBE
GETFI3: SKIPE A,FOBTSL ;IMAGE MODE: MORE BITS IN THE CURRENT FILE WORD?
JRST GETFI4 ; YES, CARRY ON
MOVS A,DBS ;ELSE CREATE A NEW BPT
LSH A,6 ;BYTE SIZE INTO S FIELD
IOR A,[POINT 0,FOWORD] ;POSITION TO BEGINNING OF WORD
MOVEM A,FOBPT
PUSHJ P,GETFI0 ;GET ANOTHER WORD
POPJ P, ;ERROR RETURNS
JRST CPOPJ1
MOVEM A,FOWORD ;SAVE FILE WORD FOR BYTE EXTRACTION
MOVEI A,=36 ;INIT BITS LEFT
GETFI4: SUB A,DBS ;SUBTRACT BYTE SIZE FROM BITS LEFT IN WORD
MOVEM A,FOBTSL
JUMPL A,GETFI5 ;JUMP IF NOT ENOUGH
ILDB A,FOBPT ;THIS IS AN EASY ONE
JRST CPOPJ2
GETFI5: PUSHJ P,GETFI0 ;WRAPAROUND CASE, GET NEXT WORD
POPJ P,
JRST CPOPJ1
MOVEM A,FOTEMP ;SAVE NEXT WORD
MOVE B,A ;POSITION FOR LSHC
MOVE A,FOWORD
MOVN D,FOBTSL ;*** NOTE WE ARE USING AC D. C IS IN USE UPLEVEL.
LSHC A,(D) ;POSITION COMBINATION BYTE
AND A,FOMASK ;FLUSH CRUFT
MOVE B,FOTEMP
MOVEM B,FOWORD ;SET UP FOR NEW WORD
MOVEI B,=36
ADDB B,FOBTSL
LSH B,6 ;MAKE NEW BPT
ADD B,DBS
LSH B,=24
HRRI B,FOWORD
MOVEM B,FOBPT
JRST CPOPJ2
GETFI6: SKIPE DTYPE ;DONE EXCEPT FOR ASCII MODE
JRST CPOPJ2
JUMPE A,GETFIL ;FOR ASCII, WE FLUSH NULLS
MOVE B,@FOBUF+1 ; CHECK FOR SOS LINE NUMBERS
TRNN B,1
JRST GETFI7
MOVNI B,5
ADDM B,FOBUF+2
AOS FOBUF+1
JRST GETFIL
GETFI7: AOSE NOEDIR ; CHECK FOR E DIRECTORY
JRST GETFI8
MOVE D,FOBUF+1
MOVE B,(D)
CAME B,[ASCII /COMME/]
JRST GETFI8
MOVE B,1(D)
CAME B,[ASCII /NT ⊗ /]
JRST GETFI8
MOVE B,2(D)
CAME B,[ASCII / VAL/]
JRST GETFI8
GETF71: PUSHJ P,GETFIL
POPJ P,
JRST CPOPJ1
CAIE A,14
JRST GETF71
JRST GETFIL
GETFI8: CAIN A,175 ; AND TRANSLATE THE FUNNY ONES
MOVEI A,33 ;ALTMODE
CAIN A,176
MOVEI A,175 ;RIGHT BRACE
CAIN A,32
MOVEI A,176 ;TILDE
JRST CPOPJ2
FOBTSL: 0
FOWORD: 0
FOBPT: 0
FOTEMP: 0
FOMASK: 0
GETDAT: ;GET DTAT BYTE FROM IMP
SOSG DIBUF+2 ;BYTE IN BUFFER?
JRST GETDA2 ; NO, THINK ABOUT AN INPUT
GETDA1: ILDB A,DIBUF+1 ;GET THE DATA BYTE
JRST CPOPJ2 ; AND RETURN
GETDA2: HRRZ A,DIBUF
HRRZ A,(A)
SKIPGE (A) ;IS THERE DATA IN NEXT BUFFER?
JRST GETDA3 ; YES, DO AN INPUT
INTMSK 1,[0] ;TURN OFF INTERRUPTS
MTAPE DIMP,[10] ;INPUT DATA WAITING IN FREE STORAGE?
JRST GETDA4 ; NO
INTMSK 1,[-1] ;TURN ON INTERRUPTS
GETDA3: IN DIMP,
JRST GETDA1 ;SUCCESSFUL INPUT
POPJ P, ;ERROR ON INPUT, GIVE ERROR RETURN
GETDA4: INTMSK 1,[-1] ;TURN ON INTERRUPTS
GETSTS DIMP,A ;GET STATUS BITS
TRNE A,IODEND ;EOF?
JRST CPOPJ1] ; YES
TRNE A,ERRBTS ;ERROR?
POPJ P, ; YES
MTAPE DIMP,GETDA6 ;GET STATUS OF CONNECTION
MOVE A,GETDA6+2
TLC A,RFC ;BOTH RFC BITS SHOULD BE ON: COMPLEMENT THEM
TLNN A,RFC!CLS ;CONNECTION CLOSED OR CLOSING? OR NOT THERE AT ALL?
JRST GETDA5 ; NO, GO INTO WAIT STATE
; MOVE A,DMODE ; YES, EITHER AN ERROR OR EN EOF
; CAIE A,1 ;ARE WE IN IMAGE MODE?
AOS (P) ; YES, EOF RETURN
POPJ P, ; NO, ERROR RETURN
GETDA5: PUSHJ P,DIWAIT ;WAIT AROUND FOR AWHILE
JRST GETDA2 ; ..AND TRY AGAIN
GETDA6: 2 ↔ 0 ↔ 0 ;DATA BLOCK FOR GET STATUS MTAPE UUO
;PUTDAT PUTDA1 PUTFIL PUTFI0 PUTFI1 PUTFI2 COREOK CORLUZ PUTFI3 PUTFI4 PUTFI5 FIBTSL FIWORD FIBPT
; Putdat, Putfil - data byte into imp or local file system
PUTDAT: SOSG DOBUF+2 ;ROOM IN BUFFER FOR BYTE?
PUSHJ P,PUTDA1 ; NO, DO AN OUTPUT
IDPB A,DOBUF+1 ; YES, STUFF IT IN
JRST CPOPJ1 ; SUCCESS RETURN
PUTDA1:
OUT DOMP, ;DO AN OUTPUT
POPJ P, ; OUTPUT WORKED
OUTSTR [ASCIZ /Output to IMP failed./]
MOVSI B,(<INTTTI>)
INTGEN B,
JRST DOWAIT
;; CALL: MOVE A,<BYTE TO GO INTO LOCAL FILE SYSTEM>
;; PUSHJ P,PUTFIL
;; ERROR RETURN
;; NORMAL RETURN
PUTFIL: MOVE B,DTYPE ;PROCESSING DEPENDS ON TYPE
JRST .+1(B) ;DISPATCH
JRST PUTFI2 ;ASCII, DO CHAR TRANSLATION
JRST PUTFI3 ;IMAGE, HAIRY CROCK. ELSE LOCAL BYTE
PUTFI0: SOSG FIBUF+2 ;ROOM IN BUFFER FOR THIS BYTE?
OUT FIMP, ; NO, OUTPUT THE BUFFER
JRST PUTFI1 ;ROOM IN BUFFER, OR SUCCESSFUL OUTPUT
POPJ P, ; ERROR RETURN
PUTFI1: IDPB A,FIBUF+1 ;PUT BYTE INTO BUFFER
JRST CPOPJ1 ;SUCCESS RETURN
PUTFI2: JUMPE A,CPOPJ1 ;ASCII, IGNORE NULLS,
CAIL A,200
JRST CPOPJ1 ; IGNORE FUNNY NVT CODES,
CAIN A,176 ; AND TRANSLATE FUNNY CHARS
MOVEI A,32 ;TILDE
CAIN A,175
MOVEI A,176 ;RIGHT BRACE
CAIN A,33
MOVEI A,175 ;ALTMODE
SKIPN NLSTFL ;DOING NLST FOR MULTIPLE RETR?
JRST PUTFI0 ;NO, NORMAL IO STUFF
HRRZ B,NLSBPT ;YES, MAKE SURE THERE'S ROOM IN CORE
CAMLE B,JOBREL
JRST COREOK
ADDI B,2 ;FUDGE FACTOR
CORE B,
JRST CORLUZ ;OOPS
COREOK: IDPB A,NLSBPT ;WIN
JRST CPOPJ1
CORLUZ: OUTSTR [ASCIZ /Not enough core available for file list.
/]
JRST RESET ;FLUSHO!
PUTFI3: SKIPE B,FIBTSL ;HAIRY IMAGE MODE WRAPAROUND BYTE CROCK
JRST PUTFI4
EXCH A,FIWORD
PUSHJ P,PUTFI0
POPJ P,
MOVE A,FIWORD
SETZM FIWORD
MOVS B,DBS
LSH B,6
IOR B,[POINT 0,FIWORD]
MOVEM B,FIBPT
MOVEI B,=36
PUTFI4: SUB B,DBS
MOVEM B,FIBTSL
JUMPL B,PUTFI5
IDPB A,FIBPT
JRST CPOPJ1
PUTFI5: MOVEI B,0
MOVE D,FIBTSL
LSHC A,(D) ;POSITION THE NEW BYTE
IOR A,FIWORD
MOVEM B,FIWORD
PUSHJ P,PUTFI0
POPJ P,
MOVEI A,=36
ADDB A,FIBTSL
LSH A,6 ;MAKING NEW BPT
ADD A,DBS
LSH A,=24
HRRI A,FIWORD
MOVEM A,FIBPT
JRST CPOPJ1
FIBTSL: 0
FIWORD: 0
FIBPT: 0
;IDCON IDCONZ IDCONI IDCONC IDCONW IDCONX IDCONY IDCONS IDCONB IDCON0 IDFUCK IDCOS0 IDCON2 IDCON1 IDCO11 IDCOND IDCONA IDCONP IDCONF IMPIBF IMPOBF
; Idcon: Initialize data link connection
; CALL: MOVEI B,DOMP ;FOR DATA OUT CONNECTION
; MOVEI B,DIMP ;FOR DATA IN
; PUSHJ P,IDCON
; ERROR RETURN
; SUCCESS RETURN
IDCON: MOVE A,DTYPE
MOVE A,IMODES(A)
HRRM A,IDCONI
MOVE A,IDCONB-DOMP(B)
MOVEM A,IDCONI+2
DPB B,[POINT 4,IDCONI,12]
DPB B,[POINT 4,IDCONC,12]
DPB B,[POINT 4,IDCONW,12]
DPB B,[POINT 4,IDCOS0,12]
IDCONZ: DPB B,[POINT 4,IDCONY,12]
IDCONI: INIT 000,000
SIXBIT /IMP/
XWD DOBUF,DIBUF
JRST NOIMP
MOVEI A,1
MOVEM A,CONECB
MOVE A,LDOSOC-DOMP(B)
MOVEM A,CONECB+LSLOC
MOVE A,DBS
SKIPN DTYPE
MOVEI A,10 ;ASCII ALWAYS 8 BITS
MOVEM A,CONECB+BSLOC
SETZM CONECB+WFLOC ;DON'T WAIT FOR CONNECTION
IDCONC: MTAPE 000,CONECB ;INITIATE DATA CONNECTION W/ USER
CAIN B,DIMP ;ARE WE DOINT DATA INPUT?
IDCONW: MTAPE 000,[=13 ↔ 1] ; YES, GIVE ALLOCATION
IDCONX: INTOFF ;ARRIVE HERE IF WE MUST WAIT FOR CONNECTION
IDCONY: MTAPE 000,IDCONS ;GET STATUS OF DIMP
INTON
MOVE A,IDCONS+1-DOMP(B)
TRNE A,77 ;ANY ERROR CODES?
JRST IDCON1 ; YES
TLNE A,CLS ;ANYBODY CLOSING CONNECTION?
JRST IDCON2 ; YES
TLC A,RFC
TLCN A,RFC ;CONNECTION COMPLETE?
JRST IDCON0 ; YES, SUCCESS RETURN
PUSHJ P,@IDCOND-DOMP(B) ;PUSHJ TO DIWAIT OR DOWAIT
XCT IDCONZ ;THIS INSTRUCTION MAKES IDCON REENTRANT
; - OR ENOUGH SO TO WORK, ANYWAY!
JRST IDCONX
IDCONS: 2 ↔ 0 ↔ 0
IDCONB: XWD DOBUF,0
XWD 0,DIBUF
IDCON0: PUSH P,JOBFF
MOVE A,IDCONF-DOMP(B)
MOVEM A,JOBFF
XCT IDCONA-DOMP(B) ;INBUF DIMP,2 OR OUTBUF DOMP,2
POP P,JOBFF
CAIN B,DOMP ;MARK OUTPUT CONNECTION COMPLETE
SETOM OUTCON ;IF OUTPUT (STOR, ETC.) OPERATION
MOVE A,DBS ;GET CONNECTION BYTE SIZE
SKIPN DTYPE
MOVEI A,10 ;ASCII ALWAYS 8 BITS
DPB A,IDCONP-DOMP(B) ;SET BYTE SIZE IN BUFFER HEADER
SKIPE SOCKET
JRST IDFUCK
PUSHJ P,SXACTV
PUSHJ P,@IDCOND-DOMP(B) ;TRY FOR SIMULTANEOUS SOCKET ARRIVAL
IDFUCK: MOVEI A,7
MOVEM A,CONECB
MOVE A,LDOSOC-DOMP(B)
MOVEM A,CONECB+LSLOC
IDCOS0: MTAPE 000,CONECB ;GET HOST AND SOCKET NUMBERS
MOVE A,CONECB+FSLOC ;GET PROPER SOCKET NUMBER
SKIPE SOCKET ;OK IF NO SOCKET
CAMN A,SOCKET ;ELSE BETTER MATCH
JRST [SETZM SOCKET↔JRST CPOPJ1] ;DON'T GET SCREWED BY A LATER DEFAULT
OUTSTR [ASCIZ /Data socket does not match SOCK reply./]
MOVSI A,(<INTTTI>)
INTGEN A,
JRST @IDCOND-DOMP(B) ;WAIT FOR ABORT
IDCON2: PUSHJ P,ERRWAT ;DON'T BOTHER COMPLAINING IF
PUSHJ P,@IDCOND-DOMP(B) ; SERVER COMPLAINED ANYWAY
OUTSTR [ASCIZ /Data socket closed--/]
JRST IDCO11
IDCON1: PUSHJ P,ERRWAT
PUSHJ P,@IDCOND-DOMP(B)
IDCO11: MESSG (Error making data connection)
POPJ P,
IDCOND: DOWAIT
DIWAIT
IDCONA: UOUTBF DOMP,[2 ↔ 337]
UINBF DIMP,[2 ↔ 337]
IDCONP: POINT 6,DOBUF+1,11
POINT 6,DIBUF+1,11
IDCONF: IMPOBF
IMPIBF
IMPIBF:
IMPOBF: BLOCK 2*341
;ILDDEV ILDDO ILDDSH ILDDE ILDDE2 ILDDL ILDDL2 ILDSSZ ILDSS1 ILDSS2 LEERR LEERRX LEETAB ILDD ILDDIO DSKIBF DSKOBF FASTAB
; Ilddev - Initialize local data device
;; CALL: MOVE C,<DEVICE NAME>
;; MOVE D,<PROJECT PROGRAMMER NAME>
;; MOVE E,<EXTENSION NAME>
;; MOVE F,<FILE NAME>
;; MOVE B,<DIMP or DOMP> ;(FOR INPUT OR OUTPUT TO IMP)
;; PUSHJ P,ILDDEV
;; ERROR RETURN
;; NORMAL RETURN
ILDDEV:
SETZM NLSTFL ;OUR SIDE GOES TO FILE, NOT CORE
MOVE A,DTYPE
MOVE A,FMODES(A)
MOVEM A,ILDD
MOVEM C,ILDD+1
MOVE A,ILDDIO-DOMP(B)
MOVEM A,ILDD+2
MOVEI A,2(B)
DPB A,[POINT 4,ILDDO,12]
DPB A,[POINT 4,ILDDE,12]
DPB A,[POINT 4,ILDDL,12]
DPB A,[POINT 4,ILDDL2,12]
DPB A,[POINT 4,ILDDE2,12]
HRRM A,ILDDSH ;Channel number for filestatus display
MOVE A,C ;Check device for high bandwidth
PNAME A, ;Just in case it was redefined.
JRST [ OUTSTR [ASCIZ/NO SUCH DEVICE.
/]↔ POPJ P,]
MOVSI T,-FASLEN
CAMN A,FASTAB(T)
JRST [ OUTSTR [ASCIZ/DEVICE IS INAPPROPRIATE FOR FTP.
/]↔ POPJ P,] ;Usually because network isn't fast enough for it.
AOBJN T,.-2
MOVE A,ILDD ;Check to see if mode is valid, so we don't
ANDI A,17 ;get a message from moniter.
MOVEI T,1
ROT T,(A)
MOVE A,C
DEVCHR A,
MOVEM A,DVICE# ;SAVE FOR POSSIBLE LOOKUP/ENTER ERROR MSG
TDNN A,T
JRST [ OUTSTR [ASCIZ/ILLEGAL MODE.
/]↔ POPJ P,]
ILDDO: OPEN 000,ILDD
POPJ P, ;CAN'T OPEN FILE SYSTEM
ILDDSH: MOVEI A,000
SHOWIT A, ;ENABLE FILESTATUS DISPLAY
JUMPN D,.+2
DSKPPN D,
MOVEM F,ILDD
MOVEM E,ILDD+1
SETZM ILDD+2
MOVEM D,ILDD+3
CAIE B,DIMP
JRST ILDDL
ILDDE: ENTER 000,ILDD
JRST [OUTSTR [ASCIZ /ENTER failed/]
JRST LEERR]
PUSH P,JOBFF
MOVEI A,DSKOBF
MOVEM A,JOBFF
ILDDE2: OUTBUF 000,NBUFS ;WAS 13
POP P,JOBFF
MOVEI A,=36
MOVEM A,FIBTSL
SETZM FIWORD
MOVS A,DBS
LSH A,6
IOR A,[POINT 0,FIWORD]
MOVEM A,FIBPT
JRST ILDSSZ
ILDDL: LOOKUP 000,ILDD
JRST [OUTSTR [ASCIZ /LOOKUP failed/]
JRST LEERR]
PUSH P,JOBFF
MOVEI A,DSKIBF
MOVEM A,JOBFF
ILDDL2: INBUF 000,NBUFS
POP P,JOBFF
SETZM FOBTSL
MOVEI A,1
LSH A,@DBS
SUBI A,1
MOVEM A,FOMASK ;SET UP MASK FOR IMAGE MODE
ILDSSZ: MOVE A,DTYPE
XCT ILDSS1(A) ;GET BYTE SIZE FOR FILE
DPB A,ILDSS2-DOMP(B) ;PUT IN HEADER
JRST CPOPJ1
ILDSS1: MOVEI A,7 ;ASCII, DSK BYTE SIZE IS 7
MOVEI A,=36 ;IMAGE, DSK BYTE SIZE IS 36
MOVE A,DBS ;LOCAL, GET SIZE FROM USER SPEC
ILDSS2: POINT 6,FOBUF+1,11
POINT 6,FIBUF+1,11
LEERR: MOVE A,DVICE ;GET DEVCHR
TLNN A,200000 ;IS IT A DSK?
JRST LEERRX ;NOPE, NO ERROR CODE
HRRZ A,ILDD+1 ;YUP, GET ERROR CODE
CAILE A,LEEMAX
MOVEI A,LEEMAX
OUTSTR @LEETAB(A) ;GIVE THE MESSAGE
LEERRX: OUTSTR [ASCIZ /
/]
POPJ P, ;TAKE ERROR RETURN
LEETAB: [ASCIZ /: no such file/]
[ASCIZ /: no such PPN/]
[ASCIZ /: protection violation/]
[ASCIZ /: file busy/]
LEEMAX←←.-LEETAB
[ASCIZ /: unknown error code!/]
ILDD: BLOCK 4
ILDDIO: XWD 0,FOBUF
XWD FIBUF,0
DSKIBF: BLOCK NBUFS*203
DSKOBF: BLOCK NBUFS*203
;List of devices which should not be used with FTP, usually for bandwidth reasons.
FASTAB: SIXBIT/XGP/
SIXBIT/ADC/
SIXBIT/DAC/
SIXBIT/AD/
SIXBIT/PTR/ ;Reader needs tending
SIXBIT/TV/
SIXBIT/ELF/ ;PDP-11 interface. NO!
FASLEN←←.-FASTAB
;FNREAD FNREA1 FNSEND FNSEN1 FNSPPL FNSENP FNSE10 FNSE11 FNSE12 FNSEN2 FNSEN3 FNSEN4 GFNY GFN GFNX GFNY1 NXTSKP NXTTOK GOTTOK TNONUL GFNLUZ PKUALT SYNBAD SAFOPT DEVICE ITSNM1 EXTNXT ITSNM2 NULDOT T20VER SETFIL TNXPPN PPNNXT PPNZB PPNLZ1 PPNXIT PPNLUZ GETPNM GETPN1 SEMICL GFNEOL GFNEO1 GFNEO2 EQUALS GFNDUN SKIPS1 SKIPSP SKIPS2 LETTS3 LETTST LETTS0 LETTS1 LETTS5 LETTS2 LETTS6 LETTS4 GETSI4 GETSIX ANCHR6 GETSI1 GETSI2 GETSI3
FNREAD: MOVE B,[POINT 7,FNBUF] ;READ AND SAVE FILE XFER CMD ARGS
MOVEM B,FNBPT ;INIT BPT WHILE WE'RE AT IT
SETZM LPPNOW#
FNREA1: PUSHJ P,GETTTY ;READ A CHAR
IDPB A,B ;STUFF IT IN THE BUFFER
CAIE A,12 ;LF?
CAIN A,175 ;OR ALT?
POPJ P,
TRZE A,200 ;flush CONTROL bit, skip if off
CAIE A,175 ;was this an altmode with CONTROL?
JRST FNREA1 ;NO, GET THE REST
SETOM ALTBKY ;Yup, remember for SAFASK
POPJ P,
FNSEND: PUSHJ P,TTSTROUT ;SEND COMMAND
SETOM FNSENF# ;FLAG FOR WILDCARD SUBSTITUTION
SETZM DOWNFL
FNSEN1: ILDB A,FNBPT ;NOW SEND THE REMOTE PATHNAME
SKIPE DOWNFL
JRST FNSEN3
CAIN A,"↓"
JRST FNSEN4
CAIN A,"["
SKIPN LPPNOW
JRST FNSENP ;JUMP UNLESS LOCAL PPN
FNSPPL: ILDB A,FNBPT
CAIN A,"]"
JRST FNSEN1
CAIE A,15
CAIN A,12
JRST FNSENP
CAIE A,175
JRST FNSPPL
FNSENP: SKIPN WILDCD ;SPECIAL PROCESSING IF MULT STOR
JRST FNSEN2 ; ELSE JUST OUTPUT
CAIN A,"."
SETZM FNSENF
CAIE A," "
JRST FNSE10
PUSHJ P,IMPOUT ;SPACE IN WILDCARD: PUT IT OUT,
SKIPE ITSFLG ; AND IF ITS, TREAT LIKE .
SETZM FNSENF
JRST FNSEN1
FNSE10: CAIE A,"*" ;* IN WILDCARD, SPECIAL ACTION
JRST FNSE12 ;ELSE NORMAL
AOSG FNSENF ;WHICH ONE WE WANT?
SKIPA B,GFNFIL
MOVE B,GFNEXT
PUSHJ P,FNSE11
JRST FNSEN1
FNSE11: JUMPE B,CPOPJ ;SEND THE SIXBIT OUT
MOVEI A,0
LSHC A,6
JUMPE A,FNSE11
ADDI A,40
PUSHJ P,IMPOUT
JRST FNSE11
FNSE12: CAIN A,15 ;CR IN WILDCARD
AOSLE FNSENF ; AND NO WILD YET?
JRST FNSEN2 ;NO, NORMAL
MOVE B,GFNFIL ;YES, PUT OUT *.* EQUIVALENT NOW
PUSHJ P,FNSE11 ;GROSS HEURISTIC, COULD BE ALL WRONG!
MOVEI A,"."
SKIPE ITSFLG ;PUNCTUATION HERE IS HOST-DEPENDENT
MOVEI A," "
PUSHJ P,IMPOUT
MOVE B,GFNEXT
PUSHJ P,FNSE11
MOVEI A,15
FNSEN2: PUSHJ P,IMPOUT
CAIE A,12
JRST FNSEN1
POPJ P,
FNSEN3: CAIE A,"↓"
JRST FNSEN2
FNSEN4: SETCMM DOWNFL
JRST FNSEN1
GFNY: SETZM GIVELF ;SIGH, REALLY READ TTY
SETZM TTCHSV
PUSH P,FNBPT ;SAVE FNBPT TOO
MOVE B,[POINT 7,FNBUF2]
MOVEM B,FNBPT
SETZM ALTBKY# ;NO BUCKIES ON ALTMODE YET
PUSHJ P,FNREA1
SETOM GIVELF ;JUST IN CASE OF ALTMODE
SETZM SAFDLM# ;SAVE NON-FN SAFETY RESPONSES.
AOS -1(P)
PUSHJ P,GFNY1
SOS -1(P)
POP P,FNBPT
POPJ P,
GFN: MOVE B,[POINT 7,FNBUF]
MOVEM B,FNBPT
SKIPN PKUFLG ;DON'T READ TTY IF WE HAVE SAVED PICKUP
PUSHJ P,FNREAD ;READ AND SAVE THE STRING FROM THE TTY
GFNX: SETOM SAFDLM# ;DON'T SAVE NON-FN SAFETY RESPONSES
GFNY1: SETZM BADSYN# ;FN SCANNER. THIS FLAGS NOT SAIL SYNTAX
SETZM BADPPN#
SETZM GOTDOT# ;BH 4/7/77 ADD TOPS-20 NAME.EXT.VERSION FORMAT
SETZM FNDLIM# ;TO SAVE DELIMITER (ARROW OR =)
SETZM DOWNFL#
SKIPE NOHACK
SETOM NOWILD ;NOHACK (LOCAL FN REQUIRED) IMPLIES NOWILD (NO *)
MOVSI A,'DSK' ;INITIALIZE OUR VARIABLES
MOVEM A,GFNDEV#
SKIPE NOWILD ;FOR MLFL,
TDZA A,A ; NO WILDCARD DEFAULT
MOVSI A,'* '
MOVEM A,GFNFIL#
MOVEM A,GFNEXT#
MOVEM A,WILDCD# ;THIS FLAGS * IN PATHNAME
MOVEI A,0
DSKPPN A,
MOVEM A,GFNPPN#
NXTSKP: ILDB A,FNBPT ;WHAT A RELIEF TO BE IN 1-LOOKAHEAD MODE!
NXTTOK: PUSHJ P,GETSIX ;GET A TOKEN
GOTTOK: PUSHJ P,SKIPSP ;SKIP (BUT NOTE) FOLLOWING SPACES
JUMPN B,TNONUL ;JUMP IF TOKEN FOUND
SKIPE SAFDLM ;OR IF NOT THE FIRST TIME THROUGH
JRST TNONUL
CAIN A,175 ;INTERESTED IN ALT, CR, OR LF
JRST SAFOPT
CAIE A,15
CAIN A,12
JRST SAFOPT
TNONUL: SETOM SAFDLM
CAIN A,":" ;DISPATCH ON INTERESTING TERMINATORS
JRST DEVICE ;DEVICE NAME
CAIN A,"."
JRST EXTNXT ;THIS IS FN, NEXT IS EXT
CAIN A,"["
JRST PPNNXT ;THIS IS FN, NEXT IS PPN
CAIN A,"="
JRST EQUALS ;DONE WITH SAIL PART
CAIE A,"←"
CAIN A,"→"
JRST EQUALS ;WHAT A BAD IDEA
CAIN A,12
JRST GFNEOL
CAIN A,"<" ;> STUPID FAIL
JRST TNXPPN ;TENEX PPN STARTS HERE
CAIN A,";"
JRST SEMICL ;HAIRY. TENEX CRUD OR ITS SNAME
CAIN A,175
JRST PKUALT ;ALTMODE NOT CAUGHT BY SAFDLM, MAYBE FOR PICKUP
SKIPE SPACE# ;FLAG SET BY SKIPSP
JRST ITSNM1 ;ITS FN1 (B CAN'T BE 0 HERE)
GFNLUZ: OUTSTR [ASCIZ /Can't parse your pathname
/]
POPJ P,
PKUALT: SKIPE NOWILD ;SEE IF THIS IS FROM PICKUP
SKIPE NOHACK ; I.E. NOWILD ON BUT NOHACK OFF
JRST GFNLUZ ;NOPE, A LOSER
MOVEM A,SAFDLM ;YUP, SAVE THE ALT
JRST GFNEOL
SYNBAD: SETOM BADSYN ;SET BAD SYNTAX FOR SAIL FILE
JRST NXTTOK ;IGNORE THIS TOKEN
SAFOPT: MOVEM A,SAFDLM ;BARE CR, LF, OR ALT:
JRST CPOPJ1 ;SAVE IT AND RETURN
DEVICE: JUMPE B,SYNBAD ;DEVICE MAYN'T BE NULL
MOVEM B,GFNDEV ;SAVE THE DEVICE
CAMN B,['* ']
SETOM BADSYN
JRST NXTSKP ;READY FOR ANOTHER TOKEN
ITSNM1: SETOM BADSYN
JRST ITSNM2
EXTNXT: ILDB A,FNBPT ;SKIP THE DOT
SKIPE GOTDOT ;BH 4/7/77 HAVE WE ALREADY READ AN EXTENSION?
JRST T20VER ; YES, THIS IS TOPS-20 VERSION NUMBER
SKIPE ITSFLG ;BH 11/24/77 KLUDGE FOR .INFO.;
JUMPE B,NULDOT ; TURN IT INTO JUST INFO
SETOM GOTDOT ; NO, BUT FLAG WE HAVE AN EXTENSION
ITSNM2: JUMPE B,GFNLUZ ;FN MAYN'T BE NULL
PUSHJ P,SETFIL ;SET FN
PUSHJ P,GETSIX ;WE'LL GET THE EXT HERE
JUMPE B,GOTTOK ;IF NO EXT, IGNORE
HLLZM B,GFNEXT ;SAVE EXT
CAMN B,['* ']
SETOM WILDCD
JRST NXTTOK
NULDOT: PUSHJ P,ANCHR6 ;ANCHORED SIXBIT TOKEN (IE NO SPACES ALLOWED)
JUMPE B,GFNLUZ ;BARE DOT STILL INCOMPREHENSIBLE
CAIE A,"."
ILDB A,FNBPT ;SKIP TRAILING DOT
JRST GOTTOK ;END .INFO. HACK
T20VER: SETOM BADSYN ;BH 4/7/77 NO VERSION NUMBERS IN SAIL FILENAME
PUSHJ P,GETSIX ;NOW JUST FLUSH THE TOKEN
JRST NXTTOK
SETFIL: MOVEM B,GFNFIL ;SAVE FN
CAME B,['* ']
SETZM WILDCD ;NOT WILDCARD UNLESS IT WAS *
SETZM GFNEXT ;FLUSH WILDCARD DEFAULT
POPJ P,
TNXPP2: CAIE A,"."
JRST NXTTOK ;I give up, what is it?
ILDB A,FNBPT ;skip over the dot
TNXPPN: SKIPE ITSFLG
JRST ITSNM1 ;IF ITS THEN THIS IS IGNORED TOKEN
ILDB A,FNBPT ;TENEX PPN, SKIP LESSTHAN
SETOM BADSYN ;NONE ALLOWED IN SAIL NAME
PUSHJ P,GETSIX ;SKIP OVER THE DIRECTORY NAME
PUSHJ P,SKIPSP
;< STUPID FAIL
CAIE A,">" ;MUST END RIGHT
JRST TNXPP2 ;maybe it's a dot!
ILDB A,FNBPT
JRST NXTTOK
PPNNXT: JUMPE B,PPNZB ;PPN, IS THERE A FN?
PUSHJ P,SETFIL
PPNZB: PUSHJ P,GETPNM ;GET PRJ
JUMPE B,PPNLUZ ;MUST BE ONE
HRLM B,GFNPPN ;MIGHT BE [PRJ] SO KEEP PRG
PPNLZ1: PUSHJ P,SKIPSP
CAIE A,","
JRST PPNXIT
PUSHJ P,GETPNM
JUMPE B,PPNLUZ
HRRM B,GFNPPN ;SAVE PRG
PUSHJ P,SKIPSP ;READ REMOTE TOPS-10 SFD PPN FORMAT
CAIN A,","
JRST PPNLUZ ;BUT DON'T ALLOW IT TO BE LOCAL
PPNXIT: CAIN A,"]"
ILDB A,FNBPT
JRST NXTTOK
PPNLUZ: SETOM BADSYN
SETOM BADPPN
JRST PPNLZ1
GETPNM: ILDB A,FNBPT ;SKIP LEFT BRACKET OR COMMA
PUSHJ P,SKIPSP ;READ PRJ OR PRG
MOVEI B,0
GETPN1: PUSHJ P,LETTST ;ALPHAMERIC?
POPJ P,
LSH B,6
IORI B,(A)
TLNE B,-1
SETOM BADSYN ;PROTECT US FROM TOO-LONG ONES
ILDB A,FNBPT
JRST GETPN1
SEMICL: SETOM BADSYN
SKIPE ITSFLG ;SEMICOLON, DEPENDS ON WHO
JRST NXTSKP ;ITS, WE JUST HAD SNAME
GFNEOL: JUMPE B,GFNEO1 ;IF NO TOKEN, WE'RE DONE
PUSHJ P,SETFIL ;ELSE SET FILENAME
GFNEO1: MOVE B,[POINT 7,FNBUF] ;GOT TO EOL WITH NO EQUAL,
EXCH B,FNBPT ; THIS FN IS FOR REMOTE HOST TOO
MOVEM B,PKUBPT ;THIS MAY BE NEEDED FOR PICKUP RETR
SKIPE NOHACK ;FLAG IS SET EXCEPT FOR STOR AND RETR
JRST GFNLUZ ; TO REQUIRE EXPLICIT LOCAL PATHNAME
MOVSI B,'DSK'
MOVEM B,GFNDEV
SKIPN LISTNG ;BH 12/10/77 NO LPPN FOR LIST ET AL
SKIPN LPPNON# ;BH 4/4/76 LOCAL PPN MODE
JRST GFNEO2
SKIPE BADPPN
JRST GFNLUZ
SETOM LPPNOW
JRST GFNDUN
GFNEO2: MOVEI B,0 ;DON'T BELIEVE THEIR DEV OR PPN
DSKPPN B,
MOVEM B,GFNPPN
JRST GFNDUN
EQUALS: MOVEM A,FNDLIM ;SAVE ARROW OR EQUAL FOR CALLER TO CHECK
SKIPE BADSYN ;FN WAS JUST FOR US,
JRST GFNLUZ ; SYNTAX MUST BE PERFECT
JUMPE B,GFNDUN
PUSHJ P,SETFIL
GFNDUN: MOVE C,GFNDEV
MOVE D,GFNPPN
MOVE E,GFNEXT
MOVE F,GFNFIL
JRST CPOPJ1 ;NOTE: AC A MUST HAVE DELIMITER ON RETURN
SKIPS1: ILDB A,FNBPT ;IT'S A SPACE, SKIP IT
SOSA SPACE ; AND FLAG IT
SKIPSP: SETZM SPACE ;SKIP ANY SPACES HERE AND FLAG
SKIPS2: CAIE A,11 ;TABS ARE SPACES, SORRY PITTS
CAIN A,40
JRST SKIPS1
CAIN A,15 ;IGNORE CR
SKIPN SAFDLM ; UNLESS FOR SAFETY ANSWER
POPJ P,
ILDB A,FNBPT
JRST SKIPS2
LETTS3: ILDB A,FNBPT
SETOM BADSYN
LETTST: SKIPE DOWNFL
JRST LETTS4
CAIE A,"@"
CAIN A,"-" ;UNLESS HYPHEN OR AT,
JRST LETTS3 ; DON'T IGNORE
CAIL A,"A" ;CHECK FOR ALPHAMERIC
CAILE A,"Z"
JRST LETTS1 ;NOT UC
LETTS0: SUBI A,40 ;OK, MAKE SIXBIT
JRST CPOPJ1 ;TAKE WIN RETURN
LETTS1: CAIL A,"a"
CAILE A,"z"
JRST LETTS2
LETTS5: SUBI A,100 ;MAKE LC INTO SIXBIT
JRST CPOPJ1
LETTS2: CAIL A,"0"
CAILE A,"9"
CAIA
JRST LETTS0
CAIE A,"↓"
POPJ P,
LETTS6: SETCMM DOWNFL
ILDB A,FNBPT
JRST LETTST
LETTS4: CAIN A,"↓"
JRST LETTS6
CAIL A,"a"
CAILE A,"z"
JRST LETTS0
JRST LETTS5
GETSI4: ILDB A,FNBPT
GETSIX: PUSHJ P,SKIPSP ;GET SIXBIT TOKEN
ANCHR6: MOVE C,[POINT 6,B] ;HO HUM
MOVEI B,0
GETSI1: PUSHJ P,LETTST ;CHECK FOR OK CHAR
JRST GETSI2 ;NOPE, MAYBE *
TRNN B,77 ;IGNORE OVERRUN
IDPB A,C
SETOM SAFDLM ;NO MORE NON-FN RESPONSES
ILDB A,FNBPT
JRST GETSI1
GETSI2: JUMPN B,CPOPJ ;CAN'T BE WILDCARD IF ALREADY GOT SOME
SKIPN ITSFLG
JRST GETSI3 ;ABSORB BROKETS FOR ITS ONLY
CAIE A,"<"
CAIN A,">"
JRST GETSI4 ;COMPLETELY IGNORE THE BROKET
GETSI3: SKIPN NOWILD ;NO WILDCARD FOR MLFL
CAIE A,"*"
POPJ P,
MOVSI B,'* ' ;* ONLY OK BY ITSELF
ILDB A,FNBPT ; SO WE LET UPLEVEL WORRY ABOUT WHAT'S NEXT
POPJ P,
> ;END OF {IFN FTPCOM, < ETC. >}
;OPRINT OPRINN DPRINT DPRINN DPRIN0 DPRIN1 DPRIN2 DPRIN3 DPRIN4 SIZE NCHRS RADIX
; Dprint: print in decimal the number in accumulator T,
; DESTROYING BOTH T AND T+1.
;DPRINN ROUTINE: SAME AS DPRINT, EXCEPT PRINTS NUMBER IN A FIELD OF
; C(T+1) POSITIONS, WITH LEADING SPACES IF NECESSARY.
; C(T+1) IGNORED IF IT IS TOO SMALL.
;NOT REENTRANT.
OPRINT: SETZ T+1,
OPRINN: MOVNM T+1,SIZE
MOVEI T+1,=8
JRST DPRIN0
DPRINT: SETZ T+1,
DPRINN: MOVNM T+1,SIZE
MOVEI T+1,=10
DPRIN0: MOVEM T+1,RADIX
SETOM NCHRS
DPRIN1: IDIV T,RADIX
HRLM T+1,(P) ;SAVE REMAINDER
JUMPE T,DPRIN3 ;JUMP IF ALL DIGITS ARE FORMED
SOS NCHRS ;BUMP COUNT OF DIGITS
PUSHJ P,DPRIN1 ;GO COMPUTE NEXT DIGIT
DPRIN2: HLRZ T,(P) ;GET NEXT DIGIT TO PRINT
ADDI T,60 ;CONVERT TO ASCII
OUTCHR T ;TYPE IT
POPJ P, ;RETURN TO DPRIN2 OR CALLING ROUTINE
DPRIN3: SKIPN T,SIZE ;DEFAULT FIELD SIZE?
JRST DPRIN2 ; YES
DPRIN4: CAML T,NCHRS ;MORE POSITIONS THAN CHARACTERS?
JRST DPRIN2 ; NO
OUTCHR [40] ;TYPE SPACE
AOJA T,DPRIN4
SIZE: 0
NCHRS: 0
RADIX: 0
;SYSINI SYSINH HAIRSP HAIRT HAIRA HAIRSW HAIRQ HAIRR HAIRL HAIRX HAIRIN HAIRIM NOHAIR SYSIN0 SYSRST SYSSIX SYSSX1 SYSSX2 SYSSX3 SYSSXE
;SYSTEM STARTUP CODE- SYSINI
ISSYS,<
SYSINI:
IFN FTPCOM,<
SETOM HAIRY ;BH 11/27/77 ASSUME HAIRY FTP COMMAND
SETZM HASCII
SETZM AUTOLF ;NOT /Q
SETZM AUTOAL ;no auto abort if file already exists, yet
SETZM LPPNON ;DAMNIT I HATE LPPN! -- MRC
SETZM TYPESW# ;NOT FTP/T
>;FTPCOM
SYSINH: SETOM SYSMOD ;ASSUME STARTED IN SYSTEM MODE
RESCAN RSCCNT ;RESCAN AND SAVE COUNT
PUSHJ P,SYSSIX
JUMPE AC1,SYSIN0
ISDIAL,<AND AC2,['DIAL ']
CAMN AC1,AC2
POPJ P,
>;ISDIAL
IFN FTPCOM,<
AND AC2,['FTP ']
CAME AC1,AC2 ;WAS IT SYSTEM FTP COMMAND?
JRST SYSIN0 ;NO
SKIPN HAIRY
POPJ P, ;SECOND TIME THROUGH, NOT HAIRY
MOVE AC1,[POINT 7,HAIRBF]
MOVEM AC1,HAIRBP ;BH
HAIRSP: CAIE AC4,40 ;SKIP SPACES
CAIN AC4,11
JRST HAIRSW
CAIE AC4,"/" ;MAYBE /A SWITCH?
JRST HAIRIM
READW(AC4)
CAIE AC4,"A"
CAIN AC4,"a"
JRST HAIRA
CAIE AC4,"R"
CAIN AC4,"r"
JRST HAIRR
CAIE AC4,"L"
CAIN AC4,"l"
JRST HAIRL
CAIE AC4,"T"
CAIN AC4,"t"
JRST HAIRT
CAIE AC4,"Q"
CAIN AC4,"q"
JRST HAIRQ
CAIE AC4,"X"
CAIN AC4,"x"
JRST HAIRX
CAIE AC4,"D" ;dammit BH, can't you have switches and commands
CAIN AC4,"d" ;people would think of?
JRST HAIRX
OUTSTR [ASCIZ /Bad switch
/]
JRST SYSIN0 ;FLUSH
HAIRT: SETOM TYPESW ;/T, O/P TO TTY IN ASCII MODE
HAIRA: SETOM HASCII
HAIRSW: READW(AC4)
JRST HAIRSP
HAIRQ: SETOM AUTOLF ;/Q, DON'T ASK FOR OVERWRITE CONFIRMATION
JRST HAIRSW
HAIRR: SETZM LPPNON ;/R, RPPN MODE
JRST HAIRSW
HAIRL: SETOM LPPNON ;/L, LPPN MODE
JRST HAIRSW
HAIRX: SETOM CIDEBG ;/X, TYPE OUT ALL IMP INPUT FOR DEBUGGING
JRST HAIRSW
HAIRIN: READW (AC4) ;BH 11/27/77 READ POSSIBLE HAIRY MIT-STYLE CMD
HAIRIM: IDPB AC4,HAIRBP
CAIN AC4,"{" ;} BEGINNING OF HAIRY HOST SPEC?
POPJ P, ;YES, DONE FOR NOW
CAIE AC4,12 ;NO, EOL?
CAIN AC4,175
JRST NOHAIR ;YES, NOT A HAIRY CMD
JRST HAIRIN ;NO, CONTINUE
NOHAIR: SETZM HAIRY ;NOT HAIRY
SETZM HASCII
SETZM AUTOLF
SETZM AUTOAL ;no auto abort if file already exists, yet
JRST SYSINH ;SO TRY AGAIN
>;FTPCOM
SYSIN0: SETZM SYSMOD
IFN FTPCOM,<
SETZM HAIRY
SETZM AUTOLF
SETZM AUTOAL ;no auto abort if file already exists, yet
>;FTPCOM
SYSRST: SKIPG RSCCNT
POPJ P,
READS(AC1,<JRST [SETZM RSCCNT
POPJ P,]
>)
JRST SYSRST
SYSSIX: MOVE AC3,[POINT 6,AC1]
SETZ AC1,
SETO AC2,
SYSSX1: READW(AC4)
CAIE AC4,40
CAIN AC4,11
JRST SYSSX1 ;SKIP LEADING SPACES AND TABS
SYSSX2: CAIN AC4,15
JRST SYSSX3
CAIL AC4,"a"
CAILE AC4,"z"
CAIA
SUBI AC4,40
CAIL AC4,"A"
CAILE AC4,"Z" ;JUST LETTERS IS GOOD ENOUGH FOR THIS
JRST SYSSXE ; quit on non-letter
SUBI AC4,40 ; make into sixbit
TLNE AC3,770000
IDPB AC4,AC3
LSH AC2,-6
SYSSX3: READW(AC4)
JRST SYSSX2
SYSSXE: SETCA AC2,
POPJ P,
>;ISSYS
END START