Trailing-Edge
-
PDP-10 Archives
-
decuslib20-01
-
decus/20-0002/ioser.tnx
There is 1 other file named ioser.tnx in the archive. Click here to see a list.
00100 COMMENT VALID 00112 PAGES
00200 C REC PAGE DESCRIPTION
00300 C00001 00001
00400 C00010 00002 TENX<THE ENTIRE FILE IS FOR TENEX ONLY
00500 C00013 00003 DSCR IOSTT(CDB) values.
00600 C00016 00004
00700 C00020 00005 COMPIL(PAT,<OPEN,LOOKUP,ENTER,USETI,USETO,MTAPE,TENXFI,RELEASE,CLOSE,CLOSIN,CLOSO,GETCHAN,CVJFN,RENAME>
00800 C00029 00006 DSCR PROCEDURE LOOKUP(INTEGER CHNL STRING FILE REFERENCE INTEGER FLAG)
00900 C00033 00007 HERE(ENTER)
01000 C00036 00008 DSCR
01100 C00039 00009 DSCR PROCEDURE USETI,USETO(INTEGER CHANNEL,BLOCK)
01200 C00041 00010 DSCR PROCEDURE CLOSE(INTEGER CHANNEL,[CLOSEINHIBITBITS])
01300 C00042 00011 HERE(RELEASE)
01400 C00043 00012 DSCR
01500 C00044 00013 DSCR STRING PROCEDURE TENXFI(STRING DECFILE)
01600 C00048 00014 DSCR
01700 C00050 00015 COMPIL(JOBINF,<ODTIM,IDTIM,RUNTM,GTAD,GJINF>,<ZSETST,ZADJST,X22,X33,X44,.SKIP.,CATCHR>
01800 C00051 00016
01900 C00052 00017 DSCR INTEGER SIMPLE PROCEDURE RUNTM(INTEGER FORK REFERENCE INTEGER CONSOLE)
02000 C00053 00018 DSCR INTEGER SIMPLE PROCEDURE GTAD
02100 C00054 00019 DSCR INTEGER SIMPLE PROCEDURE GJINF(REFERENCE INTEGER LOGDIR,CONDIR,TTYNO)
02200 C00055 00020 ENDCOM(JOBINF)
02300 C00056 00021 COMPIL(DIRECT,<STDIR,DIRST>,<X22,X33,CATCHR,ZSETST,ZADJST.SKIP.>
02400 C00058 00022 DSCR STRING SIMPLE PROCEDURE DIRST(INTEGER I)
02500 C00060 00023 COMPIL(RUNPRG,<RUNPRG>,<X22,X33,CATCHR>,<RUNPRG -- RUN A PROGRAM>)
02600 C00065 00024 COMPIL(OPF,<OPENFILE,SETINPUT,SETPL,INDEXFILE,SETCHAN>,<.SKIP.>,<OPENFILE -- OPEN A FILE>)
02700 C00074 00025 DSCR PROCEDURE SETINPUT(INTEGER CHAN REFERENCE INTEGER COUNT,BR,EOF)
02800 C00075 00026 DSCR
02900 C00077 00027 DSCR
03000 C00079 00028 DSCR SETCHAN(JFN,GTFLAGS,OPFLAGS)
03100 C00080 00029 COMPIL(GTJFN,<GTJFN,GTJFNL>,<.SKIP.,SETCHN,CATCHR,X11,X22,X44>,<GTJFN -- GET A JFN>)
03200 C00082 00030 DSCR INTEGER PROCEDURE GTJFNL(STRING ORIG INTEGER FLAGS, XWDJFN!JFN
03300 C00085 00031 COMPIL(FILINF,<GNJFN,DELF,UNDELETE,DELNF,SIZEF,JFNS,JFNSL,OPENF,CFILE,CLOSF,RLJFN,GTSTS,STSTS,RNAMF>
03400 C00087 00032 DSCR PROCEDURE DELF(INTEGER CHAN)
03500 C00089 00033 DSCR PROCEDURE UNDELETE(INTEGER CHAN)
03600 C00090 00034 DSCR INTEGER PROCEDURE SIZEF(INTEGER JFN)
03700 C00091 00035
03800 C00093 00036 DSCR SIMPLE PROCEDURE OPENF(INTEGER JFN,FLAGS)
03900 C00095 00037
04000 C00098 00038 DSCR SIMPLE PROCEDURE CLOSF(INTEGER JFN)
04100 C00100 00039 DSCR SIMPLE PROCEDURE RLJFN(INTEGER JFN)
04200 C00101 00040 DSCR INTEGER SIMPLE PROCEDURE GTSTS(INTEGER JFN)
04300 C00102 00041 DSCR BOOLEAN SIMPLE PROCEDURE STSTS(INTEGER JFN,STATUS)
04400 C00103 00042 DSCR BOOLEAN SIMPLE PROCEDURE RNAMF(INTEGER EXISTINGJFN,NEWJFN)
04500 C00104 00043 COMPIL(DEVINF,<CNDIR,ASND,RELD,GDSTS,SDSTS,STDEV,DEVST,GTFDB,CHFDB>
04600 C00106 00044 DSCR BOOLEAN PROCEDURE ASND(INTEGER DEVICE)
04700 C00107 00045 DSCR BOOLEAN PROCEDURE RELD(INTEGER DEVICE)
04800 C00108 00046 DSCR INTEGER SIMPLE PROCEDURE GDSTS(INTEGER CHAN REFERENCE INTEGER WORDCNT)
04900 C00109 00047 DSCR PROCEDURE SDSTS(INTEGER JFN,NEWSTATUS)
05000 C00110 00048 DSCR INTEGER PROCEDURE STDEV(STRING S)
05100 C00111 00049
05200 C00112 00050 DSCR SIMPLE PROCEDURE GTFDB(INTEGER JFN REFERENCE INTEGER ARRAY BUF)
05300 C00113 00051
05400 C00114 00052 DSCR INTEGER SIMPLE PROCEDURE WORDIN(INTEGER JFN)
05500 C00116 00053 HERE(ARRYIN)
05600 C00120 00054 HERE(WORDOUT)
05700 C00122 00055 HERE(ARRYOUT)
05800 C00125 00056
05900 C00127 00057 HERE(SWDPTR)
06000 C00129 00058
06100 C00136 00059 SETWPT:
06200 C00140 00060 SETWIO:
06300 C00141 00061 ADWI:
06400 C00143 00062 DSCR CHAR_CHARIN(CHANNEL)
06500 C00146 00063 DSCR STRING SIMPLE PROCEDURE SINI(INTEGER JFN,MAXLENGTH,BRKCHAR)
06600 C00150 00064 Input
06700 C00158 00065 .DOINP: PUSHJ P,DOINP
06800 C00159 00066
06900 C00163 00067 Realin, Realscan
07000 C00170 00068 NUMIN -- CONTD.
07100 C00177 00069 LNUMIN NUMBER INPUT
07200 C00188 00070
07300 C00190 00071 DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
07400 C00191 00072
07500 C00193 00073
07600 C00196 00074 DSCR PROCEDURE LINOUT(INTEGER JFN,VALUE)
07700 C00199 00075 HERE(RCHPTR)
07800 C00200 00076 HERE(SCHPTR)
07900 C00202 00077 DSCR Auxiliary routines for character i/o.
08000 C00208 00078 SETCPT:
08100 C00211 00079 SETCIO:
08200 C00212 00080 DSCR
08300 C00225 00081 DSCR ADCO,ADCO1
08400 C00229 00082 DSCR SETIO
08500 C00236 00083 DSCR
08600 C00239 00084 ENDCOM(IOROU)
08700 C00240 00085 DSCR SIMPLE PROCEDURE SFPTR(INTEGER JFN,POINTER)
08800 C00241 00086 DSCR INTEGER SIMPLE PROCEDURE RFPTR(INTEGER JFN)
08900 C00242 00087 DSCR SIMPLE PROCEDURE MTOPR(INTEGER JFN,FUNCTION,VALUE)
09000 C00243 00088 DSCR SIMPLE PROCEDURE BKJFN(INTEGER JFN)
09100 C00244 00089 DSCR INTEGER SIMPLE PROCEDURE RFBSZ(INTEGER JFN)
09200 C00245 00090 COMPIL(DSKOPS,<DSKIN,DSKOUT>
09300 C00247 00091 DSCR SIMPLE PROCEDURE
09400 C00248 00092 COMPIL(DEVS,<DEVTYPE,DVCHR,ERSTR>
09500 C00249 00093 DSCR INTEGER SIMPLE PROCEDURE DVCHR(INTEGER JFN REFERENCE INTEGER AC1,AC3)
09600 C00250 00094 DSCR SIMPLE PROCEDURE ERSTR(INTEGER ERRNO,FORK)
09700 C00252 00095 COMPIL(UTILITY,<SETCHN,ZSETST,ZADJST,.RESET,RDSEG>
09800 C00258 00096 DSCR STRING SIMPLE PROCEDURE ZADJST(INTEGER CNTEST,BP)
09900 C00261 00097 DSCR
10000 C00265 00098 COMPIL(TTM,<RFMOD,SFMOD,STPAR,STI,RFCOC,SFCOC,GTTYP,STTYP,SETEDIT>
10100 C00271 00099 COMPIL(PAGES,<PMAP>,<SAVE,RESTR,X44>
10200 C00272 00100 COMPIL(TT2,<PBTIN,INTTY>
10300 C00273 00101 DSCR STRING SIMPLE PROCEDURE INTTY
10400 C00275 00102 NOIMSSS<NON-IMSSS VERSION OF INTTY FOR THOSE WHO SUFFER
10500 C00279 00103 TTY FUNCTIONS
10600 C00282 00104 HERE(PBIN)
10700 C00292 00105 Filnam
10800 C00295 00106 Flscan
10900 C00297 00107 COMPIL(CAS,<CSERR,LPRYER>,<GOGTAB>
11000 C00298 00108
11100 C00299 00109
11200 C00300 00110
11300 C00301 00111
11400 C00302 00112
11500 C00303 ENDMK
11600 C;
00100 TENX<;THE ENTIRE FILE IS FOR TENEX ONLY
00200 COMMENT TENEX-IOSER -- R. SMITH
00300 LSTON (IOSER)
00400
00500
00600 IFN ALWAYS, <BEGIN IOSER>
00700
00800 COMMENT INDICES, BITS FOR TENEX VERSION OF IOSER
00900
01000
01100 ;WORDS IN CDB BLOCK FOR EACH CHANNEL
01200
01300
01400 ?GFL__0 ;FLAGS FOR GTJFN
01500 ?OFL__1 ;FLAGS FOR OPENF
01600 ?BRCHAR__2 ;BRCHAR ADDRESS
01700 ?ICOUNT__3 ;COUNT ADDRESS
01800 ?ENDFL__4 ;EOF ADDRESS
01900 ?IOCNT__5 ;I/O COUNT
02000 ?IOBP__6 ;I/O BP
02100 ?IOSTT__7 ;STATUS OF THE IO (SEE FLAGS BELOW)
02200 ?IOADDR__10 ;ADDRESS OF THE IO BUFFER IF THERE IS ONE
02300 ?DVTYP__11 ;DEVICE TYPE
02400 ?DVDSG__12 ;DEVICE DESIGNATOR
02500 ?OPNDUN__13 ;TRUE IF OPENED WITH THE OPEN STATEMENT
02600 ?DVCH__14 ;DEVICE CHARACTERISTICS
02700 ?DMPED__15 ;TRUE IF DUMP MODE OUTPUT SEEN
02800 ;IN PARTICULAR USED TO NOTE IF A MAGTAPE
02900 ;HAS BEEN WRITTEN BUT NOT YET CLOSED,
03000 ;SINCE EOF'S ARE WRITTEN AT THE CLOSE
03100 ;BY CLOSF,CFILE,CLOSE,ETC.
03200 ?LINNUM__16 ;LINE NO (FOR INPUT FUNCTION)
03300 ?PAGNUM__17 ;PAGE NO (FOR INPUT FUNCTION)
03400 ?SOSNUM__20 ;SOS LINE NO (FOR INPUT FUNCTION)
03500 ?FKPAGE__21 ;XWD FORK,PAGE FOR PMAPPING TO DSK
03600 ?IOPAGE__22 ;PAGE OF THE FILE (IF PMAPPED)
03700 ?FDBSZ__23 ;BYTE SIZE OF FILE AS IN FDB
03800 ?FDBEOF__24 ;NO. OF BYTES TO EOF AS IN FDB
03900 ?TTYINF__25 ;TTY BUFFERING INFO--
04000 CRYPT<
04100 ?DCRYPT__26 ;[06] Addr of input decryption routine
04200 ?NCRYPT__27 ;[06] Addr of output encryption routine
04300 >; CRYPT
04400
04500 ;ADDITIONS TO CDB NUMBERS SHOULD INCLUDE CHANGE TO TIOTLN BELOW
04600
04700 NOCRYPT<
04800 ?TIOTLN__26 ;CURRENT LENGTH OF CDB BLOCK
04900 >; NOCRYPT
05000
05100 CRYPT<
05200 ?TIOTLN__30 ;CURRENT LENGTH OF CDB BLOCK
05300 >; CRYPT
05400
00100 DSCR IOSTT(CDB) values.
00200 The following numbers can be in IOSTT(CDB). They indicate
00300 the current state of the IO for the associated channel.
00400 These numbers are set up by SETIO, which is called by
00500 the first IO that happens on the channel. Each routine has
00600 a dispatch table, usually called TABL, and the SIMIO macro
00700 does an XCT on those tables.
00800
00900
01000 ?XNULL__0 ;NOTHING HAPPENING YET
01100 ?XICHAR__1 ;PMAPPING INPUT CHARS
01200 ?XOCHAR__2 ;PMAPPING OUTPUT CHARS
01300 ?XIWORD__3 ;PMAPPING INPUT WORDS
01400 ?XOWORD__4 ;PMAPPING OUTPUT WORDS
01500 ?XCICHAR__5 ;36 BIT BUFFERING, INPUT CHARS
01600 ?XCOCHAR__6 ;36 BIT BUFFERING, OUTPUT CHARS
01700 ?XCIWORD__7 ;36 BIT BUFFERING, INPUT OR OUTPUT WORDS
01800 ?XBYTE7__10 ;7 BIT BIN, SIN ETC
01900 ?XDICHAR__11 ;DUMP MODE CHARACTER INPUT
02000 ?XDOCHAR__12 ;DUMP MODE CHARACTER OUTPUT
02100 ?XDARR__13 ;DUMP MORE ARRAY INPUT OR OUTPUT
02200
02300 DEFINE SIMIO(AC,TABL,ERR) <
02400 SKIPGE AC,IOSTT(CDB)
02500 JRST [PUSHJ P,OPNCHK
02600 MOVE AC,IOSTT(CDB)
02700 JRST .+1]
02800 CAILE AC,13 ;MAXIMUM THAT IOSTT CAN BE
02900 JRST ERR
03000 XCT TABL(AC)
03100 >;SIMIO
03200
03300 DEFINE CHKDECCLZ <
03400 SKIPGE IOSTT(CDB)
03500 PUSHJ P,OPNCHK
03600 >;CHKDECCLZ
03700
03800 DEFINE SETZEOF <
03900 SETZM .SKIP.
04000 SKIPE ENDFL(CDB)
04100 SETZM @ENDFL(CDB)
04200 >;SETZEOF
04300
04400 DEFINE SETOEOF <
04500 SETOM .SKIP.
04600 SKIPE ENDFL(CDB)
04700 SETOM @ENDFL(CDB)
04800 >;SETOEOF
04900
05000
00100
00200 IFNDEF JFNSIZE, <?JFNSIZE__20> ;NUMBER OF CHANNELS ALLOWED
00300 ?DMOCNT__200 ;(DEFAULT) COUNT FOR DUMP MODE OUTPUT
00400 IFNDEF STARTPAGE,<?STARTPAGE__610 ;STARTING PAGE FOR BUFFERS>
00500
00600 ;BITS FOR SCAN FLAGS FOR OPENFILE ROUTINE
00700 ;THE BITS OF THE FLAGS WORD ARE THE SAME AS THE BITS OF GTJFN AND OPENF
00800 ;HOPEFULLY (WHERE APPLICABLE)
00900
01000 ?STARBIT__1B11 ;B11 OF GTJFN FOR INDEXED FILES
01100 ?TEMBIT__1B5 ;B5 OF GTJFN FOR TEMPORARY FILE
01200 ?DELBIT__1B8 ;GTJFN -- IGNORE DELETED BIT
01300 ?RDBIT__1B19 ;B19 OF OPENF FOR READING
01400 ?WRBIT__1B20 ;B20 OF OPENF FOR WRITING
01500 ?APPBIT__1B22 ;B22 OF OPENF FOR APPEND
01600 ?CONFB1__1B3 ;GTJFN BIT TO PRINT [CONFIRM] ETC
01700 ?CONFB2__1B4 ;GTJFN BIT TO REQUIRE CONFIRMATION FROM USER
01800 ;ODDLY ENOUGH 3 AND 4 ARE ILLEGAL
01900 ?OUTBIT__1B0 ;GTJFN -- FILE FOR OUTPUT USE
02000 ?OLDBIT__1B2 ;GTJFN -- OLD FILE
02100 ?NEWBIT__1B1 ;GTJFN -- NEW FILE
02200 ?ERTNBIT__1B27 ;ERROR RETURN BIT -- INTERNAL
02300 ?BINBIT__1B26 ;BINARY BIT -- INTERNAL
02400 ?THAWBIT__1B25 ;THAWBIT GTJFN
02500 ?ERSNBIT__1B28 ;ERROR SEEN -- INTERNAL
02600 ?CONFBIT__1B29 ;CONFIRMATION -- INTERNAL
02700 ?UPDBIT__1B30 ;[CLH] UPDATE - INTERNAL
02800
02900 ;MACROS FOR BIT TESTING
03000
03100 DEFINE .ZZZ $ (X,Y,Z)<
03200 IFN Z&777777000000, <TL$X Y,Z-=18> ;Z LSH -=18
03300 IFN Z&777777, <TR$X Y,Z>
03400 >
03500
03600 DEFINE TESTE (Y,Z) <.ZZZ NE,Y,Z> ;TDNE Y,[Z]
03700 DEFINE TESTN (Y,Z) <.ZZZ NN,Y,Z> ;TDNN Y,[Z]
03800 DEFINE TESTO (Y,Z) <.ZZZ O,Y,Z> ;TDO Y,[Z]
03900 DEFINE TESTZ (Y,W) <.ZZZ Z,Y,W> ;TDZ Y,[Z]
04000
04100
04200 ;MACRO TO GET THE JFN NUMBER IN X FROM Y. IF INVALID, JUMP TO LABEL Z
04300 ;LOADS CDB (I.E., 11) WITH THE CDB ADDRESS
04400 ;LOADS CHNL WITH THE CHANNEL NUMBER
04500 DEFINE VALCHN(X,Y,Z) <
04600
04700 SKIPL CHNL,Y
04800 CAIL CHNL,JFNSIZE
04900 JRST Z
05000 MOVE CDB,CDBTBL(CHNL)
05100 HRRZ X,JFNTBL(CHNL)
05200 JUMPE X,Z
05300 >;VALCHN
05400
05500 DEFINE LITCHN(X,Y,Z) <
05600 SKIPL X,Y
05700 CAIL X,JFNSIZE
05800 JRST Z
05900 MOVEM X,CHNL
06000 MOVE CDB,CDBTBL(CHNL)
06100 HRRZ X,JFNTBL(CHNL)
06200 >;LITCHN
06300
06400 ;ONLY USES AC X
06500 DEFINE VALCH1(X,Y,Z) <
06600 SKIPL X,Y
06700 CAIL X,JFNSIZE
06800 JRST Z
06900 HRRZ X,JFNTBL(X)
07000 JUMPE X,Z
07100 >
07200
07300 ;TTY STUFF
07400 ;FOR DEC-STYLE I/O
07500 ;CHAR FOR LINE DELETION (DELLINE) AND CHARACTER DELETION (RUBCHAR)
07600 IFNDEF DELLINE,<?DELLINE__"U"-100> ;CTRL-U
07700 IFNDEF RUBCHAR,<?RUBCHAR__177> ;RUBOUT
07800 IFNDEF ALTMODE,<?ALTMODE__33 ;ONE OF MANY VERSIONS>
07900
08000 DSCR
08100 TTYINF for information about the controlling terminal.
08200
08300
08400 ?ISCTRM__ 1B0 ;CHANNEL IS THE CONTROLLING TERM
08500 ?TNXINP__ 0 ;DO STANDARD TENEX INPUT
08600 ?DECLED__ 1 ;DO DEC-STYLE INPUT
08700 ?TENXED__ 2 ;DO TENEX-STYLE INPUT
08800 ?QTTEOF__1B17 ;QUE AN EOF FOR THE TTY
00100 COMPIL(PAT,<OPEN,LOOKUP,ENTER,USETI,USETO,MTAPE,TENXFI,RELEASE,CLOSE,CLOSIN,CLOSO,GETCHAN,CVJFN,RENAME>
00200 ,<SAVE,RESTR,RELEASE,CORGET,INSET>
00300 ,<PAT -- TENEX ROUTINES EMULATING DEC CALLS>)
00400
00500 BEGIN PAT
00600
00700 DSCR PROCEDURE OPEN(INTEGER CHAN; STRING DEV; INTEGER MODE,IBUF,OBUF;
00800 REFERENCE INTEGER COUNT,BR,EOF)
00900
01000 HERE(OPEN)
01100 BEGIN OPEN
01200 GTFLAGS__4
01300 OPFLAGS__5
01400 PUSH P,-7(P)
01500 PUSH P,[0] ;CLOSE INHIBIT
01600 PUSHJ P,RELEASE ;RELEASE IF ALREADY OPEN
01700
01800 ;SEE WHAT KIND OF DEVICE WE HAVE
01900
02000 PUSH SP,-1(SP)
02100 PUSH SP,-1(SP)
02200 PUSH P,[0]
02300 PUSHJ P,CATCHR ;PUT ON A NULL CHAR
02400 PUSHJ P,MAKUP ;MAKE UPPER CASE (DAMMIT)
02500 PUSH SP,-3(SP)
02600 PUSH SP,-3(SP)
02700 PUSH SP,[3]
02800 PUSH SP,[POINT 7,[ASCIZ/:
02900 /]]
03000 PUSHJ P,CAT ;PUT ON A STRING
03100 POP SP,-4(SP)
03200 POP SP,-4(SP) ;SAVE ABOVE
03300
03400 PUSHJ P,SAVE ;NOW SAVE ACS
03500 SETZ LPSA, ;NO PARAMETERS TO REMOVE
03600 MOVE CHNL,-7(P) ;USER CHANNEL NUMBER
03700 MOVE 1,(SP) ;STRING FOR DEVICE
03800 ;[clh] SUB SP,X22 ;ADJUST STACK
03900 JSYS STDEV
04000 JRST BADOPN ;NOT A PLAUSIBLE DEVICE
04100 PUSH P,2 ;SAVE DEVICE DESIGNATOR
04200 ;ITS A PLAUSIBLE DEVICE
04300 MOVEI C,TIOTLN
04400 PUSHJ P,CORGET
04500 ERR <OPEN: CANNOT GET CORE>
04600 MOVE CDB,B ;IO BLOCK ADDRESS
04700 MOVEM CDB,CDBTBL(CHNL) ;SAVE
04800 ;ZERO OUT CORE (SINCE CORGET DOESNT!!!)
04900 HRL B,B
05000 ADDI B,1
05100 SETZM (CDB)
05200 BLT B,TIOTLN-1(CDB)
05300
05400 POP P,1 ;GET DEVICE DESIGNATOR
05500 MOVEM 1,DVDSG(CDB) ;AND SAVE IT
05600 JSYS DVCHR
05700 MOVEM 2,DVCH(CDB) ;SAVE DEVICE CHARACTERISTICS
05800 HLRZ 1,2
05900 ANDI 1,777 ;DEVICE TYPE
06000 MOVEM 1,DVTYP(CDB) ;SAVE IT
06100 MOVEI 2,STARTPAGE(CHNL) ;PAGE BUFFERING
06200 HRLI 2,400000 ;XWD FORK,PAGE
06300 MOVEM 2,FKPAGE(CDB)
06400 LSH 2,9 ;ADDRESS
06500 MOVEM 2,IOADDR(CDB)
06600 SETOM IOPAGE(CDB) ;AT (MYTHICAL) PAGE -1
06700 MOVE 2,DVCH(CDB) ;DEVICE CHARS
06800 TLNN 2,100000 ;IS DEVICE A DIRECTORY DEVICE
06900 JRST GTNOW ;NOPE, DO GTJFN AND OPENF NO
07000 HASDIR:
07100 ;GET THE MODE IN 4
07200 MOVE 4,-6(P) ;MODE
07300 ANDI 4,17 ;FORGET OTHER JUNK
07400 ;IF DEVICE IS A DECTAPE IN DUMP MODE THEN DO IT NOW ALSO
07500 CAIE 1,3 ;IS IT A DECTAPE?
07600 JRST HASDI1 ;NO
07700 CAIN 4,17 ;IN DUMP MODE?
07800 JRST DOMNT ;YES MOUNT AND THEN OPEN
07900 ;SO DONT DO GTJFN NOW, BUT WAIT
08000 HASDI1: SETZM JFNTBL(CHNL) ;BE SURE
08100 MOVEM 4,GFL(CDB) ;SAVE THE MODE AS THE GTJFN FLAGS
08200 HRL 4,-5(P) ;INPUT BUFFERS
08300 HRR 4,-4(P) ;OUTPUT BUFFERS
08400 MOVEM 4,OFL(CDB) ;SAVE AS THE OPENF FLAGS
08500 ;[clh] save away file spec for lookup or enter
08600 MOVEI C,=11 ;SIZE OF BLOCK NEEDED TO STORE DEV
08700 PUSHJ P,CORGET
08800 ERR <OPEN: CANNOT GET CORE>
08900 HRRZ A,-1(SP) ;0 _ COUNT
09000 SUBI A,1 ; DON'T INCLUDE THE NULL
09100 MOVEM A,(B)
09200 MOVE A,0(SP) ;1 _ BYTE PTR
09300 HRRI A,2(B)
09400 MOVEM A,1(B)
09500 HRL A,0(SP) ;2 - 10 _ STRING ITSELF
09600 HRRI A,2(B)
09700 BLT A,=10(B)
09800 MOVEM B,OPNDUN(CDB) ;SAVE ADDR OF BLOCK FOR LOOKUP/ENTER
09900 JRST GUDRT1 ;AND RETURN
10000 ;[clh] ^^
10100
10200 ;MOUNT AND OPEN DECTAPE IN DUMP MODE
10300 DOMNT: MOVE A,DVDSG(CDB) ;GET DEVICE DESIGNATOR
10400 TLO A,(1B3) ;DONT READ DIRECTORY FOR DUMP MODE
10500 JSYS MOUNT
10600 JRST BADOPN ;CANNOT MOUNT
10700 MOVSI GTFLAGS,100001
10800 MOVE 1,GTFLAGS
10900 MOVE 2,-2(SP) ;[clh]
11000 JSYS GTJFN
11100 JRST BADOPN
11200 MOVEM 1,JFNTBL(CHNL)
11300 MOVEM GTFLAGS,GFL(CDB)
11400 MOVE OPFLAGS,[447400000000!RDBIT!WRBIT]
11500 MOVE 2,OPFLAGS
11600 JSYS OPENF
11700 JRST CNTOPN
11800 JRST OPOK
11900
12000 GTNOW:
12100 MOVSI GTFLAGS,100001
12200 MOVE 1,GTFLAGS
12300 MOVE 2,-2(SP) ;[clh] DEVICE STRING
12400 JSYS GTJFN
12500 JRST BADOPN ;NOPE CANNOT GET
12600 MOVEM 1,JFNTBL(CHNL) ;SAVE JFN
12700 MOVEM GTFLAGS,GFL(CDB) ;AND SAVE THEM
12800 ;CHECK IF IT IS THE CONTROLLING TERMINAL (DEVICE "TTY" ONLY )
12900 MOVE 2,DVTYP(CDB) ;GET DEVICE TYPE
13000 CAIE 2,12 ;IS IT A TERMINAL?
13100 JRST NOTTTY ;NO
13200 PUSH P,3
13300 PUSH P,4
13400 PUSH P,5
13500 PUSH P,6
13600 HRRZ 2,JFNTBL(CHNL)
13700 HRROI 1,4 ;WRITE IN 4
13800 MOVSI 3,200000 ;DEVICE ONLY
13900 SETZ 4,
14000 JSYS JFNS ;GET STRING
14100 MOVEM 4,2 ;SAVE IN 2
14200 POP P,6
14300 POP P,5 ;RESTORE
14400 POP P,4
14500 POP P,3
14600 CAME 2,[ASCIZ/TTY/] ;DEVICE TTY?
14700 JRST NOTTTY ;NO
14800 MOVE 2,[ISCTRM+DECLED] ;THE CONTROLLING TERMINAL
14900 MOVEM 2,TTYINF(CDB) ;REMEMBER
15000 NOTTTY:
15100 ;COMPUTE OPENF FLAGS
15200 SETZ OPFLAGS,
15300 MOVE 2,DVCH(CDB) ;DEVICE CHARACTERISTICS
15400 TESTE 2,<1B1> ;CAN DO INPUT?
15500 TESTO OPFLAGS,RDBIT
15600 TESTE 2,<1B0> ;CAN DO OUTPUT?
15700 TESTO OPFLAGS,WRBIT
15800 MOVE 1,DVTYP(CDB) ;CHECK DEVICE TYPE
15900 CAIE 1,7 ;IS IT THE LPT?
16000 CAIN 1,12 ;IS IT A TTY?
16100 JRST OP7BT ;USE 7 BIT BYTES
16200 ;NOW TRY VARIOUS THINGS, LOOKING FOR SOMETHING THAT WORKS
16300
16400 HRRZ 1,JFNTBL(CHNL)
16500 HRLI OPFLAGS,440000
16600 MOVE 2,OPFLAGS ;36-BIT, MODE 0
16700 JSYS OPENF
16800 SKIPA
16900 JRST OPOK
17000 HRRZ 1,JFNTBL(CHNL)
17100 HRLI OPFLAGS,447400 ;36-BIT, MODE 17
17200 MOVE 2,OPFLAGS
17300 JSYS OPENF
17400 SKIPA
17500 JRST OPOK
17600 OP7BT: HRRZ 1,JFNTBL(CHNL)
17700 HRLI OPFLAGS,70000 ;7-BIT, MODE 0
17800 MOVE 2,OPFLAGS
17900 JSYS OPENF
18000 JRST NOOPN
18100 OPOK: MOVEM OPFLAGS,OFL(CDB) ;SAVE OP FLAGS
18200 GUDRET:
18300 ;SAVE FLAGS
18400 SETOM OPNDUN(CDB) ;INDICATE OPENED WITH OPEN
18500 GUDRT1: POP P,TEMP ;RETURN ADDRESS
18600 POP P,ENDFL(CDB) ;SAVE GOOD THINGS
18700 POP P,BRCHAR(CDB)
18800 POP P,ICOUNT(CDB)
18900 SETZM @ENDFL(CDB) ;INDICATE GOOD OPENING
19000 SUB SP,X44 ;[clh] CLEAN UP STACKS
19100 SUB P,X44
19200 JRST RESTR ;AND RETURN
19300
19400
19500 NOOPN:
19600 CNTOPN: SKIPN 1,JFNTBL(CHNL) ;RELEASE JFN
19700 JSYS RLJFN
19800 JFCL
19900 BADOPN:
20000 SKIPE B,CDBTBL(CHNL) ;CORE ALLOCATED?
20100 PUSHJ P,CORREL ;RELEASE CORE
20200 SETZM JFNTBL(CHNL)
20300 SETZM CDBTBL(CHNL)
20400 SKIPN @-1(P) ;USER WANTS ERROR?
20500 ERR <OPEN: IO ERROR OR ILLEGAL SPECIFICATIONS>,1
20600 SETOM @-1(P)
20700 POP P,TEMP
20800 SUB P,[XWD 7,7]
20900 SUB SP,X44 ;[clh]
21000 JRST RESTR
21100
21200
21300
21400
21500 BEND OPEN
21600
21700 ;MAKE UPPER CASE LETTERS
21800 MAKUP: PUSHJ P,SAVE
21900 SKIPE SGLIGN(USER)
22000 PUSHJ P,INSET
22100 HRRZ A,-1(SP) ;LENGTH OF STRING
22200 ADDM A,REMCHR(USER)
22300 SKIPLE REMCHR(USER) ;OK?
22400 PUSHJ P,STRNGC ;NO, COLLECT
22500 MOVE B,A
22600 HRRO A,A
22700 PUSH SP,A
22800 PUSH SP,TOPBYTE(USER)
22900 UPPER1: JUMPLE B,UPPER2 ;DONE YET?
23000 ILDB C,-2(SP) ;NEXT CHAR
23100 CAIL C,141
23200 CAILE C,172
23300 SKIPA
23400 SUBI C,40 ;CONVERT TO UPPER CASE
23500 IDPB C,TOPBYTE(USER)
23600 SOJA B,UPPER1
23700 UPPER2: POP SP,-2(SP)
23800 POP SP,-2(SP)
23900 SETZ LPSA,
24000 POP P,TEMP ;RETURN ADDR
24100 JRST RESTR ;RETURN
24200
00100 DSCR PROCEDURE LOOKUP(INTEGER CHNL; STRING FILE; REFERENCE INTEGER FLAG)
00200
00300
00400
00500 HERE(LOOKUP)
00600 BEGIN LOOKUP
00700 PUSHJ P,TENXFI ;MAKE THE FILE SPEC TENEX
00800
00900 PUSH P,1
01000 PUSH P,2
01100 PUSH P,3
01200 PUSH P,CHNL
01300 PUSH P,CDB
01400 DEFINE CHNARG <-7(P)>
01500 DEFINE FLGARG <-6(P)>
01600
01700 SETZM @FLGARG ;CLEAR FLAG
01800 SKIPL CHNL,CHNARG
01900 CAIL CHNL,JFNSIZE
02000 JRST BADLU1
02100 MOVE CDB,CDBTBL(CHNL)
02200 SKIPN OPNDUN(CDB) ;ERROR IF NOT OPENED
02300 JRST BADLU1
02400 MOVE 2,DVCH(CDB) ;GET DEVICE CHARACTERISTICS
02500 TLNN 2,100000 ;DOES DEVICE HAVE A DIRECTORY?
02600 JRST LUKRET ;NO, NO LOOKUP
02700 SKIPE JFNTBL(CHNL) ;JFN ALREADY ASSIGNED?
02800 PUSHJ P,RELNOW ;YES, RELEASE IT
02900
03000 PUSHJ P,DEVCAT
03100
03200 MOVSI 1,100001 ;OLD FILE
03300 MOVE 2,(SP)
03400 JSYS GTJFN
03500 JRST BADLUK
03600 MOVEM 1,JFNTBL(CHNL)
03700 MOVSI 3,100001
03800 MOVEM 3,GFL(CDB)
03900 MOVE 2,[XWD 440000,200000] ;36-BIT
04000 JSYS OPENF
04100 SKIPA
04200 JRST GUDLUK
04300 MOVE 1,JFNTBL(CHNL)
04400 MOVE 2,[XWD 447400,200000] ;36-BIT, DUMP
04500 JSYS OPENF
04600 SKIPA
04700 JRST GUDLUK
04800 MOVE 1,JFNTBL(CHNL)
04900 MOVE 2,[XWD 70000,200000] ;7-BIT
05000 JSYS OPENF
05100 JRST BADLUK
05200 GUDLUK: MOVEM 2,OFL(CDB)
05300 SETZM @FLGARG
05400 LUKRET: POP P,CDB
05500 POP P,CHNL
05600 POP P,3
05700 POP P,2
05800 POP P,1
05900 SUB SP,X22
06000 SUB P,X33
06100 JRST @3(P)
06200
06300 BADLUK: MOVEM 1,@FLGARG
06400 JRST LUKRET
06500
06600 BADLU1: SETOM @FLGARG
06700 JRST LUKRET
06800
06900
07000 BEND LOOKUP
07100
07200 DEVCAT:
07300 ;HERE WITH CDB LOADED, FILENAME ON THE SP STACK
07400 ;RETURN WITH "DEV:FILE" & 0 ON THE SP STACK
07500 ;MUST NOT HAVE CALLED SAVE WHEN THIS IS CALLED
07600 PUSH P,1
07700 PUSH P,2
07800 ;[clh] if opndun .gt. 0, it is a pointer to a block with a device name in it
07900 SKIPG 1,OPNDUN(CDB) ;DO WE HAVE A DEVICE NAME?
08000 JRST DEVCA1 ;NO [SHOULD NEVER HAPPEN]
08100 PUSH SP,0(1) ;COPY STRING HEADER FROM DEV NAME
08200 PUSH SP,1(1)
08300 JRST DEVCA2
08400 DEVCA1:
08500 ;[clh]^^
08600 PUSH P,[=100]
08700 PUSHJ P,ZSETST ;BP IN 1
08800 MOVE 2,DVDSG(CDB) ;DEVICE DESIGNATOR
08900 JSYS DEVST
09000 ERR <LOOKUP, ENTER, OR RENAME: CANNOT DO DEVST>
09100 PUSH P,[=100]
09200 PUSH P,1 ;UPDATED BP
09300 PUSHJ P,ZADJST
09400 DEVCA2: PUSH P,[":"]
09500 PUSHJ P,CATCHR
09600 PUSHJ P,CAT.RV
09700 PUSH P,[0]
09800 PUSHJ P,CATCHR
09900 POP P,2
10000 POP P,1
10100 POPJ P,
10200
10300 ;RELEASE JFN ALREADY THERE
10400 RELNOW:
10500 PUSH P,CHNL ;CHANNEL
10600 PUSHJ P,CLOSF ;CLOSE DANCE
10700 PUSH P,1
10800 MOVE 1,JFNTBL(CHNL) ;GET JFN
10900 JSYS RLJFN ;RELEASE
11000 ERR <CANNOT RELEASE JFN>,1
11100 SETZM JFNTBL(CHNL) ;AND ZERO OUT
11200 SETZM IOSTT(CDB) ;NO STATUS
11300 POP P,1
11400 POPJ P,
11500
11600
00100 HERE(ENTER)
00200 BEGIN ENTER
00300
00400 PUSHJ P,TENXFI
00500
00600 PUSH P,1
00700 PUSH P,2
00800 PUSH P,3
00900 PUSH P,CHNL
01000 PUSH P,CDB
01100 DEFINE CHNARG <-7(P)>
01200 DEFINE FLGARG <-6(P)>
01300
01400 SETZM @FLGARG ;CLEAR FLAG FOR USER
01500 SKIPL CHNL,CHNARG
01600 CAIL CHNL,JFNSIZE
01700 JRST BADEN1
01800 MOVE CDB,CDBTBL(CHNL)
01900 SKIPN OPNDUN(CDB)
02000 JRST BADEN1 ;WAS AN OPEN PERFORMED HERE?
02100 SKIPN 1,JFNTBL(CHNL)
02200 JRST NOTOPN
02300 MOVE 2,DVCH(CDB) ;GET DEVICE CHARACTERISTICS
02400 TLNN 2,100000 ;DOES DEVICE HAVE DIRECTORY?
02500 JRST ENTRET ;NO
02600
02700 SKIPGE IOSTT(CDB) ;A DEC-STYLE CLOSE DONE? CHKDECCLZ
02800 JRST [PUSHJ P,RELNOW ;RELEASE JFN
02900 JRST NOTOPN ;AND PROCEED
03000 ]
03100
03200 PUSH P,1 ;SAVE JFN
03300 SETO 1, ;UNMAP THE BUFFER PAGE
03400 MOVE 2,FKPAGE(CDB)
03500 SETZ 3,
03600 JSYS PMAP ;REMOVE PAGE
03700 POP P,1
03800
03900 SETOM IOPAGE(CDB)
04000 SETZM IOSTT(CDB)
04100
04200 PUSH P,1 ;SAVE JFN
04300 TLO 1,400000 ;DO NOT RELEASE THE JFN
04400 JSYS CLOSF
04500 JFCL ;IGNORE
04600 POP P,1
04700 MOVE 2,OFL(CDB)
04800 TESTO 2,WRBIT ;TURN ON WRITE BIT
04900 MOVEM 2,OFL(CDB) ;AND SAVE NEW FLAGS
05000 JSYS OPENF
05100 JRST BADENT ;ERROR IN 1
05200 JRST ENTRET ;RETURN
05300
05400 NOTOPN:
05500 PUSHJ P,DEVCAT
05600
05700 MOVSI 1,600001 ;NEW FILE
05800 MOVE 2,(SP)
05900 JSYS GTJFN
06000 JRST BADENT ;CANNOT GTJFN
06100 MOVEM 1,JFNTBL(CHNL)
06200 MOVSI 2,600001 ;THE
06300 MOVEM 2,GFL(CDB) ;SAVE THE GTJFN FLAGS
06400 B36: HRRZ 1,JFNTBL(CHNL)
06500 MOVE 2,[XWD 440000,100000] ;36-BIT
06600 JSYS OPENF
06700 SKIPA
06800 JRST ENT1
06900 HRRZ 1,JFNTBL(CHNL)
07000 MOVE 2,[XWD 447400,100000] ;36-BIT, DUMP
07100 JSYS OPENF
07200 SKIPA
07300 JRST ENT1
07400 HRRZ 1,JFNTBL(CHNL)
07500 MOVE 2,[XWD 70000,100000]
07600 JSYS OPENF
07700 JRST BADENT
07800 ENT1: MOVEM 2,OFL(CDB)
07900 ENTRET: SETZM @FLGARG
08000 ENTPOP: POP P,CDB
08100 POP P,CHNL
08200 POP P,3
08300 POP P,2
08400 POP P,1
08500 SUB SP,X22
08600 SUB P,X33
08700 JRST @3(P)
08800
08900
09000 BADENT: MOVEM 1,@FLGARG
09100 JRST ENTPOP
09200
09300 BADEN1: SETOM @FLGARG
09400 JRST ENTPOP
09500
09600 BEND ENTER
09700
00100 DSCR
00200 RENAME(CHNL,"STR",PROT,@FLAG)
00300 Since protection is not implemented in TENEX,
00400 the feature will be ignored.
00500
00600
00700 HERE(RENAME)
00800 BEGIN RENAME
00900 PUSH P,1
01000 PUSH P,2
01100 PUSH P,3
01200 PUSH P,CHNL
01300 PUSH P,CDB
01400 DEFINE CHNARG <-10(p)>
01500 DEFINE FLGARG <-6(P)>
01600
01700 VALCHN 1,CHNARG,RENBAD
01800 PUSHJ P,OPNCHK ;MAKE SURE OPEN (SOMEWHAT REDUNDANT)
01900 MOVE 2,DVCH(CDB) ;DEVICE CHARS
02000 TLNN 2,100000 ;DIRECTORY DEVICE?
02100 JRST RENRET ;NO, NOP
02200
02300 PUSHJ P,TENXFI ;MAKE A TENEX FILE NAME
02400
02500 ;PERHAPS ONLY A DELETE?
02600 HRRZ 2,-1(SP) ;NULL FILE SPEC?
02700 JUMPE 2,RENDEL ;YES, DELETE
02800
02900 ;ACTUALLY RENAME (ON THE SAME DEVICE)
03000 PUSH P,CHNARG
03100 PUSHJ P,CLOSF ;FIRST CLOSE THE FILE
03200
03300 PUSHJ P,DEVCAT
03400
03500 MOVE 3,1 ;SAVE FIRST JFN
03600 MOVE 1,GFL(CDB) ;USE SAME FLAGS
03700 TESTZ 1,OLDBIT ;EXCEPT NOT OLD
03800 TESTO 1,NEWBIT ;BUT DO WANT NEW
03900 TESTO 1,OUTBIT ;AND VERSION DEFAULTING
04000 MOVEM 1,GFL(CDB) ;SAVE FLAGS
04100 MOVE 2,(SP)
04200 JSYS GTJFN
04300 JRST RENERR ;ERROR BITS IN 1
04400
04500 MOVE 2,1 ;NEW JFN
04600 MOVE 1,3 ;OLD JFN
04700 JSYS RNAMF
04800 JRST RENERR ;ERROR BITS IN 1
04900 MOVE 1,2 ;NEW JFN
05000 MOVE 2,OFL(CDB) ;OPENF FLAGS
05100 JSYS OPENF
05200 JRST RENERR ;ERROR BITS IN 1
05300 MOVEM 1,JFNTBL(CHNL) ;SAVE THE NEW JFN
05400
05500 RENRET: SETZM @FLGARG ;INDICATE A GOOD RETURN
05600 RENRE1: POP P,CDB
05700 POP P,CHNL
05800 POP P,3
05900 POP P,2
06000 POP P,1
06100 SUB SP,X22
06200 SUB P,X44
06300 JRST @4(P)
06400
06500 RENERR: MOVEM 1,@FLGARG
06600 JRST RENRE1
06700
06800 RENBAD: SETOM @FLGARG
06900 JRST RENRE1
07000
07100 RENDEL: TLO 1,400000 ;TURN ON BIT 0 FOR NO RELEASE
07200 JSYS DELF ;JFN IN 1
07300 JRST RENERR
07400 JRST RENRET
07500 BEND RENAME
07600
00100 DSCR PROCEDURE USETI,USETO(INTEGER CHANNEL,BLOCK)
00200
00300
00400 HERE(USETI)
00500 HERE(USETO)
00600 BEGIN USETS
00700
00800 PUSH P,1
00900 PUSH P,2
01000 PUSH P,3
01100 PUSH P,CHNL
01200 SETZM .SKIP.
01300 VALCHN 1,-6(P),USETERR
01400 MOVE 2,DVTYP(CDB)
01500 CAIN 2,3 ;IS IT A DECTAPE
01600 JRST USEDTA
01700 MOVE 2,-5(P) ;ARGUMENT
01800 SOJ 2,
01900 LSH 2,7 ;CONVERT BLOCK TO WORD NUMBER
02000 PUSH P,-6(P) ;CHANNEL ARG
02100 PUSH P,2 ;WORD TO SET TO
02200 PUSHJ P,SWDPTR ;SET THE WORD POINTER
02300 USETRET:POP P,CHNL
02400 POP P,3
02500 POP P,2
02600 POP P,1
02700 SUB P,X33
02800 JRST @3(P)
02900
03000
03100 USEDTA:
03200 MOVEI 2,30 ;OPERATION 30 FOR DECTAPES
03300 HRRZ 3,-5(P) ;TAPE BLOCK
03400 JSYS MTOPR ;SET DIRECTLY
03500 JRST USETRET ;AND RETURN
03600
03700 USETER: ERR<Illegal JFN>,1
03800 SETOM .SKIP.
03900 JRST USETRET ;AND RETURN
04000
04100 BEND USETS
04200
00100 DSCR PROCEDURE CLOSE(INTEGER CHANNEL,[CLOSEINHIBITBITS])
00200 procedure closo(integer chan; integer bits(0))
00300 procedure closin(integer chan; integer bits(0))
00400
00500 BEGIN CLOSES
00600
00700 HERE(CLOSIN)
00800 HERE(CLOSO)
00900 PUSH P,-2(P)
01000 PUSHJ P,CLOSF
01100 PUSHJ P,SAVE
01200 VALCHN 1,-2(P),.+2
01300 SETOM IOSTT(CDB) ;MARK AS BEING CLOSED
01400 MOVE LPSA,X33
01500 JRST RESTR
01600
01700 HERE(CLOSE)
01800 DOOPN: PUSH P,-2(P)
01900 PUSHJ P,CLOSF ;FORCE BUFFERS OUT, WRITE MAGT EOFS, CLOSF
02000 PUSHJ P,SAVE
02100 VALCHN 1,-2(P),CLORET
02200 SETOM IOSTT(CDB) ;MARK AS BEING CLOSED
02300 CLORET: MOVE LPSA,X33
02400 JRST RESTR
02500
02600 BEND CLOSES
02700
00100 HERE(RELEASE)
00200 DSCR
00300 Ignores the close inhibit bits that are available in
00400 the STANFORD SAIL, until we decide what to do with them.
00500
00600
00700 PUSH P,1
00800 PUSH P,-3(P) ;CHANNEL
00900 PUSHJ P,CFILE
01000 POP P,1 ;RESTORE 1
01100 SUB P,X33
01200 JRST @3(P) ;RETURN
01300
01400
01500
01600
00100 DSCR
00200 PROCEDURE MTAPE(INTEGER CHAN,OPERATION)
00300 (the operation is a character e.g., "U" to unload)
00400 as in the SAIL manual.
00500
00600
00700 HERE(MTAPE)
00800 BEGIN MTAPE
00900 PUSHJ P,SAVE
01000 MOVE LPSA,X33
01100 LDB C,[POINT 5,-1(P),35]
01200 MOVE A,OPTAB
01300 MOVE B,OPTAB+1
01400 TRZE C,30 ;COMPRESS TABLE
01500 ADDI C,5
01600 LSH C,2
01700 ROTC A,(C)
01800 ANDI B,17
01900 VALCHN 1,-2(P),MTAERR
02000 PUSHJ P,OPNCHK ;MAKE SURE OPEN
02100 JSYS MTOPR
02200 JRST RESTR
02300 MTAERR: ERR <Illegal JFN>,1
02400 JRST RESTR
02500
02600 OPTAB: BYTE (4) 16,17,0,0,3,6,7,13,10 ;A,B,E,F,R,S,T
02700 BYTE (4) 11,0,1 ;U,W
02800
02900 BEND MTAPE
03000
03100
03200
03300
00100 DSCR STRING PROCEDURE TENXFI(STRING DECFILE)
00200
00300 Converts the string to a TENEX file specification.
00400 A la Alex Cannara.
00500
00600
00700 HERE(TENXFI)
00800 BEGIN TENXFI
00900
01000 CTRLV__"V"-100
01100 FIND__2
01200
01300 PUSH P,1
01400 PUSH P,2
01500 PUSH P,3
01600 SETZM FIND
01700 PUSH SP,[0] ;DEVICE TEMPORARY
01800 PUSH SP,[0]
01900 PUSH SP,[0] ;DIR TEMPORARY
02000 PUSH SP,[0]
02100 PUSH SP,[0] ;NAM TEMPORARY
02200 PUSH SP,[0]
02300
02400 DEFINE ORIG <-7(SP)>
02500 DEFINE ORIG1 <-6(SP)>
02600 DEFINE DEV <-5(SP)>
02700 DEFINE DEV1 <-4(SP)>
02800 DEFINE DIR <-3(SP)>
02900 DEFINE DIR1 <-2(SP)>
03000 DEFINE NAM <-1(SP)>
03100 DEFINE NAM1 <0(SP)>
03200
03300 ;SIMPLE SINCE NAME IS AT THE TOP OF SP
03400 DEFINE CATNAM (X) <
03500 PUSH P,X
03600 PUSHJ P,CATCHR
03700 >
03800 DEFINE CATDIR (X) <
03900 PUSH P,X
04000 PUSH SP,DIR
04100 PUSH SP,DIR
04200 PUSHJ P,CATCHR
04300 POP SP,-4(SP)
04400 POP SP,-4(SP)
04500 >
04600
04700 DEFINE GCH <
04800 HRRZ 1,ORIG
04900 JUMPE 1,TENDUN
05000 ILDB 3,ORIG1
05100 SOS ORIG
05200 >
05300
05400
05500 TENX1: GCH
05600 CAIE 3,CTRLV
05700 JRST NOQUOTE
05800 SKIPE FIND
05900 JRST QUODIR
06000 PUSHJ P,CATNA3
06100 GCH
06200 PUSHJ P,CATNA3 ;AND THE CHAR FOLLOWING THE CTRLV
06300 JRST TENX1
06400 QUODIR: PUSHJ P,CATDI3
06500 GCH
06600 PUSHJ P,CATDI3
06700 JRST TENX1 ;AND CONTINUE
06800
06900 NOQUOTE:
07000 CAIN 3,":" ;COLON -- DEVICE
07100 JRST ISDEV ;ITS BEEN A DEVICE ALL ALONG!!
07200 CAIN 3,","
07300 JRST TENX1 ;IGNORE COMMA
07400 CAIE 3,40 ;SPACE
07500 CAIN 3,11 ;OR TAB
07600 JRST TENX1
07700
07800 CAIE 3,"<" ;THESE START THE DIRECTORY NAME
07900 CAIN 3,"["
08000 JRST STDIR
08100 CAIE 3,">" ;THESE FINISH THE DIR. NAME
08200 CAIN 3,"]"
08300 JRST ENDDIR
08400 SKIPE FIND ;DOING DIRECTORY?
08500 JRST .+3 ;YES
08600 PUSHJ P,CATNA3
08700 JRST TENX1
08800 PUSHJ P,CATDI3
08900 JRST TENX1
09000
09100 STDIR: SETOM FIND
09200 SKIPE DIR ;ANYTHING THERE?
09300 JRST TENX1 ;YES, IGNORE
09400 CATDIR <[74]>
09500 JRST TENX1
09600
09700 ENDDIR: SETZM FIND
09800 JRST TENX1
09900
10000 ISDEV: PUSHJ P,CATNA3 ;PUT THE COLON ON THE NAME
10100 MOVE 3,NAM ;THE "NAME" HAS REALLY BEEN A DEV
10200 MOVEM 3,DEV
10300 MOVE 3,NAM1
10400 MOVEM 3,DEV1
10500
10600 SETZM NAM ;SO CLEAR THE NAME -- START OVER
10700 SETZM NAM1
10800 JRST TENX1
10900
11000 TENDUN:
11100 ;CHECK TO SEE WHAT LAST CHAR OF DIR IS
11200 SKIPN DIR
11300 JRST GOTDIR ;NO DIRECTORY THERE
11400 CATDIR <[76]> ;PUT ON A ">"
11500 ;NOW STACK HAS ORIG,DEV,DIR,NAM
11600 GOTDIR:
11700 PUSHJ P,CAT
11800 ;NOW STACK HAS ORIG,DEV,<DIR>NAM
11900 PUSHJ P,CAT
12000 ;NOW STACK HAS ORIG,DEV:<DIR>NAM
12100 GOTDI1: POP SP,-2(SP)
12200 POP SP,-2(SP)
12300
12400 TXFRET:
12500 POP P,3
12600 POP P,2
12700 POP P,1
12800 POPJ P,
12900
13000
13100 ;CALL CAT MACROS WITH AC 3 AS THE ARG
13200 CATNA3: CATNAM 3
13300 POPJ P,
13400
13500 CATDI3: CATDIR 3
13600 POPJ P,
13700
13800
13900 BEND TENXFI
14000
00100 DSCR
00200 INTEGER PROCEDURE GETCHAN(INTEGER I)
00300 RETURNS AN UNUSED CHANNEL NUMBER, AND MARKS IT
00400 FOR USE, SO THAT NO ONE WILL TRY TO USE IT.
00500
00600
00700 HERE(GETCHAN)
00800 MOVE A,[XWD -JFNSIZE+1,1] ;START AT CHANNEL 1
00900 GETCH1: SKIPN CDBTBL(A) ;ALLOCATED YET?
01000 JRST GETCH2 ;NO, TAKE IT
01100 AOBJN A,GETCH1 ;YES
01200 SETOM A ;INDICATE ERROR
01300 POPJ P,
01400
01500 GETCH2: HRRZ A,A
01600 PUSH P,B ;NOW ALLOCATE A TABLE
01700 PUSH P,C
01800 MOVEI C,TIOTLN
01900 PUSHJ P,CORGET
02000 ERR <GETCHAN: CANNOT GET CORE>
02100 MOVEM B,CDBTBL(A)
02200
02300 HRL C,B ;ZERO OUT BLOCK
02400 HRRI C,1(B)
02500 SETZM (B)
02600 BLT C,TIOTLN-1(B)
02700
02800 SETZM JFNTBL(A) ;BUT NO JFN (YET)
02900 POP P,C
03000 POP P,B
03100 POPJ P,
03200
03300 DSCR
03400 INTEGER PROCEDURE CVJFN(INTEGER CHAN)
03500
03600 Returns the JFN (XWD flags,jfn) associated
03700 with a logical channel, -1 if no jfn assigned.
03800 Hereby, the user of these routines can access
03900 the system directly if the need arises.
04000
04100 HERE(CVJFN)
04200 SKIPL 1,-1(P)
04300 CAIL 1,JFNSIZE
04400 JRST CVJFER
04500 SKIPN 1,JFNTBL(1)
04600 JRST CVJFER
04700 CVJFR: SUB P,X22
04800 JRST @2(P)
04900 CVJFER: SETO 1,
05000 JRST CVJFR
05100
05200
05300 BEND PAT
05400
05500 ENDCOM(PAT)
05600
00100 COMPIL(JOBINF,<ODTIM,IDTIM,IDTIM$,RUNTM,GTAD,GJINF>,<ZSETST,ZADJST,X22,X33,X44,.SKIP.,CATCHR>
00200 ,<JOBINF -- JOB UTILITY ROUTINES>)
00300 DSCR STRING SIMPLE PROCEDURE ODTIM(INTEGER DT,FORMAT)
00400 Returns the string representation of DT
00500 (which is in internal TENEX representation). If DT
00600 is -1 the current date and time are used. If format
00700 is -1, the standard format is used.
00800
00900 HERE(ODTIM)
01000 PUSH P,[=100] ; 100 CHARS
01100 PUSHJ P,ZSETST ;GET BP IN 1
01200 MOVE 2,-2(P) ;TIME
01300 MOVE 3,-1(P) ;FORMAT
01400 JSYS ODTIM
01500 PUSH P,[=100]
01600 PUSH P,1 ;UPDATED BP
01700 PUSHJ P,ZADJST ;GET STRING
01800 SUB P,X33 ;ADJUST STACK
01900 JRST @3(P) ;RETURN
00100
00200 DSCR INTEGER SIMPLE PROCEDURE IDTIM(STRING S,bits[0])
00300 Returns the internal TENEX representation of S, which
00400 is assumed to be the date and time in some reasonable format.
00500 If the format cannot be scanned, the error is returned in .SKIP.
00600
00700
00800
00900 HERE(IDTIM)
01000 ;[clh] old form of IDTIM, without the magic bits
01100 PUSH P,0(P) ;[clh] RET, RET
01200 SETZM -1(P) ;[clh] 0, RET
01300
01400 HEREFK(IDTIM$,IDTIM.)
01500 ;[clh] new form of IDTIM, with bits
01600 PUSH P,[0]
01700 PUSHJ P,CATCHR
01800 MOVE 1,(SP) ;BYTE-POINTER
01900 MOVE 2,-1(P) ;[clh] bits
02000 SETZM .SKIP. ;[clh] assume no errors
02100 JSYS IDTIM
02200 MOVEM 2,.SKIP. ;ERROR TO USER
02300 MOVE 1,2 ;ANSWER
02400 SUB SP,X22 ;ADJUST SP STACK
02500 SUB P,X22 ;[CLH]
02600 JRST @2(P) ;[CLH]
00100 DSCR INTEGER SIMPLE PROCEDURE RUNTM(INTEGER FORK; REFERENCE INTEGER CONSOLE);
00200 Returns the runtime of a fork. If FORK=-5, then then
00300 whole job. Time is returned as milliseconds for you. Console time,
00400 similarly converted, is returned in CONSOLE.
00500
00600 HERE(RUNTM)
00700 MOVE 1,-2(P)
00800 JSYS RUNTM
00900 MOVEM 3,@-1(P)
01000 SUB P,X33
01100 JRST @3(P)
00100 DSCR INTEGER SIMPLE PROCEDURE GTAD;
00200 Returns the current date and time. See Jsys manual,
00300 3-3.
00400
00500 HERE(GTAD)
00600 JSYS GTAD
00700 POPJ P,
00100 DSCR INTEGER SIMPLE PROCEDURE GJINF(REFERENCE INTEGER LOGDIR,CONDIR,TTYNO);
00200 Returns the TENEX jobnumber. LOGDIR is the directory
00300 no. logged in, CONDIR is the connected directory number. TTYNO is the
00400 TENEX teletype number, which is -1 if the job is detached.
00500 See the DIRST routine for converting directory numbers to
00600 directory strings.
00700
00800
00900 HERE(GJINF)
01000 JSYS GJINF
01100 MOVEM 1,@-3(P)
01200 MOVEM 2,@-2(P)
01300 MOVEM 4,@-1(P)
01400 MOVE 1,3;
01500 SUB P,X44
01600 JRST @4(P)
00100
00200 ENDCOM(JOBINF)
00300
00100 COMPIL(DIRECT,<STDIR,RCUSR,RCDIR,DIRST>
00200 ,<SAVE,RESTR,X22,X33,X44,CAT,CATCHR,ZSETST,ZADJST,.SKIP.>
00300 ,<DIRECT -- TENEX DIRECTORY SPECS>)
00400 DSCR INTEGER SIMPLE PROCEDURE STDIR(STRING S; BOOLEAN DORECOGNITION)
00500 DESR
00600 Returns the directory number associated with a string.
00700 Any problems are returned in .SKIP. with the code:
00800 1 string does not match
00900 2 string is ambiguous.
01000
01100 HERE(STDIR)
01200 PUSH P,[0]
01300 PUSHJ P,CATCHR ;TACK ON 0
01400 SETZ 3, ;
01500 MOVEI 1,1 ; ASSUME NO RECOGNITION
01600 SKIPE -1(P) ; DO WE WANT IT?
01700 SETO 1, ; YES AFTER ALL
01800 MOVE 2,(SP) ;BYTE-POINTER
01900 JSYS STDIR
02000 SKIPA 3,[1] ; NO MATCH;
02100 MOVEI 3,2 ; AMBIGUOUS
02200 MOVEM 3,.SKIP. ; SAVE IT FOR USER
02300 HRRZ 1,1 ; SAVE DIR NO. (ONLY)
02400 SUB SP,X22 ;ADJUST STRING STACK
02500 SUB P,X22
02600 JRST @2(P) ;RETURN
02700
02800 ;[CLH/DAW]
02900 DSCR INTEGER SIMPLE PROCEDURE RCDIR(REFERENCE STRING DIRECTORY; REFERENCE
03000 INTEGER DIRNO, FLAGS);
03100 INTEGER SIMPLE PROCEDURE RCUSR(REFERENCE STRING USER; REFERENCE
03200 INTEGER DIRNO, FLAGS);
03300 Returns a directory number if successful, 0 otherwise.
03400
03500
03600
03700 HEREFK (RCUSR,$RCUSR)
03800
03900 PUSH P,X
04000 MOVE X,[JSYS RCUSR] ;SAY WHAT WE'RE DOING
04100 JRST RCDIR1
04200
04300 HEREFK (RCDIR,$RCDIR)
04400
04500 push p,x
04600 move x,[jsys rcdir]
04700 rcdir1: push p,b
04800 push p,c
04900 move b,-6(p) ;get address of pointer
05000 push sp,-1(b) ;put on string stack
05100 push sp,(b)
05200 move a,@-4(p) ;get flags
05300 tlne a,1 ;if no recognition
05400 jrst norecg ;just make asciz
05500 push p,[=100] ;recognition: leave lots of room
05600 pushj p,zsetst ;sp now points to a string with 40 nulls
05700 move b,a ;b _ new string
05800 exch a,(sp) ;a _ old string, new one saved now
05900 push p,y
06000 hrrz c,-1(sp) ;size of original
06100 caile c,=99 ;truncate if .gt. 99
06200 movei c,=99 ;copy string and put on null
06300 jumpe c,rec2
06400 rec1: ildb y,a
06500 idpb y,b
06600 sojg c,rec1
06700 rec2: setz y,0
06800 idpb y,b
06900 pop p,y
07000 norec1: move a,@-4(p) ;get back flags
07100 move b,(sp) ;string to be translated
07200 move c,@-5(p) ;get previous directory number
07300 xct x
07400 erjmp jserr
07500 setz x,
07600 tlne a,10000 ;no more directories _ 3
07700 movei x,3
07800 tlne a,20000 ;ambigous _ 2
07900 movei x,2
08000 tlne a,40000 ;no match _ 1
08100 movei x,1
08200 erret: movem x,.skip. ;return error code
08300 exch a,@-4(p) ;return flags
08400 movem c,@-5(p) ;return directory number
08500 skipn .skip. ;if error, or
08600 tlne a,1 ; if no recognition
08700 jrst clenup ; clean up and return
08800 push p,[=100] ;length of original string
08900 push p,b ;point to end of string
09000 pushj p,zadjst ; and get new string pointer
09100 move b,-6(p) ;get address for string return
09200 pop sp,(b) ; and put the string there
09300 pop sp,-1(b)
09400 clenup: move a,@-5(p) ;return directory number
09500 pop p,c
09600 pop p,b
09700 pop p,x
09800 sub sp,x22
09900 sub p,x44
10000 jrst @4(p)
10100
10200 NORECG: PUSH P,[0] ;MAKE ASCIZ
10300 PUSHJ P,CATCHR
10400 JRST NOREC1
10500
10600 jserr: movei a,400000 ;get my last error
10700 jsys geter
10800 setzb a,c ;zero out returned stuff
10900 hrrz x,b ;put tenex error code here
11000 jrst erret
11100
11200 ;[clh/daw] ^^
00100 DSCR STRING SIMPLE PROCEDURE DIRST(INTEGER I)
00200 Returns the string name for directory I. Any problems
00300 cause .SKIP. to be set TRUE.
00400
00500
00600 HERE(DIRST)
00700 BEGIN DIRST
00800 PUSH P,[=100]
00900 PUSHJ P,ZSETST
01000 SETZM .SKIP.
01100 MOVE 2,-1(P) ;DIRECTORY NO.
01200 PUSH P,1 ;SAVE STRING POINTER
01300 JSYS DIRST
01400 JRST DIRERR ;ERROR RETURN
01500 SUB P,X11 ;CLEAR STACK, DONT NEED STRING POINTER
01600 DOADJ: PUSH P,[=100]
01700 PUSH P,1 ;UPDATED STRING POINTER
01800 PUSHJ P,ZADJST ;GET SAIL STRING ON STACK
01900 SUB P,X22
02000 JRST @2(P)
02100
02200 DIRERR: MOVEM 1,.SKIP. ;ERROR NUMBER IN TOPS 20, STRING POINTER IN TENEX
02300 ;ALWAYS TRUE
02400 POP P,1 ;GET BACK ORIGINAL BP
02500 JRST DOADJ ;AND FIX STRINGS
02600 BEND DIRST
02700 ENDCOM(DIRECT)
00100 COMPIL(RUNPRG,<RUNPRG>,<X22,X33,$OSTYP,CATCHR>,<RUNPRG -- RUN A PROGRAM>)
00200 DSCR INTEGER SIMPLE PROCEDURE RUNPRG(STRING PROGRAM; INTEGER INCREM; BOOLEAN NEWFORK)
00300 This does two entirely different things depending on whether
00400 NEWFORK is true or not.
00500 If NEWFORK then a new fork is created, capabilities transmitted,
00600 and PROGRAM is run there. INCREM is added to the entry vector. Any problems
00700 cause the routine to return FALSE, otherwise it returns TRUE.
00800 If not NEWFORK then the current job is destroyed and replaced
00900 with PROGRAM, with INCREM added to the entry vector location. This is
01000 like the DEC RUN uuo, and hence if the increment is 1, the program is
01100 started at the CCL address. If the routine returns at all, there was a problem
01200 with the file.
01300
01400
01500
01600
01700 HERE(RUNPRG)
01800 BEGIN
01900 JFN__0
02000 FORK__14
02100 PUSH P,[0]
02200 PUSHJ P,CATCHR
02300 MOVE 3,[ASCIZ /EXE/] ;[CLH] ASSUME EXE FILE
02400 SKIPN $OSTYP ;[CLH] EXCEPT IF TENEX
02500 MOVE 3,[ASCIZ /SAV/] ;[CLH] THEN SAV
02600 MOVEI 1,GTBLK ;[CLH] LONG FORM BLOCK
02700 MOVE 2,(SP) ; STRING POINTER
02800 JSYS GTJFN ; TRY FOR JFN
02900 JRST RUNERR ; ERROR
03000 MOVEM 1,JFN ; SAVE JFN
03100
03200 SKIPN -1(P) ; USER WANTS FORK?
03300 JRST SWP ; NO, REPLACE CURRENT PRG
03400
03500 MOVSI 1,100000 ; XMIT CAPABILITIES
03600 JSYS CFORK
03700 JRST RUNERR ; CANNOT CREATE FORK
03800 MOVEM 1,FORK ; SAVE HANDLE
03900 SETOB 2,3 ; INDICATE ALL PRIVILEDGES
04000 JSYS EPCAP
04100 HRLZ 1,1 ; FORK HANDLE
04200 HRR 1,JFN ; THE JFN
04300 JSYS GET ; JSYS GET THE FILE
04400 MOVEI 1,400000 ; CURRENT FORK
04500 JSYS GPJFN ;PRIMARY JFNS IN 2
04600 MOVE 1,FORK ; SET PRIMARY IO
04700 JSYS SPJFN ;FOR NEW FORK
04800 MOVE 1,FORK ; FORK
04900 MOVE 2,-2(P) ; USER VALUE FOR ENTRY VECTOR
05000 JSYS SFRKV ;START THE FORK
05100 MOVE 1,FORK ;
05200 JSYS WFORK
05300 SKIPE 1,FORK ; SET TO KILL
05400 JSYS KFORK ;KILL THE FORK
05500 HRRZ 1,JFN ;
05600 JSYS RLJFN ; RELEASE
05700 JFCL ; IGNORE
05800 JRST RUNRET ; AND RETURN SAFELY
05900
06000 ;[CLH] allow for default extension
06100 GTBLK: XWD 100000,0 ;EXISTING FILE
06200 XWD 377777,377777 ;FROM STRING ONLY
06300 0 ;NO DEFAULT DEV
06400 0 ;NO DEFAULT DIR
06500 0 ;NO DEF NAME
06600 XWD -1,3 ;DEF EXT IN AC 3
06700 0 ;NO DEF PROT
06800 0 ;NO DEF ACCT
06900 ;[CLH]^^
07000
07100 SWP:
07200 MOVEI 1,400000 ;[CLH] TURN OFF INTERRUPTS, SINCE HANLDER
07300 DIR ;[CLH] IS GOING AWAY
07400 IMSSS,< ;DESTROY EMULATOR INFO AT IMSSS
07500 SETO 1,
07600 MOVE 2,[XWD 400000,711] ;PAGE 711
07700 JSYS PMAP ;DESTROY
07800 >;IMSSS
07900 PUSH P,JFN ;SAVE THE JFN
08000 HRLI A1 ; BLT INTO ACS
08100 HRRI 1 ;
08200 BLT 15 ; THE INSTRUCTIONS -- NOTE THAT RF IS NOW CLOBBERED
08300 SKIPN $OSTYP ;[clh] if Tops20
08400 JRST SWP1 ;[clh] not, ac's are right
08500 MOVE 2,T2 ;[clh] special code for Tops-20
08600 MOVE 3,T3 ;[clh] [Rsmith objects to using DMOVE, in
08700 MOVE 5,T5 ;[clh] case of KA Tops-20?????]
08800 SWP1: POP P,0 ; RESTORE JFN TO AC0
08900 HRLI 0,400000 ; XWD FORK, JFN
09000 MOVE 16,-2(P) ; THE INCREMENT -- NOTE THAT SP IS NOW CLOBBERED
09100 MOVE 17,[254000400010] ; FOR COMPARISON -- NOTE THAT THE P STACK IS GONE
09200 JRST 4 ; AND GO
09300
09400 ;[clh] these are AC's 2 and 3 for Tops-20
09500 T2: 400000000000 ;[clh] this fork, start at 0
09600 T3: 400000001000 ;[clh] repeat count, all of core
09700 T5: CAI ;[clh] no need to loop
09800 ;here are the AC's for Tenex
09900 A1: -1 ; FOR PMAP
10000 A2: 400000000677 ; THIS FORK, START AT 677 (LEAVING EMULATOR)
10100 A3: 0 ;
10200 A4: JSYS PMAP
10300 A5: SOJL 2,4 ; LOOP THROUGH PAGES
10400 A6: MOVE 1,0 ; XWD 400000,JFN
10500 A7: JSYS GET ;
10600 A10: MOVEI 1,400000 ; THIS FORK
10700 A11: JSYS GEVEC ; JSYS GET ENTRY VECTOR
10800 A12: CAMN 2,17 ; DEC STYLE??
10900 A13: HRRZ 2,120 ; YES
11000 A14: ADD 2,16 ; ADD THE INCREMREMENT
11100 A15: JRST (2) ; AND START THE JOB
11200
11300 RUNERR: TDZA 1,[-1] ;ZERO 1 AND SKIP
11400 RUNRET: SETO 1, ;INDICATE SUCCESS
11500 SUB SP,X22
11600 SUB P,X33
11700 JRST @3(P)
11800
11900
12000 BEND;RUNPRG
12100 ENDCOM(RUNPRG)
00100 NOCRYPT<
00200 COMPIL(OPF,<OPENFILE,SETINPUT,SETPL,INDEXFILE,SETCHAN>,<.SKIP.>,<OPENFILE -- OPEN A FILE>)
00300 >; NOCRYPT
00400 CRYPT<
00500 COMPIL(OPF,<OPENFILE,SETINPUT,SETPL,SETCRYPT,INDEXFILE,SETCHAN>,<.SKIP.>,<OPENFILE -- OPEN A FILE>)
00600 >; CRYPT
00700
00800 DSCR INTEGER SIMPLE PROCEDURE OPENFILE(STRING NAME,OPTIONS)
00900
01000 Name is the name of the file to be opened. If it is null, then
01100 OPENFILE goes to the user's console for the filname (with recognition).
01200 The value of the call is the jfn returned to the user.
01300 OPTIONS is a string of options available to the user. Legal
01400 characters are:
01500
01600 One of these:
01700 R read
01800 W write
01900 A append
02000 U update - like RW, but uses existing version
02100 Version numbering
02200 O old file
02300 N new file
02400 T temporary file
02500 * index with INDEXFILE routine
02600
02700 Independent:
02800 C require confirmation
02900 D ignore deleted bit
03000 H "thawed" access
03100 Error handling
03200 E return errors to user in the external
03300 integer !skip!. TENEX error codes are used.
03400 (JFN will be released in this case.)
03500 OPENFILE does a GTJFN followed by a OPENF. If GTJFN fails, a new
03600 attempt is made, from the user's console.
03700
03800
03900 BEGIN OPENFILE
04000 JFN_3 ;WHERE TO PUT THINGS
04100 FLAGS_4
04200 GTFLAGS_5
04300 OPFLAGS_6
04400
04500 DEFINE EQ $ (X,Y) <
04600 CAIE A,"$X$"
04700 JRST .+3
04800 TESTO FLAGS,Y
04900 JRST OPCONT
05000 >
05100
05200 DEFINE JTRUE $ (X) <
05300 TESTN FLAGS,X
05400 >
05500 DEFINE JFALSE (X) <
05600 TESTE FLAGS,X
05700 >
05800
05900 DEFINE SGT (X) <
06000 TESTO GTFLAGS,X
06100 >
06200 DEFINE SOF (X) <
06300 TESTO OPFLAGS,X
06400 >
06500 DEFINE TGT (X) <
06600 TESTE FLAGS,X
06700 TESTO GTFLAGS,X
06800 >
06900 DEFINE TOP (X) <
07000 TESTE FLAGS,X
07100 TESTO OPFLAGS,X
07200 >
07300
07400 HERE(OPENFILE)
07500 SETZB FLAGS,.SKIP.
07600 SETZB GTFLAGS,OPFLAGS
07700 HRRZ B,-1(SP) ;COUNT OF OPTIONS WORD
07800
07900 WHIOPT: JUMPE B,OPTDUN
08000 ILDB A,(SP) ;GET AN OPTION
08100 CAIGE A,141
08200 JRST .+3
08300 CAIG A,172
08400 SUBI A,40 ;CONVERT TO UPPER CASE
08500 ;ANY NON-ALPHABETIC CHARS GO HERE
08600
08700 EQ *,STARBIT
08800 ;NOW ALLOW ONLY ALPHABETIC CHARS
08900 CAIL A,101 ;MUST BE
09000 CAILE A,132
09100 JRST OPTERR
09200 SKIPN BITTBL-"A"(A) ;SOMETHING THERE?
09300 JRST OPTERR ;NOPE, ERROR
09400 TDO FLAGS,BITTBL-"A"(A) ;RIGHT SPOT IN TABLE
09500 SOJGE B,WHIOPT
09600 JRST OPTDUN
09700 ;HERE ON ERROR
09800 OPTERR: ERR <OPENFILE: ILLEGAL OPTION >,1
09900 TESTO FLAGS,ERSNBIT
10000
10100 OPCONT:
10200 SOJGE B,WHIOPT
10300
10400 ;NOW SET UP GTFLAGS ACCORDING TO THE SCANNED INFORMATION
10500 OPTDUN:
10600 TGT OLDBIT ;INSIST ON OLD?
10700 TGT NEWBIT ;INSIST ON NEW?
10800 JTRUE OLDBIT
10900 JFALSE NEWBIT ;IF NEITHER
11000 JRST OPTDU1 ;WELL, ONE
11100 JTRUE WRBIT ;IF WRITING
11200 JRST OPTDU1
11300 JFALSE RDBIT ;AND NOT READING
11400 JTRUE APPBIT!UPDBIT ;[clh] OR READING AND NOT APPENDING OR UPDATING
11500 SGT OUTBIT ;THEN SET OUTPUT BIT
11600 OPTDU1:
11700 JFALSE RDBIT ;IF READING
11800 JFALSE WRBIT ;AND NOT WRITING
11900 JRST OPTDU2
12000 JTRUE APPBIT ;AND NOT APPENDING
12100 SGT OLDBIT ;THEN INSIST ON OLD
12200 OPTDU2:
12300 ;NOW TEST FOR INDEPENDANT THINGS
12400 TOP RDBIT
12500 TOP WRBIT
12600 TOP APPBIT
12700 TGT TEMBIT
12800 TGT STARBIT
12900 TGT DELBIT
13000 TOP THAWBIT
13100 JFALSE CONFBIT
13200 JRST [SGT CONFB1
13300 SGT CONFB2
13400 JRST .+1]
13500 TLO GTFLAGS,1 ;SHORT CALL OF GTJFN
13600 GTAGAIN:
13700 HRRZ A,-3(SP) ;LENGTH OF NAME
13800 JUMPE A,[TRYAGN:
13900 TLO GTFLAGS,2
14000 MOVE 2,[XWD 100,101]
14100 JRST GT]
14200 AND GTFLAGS,[717777777777]
14300
14400 PUSH SP,-3(SP)
14500 PUSH SP,-3(SP)
14600 PUSH P,[0]
14700 PUSHJ P,CATCHR ;CONCATENATE A NULL CHAR
14800 MOVE 2,(SP) ;BYTE-POINTER
14900 SUB SP,X22 ;ADJUST STACK
15000 GT: MOVE 1,GTFLAGS
15100 JSYS GTJFN
15200 JRST GTERR
15300 MOVEM 1,JFN ;REMEMBER JFN
15400 PUSHJ P,SETCHN ;SET A CHANNEL, ALLOCATE, GET CDB, SET DVTYP, RETURN CHANNEL
15500 MOVEM 1,CHNL ;REMEMBER CHANNEL
15600 MOVEM GTFLAGS,GFL(CDB)
15700
15800
15900 COMMENT Do the open.
16000
16100 MOVE 1,DVTYP(CDB) ;CHECK THE DEVICE TYPE
16200 CAIE 1,7 ;IS IT THE LPT?
16300 CAIN 1,12 ;IS IT A TTY?
16400 JRST B7 ;YES, USE 7 BIT
16500 B36: HRRZ 1,JFN ;JFN
16600 HRRZ 2,OPFLAGS
16700 HRLI 2,440000 ;36-BIT, MODE 0
16800 JSYS OPENF
16900 JRST B36DMP ;TRY 36-BIT, DUMP MODE
17000 JRST OPNOK
17100 B36DMP: HRRZ 1,JFN
17200 HRRZ 2,OPFLAGS
17300 HRLI 2,447400 ;36 BITS, DUMP MODE
17400 JSYS OPENF
17500 JRST B7
17600 JRST OPNOK
17700 B7: HRRZ 1,JFN
17800 HRRZ 2,OPFLAGS
17900 HRLI 2,70000 ;7 BIT
18000 JSYS OPENF
18100 JRST OPERR ;NOPE
18200 OPNOK: MOVEM 2,OFL(CDB) ;SAVE
18300 MOVE 1,CHNL ;RETURN CHANNEL NO
18400 OPFRET: SUB SP,X44 ;ADJUST
18500 POPJ P, ;AND RETURN
18600
18700
18800
18900
19000 GTERR:
19100 ;HERE WITH ERROR ON GTJFN
19200 JTRUE ERTNBIT ;USER WANT'S ERRORS?
19300 JRST GTER1 ;NO
19400 ERRRET: MOVEM 1,.SKIP. ;STORE FOR USER
19500 SETO 1, ;SOMETHING SUSPICIOUS
19600 JRST OPFRET ;AND RETURN
19700
19800 GTER1: PUSHJ P,SERSTR ;SHOW ERSTR
19900 HRROI 1,[ASCIZ/
20000 Cannot GTJFN file /]
20100 JSYS PSOUT
20200 PUSH SP,-3(SP)
20300 PUSH SP,-3(SP)
20400 PUSHJ P,OUTSTR
20500 HRROI 1,[ASCIZ/, try again */]
20600 JSYS PSOUT
20700 JRST TRYAGN
20800
20900
21000
21100 OPERR: JTRUE ERTNBIT
21200 JRST OPER1
21300 PUSH P,1 ;SAVE ERROR BITS
21400 PUSH P,CHNL
21500 PUSHJ P,CFILE
21600 POP P,1 ;RESTORE ERROR BITS
21700 JRST ERRRET
21800
21900 OPER1: PUSHJ P,SERSTR ;SHOW ERSTR
22000 HRROI 1,[ASCIZ/
22100 Cannot OPENF file /]
22200 JSYS PSOUT
22300 PUSH SP,-3(SP)
22400 PUSH SP,-3(SP)
22500 PUSHJ P,OUTSTR
22600 HRROI 1,[ASCIZ/, try again */]
22700 JSYS PSOUT
22800 PUSH P,CHNL ;CLOSE AND RELEASE FILE AND CDB BLOCK
22900 PUSHJ P,CFILE
23000 JRST TRYAGN
23100
23200 ;HERE WITH THE TENEX ERROR CODE IN 1 -- 1 MAY BE CLOBBERED
23300 SERSTR:
23400 PUSH P,2 ;SAVE ACS
23500 PUSH P,3
23600 HRRZ 2,1
23700 HRLI 2,400000 ;THIS FORK
23800 HRROI 1,[ASCIZ/
23900 /]
24000 JSYS PSOUT
24100 MOVEI 1,101 ;PRIMARY OUTPUT
24200 SETZ 3, ;FLAGS
24300 JSYS ERSTR
24400 JFCL
24500 JFCL
24600 POP P,3
24700 POP P,2
24800 POPJ P,
24900
25000
25100 BITTBL: APPBIT ;A
25200 BINBIT ;B
25300 CONFBIT ;C
25400 DELBIT ;D
25500 ERTNBIT ;E
25600 0 ;F
25700 0 ;G
25800 THAWBIT ;H
25900 0 ;I
26000 0 ;J
26100 0 ;K
26200 0 ;L
26300 0 ;M
26400 NEWBIT ;N
26500 OLDBIT ;O
26600 0 ;P
26700 0 ;Q
26800 RDBIT ;R
26900 0 ;S
27000 TEMBIT ;T
27100 RDBIT!WRBIT!UPDBIT ;[clh] U
27200 0 ;V
27300 WRBIT ;W
27400 0 ;X
27500 0 ;Y
27600 0 ;Z
27700
27800
27900 BEND OPENFILE
28000
00100 DSCR PROCEDURE SETINPUT(INTEGER CHAN; REFERENCE INTEGER COUNT,BR,EOF)
00200 Sets up the variables associated with input (as in the DEC
00300 open statement.)
00400
00500
00600 HERE(SETINPUT)
00700 PUSHJ P,SAVE
00800 VALCHN 1,-4(P),SETERR
00900 POP P,TEMP
01000 POP P,ENDFL(CDB)
01100 SKIPE ENDFL(CDB)
01200 SETZM @ENDFL(CDB) ;ASSUME NOT EOF
01300 POP P,BRCHAR(CDB)
01400 SKIPE BRCHAR(CDB)
01500 SETZM @BRCHAR(CDB) ;ASSUME NO BRCHAR
01600 POP P,ICOUNT(CDB)
01700 SETZ LPSA, ;NO PARAMETERS
01800 SUB P,X11
01900 JRST RESTR
02000 SETERR: ERR <Illegal JFN>,1
02100 MOVE LPSA,[XWD 5,5]
02200 JRST RESTR
02300
00100 DSCR
00200 SETPL(CHAN,@LINNUM,@PAGNUM,@SOSNUM)
00300
00400 Names the variables to be used by the INPUT
00500 function for counting the line-feeds (12), formfeeds (14)
00600 seen by INPUT, as well as keeping the current SOS line
00700 number, if any. Useful when scanning a file, and
00800 you want to know what page,line you are on.
00900 Initializes all three variables to 0.
01000
01100
01200 HERE(SETPL)
01300 PUSHJ P,SAVE
01400 VALCHN 1,-4(P),SETPER
01500 POP P,TEMP ;RET ADR
01600 POP P,SOSNUM(CDB)
01700 SETZM @SOSNUM(CDB)
01800 POP P,PAGNUM(CDB)
01900 SETZM @PAGNUM(CDB)
02000 POP P,LINNUM(CDB)
02100 SETZM @LINNUM(CDB)
02200 SUB P,X11 ;REMOVE CHANNEL NO.
02300 SETRET: SETZ LPSA,
02400 JRST RESTR
02500 SETPER: ERR <Illegal JFN>,1
02600 MOVE LPSA,[XWD 5,5]
02700 JRST RESTR
02800
00100 CRYPT< ; PROCEDURE SETCRYPT(CHAN,ENCRYPT,DECRYPT)
00200 DSCR PROCEDURE SETCRYPT(CHAN,ENCRYPT,DECRYPT)
00300 where
00400 CHAN is the I/O channel for which cryption is desired
00500 SIMPLE PROCEDURE ENCRYPT(CHAN,LOC,BUFSTART,BUFEND)
00600 SIMPLE PROCEDURE DECRYPT(CHAN,LOC,BUFSTART,BUFEND)
00700 CHAN - I/O channel involved
00800 LOC - word or byte number of CHAN corresponding
00900 to BUFSTART (see LH(BUFSTART) for which)
01000 BUFSTART and BUFEND - If LH is zero then these
01100 point to the first and last word
01200 of the buffer. Otherwise they
01300 point to the first and last byte.
01400
01500 Sets things up so PROCEDURE DECRYPT is called whenever a new buffer
01600 of data is input from CHAN, and PROCEDURE ENCRYPT is called
01700 whenever a new buffer of data is about to be output to CHAN.
01800 Call SETCRYPT after doing OPENFILE or (GTJFN/OPENF).
01900 Thus the user can manipulate incoming data before it is seen
02000 by the regular SAIL input routines, and outgoing data before it is
02100 actually sent to CHAN. A typical use would be to decrypt incoming
02200 data and encrypt outgoing data.
02300
02400 Restrictions:
02500 1. Encryption of TTY IO is not allowed (continuable error).
02600 2. If a decryption routine is specified, an encryption routine must
02700 also be specified, though it may do nothing at the user level.
02800 3. Currently, only PMAP'ed files are supported (continuable error).
02900
03000 To implement this scheme, it is necessary to test for cryption
03100 being done whenever a new buffer or page is read in or written out.
03200 The logic for conventional I/O is simple, but TOPS20 PMAP'ed files
03300 present a problem when copy-on-write is NOT in effect:
03400 Decrypting the file in place will a) defeat encryption and b)
03500 cause problems if the user ^C's because some pages of the file will
03600 be encrypted and some not. Thus pages of the file that are being
03700 paged in must be dissociated from the file and decrypted. Then
03800 before they are unmapped, they must be encrypted and remapped into
03900 the file. The logic is as follows:
04000
04100 After PMAPing in: if copy-on-write then DECRYPT
04200 else
04300 dissociate page from file
04400 DECRYPT
04500
04600 When unmapping: if copy-on-write then ENCRYPT
04700 else
04800 ENCRYPT
04900 map to file
05000
05100 [RNG] [06]
05200
05300
05400 HEREFK(SETCRYPT,SETCR$)
05500
05600 PUSHJ P,SAVE
05700 VALCHN 1,-3(P),CRYERR
05800 SKIPE DVTYP(CDB) ; Is it DSK:?
06400 JRST CRNOPM ; No, not implemented
06600 POP P,TEMP ; RETURN ADDRESS
06700 POP P,DCRYPT(CDB)
06800 POP P,NCRYPT(CDB)
06900 SUB P,X11 ; REMOVE CHAN
07000 SETZ LPSA, ; NO NEED TO ADJUST STACK
07100 JRST RESTR
07200
07300 CRYERR: ERR <SETCRYPT: Illegal Channel Number>,1
07400 JRST CRYER1
07700 CRNOPM: ERR <SETCRYPT: Not implemented for non-PMAP'ed files>,1
07800 CRYER1: MOVE LPSA,[XWD 5,5]
07900 JRST RESTR
08000
08100 ; Routine to save the AC's before calling the user's crypt routine.
08200 ; He originally called an I/O runtime that wants to call a SAIL
08300 ; routine (ENCRYPT or DECRYPT) that may call another runtime routine,
08400 ; so we must save both the current runtime AC's 0-15 and the SAVE/RESTR
08500 ; RACS 0-13. Called by PUSHJ P,CRYSAV.
08600
08700 CRYSAV: POP P,TEMP ; SAVE RETURN ADDR
08800 ADD P,[XWD 14+16,14+16] ; STUFF WE WILL SAVE ON STACK
08900 PUSH P,UUO1(USER) ; THIS TOO, MAY CAUSE PDLOV
09000 ; NOW SAVE SAVED RACS
09100 PUSH P,TEMP ; PUT RETURN ADDR BACK
09200 HRRI TEMP,-33(P) ; DESTINATION
09300 HRLI TEMP,RACS(USER) ; SOURCE (0-RF=12)
09400 BLT TEMP,-21(P) ; END OF DESTINATION
09500 HRRZI TEMP,-20(P) ; DESTINATION
09600 BLT TEMP,-2(P) ; SOURCE (0-15)
09700 POPJ P,
09800
09900 ; Routine to restore saved AC's. Called by PUSHJ P,CRYRST
10000
10100 CRYRST: MOVE USER,GOGTAB
10200 MOVE TEMP,-1(P) ; GET OLD UUO1(USER)
10300 MOVEM TEMP,UUO1(USER)
10400 MOVSI TEMP,-20(P) ; SOURCE IS OLD 0-15
10500 BLT TEMP,15 ; RESTORE OUR AC'S
10600 HRLI TEMP,-33(P) ; SOURCE IS OLD RACS 0-12
10700 HRRI TEMP,RACS(USER) ; PUT THEM BACK
10800 BLT TEMP,RACS+12(USER)
10900 MOVE TEMP,0(P) ; GET RETURN ADDR
11000 SUB P,[14+16+2,14+16+2] ; ADJUST STACK, INCL RET
11100 JRST (TEMP)
11200
11300 ;; Routine to encrypt an outgoing page if the file is being
11400 ;; written or appended to and the current page is valid.
11500 ;; 1 HAS JFN, CDB, CHNL are loaded.
11600
11700 CALNCR: MOVE TEMP,OFL(CDB) ; GET STATUS WORD
11800 TESTN TEMP,WRBIT ; IF NOT (WRITING OR
11900 TESTE TEMP,APPBIT ; APPENDING)
12000 SKIPA
12100 POPJ P, ; THEN RETURN
12200 HRROI TEMP,-1
12300 CAMN TEMP,IOPAGE(CDB) ; IF PAGE!OF!FILE=-1
12400 POPJ P, ; THEN RETURN
12500 PUSH P,1 ; Prepare to check if page
12600 PUSH P,2 ; has been changed
13200 MOVE 1,FKPAGE(CDB)
13300 RPACS ; Find out status of page
13400 TESTN 2,1B10 ; IF page is not private
13500 JRST SKIPIT ; then don't bother decrypting
13510 POP P,2
13520 POP P,1
13550
13600 ; Here if we really need to encrypt the page
13700 ; Save all AC's and load the arguments to the user's routine
13800 PUSHJ P,CRYSAV ; SAVE THE AC'S AND RACS
13900 PUSH P,CHNL ; CHAN
14000 MOVE TEMP,IOPAGE(CDB) ; GET PAGE OF FILE
14100 LSH TEMP,11 ; CONVERT TO WORD NUM IN FILE
14200 PUSH P,TEMP
14300 HRRZ TEMP,FKPAGE(CDB) ; GET PAGE IN CORE
14400 LSH TEMP,11 ; CONVERT TO ADDRESS OF BUFFER
14500 PUSH P,TEMP
14600 ADDI TEMP,777 ; COMPUTE LAST WORD OF BUFFER
14700 PUSH P,TEMP
14800 PUSHJ P,@NCRYPT(CDB) ; CALL USER'S ROUTINE
14900
15000 PUSHJ P,CRYRST ; RESTORE AC'S AND RACS
15100 PUSH P,1 ; MAP PAGE BACK TO FILE
15200 PUSH P,2
15300 PUSH P,3
15400 HRL 2,1 ; THE JFN is in 1
15500 HRR 2,IOPAGE(CDB)
15600 MOVE 1,FKPAGE(CDB)
15700 SETZ 3,
15800 TESTO 3,1B9 ; SET WRITE BIT
15900 PMAP ; WRITE FILE
16000 POP P,3
16100 SKIPIT: POP P,2
16200 POP P,1
16300 POPJ P,
16400
16500 ;; Routine to decrypt an incoming page, guaranteed to be
16600 ;; copy-on-write.
16700 ;; CHNL, CDB loaded
16800
16900 CALDCR: PUSHJ P,CRYSAV ; SAVE THE AC'S AND RACS
17000 PUSH P,CHNL ; CHAN
17100 MOVE TEMP,IOPAGE(CDB) ; GET PAGE OF FILE
17200 LSH TEMP,11 ; CONVERT TO WORD NUM IN FILE
17300 PUSH P,TEMP
17400 HRRZ TEMP,FKPAGE(CDB) ; GET PAGE IN CORE
17500 LSH TEMP,11 ; CONVERT TO ADDRESS OF BUFFER
17600 PUSH P,TEMP
17700 ADDI TEMP,777 ; COMPUTE LAST WORD OF BUFFER
17800 PUSH P,TEMP
17900 PUSHJ P,@DCRYPT(CDB) ; CALL USER'S ROUTINE
18000 PUSHJ P,CRYRST ; RESTORE AC'S AND RACS
18100 POPJ P, ; Note we can't use PJRST here!
18200
18300 >; CRYPT
00100 DSCR
00200 BOOLEAN PROCEDURE INDEXFILE(INTEGER JFN)
00300
00400 RETURNS TRUE AS LONG AS WE CAN GNJFN ANOTHER FILE
00500
00600
00700 HERE(INDEXFILE)
00800 PUSH P,-1(P)
00900 PUSHJ P,CLOSF
01000 PUSH P,-1(P)
01100 PUSHJ P,GNJFN
01200 JUMPE 1,INDRET ;RETURN FALSE IF NO OTHER FILES
01300 PUSH P,2
01400 PUSH P,CDB
01500 PUSH P,CHNL
01600 ;CHANNEL ALREADY VALID
01700 MOVE CHNL,-4(P) ;CHANNEL NUMBER
01800 MOVE CDB,CDBTBL(CHNL) ;CDB LOC
01900 HRRZ 1,JFNTBL(CHNL) ;JFN
02000 MOVE 2,OFL(CDB) ;GET OPENFLAGS
02100 JSYS OPENF ;TRY OPENING
02200 JRST NOIND
02300 SKIPE ENDFL(CDB) ;ZERO SETINPUT (or OPEN) VARIABLES IF HERE
02400 SETZM @ENDFL(CDB)
02500 SKIPE BRCHAR(CDB)
02600 SETZM @BRCHAR(CDB)
02700 SKIPE LINNUM(CDB) ;ZERO SETPL VARS
02800 SETZM @LINNUM(CDB)
02900 SKIPE PAGNUM(CDB)
03000 SETZM @PAGNUM(CDB)
03100 SKIPE SOSNUM(CDB)
03200 SETZM @SOSNUM(CDB)
03300 SETO 1,
03400 INDPOP: POP P,CHNL
03500 POP P,CDB
03600 POP P,2
03700 INDRET: SUB P,X22
03800 JRST @2(P)
03900
04000 NOIND: ERR <INDEXFILE: CANNOT OPENF>,1
04100 SETZ 1,
04200 JRST INDPOP
00100 DSCR SETCHAN(JFN,GTFLAGS,OPFLAGS)
00200
00300 JFN is a real TENEX jfn. It is inserted in the SAIL
00400 runtime system, and the internal book-keeping is set to
00500 believe that the GTJFN was done with GTFLAGS and the OPENF
00600 with OPFLAGS. JFN may have come from some random source.
00700
00800 HERE(SETCHAN)
00900 PUSHJ P,SAVE
01000 MOVE LPSA,X44
01100 MOVE A,-3(P) ;JFN
01200 PUSHJ P,SETCHN
01300 MOVEM A,RACS+A(USER) ;CHANNEL
01400 HRROI A,-1(P) ;PREPARE FOR POPPING
01500 POP A,OFL(CDB) ;MOVE FROM THE STACK
01600 POP A,GFL(CDB)
01700 JRST RESTR
01800
01900 ENDCOM(OPF)
00100 COMPIL(GTJFN,<GTJFN,GTJFNL>,<.SKIP.,SETCHN,CATCHR,X11,X22,X44>,<GTJFN -- GET A JFN>)
00200 DSCR INTEGER SIMPLE PROCEDURE GTJFN(STRING S; INTEGER FLAGS)
00300 Does a GTJFN. If S is non-null, it is the filename, otherwise
00400 the routine goes to the user's console for a file. FLAGS are used for
00500 accumulator 1, and any error code is returned in .SKIP. The value
00600 of the call is the JFN, if obtained.
00700 Defaults for FLAGS: 0 means ordinary input, 1 means ordinary
00800 output. Ordinarily the user will use the OPENFI routine.
00900
01000
01100 HERE(GTJFN)
01200 SKIPN 1,-1(P)
01300 MOVSI 1,100001
01400 CAIN 1,1
01500 MOVSI 1,600001
01600 TLO 1,1 ;MARK FOR SHORT CALL
01700 HRRZ 2,-1(SP)
01800 JUMPE 2,[MOVE 2,[100000101]
01900 TLO 1,2 ;INDICATE XWD JFN,JFN IN 2
02000 JRST GOTDEST]
02100 TLZ 1,2 ;INDICATE BYTE-POINTER IN 2
02200 PUSH P,[0]
02300 PUSHJ P,CATCHR ;PUT ON A NULL
02400 MOVE 2,(SP)
02500 GOTDEST: SETZM .SKIP. ;ASSUME NO ERROR
02600 PUSH P,1 ;SAVE FLAGS
02700 JSYS GTJFN
02800 JRST GTBAD ; SOMETHING IS WRONG
02900 PUSHJ P,SETCHN ;SETUP A CHANNEL, AND ALLOCATE, GET STATUS, SET CDB
03000 POP P,GFL(CDB) ;SAVE FLAGS
03100 GTRET: SUB SP,X22
03200 SUB P,X22
03300 JRST @2(P)
03400
03500 GTBAD:
03600
03700 MOVEM 1,.SKIP. ; REMEMBER
03800 POP P,1 ;ADJUST STACK
03900 SETO 1, ; SOMETHING SUSPICIOUS TO RETURN TO USER
04000 JRST GTRET
04100
00100 DSCR INTEGER PROCEDURE GTJFNL(STRING ORIG; INTEGER FLAGS, XWDJFN!JFN;
00200 STRING DEV,DIR,NAM,EXT,PROT,ACCOUNT; INTEGER DESIRED!JFN)
00300
00400 Does the long form of GTJFN.
00500
00600 HERE(GTJFNL)
00700 BEGIN GTJFNL
00800
00900 DEFINE STRPUT(X)<
01000 PUSHJ P,.STPUT
01100 MOVEM A,X
01200 >
01300 DEFINE FLG <-14(P)>
01400 DEFINE IOJFN <-13(P)>
01500 DEFINE DESJFN <-12(P)>
01600 ADD P,[XWD 11,11] ;ROOM FOR LONG-FORM TABLE
01700 TLNN P,400000 ;OVERFLOW?
01800 ERR <GTJFNL: P-stack overflow>
01900 MOVE A,DESJFN
02000 MOVEM A,0(P) ;THE DESIRED JFN
02100 STRPUT -1(P) ;ACCOUNT
02200 STRPUT -2(P) ;PROTECTION
02300 STRPUT -3(P) ;EXTENSION
02400 STRPUT -4(P) ;NAME
02500 STRPUT -5(P) ;DIRECTORY
02600 STRPUT -6(P) ;DEVICE
02700 MOVE A,IOJFN ;XWD INPUT JFN, OUTPUT JFN
02800 MOVEM A,-7(P)
02900 MOVE A,FLG
03000 MOVEM A,-10(P)
03100 STRPUT B ;MAIN STRING POINTER
03200 MOVEI A,-10(P) ;ADDRESS OF BLOCK (ON STACK)
03300 SETZM .SKIP. ;ASSUME NO ERROR
03400 JSYS GTJFN ;LONG FORM
03500 JRST GTLBAD ;NOPE
03600 PUSHJ P,SETCHN ;SET UP CHANNEL TABLE, ALLOCATE, GET STATUS, SET CDB
03700 MOVE B,-10(P) ;GTJFN FLAGS
03800 MOVEM B,GFL(CDB) ;SAVE
03900 GTLRET: SUB P,[XWD 11+4,11+4] ;ADJUST STACK FOR LONG-FORM TABLE, AND ARGUMENTS
04000 JRST @4(P) ;AND RETURN
04100
04200 GTLBAD: MOVEM A,.SKIP. ;RETURN ERROR CODE TO USER
04300 SETO A, ;SOMETHING SUSPICIOUS
04400 JRST GTLRET ;AND RETURN
04500
04600 .STPUT: HRRZ A,-1(SP) ;GET THE COUNT
04700 JUMPE A,[SUB SP,X22 ;ADJUST AND RETURN
04800 POPJ P,]
04900 PUSH P,[0]
05000 PUSHJ P,CATCHR
05100 POP SP,A
05200 SUB SP,X11
05300 POPJ P,
05400
05500
05600 BEND GTJFNL
05700
05800
05900
06000 ENDCOM(GTJFN)
00100 COMPIL(FILINF,<GNJFN,DELF,DELF$,UNDELETE,DELNF,SIZEF,JFNS,JFNSL,OPENF,CFILE,CLOSF,CLOSF$,RLJFN,GTSTS,STSTS,RNAMF,SACTF>
00200 ,<JFNTBL,CDBTBL,X11,X22,X33,CORREL,.SKIP.,ZSETST,ZADJST,FINIO,CATCHR,CVJFN>
00300 ,<FILINF -- UTILITY FILE ROUTINES>)
00400
00500
00600 DSCR INTEGER SIMPLE PROCEDURE GNJFN(INTEGER JFN)
00700 Does the GNJFN jsys.
00800
00900 HERE(GNJFN)
01000 PUSHJ P,SAVE
01100 MOVE LPSA,X22
01200 VALCHN 1,<-1(P)>,GNERR
01300 MOVE 1,JFNTBL(CHNL) ;GET THE WHOLE JFN
01400 JSYS GNJFN
01500 JRST GNRLZ ;FAILURE TO INDEX, RELEASE JFN
01600 MOVEM 1,.SKIP. ;SAVE BITS INDICATING CHANGE
01700 SETOM RACS+A(USER) ;INDICATE SUCCESS
01800 GNRET: JRST RESTR
01900
02000 GNERR: ERR <Illegal JFN>,1
02100 SETZM RACS+A(USER)
02200 JRST RESTR
02300
02400 GNRLZ: SETZM .SKIP. ;NOTHING THERE
02500 SETZM RACS+A(USER) ;FAILURE TO INDEX
02600 PUSH P,-1(P)
02700 PUSHJ P,CFILE ;SO RELEASE FILE
02800 JRST RESTR
02900
00100 DSCR PROCEDURE DELF(INTEGER CHAN,BITS[0])
00200 Deletes file open on CHAN. Errors to .SKIP.
00300
00400 HERE(DELF)
00500 ;[clh] this is the old form of DELF, without the second arg
00600 PUSH P,0(P) ;[CLH] RET, RET
00700 SETZM -1(P) ;[CLH] 0, RET
00800
00900 HEREFK(DELF$,DELF.)
01000 ;[clh] this is the new DELF
01100 PUSH P,1
01200 VALCH1 1,-3(P),DELF1
01300 HLL 1,-2(P) ;[clh] get user bits
01400 TLO 1,400000 ;DONT RELEASE THE JFN
01500 JSYS DELF
01600 JRST DELF2
01700 SETZM .SKIP. ;NO ERROR
01800 DELFRE: POP P,1
01900 SUB P,X33
02000 JRST @3(P)
02100 DELF1: SETO 1,
02200 DELF2: MOVEM 1,.SKIP.
02300 JRST DELFRE
02400
02500 DSCR INTEGER PROCEDURE DELNF(INTEGER CHAN,NUM)
02600
02700 HERE(DELNF)
02800 PUSHJ P,SAVE
02900 MOVE LPSA,X33
03000 VALCH1 1,-2(P),DLNERR
03100 MOVE 2,-1(P)
03200 SETZM .SKIP.
03300 JSYS DELNF
03400 JRST DLNERR
03500 MOVM 2,2 ;ABSOLUTE NUMBER OF
03600 MOVEM 2,RACS+A(USER) ;FILES DELETED
03700 JRST RESTR
03800 DLNERR: MOVEM 1,.SKIP.;
03900 SETZM RACS+A(USER) ;INDICATE NO FILES DELETED
04000 JRST RESTR
00100 DSCR PROCEDURE UNDELETE(INTEGER CHAN)
00200 Undeletes file open on CHAN. Errors to .SKIP.
00300
00400 HERE(UNDELETE)
00500 PUSHJ P,SAVE
00600 MOVE LPSA,X22
00700 VALCH1 1,-1(P),UNDEL1
00800 HRLI 1,1 ;XWD 1,JFN
00900 MOVSI 2,(1B3) ;DELETED BIT
01000 SETZ 3, ;TURN IT OFF
01100 JSYS CHFDB ;CHANGE THE FDB
01200 JRST RESTR
01300 UNDEL1: SETOM .SKIP.
01400 JRST RESTR
01500
01600
01700
01800
00100 DSCR INTEGER PROCEDURE SIZEF(INTEGER JFN)
00200 Gets the size in pages of the file open on JFN, with error code to
00300 .SKIP.
00400
00500 HERE(SIZEF)
00600 PUSHJ P,SAVE
00700 MOVE LPSA,X22
00800 VALCHN 1,<-1(P)>,SIZERR
00900 SETZM .SKIP.
01000 JSYS SIZEF
01100 JRST [MOVEM 1,.SKIP.
01200 SETZM RACS+A(USER)
01300 JRST SIZRET]
01400 MOVEM 3,RACS+A(USER) ;ANSWER IN AC 3
01500 SIZRET: JRST RESTR
01600
01700 SIZERR: ERR <Illegal JFN>
01800 SETOM .SKIP.
01900 JRST SIZRET
02000
02100
00100
00200 DSCR STRING SIMPLE PROCEDURE JFNS(INTEGER JFN,FLAGS)
00300 Returns the name of the file associated with JFN.
00400 FLAGS are for ac 3 as described in the jsys manual, with
00500 0 the reasonable default.
00600
00700
00800 HERE(JFNS)
00900 VALCHN 2,<-2(P)>,JFNSER ;GET JFN IN AC2
01000 PUSH P,[=400]
01100 PUSHJ P,ZSETST ;GET BP IN AC 1
01200 MOVE 3,-1(P)
01300 JSYS JFNS
01400 PUSH P,[=400]
01500 PUSH P,1
01600 PUSHJ P,ZADJST
01700 JFNSRE: SUB P,X33
01800 JRST @3(P)
01900 JFNSER: ERR <Illegal JFN>,1
02000 PUSH SP,[0] ;RETURN NULL STRING
02100 PUSH SP,[0]
02200 JRST JFNSRE
02300
02400
02500 DSCR JFNSL is added to correct a design error in JFNS, which did
02600 not allow full flexibility.
02700
02800
02900 HERE(JFNSL)
03000 BEGIN JFNSL
03100 VALCHN 2,<-3(P)>,JFNSER ;VALIDATE, GETTING JFN IN 2
03200 MOVE 1,-1(P) ;FLAGS FOR LH
03300 CAMN 1,[-1] ;-1??
03400 HLRZ 1,JFNTBL(CHNL) ;YES, GET THOSE USED BY GTJFN
03500 HRL 2,1 ;NOW PUT FLAGS INTO LH(2)
03600 PUSH P,[=400]
03700 PUSHJ P,ZSETST ;GET BP IN AC 1
03800 MOVE 3,-2(P) ;CONTROL FLAGS FOR FORMAT
03900 JSYS JFNS
04000 PUSH P,[=400]
04100 PUSH P,1
04200 PUSHJ P,ZADJST
04300 JFNSRE: SUB P,[XWD 4,4]
04400 JRST @4(P)
04500 JFNSER: ERR <Illegal JFN>,1
04600 PUSH SP,[0] ;RETURN NULL STRING
04700 PUSH SP,[0]
04800 JRST JFNSRE
04900
05000 BEND JFNSL
00100 DSCR SIMPLE PROCEDURE OPENF(INTEGER JFN,FLAGS)
00200 Does an OPENF.
00300
00400 PARAMETERS:
00500 JFN the JFN
00600 FLAGS for accumulator 2.
00700 .SKIP. the error code (if pertinent)
00800
00900 Some defaults:
01000 FLAGS ACTION
01100 -----------------------
01200 0 INPUT CHARACTERS
01300 1 OUTPUT CHARACTERS
01400 2 INPUT 36-BIT WORDS
01500 3 OUTPUT 36-BIT WORDS
01600 4 DUMP MODE INPUT (USE DUMPI FUNCTION)
01700 5 DUMP MODE OUTPUT (USE DUMPO FUNCTION)
01800 VALUES 6-10 ARE RESERVED FOR EXPANSION
01900
02000 Other values of FLAGS are interpreted literally.
02100 Ordinarily the user will use the OPENFI routine.
02200
02300
02400 HERE(OPENF)
02500 PUSHJ P,SAVE
02600 MOVE LPSA,X33
02700 VALCHN 1,-2(P),OPNERR
02800 SKIPL 2,-1(P) ;GET THE FLAGS
02900 CAILE 2,5 ;CHECK IN RANGE 0-5
03000 JRST GOTFLAGS
03100 MOVE 2,OPNTBL(2) ;GET CORRECT WORD
03200 GOTFLAGS:
03300 SETZM .SKIP.
03400 PUSH P,2 ;SAVE FLAGS
03500 JSYS OPENF
03600 JRST NOOPN
03700 POP P,OFL(CDB) ;AND SAVE FLAGS
03800 SETZM IOSTT(CDB) ;CLEAR STATUS
03900 OPNRET: JRST RESTR
04000
04100 OPNERR: ERR <Illegal JFN>,1
04200 SETOM .SKIP.
04300 JRST OPNRET
04400
04500 NOOPN: MOVEM 1,.SKIP.
04600 SUB P,X11 ;ADJUST STACK
04700 JRST OPNRET
04800
04900 OPNTBL: 070000200000 ;7-BIT READ
05000 070000100000 ;7-BIT WRITE
05100 440000200000 ;36-BIT READ
05200 440000100000 ;36-BIT WRITE
05300 447400200000 ;36-BIT DUMP READ
05400 447400100000 ;36-BIT DUMP WRITE
00100
00200 DSCR SIMPLE INTEGER PROCEDURE CFILE(INTEGER JFN)
00300 Closes the file (CLOSF) and releases (RLFJN)
00400 the jfn. This is the ordinary way the user will use
00500 to dispense with a file.
00600 Returns TRUE if JFN legal and released, FALSE o.w.
00700 Always returns.
00800
00900
01000 HERE(CFILE)
01100 PUSH P,2
01200 PUSH P,3
01300 PUSH P,CHNL
01400 PUSH P,CDB
01500 SKIPL CHNL,-5(P)
01600 CAIL CHNL,JFNSIZE
01700 JRST CFBAD
01800 MOVE CDB,CDBTBL(CHNL) ;GET CDB
01900 SKIPN 1,JFNTBL(CHNL) ;JFN ASSIGNED?
02000 JRST CFBA1 ;NO, JUST RELEASE CORE
02100 HRRZ 1,1 ;JFN ONLY
02200 PUSHJ P,FINIO ;WRITE OUT REMAINING STUFF, CHECK EOF, MAGTAPE
02300
02400 RLCOR: SKIPN B,CDBTBL(CHNL) ;[CLH] ANY CORE TO RELEASE?
02500 JRST RLCOR1 ;[CLH] NO
02600 SKIPLE B,OPNDUN(B) ;[CLH] YES, POINT TO DEVICE NAM BLOCK?
02700 PUSHJ P,CORREL ;[CLH] YES, DO IT FIRST
02800 SKIPE B,CDBTBL(CHNL) ; ANY CORE TO RELEASE?
02900 PUSHJ P,CORREL ; RELEASE THE BLOCK
03000 RLCOR1: TLZ 1,400000 ; BE SURE TO RELEASE
03100 JSYS CLOSF ; CLOSE (AND RELEASE)
03200 JFCL ; ERROR RETURN
03300 HRRZ 1,JFNTBL(CHNL) ; GET JFN AGAIN
03400 JSYS RLJFN ; RELEASE (FOR GOOD MEASURE IF FILE NOT OPEN)
03500 JFCL ; ERROR RETURN
03600 SETO 1, ; RETURN TRUE FOR GOOD RELEASE
03700 SETZM CDBTBL(CHNL)
03800 SETZM JFNTBL(CHNL)
03900 CFRET: POP P,CDB
04000 POP P,CHNL
04100 POP P,3
04200 POP P,2
04300 SUB P,X22 ; ADJUST
04400 JRST @2(P) ; RETURN
04500
04600 CFBAD: SETZ 1, ; RETURN FALSE
04700 JRST CFRET ;
04800
04900 CFBA1: SKIPN B,CDB ;[CLH] ANY CORE TO RELEASE?
05000 JRST CFBA2 ;[CLH] NO
05100 SKIPLE B,OPNDUN(B) ;[CLH] YES, POINT TO DEVICE NAM BLOCK?
05200 PUSHJ P,CORREL ;[CLH] YES, DO IT FIRST
05300 SKIPE B,CDB
05400 PUSHJ P,CORREL ;RELEASE CORE BLOCK
05500 CFBA2: SETZM CDBTBL(CHNL) ;REMOVE ALL TRACE
05600 SETZM JFNTBL(CHNL)
05700 SETZ 1, ; RETURN FALSE
05800 JRST CFRET
05900
00100 DSCR SIMPLE PROCEDURE CLOSF(INTEGER JFN,bits[0])
00200 Does a CLOSF on the JFN. Ordinarily the user
00300 will want to use the CFILE routine, which handles errors
00400 internally. The CLOSF is accomplished in such a way that
00500 the JFN is actually not released.
00600 If the device is a magtape open for output, then
00700 2 eof's are written, followed by a backspace, unless the
00800 abort close bit is set. This writes a standard end-of-file
00900 on the tape.
01000
01100
01200 HERE(CLOSF)
01300 ;[clh] this is the old form, with only one arg
01400 PUSH P,0(P) ;[CLH] RET, RET
01500 SETZM -1(P) ;[CLH] 0, RET
01600
01700 HEREFK(CLOSF$,CLOSF.)
01800 ;[clh] this is the new closf
01900 PUSHJ P,SAVE
02000 MOVE LPSA,X33
02100 VALCHN 1,<-2(P)>,CLOERR
02200 HLL 1,-1(P) ;ADD IN BITS
02300 TLNE 1,4000 ;IF ABORT CLOSE, JUST UNMAP BUFFERS
02400 PUSHJ P,ZAPBUF
02500 TLNN 1,4000 ;IF NOT ABORT CLOSE
02600 PUSHJ P,FINIO ;THEN WRITE OUT BUFFERS, ETC.
02700
02800 DOCLO: SETZM .SKIP. ;ASSUME NO ERROR
02900 TLO 1,400000 ; DO NOT RELEASE THE JFN
03000 JSYS CLOSF
03100 MOVEM 1,.SKIP. ;ERROR
03200 CLORET: JRST RESTR
03300
03400 CLOERR:
03500 SETOM .SKIP.
03600 JRST CLORET
03700
03800 ;[CLH] ROUTINE TO UNMAP PAGES ON ABORT CLOSE
03900 ZAPBUF: PUSH P,1
04000 PUSH P,2
04100 PUSH P,3
04200 SETO 1, ;KILL PAGE
04300 MOVE 2,-6(P) ;CHANNEL NUMBER
04400 HRRI 2,STARTPAGE(2) ;BUFFER PAGE
04500 HRLI 2,400000 ;THIS PROCESS
04600 SETZ 3,
04700 JSYS PMAP
04800 POP P,3
04900 POP P,2
05000 POP P,1
05100 POPJ P,
05200 ;[CLH] ^^
00100 DSCR SIMPLE PROCEDURE RLJFN(INTEGER JFN)
00200 Does the RLJFN jsys. Ordinarily the user will want
00300 to use the CFILE routine, which handles errors internally.
00400
00500
00600 HERE(RLJFN)
00700 PUSHJ P,SAVE
00800 MOVE LPSA,X22
00900 SKIPL C,-1(P)
01000 CAIL C,JFNSIZE
01100 JRST RLJBAD
01200 SKIPN 1,JFNTBL(C)
01300 JRST RLJBAD
01400 SETZM JFNTBL(C)
01500 SKIPN B,CDBTBL(C) ;[CLH] ANY CORE TO RELEASE?
01600 JRST RLJRT1 ;[CLH] NO
01700 SKIPLE B,OPNDUN(B) ;[CLH] YES, POINT TO DEVICE NAM BLOCK?
01800 PUSHJ P,CORREL ;[CLH] YES, DO IT FIRST
01900 SKIPE B,CDBTBL(C)
02000 PUSHJ P,CORREL
02100 RLJRT1: SETZM CDBTBL(C)
02200 SETZM .SKIP. ;ASSUME NO ERROR
02300 JSYS RLJFN
02400 MOVEM 1,.SKIP. ;ERROR RETURN
02500 RLJRET: JRST RESTR
02600
02700 RLJBAD: ERR <Illegal JFN>,1
02800 SETOM .SKIP.
02900 JRST RLJRET
03000
03100
00100 DSCR INTEGER SIMPLE PROCEDURE GTSTS(INTEGER JFN);
00200 Gets the file status.
00300 WARNING: The results of this call are not necessarily appropriate
00400 if the file is open in special character input mode. If you want to check
00500 for end-of-file, examine the EOF variable instead.
00600
00700
00800 HERE(GTSTS)
00900 PUSHJ P,SAVE
01000 MOVE LPSA,X22
01100 VALCHN 1,<-1(P)>,GTSERR
01200 JSYS GTSTS
01300 MOVEM 2,RACS+A(USER)
01400 GTSRET: JRST RESTR
01500
01600 GTSERR: ERR <Illegal JFN>,1
01700 JRST GTSRET
00100 DSCR BOOLEAN SIMPLE PROCEDURE STSTS(INTEGER JFN,STATUS);
00200 Sets the status of JFN to STATUS using the STSTS jsys.
00300
00400
00500 HERE(STSTS)
00600 VALCH1 1,<-2(P)>,STSERR
00700 MOVE 2,-1(P)
00800 SETO 3, ;ASSUME SKIP
00900 SETZM .SKIP.
01000 JSYS STSTS
01100 JRST [STERRT: SETZ 3, ;PROBLEM
01200 MOVEM 1,.SKIP.
01300 JRST .+1]
01400 MOVE 1,3 ;RETURN
01500 SUB P,X33
01600 JRST @3(P)
01700
01800 STSERR: ERR <Illegal JFN>,1
01900 JRST STERRT ;RETURN
02000
00100 DSCR BOOLEAN SIMPLE PROCEDURE RNAMF(INTEGER EXISTINGJFN,NEWJFN);
00200 File open on EXISTINGJFN is renamed to file open
00300 on NEWJFN.
00400
00500 HERE(RNAMF)
00600 VALCH1 1,<-2(P)>,RNFERR
00700 VALCH1 2,<-1(P)>,RNFERR
00800 SETO 3, ;ASSUME OK
00900 SETZM .SKIP.
01000 JSYS RNAMF
01100 JRST [RNERET: SETZ 3,
01200 MOVEM 1,.SKIP.
01300 JRST .+1]
01400 RNFRET: MOVE 1,3 ;RETURN VALUE
01500 SUB P,X33
01600 JRST @3(P)
01700
01800 RNFERR: ERR <Illegal JFN>,1
01900 JRST RNERET
02000
02100 ;[CLH/DAW]
02200 DSCR BOOLEAN SIMPLE PROCEDURE SACTF(INTEGER CHAN; STRING ACCOUNTSTRING);
02300 Sets the file's account string.
02400 Returns success flag.
02500
02600 HEREFK(SACTF,$SACTF)
02700
02800 push p,b
02900 PUSH P,[0] ;MAKE ASCIZ
03000 PUSHJ P,CATCHR
03100 push p,-2(p) ;get channel number as arg to cvjfn
03200 pushj p,cvjfn ;get jfn to AC1
03300 tlz a,-1 ;jfn only
03400 move b,(sp) ;get pointer to acct str into AC2
03500 setzm .skip. ;assume success
03600 JSYS SACTF
03700 jrst sactff ;failed, code in a
03800 seto a, ;success - return true
03900 sactfs: pop p,b ;retore ac's
04000 SUB P,X22
04100 SUB SP,X22
04200 jrst @2(p)
04300 sactff: movem a,.skip. ;put code in .skip.
04400 setz a, ;say failed
04500 jrst sactfs ;and return
04600 ;[CLH/DAW]^^
04700
04800 ENDCOM(FILINF)
00100 COMPIL(DEVINF,<CNDIR,ACCES,ASND,RELD,GDSTS,SDSTS,STDEV,DEVST,GTFDB,CHFDB>
00200 ,<JFNTBL,CDBTBL,X11,X22,X33,CORREL,.SKIP.,CATCHR,ZSETST,ZADJST>
00300 ,<DEVINF -- DEVICE AND DIRECTORY ROUTINES>)
00400
00500 DSCR BOOLEAN SIMPLE PROCEDURE CNDIR(INTEGER DIR; STRING PASSWORD);
00600 Using the CNDIR jsys, connects to TENEX directory DIR (for
00700 AC1.) PASSWORD is the password, which will usually be null, as
00800 in the EXEC CONNECT command.
00900
01000
01100 HERE(CNDIR)
01200 PUSH P,[0]
01300 PUSHJ P,CATCHR ;PUT A NULL ON THE END OF THE PASSWORD
01400 POP SP,2 ;GET BP IN 2
01500 SUB SP,X11 ;CLEAN UP SP STACK
01600 MOVE 1,-1(P) ;DIRECTORY NO
01700 SETO 3, ;ASSUME SUCCESS
01800 SETZM .SKIP.
01900 JSYS CNDIR
02000 JRST [SETZ 3,
02100 MOVEM 1,.SKIP.
02200 JRST .+1]
02300 MOVE 1,3
02400 SUB P,X22
02500 JRST @2(P)
02600
02700 ;[CLH/DAW]
02800 DSCR BOOLEAN SIMPLE PROCEDURE ACCES(STRING DIRECTORY, PASSWORD[NULL];
02900 INTEGER FLAGS[CONNECT],JOBNO[-1]);
03000 this is the Tops-20 connect and access. returns success.
03100
03200
03300 HEREFK(ACCES,$ACCES)
03400
03500 push p,b
03600 push p,[0] ;make password ASCIZ
03700 pushj p,catchr
03800 push sp,-3(sp) ;make directory ASCIZ
03900 push sp,-3(sp)
04000 push p,[0]
04100 pushj p,catchr
04200 move a,-3(p) ;get flags
04300 cain a,0 ;if zero
04400 movsi a,400000 ;then assume connect
04500 hrri a,3 ;stuff in length of block
04600 push p,(sp) ;put directory pointer into block
04700 movei b,(p) ;top of stack is now addr of arg blk
04800 push p,-2(sp) ;next password pointer
04900 push p,-4(p) ;then job number
05000 skipn (p) ;if zero
05100 setom (p) ;then use this job
05200 jsys acces
05300 erjmp acces2
05400 setzm .skip. ;no error
05500 movei a,1
05600 acces1: sub p,x33 ;get rid of arg block
05700 pop p,b ;restore ac's
05800 sub sp,[xwd 6,6] ;clean up and return
05900 sub p,x33
06000 jrst @3(p)
06100 acces2: movei a,400000 ;get my last error
06200 jsys geter
06300 setz a, ;return error (false)
06400 hrrzm b,.skip. ;put tenex error code here
06500 jrst acces1
06600
06700 ;[clh/daw] ^^
00100 DSCR BOOLEAN PROCEDURE ASND(INTEGER DEVICE)
00200 Assigns the device specified by DEVICE using the ASND jsys.
00300 Returns TRUE if successful, else error code in .SKIP.
00400
00500
00600 HERE(ASND)
00700 MOVE 1,-1(P) ;GET DEVICE DESIGNATOR
00800 JSYS ASND
00900 JRST [MOVEM 1,.SKIP.
01000 SETZ 1,
01100 JRST .+2]
01200 SETO 1,
01300 SUB P,X22
01400 JRST @2(P)
00100 DSCR BOOLEAN PROCEDURE RELD(INTEGER DEVICE)
00200 Releases DEVICE using the RELD jsys. If DEVICE is -1,
00300 then releases all devices assigned to this job.
00400
00500
00600 HERE(RELD)
00700 MOVE 1,-1(P)
00800 JSYS RELD
00900 JRST [MOVEM 1,.SKIP.
01000 SETZ 1,
01100 JRST .+2]
01200 SETO 1,
01300 SUB P,X22
01400 JRST @2(P)
00100 DSCR INTEGER SIMPLE PROCEDURE GDSTS(INTEGER CHAN; REFERENCE INTEGER WORDCNT)
00200 Returns the device status of device open on CHAN using the GDSTS
00300 jsys. The LH of WORDCNT has the word count of the last transfer completed,
00400 negative if the last transfer completed unsuccessful.
00500
00600
00700 HERE(GDSTS)
00800 VALCH1 1,<-2(P)>,GDSERR
00900 SETZM .SKIP.
01000 JSYS GDSTS
01100 MOVEM 3,@-1(P) ;REFERENCE ARG
01200 MOVE 1,2 ;RETURN VALUE
01300 GDSRET: SUB P,X33
01400 JRST @3(P)
01500 GDSERR: ERR <Illegal JFN>,1
01600 SETOM .SKIP.
01700 SETZ 1,
01800 JRST GDSRET
00100 DSCR PROCEDURE SDSTS(INTEGER JFN,NEWSTATUS)
00200
00300 HERE(SDSTS)
00400 VALCH1 1,<-2(P)>,SDSERR
00500 SETZM .SKIP. ;INDICATE NO ERROR
00600 MOVE 2,-1(P)
00700 JSYS SDSTS
00800 SDSRET: SUB P,X33
00900 JRST @3(P)
01000 SDSERR: ERR <Illegal JFN>,1
01100 SETOM .SKIP.
01200 JRST SDSRET
00100 DSCR INTEGER PROCEDURE STDEV(STRING S)
00200 S is a string pointer to a string of the form DTA1.
00300 The device designator is returned.
00400
00500
00600 HERE(STDEV)
00700 PUSH P,[0]
00800 PUSHJ P,CATCHR
00900 POP SP,1
01000 SUB SP,X11 ;CLEAN SP STACK
01100 SETZM .SKIP.
01200 JSYS STDEV
01300 JRST [PUSHJ P,SAVE ;GET FRESH ACS
01400 MOVEI 1,400000 ;THIS FORK
01500 JSYS GETER ;GET ERROR NUMBER
01600 HRRZM 2,.SKIP. ;SAVE IN .SKIP. FOR USER
01700 SETZM RACS+1(USER) ;ZERO RETURN
01800 SETZ LPSA, ;NOTHING TO REMOVE FROM STACK
01900 JRST RESTR ;AND RETURN
02000 ]
02100 MOVE 1,2
02200 POPJ P,
02300
00100
00200 DSCR STRING PROCEDURE DEVST(INTEGER DEVICE)
00300
00400 HERE(DEVST)
00500 PUSH P,[=100]
00600 PUSHJ P,ZSETST ;GET A BP FOR 100 CHARS
00700 SETZM .SKIP.
00800 MOVE 2,-1(P)
00900 JSYS DEVST
01000 MOVEM 2,.SKIP. ;INDICATE ERROR
01100 PUSH P,[=100]
01200 PUSH P,1 ;UPDATED BP
01300 PUSHJ P,ZADJST
01400 SUB P,X22
01500 JRST @2(P)
01600
00100 DSCR SIMPLE PROCEDURE GTFDB(INTEGER JFN; REFERENCE INTEGER ARRAY BUF)
00200
00300 Entire FDB of JFN is read into BUF. No bounds checking,
00400 so BUF should be at least '26 words.
00500
00600 HERE(GTFDB)
00700 PUSHJ P,SAVE
00800 MOVE LPSA,X33
00900 VALCHN 1,<-2(P)>,FDBAD
01000 MOVSI 2,25 ;ALL 25 WORDS
01100 HRRZ 3,-1(P) ;ADDRESS OF ARRAY
01200 JSYS GTFDB
01300 JRST RESTR
01400
01500 FDBAD: ERR <Illegal JFN>,1
01600 JRST RESTR
01700
01800 HERE(CHFDB)
01900 DSCR
02000 CHFDB(CHAN,DISPLACEMENT,MASK,CHANGED!BITS)
02100
02200 PUSHJ P,SAVE
02300 MOVE LPSA,[XWD 5,5]
02400 VALCHN 1,-4(P),FDBAD ;GET JFN TO 1
02500 HRL 1,-3(P) ;DISPLACEMENT TO LEFT HALF OF ONE
02600 MOVE 2,-2(P)
02700 MOVE 3,-1(P)
02800 JSYS CHFDB
02900 JRST RESTR
03000
00100
00200 ENDCOM(DEVINF)
00300
00400 DEFINE WORDROU < WORDIN,ARRYIN,WORDOUT,ARRYOUT,RWDPTR,SWDPTR >
00500 DEFINE CHARROU < CHARIN,SINI,INPUT,LREALIN,LREALSCAN,REALIN,REALSCAN,INTIN,INTSCAN,CHAROUT,OUT,LINOUT,RCHPTR,SCHPTR >
00600 DEFINE UTILROU < FINIO >
00700
00800 COMPIL(IOROU,<WORDROU,CHARROU,UTILROU>
00900 ,<JFNTBL,CDBTBL,X22,X33,X44,.SKIP.,SAVE,RESTR>
01000 ,<IOROU -- Input and output routines>)
01100
00100 DSCR INTEGER SIMPLE PROCEDURE WORDIN(INTEGER JFN);
00200 Reads a word in from the file
00300
00400 HERE(WORDIN)
00500 BEGIN WORDIN
00600
00700 PUSHJ P,SAVE
00800 MOVE LPSA,X22
00900 VALCHN 1,-1(P),WERR
01000 SETZEOF ;INDICATE NO EOF
01100
01200 DOSIMIO:SIMIO 2,TABL,WERR ;SOSGE IOCNT(CDB)
01300 JRST .ADWI
01400 ILDB 2,IOBP(CDB)
01500 STOAC2: MOVEM 2,RACS+A(USER)
01600 JRST RESTR
01700
01800 DOBIN: JSYS BIN
01900 JUMPN 2,STOAC2 ;CANNOT BE END OF FILE
02000 CHKEOF: SETZM RACS+A(USER) ;RETURN 0 IN ANY EVENT
02100 JSYS GTSTS
02200 TESTE 2,1B8 ;EOF?
02300 JRST INPEOF ;YES, INDICATE
02400 JRST RESTR
02500
02600 TABL: JRST DOSETWI ;0 -- SET UP
02700 JRST .CISWI ;1 -- XICHAR
02800 JRST .COSWI ;2 -- XOCHAR
02900 SOSGE IOCNT(CDB) ;3 -- XIWORD
03000 JRST .WOSWI ;4 -- XOWORD
03100 JRST WERR ;5 -- XCICHAR
03200 JRST WERR ;6 -- XCOCHAR
03300 JRST DOBIN ;7 -- XCWORD
03400 REPEAT 4,<JRST WERR> ;10-13
03500
03600 DOSETWI:
03700 PUSHJ P,SETWI
03800 JRST DOSIMIO
03900
04000
04100 .ADWI: PUSHJ P,ADWI
04200 JRST .ADEOF ;END OF FILE
04300 JRST DOSIMIO ;START OVER
04400
04500 .ADEOF: SETZM RACS+A(USER) ;RETURN 0 WORD
04600 JRST INPEOF ;AND INDICATE EOF
04700 WERR: ERR <Dryrot at WORDIN>,1
04800 SETZM RACS+A(USER)
04900 JRST INPEOF ;INDICATING EOF OR ERROR
05000
05100 .CISWI: PUSHJ P,CISWI
05200 JRST DOSIMIO
05300
05400 .COSWI: PUSHJ P,COSWI
05500 JRST DOSIMIO
05600
05700 .WOSWI: PUSHJ P,WOSWI
05800 JRST DOSIMIO
05900
06000
06100 BEND WORDIN
00100 HERE(ARRYIN)
00200 BEGIN ARRYIN
00300
00400 PUSHJ P,SAVE
00500 MOVE LPSA,X44
00600 VALCHN 1,-3(P),WERR
00700 SETZEOF ;ASSUME OK
00800 DOSIMIO:
00900 SIMIO 2,TABL,WERR ;MOVE 6,-2(P)
01000 SKIPGE 2,-1(P) ;EXTENT
01100 ERR <ARRYIN: Negative word count>
01200 WIN3: JUMPE 2,RESTR ;NOTHING LEFT TO TRANSFER
01300 SKIPG E,IOCNT(CDB)
01400 JRST WIN5
01500 IBP IOBP(CDB) ;INCREMENT THE POINTER
01600 HRL C,IOBP(CDB) ;SOURCE
01700 MOVEI D,(6) ;FOR BLT
01800 HRR C,6 ;"TO" ADDRESS
01900 CAIG B,(E) ;ENOUGH HERE
02000 JRST WIN4
02100 ADDI D,-1(E) ;FINISH HERE
02200 BLT C,(D)
02300 SUBM E,IOCNT(CDB)
02400 ADDM E,IOBP(CDB)
02500 ADD 6,E ;FIX INPUT POINTER
02600 SUB B,E ;FIX INPUT COUNT
02700 WIN5: PUSHJ P,ADWI ;GET MORE
02800 JRST ISEOF ;END OF FILE -- NO MORE THERE
02900 JRST WIN3
03000 WIN4: ADDI D,-1(B) ;
03100 BLT C,(D) ;LAST BLT
03200 SUB E,B ;FIX UP COUNT
03300 SOJ B,
03400 MOVEM E,IOCNT(CDB)
03500 ADDM B,IOBP(CDB)
03600 JRST RESTR
03700
03800 TABL: JRST DOSETWI ;0 -- SET UP
03900 JRST .CISWI ;1 -- XICHAR
04000 JRST .COSWI ;2 -- XOCHAR
04100 MOVE 6,-2(P) ;3 -- XIWORD
04200 JRST .WOSWI ;4 -- XOWORD
04300 JRST WERR ;5 -- XCICHAR
04400 JRST WERR ;6 -- XCOCHAR
04500 JRST DOSIN ;7 -- XCWORD
04600 JRST WERR ;10 -- XBYTE7
04700 JRST WERR ;11 -- XDICHAR
04800 JRST WERR ;12 -- XDOCHAR
04900 JRST DODUMPI ;13 -- XDARR
05000
05100 ISEOF: MOVE TEMP,-1(P) ;NUMBER OF WORDS WANTED
05200 SUBM TEMP,B ;INPUT IN RH
05300 WIN2: HRROM B,.SKIP.
05400 SKIPE ENDFL(CDB)
05500 HRROM B,@ENDFL(CDB)
05600 JRST RESTR
05700
05800 .CISWI: PUSHJ P,CISWI
05900 JRST DOSIMIO
06000
06100 .COSWI: PUSHJ P,COSWI
06200 JRST DOSIMIO
06300
06400 .WOSWI: PUSHJ P,WOSWI
06500 JRST DOSIMIO
06600
06700 DOSETWI:
06800 PUSHJ P,SETWI
06900 JRST DOSIMIO
07000
07100 DOSIN:
07200 MOVN 3,-1(P) ;WORD COUNT
07300 MOVSI 2,444400
07400 HRR 2,-2(P) ;ADDRESS OF BUFFER
07500 JSYS SIN
07600 JUMPE 3,RESTR ;DID WE GET IT ALL?
07700 SINEOF: ADD 3,-1(P) ;CALCULATE NO OF WORDS READ
07800 HRLI 3,-1 ;MAKE IT XWD -1,,COUNT
07900 SKIPE ENDFL(CDB) ;EOF LOCATION?
08000 MOVEM 3,@ENDFL(CDB) ;YES
08100 MOVEM 3,.SKIP.
08200 JRST RESTR ;AND RETURN
08300
08400 DODUMPI:
08500 MOVN 3,-1(P)
08600 MOVEI 2,3
08700 HRL 3,3
08800 HRR 3,-2(P) ;ADDRESS OF BUFFER
08900 SUBI 3,1
09000 SETZ 4, ;END OF DUMP MODE COMMAND LIST
09100 JSYS DUMPI ;DO IT
09200 JRST DMPERR
09300 JRST RESTR ;ALL OK
09400
09500 DMPERR: CAIN 1,600220 ;EOF?
09600 JRST DUMPEOF ;NO
09700 ERR <ARRYIN: Dump mode error>,1
09800 MOVEM 1,.SKIP.
09900 JRST RESTR
10000
10100 DUMPEOF:
10200 MOVE 1,DVTYP(CDB)
10300 CAIE 1,2 ;MAGTAPE DEVICE?
10400 JRST INPEOF ;NO JUST INDICATE EOF
10500 HRRZ 1,JFNTBL(CHNL)
10600 SETZ 2, ;MTOPR RESET
10700 JSYS MTOPR
10800 JRST INPEOF ;INDICATE EOF AND RETURN
10900
11000 WERR: ERR <ARRYIN: Illegal JFN, byte-size, or mode.>,1
11100 JRST INPEOF
11200
11300
11400 BEND ARRYIN
00100 HERE(WORDOUT)
00200 BEGIN WORDOUT
00300 PUSHJ P,SAVE
00400 MOVE LPSA,X33
00500 VALCHN 1,-2(P),WERR
00600 SETZEOF
00700 DOSIMIO:SIMIO 2,TABL,WERR ;SOSGE IOCNT(CDB)
00800 JRST .ADWO
00900 MOVE 2,-1(P)
01000 IDPB 2,IOBP(CDB)
01100 JRST RESTR
01200
01300 TABL: JRST DOSETWO ;0 -- XNULL
01400 JRST .CISWO ;1 -- XICHAR
01500 JRST .COSWO ;2 -- XOCHAR
01600 JRST .WISWO ;3 -- XIWORD
01700 SOSGE IOCNT(CDB) ;4 -- XOWORD
01800 JRST WERR ;5 -- XCICHAR
01900 JRST WERR ;6 -- XCOCHAR
02000 JRST DOBOUT ;7 -- XCWORD
02100 REPEAT 4,<JRST WERR> ;10-13
02200
02300 .ADWO: PUSHJ P,ADWO
02400 JRST DOSIMIO
02500
02600 DOSETWO:
02700 PUSHJ P,SETWO
02800 JRST DOSIMIO
02900
03000 .CISWO: PUSHJ P,CISWO
03100 JRST DOSIMIO
03200
03300 .COSWO: PUSHJ P,COSWO
03400 JRST DOSIMIO
03500
03600 .WISWO: PUSHJ P,WISWO
03700 JRST DOSIMIO
03800
03900 WERR: ERR <WORDOUT: Illegal JFN, byte-size, mode, or combination>,1
04000 JRST INPEOF ;AND INDICATE ERROR
04100
04200 DOBOUT: MOVE 2,-1(P)
04300 JSYS BOUT
04400 JRST RESTR
04500
04600 BEND WORDOUT
00100 HERE(ARRYOUT)
00200 BEGIN ARRYOUT
00300
00400 PUSHJ P,SAVE
00500 MOVE LPSA,X44
00600 VALCHN 1,-3(P),WERR
00700 SKIPN 3,-1(P)
00800 JRST RESTR ;NOTHING TO MOVE
00900 JUMPGE 3,.+2
01000 JRST WERR
01100 SETZEOF
01200 DOSIMIO:SIMIO 2,TABL ;MOVE 6-2(P)
01300 SKIPGE B,-1(P)
01400 ERR <ARRYOUT: Word count is negative>,1
01500 WOUT2: SKIPG E,IOCNT(CDB)
01600 JRST WOUT5
01700 JUMPE B,RESTR ;NOTHING LEFT
01800 IBP IOBP(CDB)
01900 MOVE C,IOBP(CDB) ;TO ADDR
02000 HRRZI D,(C) ;FOR BLT TERMINATION
02100 HRLI C,(6)
02200 CAIGE B,(E) ;ENOUGHT IN BUFFER
02300 JRST WOUT3 ;YES
02400 ADDI D,-1(E) ;FINAL ADDRESS
02500 BLT C,(D)
02600 ADDI 6,(E) ;UPDATE BP
02700 SUBI B,(E)
02800 SETZM IOCNT(CDB)
02900 HRRM D,IOBP(CDB)
03000 WOUT5: PUSHJ P,ADWO
03100 JRST WOUT2
03200 WOUT3: JUMPLE B,RESTR
03300 SOJ B,
03400 ADD D,B
03500 BLT C,(D)
03600 SUBI E,1(B)
03700 MOVEM E,IOCNT(CDB)
03800 ADDM B,IOBP(CDB)
03900 JRST RESTR
04000
04100 TABL: JRST DOSETWO ;0 -- XNULL
04200 JRST .CISWO ;1 -- XICHAR
04300 JRST .COSWO ;2 -- XOCHAR
04400 JRST .WISWO ;3 -- XIWORD
04500 MOVE 6,-2(P) ;4 -- XOWORD
04600 JRST WERR ;5 -- XCICHAR
04700 JRST WERR ;6 -- XCOCHAR
04800 JRST DOSOUT ;7 -- XBYTE36
04900 JRST WERR ;10 -- XBYTE7
05000 JRST WERR ;11 -- XDICHAR
05100 JRST WERR ;12 -- XDOCHAR
05200 JRST DODUMPO ;13 -- XDARR
05300
05400 DOSETWO:
05500 PUSHJ P,SETWO
05600 JRST DOSIMIO
05700
05800 .CISWO: PUSHJ P,CISWO
05900 JRST DOSIMIO
06000
06100 .COSWO: PUSHJ P,COSWO
06200 JRST DOSIMIO
06300
06400 .WISWO: PUSHJ P,WISWO
06500 JRST DOSIMIO
06600
06700 DOSOUT:
06800 MOVN 3,-1(P)
06900 MOVSI 2,444400
07000 HRR 2,-2(P)
07100 JSYS SOUT
07200 JRST RESTR
07300
07400 DODUMPO:
07500 MOVN 3,-1(P)
07600 MOVEI 2,3
07700 HRL 3,3
07800 HRR 3,-2(P)
07900 SUBI 3,1
08000 SETZ 4,
08100 JSYS DUMPO
08200 JRST DMPERR
08300 SETOM DMPED(CDB)
08400 JRST RESTR
08500
08600 WERR: ERR <ARRYOUT: Illegal JFN, byte-size, mode, or combination.>,1
08700 JRST INPEOF
08800
08900
09000 DMPERR: ERR <ARRYOUT: Dump mode error>,1
09100 MOVEM 1,.SKIP. ;SAVE TENEX ERROR NUMBER
09200 JRST RESTR
09300
09400
09500 BEND ARRYOUT
00100
00200 HERE(RWDPTR)
00300 BEGIN RWDPTR
00400
00500 PUSHJ P,SAVE
00600 MOVE LPSA,X22
00700 VALCHN 1,-1(P),WERR
00800 SETZM .SKIP.
00900 DOSIMIO:SIMIO 2,TABL,WERR ;PUSHJ P,GETWPT
01000 STOAC2: MOVEM 2,RACS+A(USER)
01100 JRST RESTR
01200
01300 TABL: JRST RNULL ;0 -- XNULL
01400 PUSHJ P,GETWPT ;1 -- XICHAR
01500 PUSHJ P,GETWPT ;2 -- XOCHAR
01600 PUSHJ P,GETWPT ;3 -- XIWORD
01700 PUSHJ P,GETWPT ;4 -- XOWORD
01800 JRST WERR ;5 -- XCICHAR
01900 JRST WERR ;6 -- XCOCHAR
02000 JRST DORFPTR ;7 -- XCWORD
02100 REPEAT 4,<JRST WERR> ;10-13
02200
02300 DORFPTR:
02400 JSYS RFPTR
02500 JRST .+2
02600 JRST STOAC2
02700 ERR <RWDPTR: Cannot do RFPTR.>,1
02800 MOVEM 1,.SKIP.
02900 JRST RNULL
03000 WERR: ERR <RWDPTR: Illegal JFN, illegal mode or byte size.>,1
03100 SETOM .SKIP.
03200
03300 RNULL:
03400 PUSHJ P,SETWIO
03500 JRST DOSIMIO ;AND LOOK AGAIN
03600
03700
03800 BEND RWDPTR
00100 HERE(SWDPTR)
00200 BEGIN SWDPTR
00300
00400 PUSHJ P,SAVE
00500 MOVE LPSA,X33
00600 VALCHN 1,-2(P),WERR
00700 SETZM .SKIP.
00800 DOSIMIO:MOVE 2,-1(P) ;PICK UP NEW WORD IN 2
00900 SIMIO 3,TABL,WERR
01000 JRST RESTR
01100
01200 TABL: JRST RNULL ;0 -- XNULL
01300 PUSHJ P,SETWPT ;1 -- XICHAR
01400 PUSHJ P,SETWPT ;2 -- XOCHAR
01500 PUSHJ P,SETWPT ;3 -- XIWORD
01600 PUSHJ P,SETWPT ;4 -- XOWORD
01700 JRST WERR ;5 -- XCICHAR
01800 JRST WERR ;6 -- XCOCHAR
01900 JRST DOSFPTR ;7 -- XCWORD
02000 REPEAT 4,<JRST WERR> ;10-13
02100
02200 DOSFPTR:JSYS SFPTR
02300 JRST SFERR
02400 JRST RESTR
02500
02600 SFERR: ERR <SWDPTR: Cannot do SFPTR>,1
02700 MOVEM 1,.SKIP.
02800 JRST RESTR
02900
03000 WERR: ERR <SWDPTR: Illegal JFN, byte size, or mode.>,1
03100 SETOM .SKIP.
03200 JRST RESTR
03300
03400 RNULL: PUSHJ P,SETWIO
03500 JRST DOSIMIO
03600
03700 BEND SWDPTR
00100
00200 DSCR
00300 Some auxiliary routines, mostly for word i/o.
00400
00500 INPEOF:
00600 ;HERE IF WE HAVE HIT EOF ON INPUT AND WISH TO SIMPLY SAY SO AND RETURN
00700 SETOEOF
00800 JRST RESTR
00900
01000 ;ROUTINES TO SET TO WORD OUTPUT
01100 COSWO: PUSHJ P,CHCEOF ;CHECK FOR NEW CHARACTER EOF
01200 CISWO:
01300 WISWO:
01400 PUSHJ P,GTWPT1
01500 MOVEM 3,IOBP(CDB)
01600 MOVEM 4,IOCNT(CDB)
01700 MOVEI 3,XOWORD
01800 MOVEM 3,IOSTT(CDB)
01900 POPJ P,
02000
02100 ;ROUTINES TO SET TO CHARACTER OUTPUT
02200 WOSCO: PUSHJ P,CHWEOF ;CHECK FOR NEW WORD EOF
02300 CISCO:
02400 WISCO:
02500 PUSHJ P,GTCPT1
02600 MOVEM 3,IOBP(CDB)
02700 MOVEM 4,IOCNT(CDB)
02800 MOVEI 3,XOCHAR
02900 MOVEM 3,IOSTT(CDB)
03000 POPJ P,
03100
03200
03300 ;ROUTINES TO SET TO CHARACTER INPUT
03400 WOSCI: PUSHJ P,CHWEOF ;CHECK FOR NEW WORD EOF
03500 JRST .+2
03600 COSCI: PUSHJ P,CHCEOF ;CHECK FOR NEW CHARACTER EOF
03700 WISCI: PUSHJ P,GTCPT1
03800 MOVEM 3,IOBP(CDB)
03900 MOVEM 5,IOCNT(CDB)
04000 MOVEI 3,XICHAR
04100 MOVEM 3,IOSTT(CDB)
04200 POPJ P,
04300
04400 ;ROUTINES TO SET TO WORD INPUT
04500 COSWI: PUSHJ P,CHCEOF ;CHECK FOR NEW CHARACTER EOF
04600 JRST .+2
04700 WOSWI: PUSHJ P,CHWEOF ;CHECK FOR NEW WORD EOF
04800 CISWI: PUSHJ P,GTWPT1
04900 MOVEM 3,IOBP(CDB)
05000 MOVEM 5,IOCNT(CDB)
05100 MOVEI 3,XIWORD
05200 MOVEM 3,IOSTT(CDB)
05300 POPJ P,
05400
05500
05600 SETWND:
05700 ;1, CDB LOADED
05800 ;SETS THE FDB SO THAT THE BYTE SIZE IS 36 AND THE NUMBER OF BYTES IS AS IN 2
05900 PUSH P,2 ;SAVE
06000 PUSH P,3
06100 MOVEM 2,FDBEOF(CDB)
06200 HRLI 1,12 ;OFFSET FOR
06300 MOVEM 2,3 ;NUMBER OF WORDS
06400 SETO 2, ;BYTE MASK
06500 JSYS CHFDB ;CHANGE THE EOF POINTER
06600 MOVEI 2,=36
06700 MOVEM 2,FDBSZ(CDB)
06800 HRLI 1,11 ;OFFSET FOR BYTE SIZE
06900 MOVSI 2,007700 ;MASK
07000 MOVSI 3,004400 ;36 BIT BYTES
07100 JSYS CHFDB
07200 HRLI 1,0 ;RESTORE GOOD JFN IN 1
07300 POP P,3 ;RESTORE
07400 POP P,2
07500 POPJ P, ;AND RETURN
07600
07700
07800 GETWND:
07900 ;HERE WITH 1,CDB LOADED
08000 ;RETURN THE WORD THAT ADDRESSES EOF IN 2, ACCORDING TO THE SYSTEM
08100 BEGIN GETWND
08200 PUSH P,3
08300 SKIPN 3,FDBSZ(CDB) ;IF BYTE SIZE IS ZERO
08400 JRST RET0 ;THEN RETURN 0
08500 CAIN 3,=36 ;ALREADY 36?
08600 JRST RET1 ;RETURN WHAT WE ALREADY HAVE THERE
08700 ;THE BYTE SIZE OF A FILE CAN BE 0 TO =64. 0 IS ALREADY TAKEN CARE OF ABOVE
08800 CAILE 3,=36
08900 ERR <GETWND: File byte size is bigger than 36 bits>,1
09000 MOVEI 2,=36
09100 IDIVI 2,(3) ;NUMBER TO MULTIPLY BY -- CLOBBERS 3!!
09200 MOVEM 2,3
09300 MOVE 2,FDBEOF(CDB)
09400 IDIVI 2,(3) ;NUMBER OF WORDS -- CLOBBERS 3!!
09500 JUMPE 3,.+2 ;EXTRA WORDS?
09600 AOJ 2, ;YES.
09700 POPBACK:POP P,3
09800 POPJ P,
09900
10000 RET0: SETZ 2,
10100 JRST POPBACK
10200
10300 RET1: MOVE 2,FDBEOF(CDB)
10400 JRST POPBACK
10500
10600 BEND GETWND
10700
10800 GETWPT:
10900 ;HERE WITH 1,CDB LOADED
11000 ;RETURNS IN 2 THE WORD THAT ADDRESSES EOB
11100 BEGIN GETWPT
11200 SKIPN 2,IOBP(CDB)
11300 POPJ P, ;WORD ZERO
11400 PUSH P,3
11500 TLZ 2,007700
11600 TLO 2,004400 ;MAKE 36 BIT
11700 IBP 2
11800 MOVE 3,IOADDR(CDB)
11900 SUBI 3,(2)
12000 MOVE 2,IOPAGE(CDB) ;CURRENT PAGE
12100 LSH 2,9 ;NUMBER OF WORDS IN PREVIOUS PAGES
12200 SUB 2,3 ;SUBTRACT SINCE 3 IS NEGATIVE
12300 POP P,3 ;RESULT IN 2
12400 POPJ P,
12500
12600 BEND GETWPT
12700
12800 GTWPT1:
12900 ;HERE WITH 1,CHNL,CDB LOADED
13000 ;RETURN IN 2 THE WORD THAT ADDRESSES EOB IN 2, ACCORDING TO THE CURRENT POINTER
13100 ;RETURN IN 3 THE UPDATED BYTE POINTER
13200 ;RETURN IN 4 THE COUNT REMAINING FOR OUTPUT
13300 ;RETURN IN 5 THE COUNT REMAINING FOR INPUT
13400 BEGIN GTWPT1
13500 SKIPN 3,IOBP(CDB)
13600 JRST NULRET
13700 TLZ 3,007700
13800 TLO 3,004400 ;MAKE A 36-BIT BP
13900 MOVEM 3,2 ;COPY INTO 2
14000 IBP 2
14100 MOVE 4,IOADDR(CDB) ;START OF BUFFER
14200 SUBI 4,(2) ;NUMBER OF WORDS CURRENTLY COMMITTED TO
14300 ;IN THIS BUFFER
14400 MOVE 2,IOPAGE(CDB) ;WHERE THE CURRENT IO IS
14500 LSH 2,9
14600 SUB 2,4 ;NUMBER OF WORDS TO ADDRESS EOF
14700 ADDI 4,1000 ;NUMBER OF WORDS REMAINING IN THIS BUFFER
14800 ;FOR OUTPUT PURPOSES
14900 MOVEM 2,5 ;SAVE CURRENT EOB POINTER
15000 PUSHJ P,GETWND ;READ THE END OF FILE IN FDB
15100 EXCH 5,2 ;EOB POINTER TO 2, EOF TO 5
15200 SUB 5,2 ;SUBTRACT THE CURRENT EOB POINTER
15300 CAML 5,4 ;IF LESS THAN OUTPUT COUNT THEN USE IT ELSE
15400 MOVEM 4,5 ;USE OUTPUT COUNT
15500 POPJ P,
15600
15700 NULRET: SETZB 2,3 ;EVERYTHING ZERO
15800 SETZB 4,5
15900 POPJ P,
16000
16100
16200 BEND GTWPT1
16300
16400 CHWEOF:
16500 ;1,CDB LOADED
16600 ;SEES IF A CHANGE OF EOF IS NEEDED, AND DOES IT
16700 SKIPN IOBP(CDB) ;ANYTHING THERE?
16800 POPJ P, ;NO, DONT FIDDLE AROUND
16900 PUSH P,2
17000 PUSH P,3
17100 PUSHJ P,GETWND ;GET WORD EOF
17200 MOVEM 2,3 ;SAVE IN 6
17300 PUSHJ P,GETWPT ;GET WORD EOB
17400 CAML 2,3 ;IS EOB LESS THAN EOF?
17500 PUSHJ P,SETWND ;BETTER RESET FDB -- ALSO IF TEST IS EQUAL
17600 POP P,3
17700 POP P,2
17800 POPJ P,
17900
18000
00100 SETWPT:
00200 BEGIN SETWPT
00300 ;HERE WITH 1,CDB LOADED
00400 ;2 HAS THE WORD THAT WE WANT TO SET TO
00500 MOVE 3,IOSTT(CDB)
00600 CAIN 3,XOWORD ;DOING WORD OUTPUT?
00700 PUSHJ P,CHWEOF ;YES CHECK
00800 CAIN 3,XOCHAR ;DOING CHAR OUTPUT?
00900 PUSHJ P,CHCEOF ;CHECK IT ALSO
01000 CAMN 2,[-1] ;WANT EOF?
01100 PUSHJ P,GETWND ;YES
01200 PUSH P,2 ;SAVE ON STACK
01300 LSH 2,-9
01400 CAME 2,IOPAGE(CDB) ;SAME PAGE?
01500 PUSHJ P,SETPAGE ;NO, SET THE PAGE
01600 POP P,2
01700 ANDI 2,777 ;PICK UP WORD IN PAGE
01800 MOVE 3,IOADDR(CDB)
01900 ADDI 3,(2)
02000 HRLI 3,444400 ;MAKE A BYTE POINTER
02100 MOVEM 3,IOBP(CDB)
02200 MOVE 3,IOSTT(CDB) ;CHECK THE STATUS AT THE MOMENT
02300 CAIE 3,XICHAR ;IF INPUTTING CHARS
02400 CAIN 3,XIWORD ;OR WORDS
02500 JRST ASSUMIN ;THEN ASSUME WE WILL CONTINUE TO INPUT
02600 MOVEI 3,XOWORD ;WELL ASSUME OUTPUT
02700 MOVEM 3,IOSTT(CDB)
02800 FULBU1: MOVEI 3,1000 ;OTHERWISE ASSUME OUTPUT
02900 SUBI 3,(2)
03000 STOAC3: MOVEM 3,IOCNT(CDB)
03100 POPJ P,
03200 ASSUMIN:
03300 MOVEI 3,XIWORD
03400 MOVEM 3,IOSTT(CDB)
03500 PUSH P,2 ;SAVE THE NUMBER OF WORDS
03600 PUSHJ P,GETWND ;GET THE END OF THE FILE IN WORDS IN 2
03700 IDIVI 2,1000 ;PAGES IN 2, WORDS IN 3
03800 CAMGE 2,IOPAGE(CDB) ;IS REQUESTED PAGE BEYOND EOF?
03900 JRST EMPBUF ;YES
04000 CAME 2,IOPAGE(CDB) ;SOMEWHERE ON THIS PAGE?
04100 JRST FULBUF ;NO
04200 POP P,2
04300 SUB 3,2
04400 JRST STOAC3
04500
04600 FULBUF: POP P,2
04700 JRST FULBU1
04800
04900 EMPBUF: POP P,2
05000 SETZ 3, ;SAY EMPTY
05100 JRST STOAC3
05200 BEND SETWPT
05300
05400 SETPAGE:
05500 ;1,CDB,CHNL LOADED
05600 ;2 HAS THE NUMBER OF THE PAGE WE WANT MAPPED
05700 CRYPT< ; Check for need to encrypt outgoing page
05800 SKIPE NCRYPT(CDB) ;DOES USER WANT TO ENCRYPT?
05900 PUSHJ P,CALNCR ;Yes, call user's routine
06000 ;if appropriate
06100 >; CRYPT
06200 PUSH P,1 ;SAVE JFN
06300 PUSH P,2
06400 PUSH P,3
06500 MOVEM 2,IOPAGE(CDB) ;PAGE BEING INSERTED
06600 PUSH P,1 ;SAVE JFN OVER SFPTR
06700 LSH 2,9 ;MAKE INTO WORDS
06800 JSYS SFPTR
06900 ERR <SETPAGE: Cannot do SFPTR>,1
07000 POP P,1
07100 HRL 1,1
07200 HRR 1,IOPAGE(CDB) ;XWD JFN,FILEPAGE
07300 HRLZI 3,140000 ;BITS 2 AND 3 FOR READ, WRITE -- ASSUME THIS
07400 MOVE 2,OFL(CDB) ;BUT BETTER CHECK:
07500 TESTN 2,WRBIT ;IF WRITING OR
07600 TESTE 2,APPBIT ;APPENDING
07700 JRST .+2 ;THEN DONT DO
07800 TESTO 3,1B9 ;THE COPY ON WRITE -- DO IT FOR READING THOUGH
07950 CRYPT<
07960 SKIPE DCRYPT(CDB) ;if we are going to decrypt
07970 JRST [ TESTO 3,1B9 ;THEN ALWAYS SET COPY-ON-WRITE
07975 TESTZ 3,1B3 ;AND NEVER SET WRITE BIT
07977 JRST .+1]
07980 >; CRYPT
07990 MOVE 2,FKPAGE(CDB) ;BUFFER IN CORE
08000 JSYS PMAP
08100 TESTE 3,1B9 ;[CLH] NO COPY-ON-WRITE
08200 SKIPN $OSTYP ;[CLH] OR TENEX?
08300 JRST SETPGG ;[CLH] YES, DONE
08400 MOVE 1,FKPAGE(CDB) ;[CLH] READING, CHECK FOR HOLE
08500 LSH 1,11 ;[CLH] ADDR OF START OF PAGE
08600 MOVE 1,(1) ;[CLH] SEE IF WE CAN ACCESS IT
08700 JUMP 16,SETPGF ;[CLH] FAILED, GET ZERO PAGE
08800 JRST SETPGG ;[CLH] OK, DONE
08900 SETPGF: SETO 1, ;[CLH] JUST CLEAR THE PAGE
09000 MOVE 2,FKPAGE(CDB) ;[CLH] PAGE NUMBER
09100 HRLI 2,400000 ;[CLH] OUR OWN FORK
09200 SETZ 3, ;[CLH]
09300 JSYS PMAP ;[CLH] CLEAR THE PAGE
09400 JRST SETPGX
09500
09600 SETPGG:
09700 CRYPT<
09800 SKIPE DCRYPT(CDB) ;DO WE NEED TO DECRYPT?
09900 PUSHJ P,CALDCR ;Yes, CALL USER'S ROUTINE
10000 >; CRYPT
10100 SETPGX: POP P,3
10200 POP P,2
10300 POP P,1 ;RESTORE THE JFN
10400 POPJ P,
10500
00100 SETWIO:
00200 ;1,CDB LOADED
00300 ;DECIDE WHETHER TO SETWI OR SETWO
00400 ;CLOBBERS 2,3
00500 MOVEI 3,SETWI ;ASSUME WORD INPUT
00600 MOVE 2,OFL(CDB)
00700 TESTN 2,RDBIT ;DOING INPUT
00800 MOVEI 3,SETWO ;NOPE ASSUME OUTPUT
00900 JRST (3) ;AND POPJ BACK
00100 ADWI:
00200 ;1,CDB LOADED
00300 ;CALL PUSHJ
00400 ;RETURN:
00500 ; +1 FOR EOF
00600 ; +2 FOR NORMAL
00700 ;ADVANCES WORD INPUT FROM DSK
00800 BEGIN ADWI
00900
01000 PUSH P,2
01100 PUSH P,3
01200 MOVE 3,IOPAGE(CDB) ;CURRENT PAGE
01300 AOJ 3, ;NEXT PAGE
01400 LSH 3,9 ;WORDS IN THAT PAGE
01500 PUSHJ P,GETWND ;END OF FILE POINTER
01600 CAML 3,2 ;BEYOND
01700 JRST ADEOF ;YES SAY SO
01800 SUB 2,3
01900 CAILE 2,1000 ;LESS THAN A FULL BUFFER?
02000 MOVEI 2,1000 ;NO GIVE ENTIRE AMOUNT
02100 MOVEM 2,IOCNT(CDB)
02150 NOCRYPT<
02200 AOS 2,IOPAGE(CDB) ;INCREMEMT PAGE, GET IN 2
02250 >
02260 CRYPT<
02265 MOVE 2,IOPAGE(CDB)
02270 ADDI 2,1 ;say which page we want
02280 >
02300 PUSHJ P,SETPAGE
02400 MOVE 2,IOADDR(CDB)
02500 HRLI 2,444400
02600 MOVEM 2,IOBP(CDB)
02700 ADRET: AOS -2(P)
02800 ADEOF: POP P,3
02900 POP P,2
03000 POPJ P,
03100
03200 BEND ADWI
03300
03400 ADWO:
03500 ;1,CDB LOADED
03600 ;ADVANCES WORD OUTPUT FROM DSK
03700 BEGIN ADWO
03800
03900 PUSH P,2
03950 NOCRYPT<
04000 AOS 2,IOPAGE(CDB) ;NEXT PAGE OF THE FILE
04050 >
04060 CRYPT<
04070 MOVE 2,IOPAGE(CDB) ;say which page we want
04080 ADDI 2,1
04090 >
04100 PUSHJ P,SETPAGE
04200 MOVEI 2,1000
04300 MOVEM 2,IOCNT(CDB)
04400 MOVE 2,IOADDR(CDB)
04500 HRLI 2,444400
04600 MOVEM 2,IOBP(CDB)
04700 POP P,2
04800 POPJ P,
04900
05000 BEND ADWO
00100 DSCR CHAR_CHARIN(CHANNEL)
00200
00300 HERE(CHARIN)
00400 BEGIN CHARIN
00500
00600 PUSHJ P,SAVE
00700 MOVE LPSA,X22
00800 LITCHN 1,-1(P),CHALIT
00900 SETZEOF
01000 MOVE CHNL,1 ;[CLH] DOINP NEEDS THIS
01100 DOSIMIO:
01200 SIMIO E,TABL,CERR ;SOSGE IOCNT(CDB)
01300 JRST .DOINP
01400 ILDB 2,IOBP(CDB)
01500 STOAC2: MOVEM 2,RACS+A(USER)
01600 JRST RESTR
01700
01800 TABL: JRST DOSETCI ;0 -- XNULL
01900 SOSGE IOCNT(CDB) ;1 -- XICHAR
02000 JRST .COSCI ;2 -- XOCHAR
02100 JRST .WISCI ;3 -- XIWORD
02200 JRST .WOSCI ;4 -- XOWORD
02300 SOSGE IOCNT(CDB) ;5 -- XCICHAR
02400 REPEAT 2,<JRST CERR> ;6,7 -- XCOCHAR,XCOWORD
02500 SOSGE IOCNT(CDB) ;10 -- XBYTE7
02600 SOSGE IOCNT(CDB) ;11 -- XDICHAR
02700 REPEAT 2,<JRST CERR> ;12,13 -- XDOCHAR,XDARR
02800
02900 .DOINP:
03000 PUSHJ P,DOINP ;READ NEXT BUFFER
03100 JRST DOSIMIO ;BUFFERED INPUT RETURN
03200 JRST IND ;CHARACTER IN D--DID A BIN
03300 JRST ADCIEOF ;EOF
03400
03500 ADCIEOF:SETZM RACS+A(USER) ;RETURN 0
03600 JRST INPEOF ;AND SAY EOF
03700 DOSETCI:
03800 PUSHJ P,SETCI
03900 JRST DOSIMIO
04000
04100
04200 .COSCI: PUSHJ P,COSCI
04300 JRST DOSIMIO
04400
04500 .WISCI: PUSHJ P,WISCI
04600 JRST DOSIMIO
04700
04800 .WOSCI: PUSHJ P,WOSCI
04900 JRST DOSIMIO
05000
05100 CERR: ERR <CHARIN: Illegal JFN, byte-size, or mode>,1
05200 JRST INPEOF ;INDICATE EOF AND RETURN
05300
05400 CHALIT: SETZM .SKIP.
05500 MOVE 1,-1(P) ;PICK UP JFN LITERALLY
05600 JSYS BIN
05700 JUMPN 2,STOAC2
05800 SETZM RACS+A(USER)
05900 JSYS GTSTS
06000 TESTE 2,1B8
06100 SETOM .SKIP.
06200 JRST RESTR
06300
06400 IND: MOVEM D,2 ;PUT IN 2
06500 JRST STOAC2 ;AND RETURN CHARACTER
06600
06700 BEND CHARIN
00100 DSCR STRING SIMPLE PROCEDURE SINI(INTEGER JFN,MAXLENGTH,BRKCHAR);
00200 Reads in a string of characters, terminated by BRKCHAR or
00300 reaching maxlength, whichever happens first.
00400
00500
00600 HERE(SINI)
00700 BEGIN SINI
00800
00900 PUSHJ P,SAVE
01000 MOVE LPSA,X44
01100 VALCHN 1,-3(P),CERR
01200 SETZEOF
01300 MOVE CHNL,1 ;[CLH] DOINP NEEDS THIS
01400 DOSIMIO:SKIPG C,-2(P)
01500 JRST NULRET
01600 SIMIO 2,TABL,CERR ;EXCH 1,C
01700 SKIPE SGLIGN(USER)
01800 PUSHJ P,INSET
01900 ADDM 1,REMCHR(USER)
02000 SKIPLE REMCHR(USER)
02100 PUSHJ P,STRNGC
02200 MOVE E,TOPBYTE(USER) ;BYTE POINTER TO TOP OF STRING SPACE
02300 PUSH SP,[0]
02400 PUSH SP,E
02500 EXCH 1,C ;1 HAS JFN, C HAS COUNT
02600 MOVN C,C
02700 IN1: SOSGE IOCNT(CDB)
02800 JRST .DOINP
02900 IN2: ILDB D,IOBP(CDB)
03000 IND: JUMPE D,IN1 ;IF EMPTY KEEP LOOKING
03100 CAMN D,-1(P) ;BREAK CHAR?
03200 JRST DOBRK ;YES
03300 IDPB D,E
03400 IN3: AOJL C,IN1 ;SUBTRACT 1 AND JUMP IF GREATER
03500
03600 SETOM .SKIP. ;INDICATE TERMINATED FOR COUNT
03700 DONE: ADDM C,REMCHR(USER) ;MAKE REMCHR HONEST
03800 MOVEM E,TOPBYTE(USER)
03900 ADD C,-2(P) ;GET ACTUAL NUMBER OF CHARACTERS
04000 ;TRANSFERRED
04100 HRROM C,-1(SP) ;SAVE COUNT FOR USER
04200 JRST RESTR
04300
04400 DOBRK: IDPB D,E ;SAVE THE BREAK CHARACTER (AS DOES THE SIN JSYS)
04500 MOVEM D,.SKIP. ;SAVE BREAK CHARACTER IN .SKIP. AS DOC. SAYS
04600 AOJ C, ;ADD 1 TO THE COUNT
04700 JRST DONE ;AND FINISH UP
04800
04900 CERR: ERR <SINI: Illegal JFN, illegal mode or byte size>,1
05000 NULRET: PUSH SP,[0] ;RETURN NULL STRING
05100 PUSH SP,[0]
05200 JRST RESTR
05300
05400 TABL: JRST DOSETCI ;0 -- XNULL
05500 EXCH 1,C ;1 -- XICHAR
05600 JRST .COSCI ;2 -- XOCHAR
05700 JRST .WISCI ;3 -- XIWORD
05800 JRST .WOSCI ;4 -- XOWORD
05900 EXCH 1,C ;5 -- XCICHAR
06000 JRST CERR ;6 -- XCOCHAR
06100 JRST CERR ;7 -- XCWORD
06200 EXCH 1,C ;10 -- XBYTE7
06300 EXCH 1,C ;11 -- XDICHAR
06400 REPEAT 2,<JRST CERR> ;12,13 -- XDOCHAR,XDARR
06500
06600 .DOINP: PUSHJ P,DOINP ;READ IN THE NEXT BUFFER
06700 JRST IN1 ;GOT IT
06800 JRST IND ;CHARACTER IN D
06900 DOEOF: SETOEOF ;END OF FILE
07000 JRST DONE
07100
07200 DOSETCI:
07300 PUSHJ P,SETCI
07400 JRST DOSIMIO
07500
07600 .COSCI: PUSHJ P,COSCI
07700 JRST DOSIMIO
07800
07900 .WISCI: PUSHJ P,WISCI
08000 JRST DOSIMIO
08100
08200 .WOSCI: PUSHJ P,WOSCI
08300 JRST DOSIMIO
08400
08500
08600 BEND SINI
08700
00100 COMMENT Input
00200
00300 DSCR "STRING"_INPUT(CHANNEL,BREAK TABLE NUMBER);
00400 CAL SAIL
00500 SID NO ACS SAVED BY INPUT!!!!!!
00600
00700
00800 .IN.:
00900 HERE (INPUT)
01000 MOVE USER,GOGTAB ;GET TABLE POINTER
01100 ;;%##% FOR BENEFIT OF ERROR ROUTINE
01200 MOVE TEMP,(P)
01300 MOVEM TEMP,UUO1(USER)
01400 ;;%##%
01500 MOVEM RF,RACS+RF(USER);SAVE F-REGISTER
01600 SKIPE SGLIGN(USER)
01700 PUSHJ P,INSET
01800
01900 VALCHN 1,-2(P),INPBAD ;MOSTLY EXTRA CODE REALLY
02000 INPSIM:
02100 SIMIO E,INPTBL,INPBAD ;MOVE X,-1(P) ; TABLE NUMBER
02200
02300 MOVEI TEMP,-1 ;ERROR IF BLOCK NOT THERE OR TABLE NOT INIT'ED
02400 PUSHJ P,BKTCHK ;CHECK TABLE #
02500 JRST [PUSH SP,[0] ;ERROR
02600 PUSH SP,[0]
02700 SUB P,X33
02800 JRST @3(P)]
02900 PUSH P,CDB ;SAVE POINTER TO CORGET BLOCK
03000 PUSH P,CHNL ;SAVE RANGE 1 TO 18
03100
03200 MOVE CHNL,-4(P) ;CHANNEL NUMBER -- ALREADY CHECKED
03300 MOVE CDB,CDBTBL(CHNL)
03400 HRRZ CHNL,JFNTBL(CHNL);ALREADY CHECKED ABOVE
03500 ;;;; LDB E,[POINT 4,OFL(CDB),9] ;DATA MODE
03600 SETZEOF
03700 SKIPE BRCHAR(CDB) ;BRCHAR LOCATION
03800 SETZM @BRCHAR(CDB) ;ASSUME NO BREAK CHAR
03900 MOVEI A,=200 ;DEFAULT NO. OF CHARS
04000 SKIPE ICOUNT(CDB) ;USER-SPECIFIED COUNT?
04100 HRRZ A,@ICOUNT(CDB) ;MAX COUNT FOR INPUT STRING
04200 ADDM A,REMCHR(USER)
04300 SKIPLE REMCHR(USER) ;ENOUGH ROOM?
04400 PUSHJ P,STRNGC ;NO, TRY TO GET SOME
04500
04600 POP P,TEMP
04700 MOVE FF,BRKMSK(TEMP) ;BITS FOR THIS TABLE
04800 POP P,LPSA ;LPSA POINTS AT CORGET BLOCK FOR BREAK TABLES
04900 ADD TEMP,LPSA ;TEMP IS RELOCATED 1 TO 18
05000 MOVEM TEMP,-1(P) ;SAVE RELOCATED 1 TO 18 ON STACK
05100 MOVEI Z,1 ;FOR TESTING LINE NUMBERS
05200 SKIPN LINTBL(TEMP) ;DON'T LET TEST SUCCEED IF
05300 MOVEI Z,0 ;WE'RE TO LET LINE NUMBERS THRU
05400
05500 MOVN B,A ;NEGATE MAX CHAR COUNT
05600 PUSH SP,[0] ;LEAVE ROOM FOR FIRST STR WORD
05700 PUSH SP,TOPBYTE(USER) ;SECOND STRING WORD
05800 MOVE Y,LPSA
05900 ADD Y,[XWD D,BRKTBL] ;BRKTBL+RLC(LPSA)
06000 JUMPE B,DONE1 ; BECAUSE THE AOJL WON'T
06100
06200 ;;%DQ% JFR 8-17-76
06300 TRNE FF,@BRKDUM(LPSA);TREAT NUL LIKE ORDINARY CITIZEN?
06400 TROA C,1 ;YES
06500 TRZ C,1 ;NO
06600 ;;%DQ% ^
06700 TRNE FF,@BRKCVT(LPSA) ;DOING UC COERCION?
06800 TLOA C,400000 ;YES
06900 TLZ C,400000 ;NO
07000
07100 .IN: SOSGE IOCNT(CDB) ;BUFFER EMPTY?
07200 JRST .DOINP
07300 IN1:
07400 ILDB D,IOBP(CDB) ;GET NEXT CHARACTER
07500 TDNE Z,@IOBP(CDB) ;LINE NUMBER (ALWAYS SKIPS IF NOT WORRIED)?
07600 JRST INLINN ;YES, GO SEE WHAT TO DO
07700 IN2:
07800 INB:
07900 ;;%DQ% JFR 8-17-76
08000 JUMPE D,[TRNN C,1 ;REALLY IGNORE 0'S ?
08100 JRST .IN ;YES
08200 JRST NOCV.I ];NO-- AND WE KNOW IT'S A 0, SO GET TO THE POINT
08300 ;;%DQ% ^
08400 CAILE D,14 ;FIRST CHECK
08500 JRST INB1 ;IF IN RANGE AT ALL
08600 CAIN D,12
08700 JRST INB2
08800 CAIE D,14 ;LF OR FF?
08900 JRST INB1 ;NO
09000 INB2: SKIPN LINNUM(CDB) ;COUNTING VIA SETPL FUNCTION??
09100 JRST INB1 ;NO
09200 TDNN FF,@Y ;SOMETHING SPECIAL FOR THIS CHARACTER?
09300 JRST INCR ;NO NOTHING SPECIAL
09400 HLLZ TEMP,@Y ;GET BITS FOR THIS CHAR
09500 TDNN TEMP,FF ;IGNORE?
09600 JRST INCR ;YES
09700 MOVE TEMP,-1(P) ;BREAKTABLE (RELOCATED)
09800 SKIPLE DSPTBL(TEMP) ;APPEND OR SKIP?
09900 JRST INB1 ;YES
10000 INCR: CAIN D,12 ;LINE-FEED?
10100 AOS @LINNUM(CDB) ;INDICATE ANOTHER LINE
10200 CAIE D,14 ;FORM-FEED?
10300 JRST INB1 ;NO
10400 SKIPE PAGNUM(CDB)
10500 AOS @PAGNUM(CDB) ;COUNT PAGES ALSO
10600 SKIPE LINNUM(CDB)
10700 SETZM @LINNUM(CDB) ;SET LINNUM TO ZERO (NEW PAGE)
10800
10900 INB1: JUMPGE C,NOCV.I ;NOT COERCING?
11000 CAIL D,"a" ;ONLY COERCE LOWER CASE
11100 CAILE D,"z" ;
11200 JRST .+2 ;SPECIAL RHT "FAST SKIP"
11300 TRZ D,40 ;MAKE UPPER CASE
11400
11500 NOCV.I: TDNE FF,@Y ;MUST WE DO SOMETHING SPECIAL?
11600 JRST INSPC ;YES, HANDLE
11700
11800 MOVEC: IDPB D,TOPBYTE(USER) ;LENGTHEN STRING
11900 AOJL B,.IN ;GET SOME MORE
12000 JRST DONE1
12100
12200 INSPC: HLLZ TEMP,@Y ;IGNORE OR BREAK?
12300 TDNN TEMP,FF ; (CHOOSE ONE)
12400 JRST .IN ;IGNORE
12500
12600 ; BREAK -- STORE BREAK CHAR, FINISH OFF
12700
12800 DONE: SKIPE BRCHAR(CDB) ;USER BRCHAR VAR?
12900 MOVEM D,@BRCHAR(CDB) ;STORE BREAK CHAR
13000 MOVE TEMP,-1(P) ;RELOCATED 1 TO 18
13100 SKIPN Y,DSPTBL(TEMP) ;WHAT TO DO WITH BREAK CHAR?
13200 JRST DONE1 ;SKIP IT
13300 JUMPL Y,APPEND ;ADD TO END OF INPUT STRING
13400
13500 RETAIN: PUSHJ P,BACKUP
13600 JRST DONE1
13700
13800 APPEND: IDPB D,TOPBYTE(USER) ;PUT ON END
13900 AOJA B,DONE1 ;ONE MORE TO COUNT
14000
14100
14200 ; DONE -- MARK STRING COUNT WORD
14300
14400 DONE1: ADDM B,REMCHR(USER) ;GIVE UP THOSE NOT USED
14500 SKIPN ICOUNT(CDB) ;USER SUPPLIED COUNT?
14600 JRST [ADDI B,=200 ;USER DEFAULT
14700 JRST .+2]
14800 ADD B,@ICOUNT(CDB) ;HOW MANY DID WE ACTUALLY GET?
14900 ;;#GI# DCS 2-5-72 REMOVE TOPSTR
15000 HRROM B,-1(SP) ;MARK RESULT, NON-CONSTANT
15100 ;;#GI#
15200 MOVE RF,RACS+RF(USER);GET F-REGISTER BACK
15300 SUB P,X33 ;REMOVE INPUT PARAMETER, RETURN ADDRESS
15400 JRST @3(P) ;RETURN
15500
15600 ; CAN EITHER DELETE LINE NUMBER (Y GT 0) OR STOP,
15700 ; TELL THE USER (BRCHAR=-1), AND MARK LINE NUMBER
15800 ; NOT A LINE NUMBER FOR NEXT TIME
15900
16000
16100
16200
00100 .DOINP: PUSHJ P,DOINP
00200 JRST .IN ;NORMAL BUFFERED RETURN
00300 JRST INB ;7-BIT, CHAR IN D
00400 JRST DONE1 ;EOF OR ERROR
00500
00600 BEGIN INPTBL
00700
00800 ^INPTBL:JRST DOSETCI ;0 -- XNULL
00900 MOVE X,-1(P) ;1 -- XICHAR
01000 JRST .COSCI ;2 -- XOCHAR
01100 JRST .WISCI ;3 -- XIWORD
01200 JRST .WOSCI ;4 -- XOWORD
01300 MOVE X,-1(P) ;5 -- XCICHAR
01400 REPEAT 2,<JRST INPBAD> ;6,7
01500 MOVE X,-1(P) ;10 -- XBYTE7
01600 MOVE X,-1(P) ;11 -- XDICHAR
01700 REPEAT 2,<JRST INPBAD> ;12,13
01800
01900 DOSETCI:
02000 PUSHJ P,SETCI
02100 JRST INPSIM
02200
02300 .COSCI: PUSHJ P,COSCI
02400 JRST INPSIM
02500
02600 .WISCI: PUSHJ P,WISCI
02700 JRST INPSIM
02800
02900 .WOSCI: PUSHJ P,WOSCI
03000 JRST INPSIM
03100
03200
03300 BEND INPTBL
03400
00100
00200 COMMENT BACKUP TO BACKUP JFN
00300
00400 ;CALL TO HERE WITH A PUSHJ, WITH CDB,CHNL LOADED [CHNL WITH THE JFN!]
00500 ^BACKUP:
00600 PUSH P,1
00700 LDB 1,[POINT 6,OFL(CDB),5] ;BYTE-SIZE
00800 CAIN 1,44
00900 JRST BACKU1
01000 SKIPE TTYINF(CDB) ;CONTROLLING TERMINAL?
01100 JRST BACTTY ;YES
01200 BACBKJ: HRRZ 1,CHNL ;THE JFN
01300 JSYS BKJFN
01400 ERR <BACKUP: Cannot do BKJFN jsys for RETAIN>,1
01500 BACRET: POP P,1
01600 POPJ P,
01700 BACKU1: SOS IOBP(CDB)
01800 IBP IOBP(CDB)
01900 IBP IOBP(CDB)
02000 IBP IOBP(CDB)
02100 IBP IOBP(CDB)
02200 AOS IOCNT(CDB)
02300 JRST BACRET
02400
02500 BACTTY: HRRZ 1,TTYINF(CDB)
02600 CAIN 1,TNXINP ;TENEX DEFAULT
02700 JRST BACBKJ ;YES, USE BKJFN
02800 CAIE 1,DECLED ;DEC STYLE?
02900 CAIN 1,TENXED ;OR TENEX?
03000 JRST BACKU1
03100 ERR <BACKUP: Illegal editing mode for controlling terminal>,1
03200 JRST BACKU1
03300
03400 ;LINE NUMBER STUFF
03500
03600 INLINN:
03700 NOPGNN:
03800 SKIPE SOSNUM(CDB) ;WANT THE NUMBER?
03900 JRST [MOVE TEMP,@IOBP(CDB) ;SAVE IT FOR THE USER
04000 MOVEM TEMP,@SOSNUM(CDB)
04100 JRST .+1]
04200 MOVE TEMP,-1(P) ;RELOCATED TABLE
04300 SKIPGE TEMP,LINTBL(TEMP) ;LINTBL+RLC+TABLE
04400 JRST GIVLIN ; WANTS IT NEXT TIME OR SOMETHING
04500
04600 JSP TEMP,EATLIN ;TOSS IT OUT, AND
04700 JRST .IN ; CONTINUE
04800
04900 EATLIN:
05000 AOS IOBP(CDB) ;FORGET IT ENTIRELY
05100 MOVNI A,5 ;INDICATE SKIPPING SIX
05200 ADDB A,IOCNT(CDB) ;IN COUNT
05300 JUMPGE A,(TEMP) ;OVERFLOW BUFFER??
05400 PUSHJ P,DOINP
05500 JRST OKLN ;36-BIT RETURN
05600 ERR <INPUT: 7-BIT BYTES CANNOT HAVE LINE NUMBERS>
05700 JRST DONE1 ;END-OF-FILE
05800 OKLN:
05900 IBP IOBP(CDB) ;GET OVER TAB FINALLY
06000 SOS IOCNT(CDB) ;IS THIS RIGHT -- RLS 12/74
06100 JRST (TEMP) ;AND CONTINUE
06200
06300
06400 GIVLIN: TRNE TEMP,-1 ;WANT LINE NO IN BRCHAR WORD?
06500 JRST GVLLN ;NO, WANTS IT NEXT TIME.
06600 SKIPL TEMP,@IOBP(CDB) ;NEGATED LINE NO
06700 MOVNS TEMP
06800 SKIPE BRCHAR(CDB) ;USER LOCATION?
06900 MOVEM TEMP,@BRCHAR(CDB) ;STORE WHERE HE WANTS IT
07000 JSP TEMP,EATLIN ;GO EAT UP LINE NUMBER AND
07100 JRST DONE1 ;FINISH UP
07200 GVLLN:
07300 SKIPE BRCHAR(CDB)
07400 SETOM @BRCHAR(CDB) ;TELL THE USER
07500 AOS IOCNT(CDB) ;REVERSE THE SOSLE
07600 MOVE Y,OFL(CDB) ;NOW CHECK TO SEE IF WE CAN DO THIS WITHOUT DISASTER
07700 TESTN Y,WRBIT ;WRITING?
07800 TESTE Y,APPBIT ;OR APPENDING?
07900 ERR <INPUT: Give line feature not implemented when reading and writing.
08000 Continuation will cause the line number to be modified.>
08100 MOVEI Y,1 ;TURN OFF LINE NUMBER
08200 ANDCAM Y,@IOBP(CDB) ; BIT
08300 MOVSI Y,070000 ;BACK UP BYTE POINTER
08400 ADDM Y,IOBP(CDB)
08500 JRST DONE1 ;FINISH OFF IN BAZE OF GORY
08600
08700 INPBAD: ERR <INPUT: Illegal JFN or bad input>
08800
00100 COMMENT Realin, Realscan
00200
00300 DSCR REAL_REALIN(CHANNEL NUMBER);
00400 CAL SAIL
00500
00600 HERE (REALIN)
00700 IFN ALWAYS,<BEGIN NUMIN>
00800 PUSHJ P,SAVE
00900 PUSHJ P,NUMIN ;SET UP TO GET CHARS FROM CHANNEL
01000 PUSHJ P,RLNIN ;GOBBLE A REAL NUMBER
01100 SNGL A,A
01200 INRETA: MOVEM A,RACS+A(USER)
01300 INRET: SKIPE BRCHAR(CDB) ;USER WANTS BREAK CHARACTER?
01400 MOVEM Z,@BRCHAR(CDB) ;FIX UP BREAK CHARACTER
01500 SOS IOBP(CDB) ;BACK UP TO GET IT NEXT TIME
01600 FOR II_1,4 <
01700 IBP IOBP(CDB)>
01800 AOS IOCNT(CDB)
01900 MOVE LPSA,X22 ;GET RID OF CHANNEL AND RET. WD
02000 JRST RESTR
02100
02200 HERE (REALSCAN)
02300 PUSHJ P,SAVE
02400 PUSHJ P,STRIN ;SET UP TO GET CHARS FROM A STRING
02500 PUSHJ P,RLNIN
02600 SNGL A,A
02700 STRRTA: MOVEM A,RACS+A(USER)
02800 STRRET:
02900 HRRZ X,-2(P)
03000 SOJ CDB, ;BACK UP BYTE POINTER
03100 FOR II_1,4<
03200 IBP CDB>
03300 MOVEM CDB,(X)
03400 AOJ CHNL,
03500 HRRM CHNL,-1(X)
03600 MOVEM Z,@-1(P) ;STORE BREAK CHARACTER
03700 MOVE LPSA,X33 ;GET RID OF BRK VAR, STR ADDR
03800 JRST RESTR
03900
04000 FNDDIG: ;FIND DIGIT OR DECIMAL POINT, KEEP TRACK OF SIGN
04100 EXCH A,(P) ;FIRST PUT "GET NEXT CHAR" INSTR ON STACK
04200 PUSH P,A ;AHEAD OF RETURN WORD
04300 FNDDI1: XCT -1(P) ;GET NEXT CHAR
04400 CAIL D,"0"
04500 CAILE D,"9"
04600 CAIN D,"."
04700 POPJ P,
04800 JUMPL D,.-1 ;END OF FILE OR STRING
04900 CAIN D,"-"
05000 TLOA FF,NUMNEG
05100 TLZ FF,NUMNEG ;SIGN MUST IMMEDIATELY PRECEDE NUMBER
05200 JRST FNDDI1
05300
05400 RLNIN:
05500 SETZ FF, ;ZERO FLAGS
05600 PUSHJ P,FNDDIG
05700 JUMPL D,.+2
05800 TLO FF,NUMSAW
05900 PUSHJ P,GETNUM ;TRY FOR AN INTEGER
06000 CAIE D,"."
06100 TRZA C,-1 ;NO DIGITS AFTER DEC PT.
06200 PUSHJ P,GETN1D ;FINISH UP FRACTION
06300 EXCH C,(P) ;DIGIT COUNTS NXTCHR INSTR
06400 PUSH P,X ;PARTIAL RESULT
06500 PUSH P,Y
06600 PUSH P,FF ;FLAGS
06700 PUSH P,C ;NXTCHR INSTR
06800 SETZ FF, ;EXPONENT FLAGS
06900 CAIE D,"@"
07000 CAIN D,"E"
07100 JRST [XCT (P) ;EAT A CHAR
07200 CAIE D,"@"
07300 CAIN D,"E"
07400 RLNIN2: XCT (P) ;ALLOW FOR TWO OF THESE
07500 CAIN D,"-"
07600 TLOA FF,NUMNEG
07700 CAIN D,"+"
07800 XCT (P) ;PAST SIGN
07900 PUSHJ P,GETNUM ;RECURSE FOR EXPONENT
08000 PUSHJ P,TZMUL ;GET EXPONENT AS AN INTEGER
08100 JUMPN C,RLNIN1
08200 ERR <NUMIN: Improper exponent>,1 ;NO DIGITS APPEARED
08300 JRST RLNIN1
08400 ]
08500 CAIN D,"D"
08600 JRST RLNIN2
08700 SETZB X,Y ;EXPONENT IS ZERO
08800 SETZ C, ;AND THERE WERE NO DIGITS IN IT
08900 RLNIN1:
09000 MOVE Z,D ;SAVE BRCHAR (COULD BE -1 FOR EOF)
09100 SUB P,X11 ;GET RID OF NXTCHR INSTR
09200 TLNN FF,NUMNEG
09300 SKIPA D,Y ;LOW WD OF EXPONENT
09400 MOVN D,Y ;EXPONENT WAS NEG
09500 POP P,FF ;FLAGS OF FRACTION
09600 ;-2(P): FRACTION DIGIT COUNTS
09700 ;-1(P), -0(P): FRACTION
09800 TLNN C,-1 ;IF ANY TRAILING ZEROES LEFT, A WHOPPING BIG EXP.
09900 SKIPE X ;HIGH PART HAD BETTER BE ZERO
10000 JRST [SUB P,X33 ;WIPE OUT FRACTION AND DIGIT COUNTS
10100 JRST DFSERR] ;AND COMPLAIN
10200 POP P,Y ;FRACTION PART
10300 POP P,X
10400 POP P,C ;DIGIT COUNTS OF FRACTON
10500 JRST DFSC
10600
10700 HEREFK(LREALIN,LREA.IN)
10800 PUSHJ P,SAVE
10900 PUSHJ P,NUMIN
11000 PUSHJ P,RLNIN
11100 DMOVEM A,RACS+A(USER)
11200 JRST INRET
11300
11400 HEREFK(LREALSCAN,LREA.SCAN)
11500 PUSHJ P,SAVE
11600 PUSHJ P,STRIN
11700 PUSHJ P,RLNIN
11800 DMOVEM A,RACS+A(USER)
11900 JRST STRRET
12000
12100 DSCR INTEGER_INTIN(CHANNEL NUMBER);
12200 CAL SAIL
12300
12400 HERE (INTIN)
12500 PUSHJ P,SAVE
12600 PUSHJ P,NUMIN
12700 PUSHJ P,RLNIN
12800 ;[clh] SNGL A,A
12900 PUSHJ P,RFIX
13000 JRST INRETA
13100
13200 repeat 0,< ;[clh]
13300 RFIX: ;SIGN(A)*FLOOR(ABS(A)+0.5)
13400 KI10< JUMPL A,.+3
13500 FIXR A,A
13600 POPJ P,
13700 MOVN A,A
13800 FIXR A,A
13900 MOVN A,A
14000 POPJ P,
14100 >;KI10
14200 NOKI10< JUMPL A,.+4
14300 FADRI A,(0.5) ;SORRY, 166 !
14400 FIX A,A
14500 POPJ P,
14600 MOVN A,A
14700 FADRI A,(0.5)
14800 FIX A,A
14900 MOVN A,A
15000 POPJ P,
15100 >;NOKI10
15200 > ;[clh] repeat 0
15300
15400 ;[clh] new routine to go straight from double precision to integer
15500 RFIX: ;SIGN(A)*FLOOR(ABS(A)+0.5)
15600 JUMPGE A,RFIX1 ;MAKE POSITIVE [ASSUME FF,NUMNEG IS STILL SET]
15700 KI10<
15800 DMOVN A,A
15900 >; KI10
16000 NOKI10<
16100 SETCA A,
16200 MOVN A+1,A+1
16300 TLZ A+1,400000
16400 JUMPN A+1,RFIX1
16500 AOJ A,
16600 >; NOKI10
16700 RFIX1: LDB C,[POINT 9,A,8] ;EXPONENT
16800 TLZ A,777000 ;CLEAR EXPONENT
16900 ASHC A,-233(C) ;SHIFT TO MAKE INTEGER
17000 JOV RFIXER
17100 TLNE B,200000 ;FRACTION .GE. 1/2?
17200 ADDI A,1 ;YES, ROUND UP
17300 JOV RFIXER
17400 TLNE FF,NUMNEG ;IF NEGATIVE, PUT BACK SIGN
17500 MOVN A,A
17600 POPJ P,
17700
17800 RFIXER: ERR <RFIX: Number too big>,1
17900 SETZ A,
18000 POPJ P,
18100 ;[clh] ^^
18200
18300 DSCR INTEGER_INTSCAN("STRING");
18400 CAL SAIL
18500
18600 HERE (INTSCAN)
18700 PUSHJ P,SAVE
18800 PUSHJ P,STRIN
18900 PUSHJ P,RLNIN
19000 ;[clh] SNGL A,A
19100 PUSHJ P,RFIX
19200 JRST STRRTA
19300
19400
00100 ;NUMIN -- CONTD.
00200
00300 NUMIN:
00400 ?NUMSIM:
00500 VALCHN 1,-2(P),NUMBAD ;1,CDB, CHNL LOADED
00600 SIMIO Z,NUMTBL,NUMBAD ;MOVE CHNL,1 ;JFN TO 1
00700 SKIPE ENDFL(CDB)
00800 SETZM @ENDFL(CDB)
00900 SETZM .SKIP.
01000 SKIPE BRCHAR(CDB)
01100 SETZM @BRCHAR(CDB)
01200
01300 MOVE A,[JSP A,NCH]
01400 MOVEI Z,1 ;FOR LINE NUMBER TEST
01500 POPJ P,
01600
01700 ; READ A CHARACTER FROM INPUT FILE -- FOR SCAN.
01800 NCH: SOSGE IOCNT(CDB); DECREMENT CHARACTER COUNT
01900 JRST NUMINP
02000
02100 NCH1: ILDB D,IOBP(CDB); LOAD BYTE
02200 TDNE Z,@IOBP(CDB); CHECK FOR LINE NUMBER
02300 JRST NCH5
02400 NCH1.1: SKIPN LINNUM(CDB) ;WANT SETPL THINGS?
02500 JRST (A) ;NO RETURN
02600 CAIN D,12 ;LINE FEED?
02700 AOS @LINNUM(CDB) ;YES
02800 CAIE D,14 ;FORM FEED?
02900 JRST (A) ;NOPE, NOTHING
03000 SKIPE PAGNUM(CDB)
03100 AOS @PAGNUM(CDB) ;INCREMENT PAGE COUNTER
03200 SKIPE LINNUM(CDB)
03300 SETZM @LINNUM(CDB) ;AND ZERO LINE COUNTER
03400 JRST (A); RETURN
03500
03600 NCH7: SETO D, ;EOF OR DATA ERROR.
03700 JRST (A)
03800
03900 NCH5: SKIPE SOSNUM(CDB) ;WANT SETPL STUFF?
04000 JRST [MOVE D,@IOBP(CDB)
04100 MOVEM D,@SOSNUM(CDB) ;INFORM USER ABOUT LINE NUMBER
04200 JRST .+1]
04300 AOS IOBP(CDB); WE HAVE A LINE NUMBER
04400 MOVNI D,5; MOVE OVER IT
04500 ADDB D,IOCNT(CDB)
04600 SKIPL D ;NOTHING LEFT?
04700 JRST NCH ;DO ANOTHER INPUT
04800 PUSHJ P,DOINP ;
04900 JRST NCH6 ;36-BIT RETURN -- MUST BE
05000 PUSHJ P,NUMBAD ;IMPOSSIBLE
05100 JRST NCH7 ;EOF OR SOME SUCH
05200
05300 NCH6: SOSGE IOCNT(CDB); REMOVE TAB
05400 JRST NCH7 ;NONE THERE OR ERROR
05500 IBP IOBP(CDB)
05600 JRST NCH
05700
05800 ;SETUP FOR STRING INPUT (REALSCAN, INTSCAN)
05900 STRIN:
06000 MOVE A,[JSP A,NCHA]
06100 HRRZ CHNL,-3(P) ;ADDR OF WD2
06200 MOVE CDB,(CHNL) ;BP
06300 HRRZ CHNL,-1(CHNL) ;LENGTH
06400 POPJ P,
06500
06600 ;READ A CHARACTER ROUTINE FOR STRINGS.
06700 NCHA: SOJL CHNL,NCH7
06800 ILDB D,CDB
06900 CAIN D,15
07000 JRST NCHA ;IGNORE CR
07100 JUMPE D,NCHA ;AND NUL
07200 JRST (A)
00100 ;LNUMIN NUMBER INPUT
00200 COMMENT
00300 These routines form a character-string
00400 to number conversion package. GETNUM eats characters one at a time
00500 until a non-digit is eaten; GETNUM then returns intermediate information
00600 which can be used by the other routines.
00700 GETNU1 is the routine to call
00800 after GETNUM when a decimal point is seen and you eventually want a floating
00900 point number.
01000
01100 GETNUM: -1(P) instruction to XCT, gets next character in D
01200 (P) return word
01300 D first digit
01400 result: as in GETNU1
01500
01600 GETNU1: X,Y double length partial integer result
01700 -1(P) instruction to XCT, gets next character in D
01800 (P) return word
01900 C # trailing zeroes ,, power of 10 scale factor
02000 D first digit
02100 result: X,Y double length partial integer result
02200 (P) instructin to XCT, gets next character in D
02300 FF flags (sign, overflow)
02400 C # trailing zeroes ,, scale factor + # digits since then
02500 D break character
02600
02700 MAKINT: X,Y double length partial integer result
02800 (P) return word
02900 FF sign flag
03000 C # trailing zeroes ,, junk
03100 result: A integer value
03200
03300 DFSC:
03400 X,Y double length partial integer result
03500 (P) return word
03600 FF flags
03700 C # trailing zeroes ,, # digits since decimal point
03800 D exponent
03900 result: A,B floating point value
04000
04100 AC USAGE:
04200
04300 FF flags
04400 A,B double temp return word for JSP NCH
04500 C #tz ,, # digits
04600 D char
04700 X,Y double integer partial result
04800 Z 1 (for testing line numbers)
04900 CHNL channel number, or # chars left in string
05000 CDB channel data block addr, or bp to string
05100 RF res.
05200 LPSA scale factor for DMUL gen.temp.
05300 TEMP gen. temp.
05400 USER res.
05500 SP res.
05600 P res.
05700
05800
05900 ;GETNUM GETNU1
06000
06100 NUMNEG__400000
06200 EXPNEG__200000
06300 NUMSAW__100000
06400
06500 GETNUC: XCT -1(P) ;GET A CHAR FIRST
06600 GETNUM:
06700 SETZB X,Y ;INITIAL RESULT
06800 SETZ C, ;DIGIT COUNTS
06900 JRST 2,@.+1 ;CLEAR FLAGS
07000 GETNU1
07100
07200 GETN1D: TRZA C,-1 ;NUMBER OF DIGITS SINCE DEC. PT IS ZERO
07300 GETN1E: AOBJN C,.+1 ;A TRAILING ZERO
07400 GETN1C: XCT -1(P) ;GET NEXT CHAR
07500 GETNU1: CAIL D,"0"
07600 CAILE D,"9"
07700 POPJ P, ;NOT DIGIT
07800 SUBI D,"0" ;CONVERT TO DIGIT NOW
07900 JUMPE D,GETN1E ;A TRAILING ZERO
08000 ADDI C,1 ;ANOTHER DIGIT
08100 TLNE C,-1 ;WERE THERE TRAILING ZEROES BEFORE IT?
08200 PUSHJ P,TZMUL ;YES
08300 PUSHJ P,M10ADD ;MULT BY =10 AND ADD D
08400 JRST GETN1C
08500
08600 TZMUL: HLRZ TEMP,C ;# TRAILING ZEROES
08700 JUMPE TEMP,CPOPJ ;QUIT IF NONE
08800 MOVEI C,(C) ;WILL BE NONE IF WE FINISH WITHOUT OVERFLOW
08900 JUMPN Y,.+2 ;[CLH] IF X,Y=0, NOTHING TO DO
09000 JUMPE X,CPOPJ ;[CLH]
09100 MOVEI LPSA,(D) ;SAVE DIGIT
09200 SETZ D,
09300 PUSHJ P,M10ADD ;ADJUST VALUE TO ACCOUNT FOR TRAILING ZEROES
09400 SOJG TEMP,.-2
09500 MOVEI D,(LPSA) ;RESTORE D
09600 POPJ P,
09700
09800 M10ADD:
09900 MOVE A,Y ;LOW HALF
10000 MULI A,=10
10100 TLO A+1,400000 ;PREVENT OVERFLOW
10200 ADDI A+1,(D) ;ADD NEW DIGIT
10300 TLZN A+1,400000 ;WOULD THERE HAVE BEEN AN OVERFLOW?
10400 ADDI A,1 ;YES. (THIS CAN'T OVERFLOW; A WAS AT MOST 9)
10500 MOVE D,X ;HIGH HALF
10600 IMULI D,=10
10700 JOV [ADD C,X11 ;PRETEND WE HAD A TRAILING ZERO
10800 SOJA C,CPOPJ]
10900 TLO D,400000 ;PREVENT OVERFLOW
11000 ADDI D,(A) ;CARRY IN FROM LOW HALF
11100 TLZN D,400000 ;WOULD THERE HAVE BEEN AN OVERFLOW?
11200 JRST @.-4 ;YES
11300 MOVEM A+1,Y ;STORE LOW HALF
11400 MOVEM D,X ;AND HIGH HALF
11500 CPOPJ: POPJ P,
11600 ;DFSC
11700
11800 ; FF NUMNEG FLAG
11900 ; C # TRAILING ZEROES,, # DIGITS SINCE DECIMAL PT.
12000 ; D EXPONENT
12100 ; X,Y FRACTION
12200
12300 DFSC:
12400 MOVE A,X ;BEGIN CONVERTING TO PURE FRACTION
12500 JFFO A,DFSC1
12600 MOVE A,X+1 ;HIGH WD WAS ZERO
12700 JFFO A,.+1
12800 ADDI A+1,=35
12900 DFSC1: MOVEI LPSA,-1(A+1) ;# OF PLACES TO SHIFT (REMEMBER SIGN BIT)
13000 ASHC X,(LPSA) ;MAKE INTO PURE FRACTION
13100 SUBI LPSA,=70
13200 MOVN LPSA,LPSA ;EXPONENT OF 2 OF FRACTION
13300
13400 ;***** SOMETHING FISHY HERE. CONSIDER 12345.98@3
13500 SUBI D,(C) ;DIGITS SINCE DECIMAL POINT DECREASE THE EXPONENT
13600 HLRZ C,C
13700 ADDI D,(C) ;BUT TRAILING ZEROES DONT COUNT
13800 JUMPE D,DFSC2 ;EXPONENT OF 10 IS ZERO
13900 JUMPG D,DFSC3
14000 TLO FF,EXPNEG ;EXPONENT WAS NEG
14100 MOVN D,D
14200 SKIPA TEMP,[EXP.M1,,FR.M1] ;USE THIS TABLE SINCE EXP WAS NEG
14300 DFSC3: MOVE TEMP,[EXP.P1,,FR.P1] ;EXP WAS POS
14400 TRNE D,777700 ;CHECK EXPONENT RANGE
14500 JRST DFSERR
14600 TRNE D,40 ;E+-32 INVOLVED?
14700 TLNE FF,EXPNEG ;YES. TOO BAD IF E-48
14800 JRST MULOOP ;OK
14900 TRNE D,20 ;E-48 ?
15000 JRST DFSERR
15100 MULOOP: TRZE D,1 ;SHOULD WE MULTIPLY?
15200 PUSHJ P,DMUL.. ;YES
15300 JUMPE D,DFSC2
15400 ASH D,-1 ;NEXT BIT INTO POSITION
15500 AOBJN TEMP,.+1 ;ADD 1 TO LH
15600 AOJA TEMP,MULOOP ;AND 2 TO RH
15700
15800 DFSC2:
15900 KI10< DMOVE A,X >;KI10
16000 NOKI10< MOVE A,X
16100 MOVE A+1,X+1 >;NOKI10
16200 ASHC A,-8 ;MAKE ROOM FOR EXPONENT
16300 FSC A,200(LPSA) ;INSERT IT
16400 JFOV DFSERR
16500 DFSC4:
16600 JUMPGE Z,.+3 ;IF RAN OUT OF CHARS
16700 TLNE FF,NUMSAW ; AND SAW NUMBER
16800 MOVEI Z,0 ; THEN FLAG IT THIS WAY
16900 KI10< TLNE FF,NUMNEG
17000 DMOVN A,A
17100 POPJ P,
17200 >;KI10
17300 NOKI10< TLNN FF,NUMNEG
17400 POPJ P,
17500 SETCA A, ;ONES COMPLEMENT OF HIGH WORD
17600 MOVN A+1,A+1 ;TWOS COMPLEMENT OF LOW WORD
17700 TLZ A+1,400000 ;FORCE SIGN BIT OFF
17800 JUMPN A+1,CPOPJ ;IF LOW SIGNIFICANCE, DONE
17900 AOJA A,CPOPJ ;OTHERWISE TWOS COMPLEMENT OF HIGH WORD
18000 >;NOKI10
18100
18200 DFSERR: ERR <NUMIN: Exponent range exceeded>,1
18300 SETOB A,A+1
18400 TLNN FF,EXPNEG
18500 TLZA A,400000 ;EXPONENT WAS POS, GIVE AN INFINITY
18600 SETZB A,A+1 ;EXPONENT WAS NEG, GIVE ZERO
18700 JRST DFSC4 ;OF RIGHT SIGN
18800 ;DMUL..
18900 ;MULTIPLY TWO DOUBLE-LENGTH PURE FRACTIONS. ONE IS (TEMP), OTHER IS X,Y PAIR
19000 ;RETURN DOUBLE-LENGTH RESULT IN X,Y
19100 ;SCALE FACTOR KEPT IN LPSA
19200
19300 DMUL..:
19400 NOKL10< PUSH P,X ;SAVE HIGH
19500 SETZM X ;1ST WORD, FINAL PRODUCT
19600 MOVE A,(TEMP) ;HIGH
19700 MULM A,Y ;* LOW
19800 ;IGNORING 3RD WORDS: 8 EXPONENT BITS TO BURN
19900 MOVE A,1(TEMP) ;LOW
20000 MUL A,(P) ;* HIGH
20100 TLO A,400000 ;PREVENT OVERFLOWS
20200 ADD A,Y ;ADD 2ND WORDS
20300 TLZN A,400000 ;WOULD THERE HAVE BEEN AN OVERFLOW?
20400 AOS X ;YES, DO CARRY (SETS X TO 1)
20500 MOVEM A,Y ;STORE LOW RESULT
20600 POP P,A ;HIGH
20700 MUL A,(TEMP) ;* HIGH
20800 TLO A+1,400000 ;PREVENT OVERFLOW
20900 ADD A+1,Y ;COLLECT 2ND WORD
21000 TLZN A+1,400000 ;WOULD THERE HAVE BEEN AN OVERFLOW?
21100 ADDI A,1 ;YES
21200 ADD A,X ;COLLECT 1ST WORD (THIS CAN'T OVERFLOW)
21300 >;NOKL10
21400 KL10<
21500 DMOVE A,X
21600 DMOVEM A+2,X
21700 DMUL A,(TEMP)
21800 DMOVE A+2,X
21900 >;KL10
22000 TLNE A,(1B1) ;NORMALIZED FRACTION?
22100 JRST .+3 ;YES
22200 ASHC A,1 ;NO, SHIFT OVER
22300 SUBI LPSA,1 ;AND ADJUST EXPONENT
22400 MOVS TEMP,TEMP ;COLLECT EXPONENT CHANGES
22500 ADD LPSA,(TEMP)
22600 MOVS TEMP,TEMP
22700 MOVEM A,X ;STORE RESULT SO FAR
22800 MOVEM A+1,Y
22900 POPJ P,
23000
23100 FR.P1: 240000,,0 ;10^1 PURE FRACTION PART
23200 0
23300 310000,,0 ;10^2
23400 0
23500 234200,,0 ;10^4
23600 0
23700 276570,,200000 ;10^8
23800 0
23900 216067,,446770 ;10^16
24000 040000,,0
24100 235613,,266501 ;10^32
24200 133413,,263574
24300 EXP.P1: 4 ;POWER OF 2 EXPONENT PART
24400 7
24500 16
24600 33
24700 66
24800 153
24900
25000 FR.M1: 314631,,463146 ;10^-1
25100 146314,,631463
25200 243656,,050753 ;10^-2
25300 205075,,314217
25400 321556,,135307 ;10^-4
25500 020626,,245364
25600 253630,,734214 ;10^-8
25700 043034,,737425
25800 346453,,122766 ;10^-16
25900 042336,,053314
26000 317542,,172552 ;10^-32
26100 051631,,227215
26200 EXP.M1: -3
26300 -6
26400 -15
26500 -32
26600 -65
26700 -152
26800
00100
00200 NUMBAD: ERR<NUMIN: Illegal JFN, byte-size or mode>
00300 POPJ P,
00400
00500 BEGIN NUMTBL
00600
00700 ^NUMTBL:JRST DOSETCI ;0 -- XNULL
00800 MOVE CHNL,1 ;1 -- XICHAR
00900 JRST .COSCI ;2 -- XOCHAR
01000 JRST .WISCI ;3 -- XIWORD
01100 JRST .WOSCI ;4 -- XOWORD
01200 MOVE CHNL,1 ;5 -- XCICHAR
01300 REPEAT 2,<JRST NUMBAD> ;6,7
01400 MOVE CHNL,1 ;10 -- XBYTE7
01500 MOVE CHNL,1 ;11 -- XDICHAR
01600 REPEAT 2,<JRST NUMBAD> ;12,13
01700
01800 DOSETCI:
01900 PUSHJ P,SETCI
02000 JRST NUMSIM
02100
02200 .COSCI: PUSHJ P,COSCI
02300 JRST NUMSIM
02400
02500 .WISCI: PUSHJ P,WISCI
02600 JRST NUMSIM
02700
02800 .WOSCI: PUSHJ P,WOSCI
02900 JRST NUMSIM
03000
03100 BEND NUMTBL
03200
03300 NUMINP: PUSHJ P,DOINP
03400 JRST NCH ;BUFFERED INPUT
03500 JRST NCH1.1 ;7-BIT
03600 JRST NCH7 ;EOF OR ERROR
03700
03800
03900 RZ: SETZ A,
04000 JRST DONE
04100 ENDCOM(NUM)
04200 COMPIL(TBB,<.CH.,.TEN.,.MT.>,,<TABLES FOR L PAUL'S ROUTINES>)
00100 DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
00200
00300
00400 ^^.CH.: 4
00500 7
00600 16
00700 33
00800 66
00900 153
01000 777777777775
01100 777777777772
01200 777777777763
01300 777777777746
01400 777777777713
01500 777777777626
01600 ^^.MT.: 240000000000
01700 310000000000
01800 234200000000
01900 276570200000
02000 216067446770
02100 235613266501
02200 314631463147
02300 243656050754
02400 321556135310
02500 253630734215
02600 346453122767
02700 317542172553
02800 ^^.TEN.: 1
02900 =10
03000 =100
03100 =1000
03200 =10000
03300 =100000
03400 =1000000
03500 =10000000
03600 =100000000
03700 =1000000000
03800 =10000000000
03900
04000 ENDCOM(TBB)
04100 IFN ALWAYS,<
04200 BEND
04300 >;IFN ALWAYS
00100
00200 DSCR SIMPLE PROCEDURE CHAROUT(INTEGER JFN, CHAR)
00300
00400 HERE(CHAROUT)
00500 BEGIN CHAROUT
00600 PUSHJ P,SAVE
00700 MOVE LPSA,X33
00800 LITCHN 1,-2(P),CHOLIT
00900 DOSIMIO:SIMIO 3,TABL,CERR ;SOSGE IOCNT(CDB)
01000 PUSHJ P,ADCO1
01100 MOVE 2,-1(P)
01200 IDPB 2,IOBP(CDB)
01300 JRST RESTR
01400
01500 TABL: JRST DOSETCO ;0 -- XNULL
01600 JRST .CISCO ;1 -- XICHAR
01700 SOSGE IOCNT(CDB) ;2 -- XOCHAR
01800 JRST .WISCO ;3 -- XIWORD
01900 JRST .WOSCO ;4 -- XOWORD
02000 JRST CERR ;5 -- XCICHAR
02100 SOSGE IOCNT(CDB) ;6 -- XCOCHAR
02200 JRST CERR ;7 -- XCWORD
02300 JRST DOBOUT ;10 -- XBYTE7
02400 JRST CERR ;11 -- XDICHAR
02500 SOSGE IOCNT(CDB) ;12 -- XDOCHAR
02600 JRST CERR ;13 -- XDARR
02700
02800 DOSETCO:
02900 PUSHJ P,SETCO
03000 JRST DOSIMIO
03100
03200 .CISCO: PUSHJ P,CISCO
03300 JRST DOSIMIO
03400
03500 .WISCO: PUSHJ P,WISCO
03600 JRST DOSIMIO
03700
03800 .WOSCO: PUSHJ P,WOSCO
03900 JRST DOSIMIO
04000
04100 CERR: ERR <CHAROUT: Illegal JFN, byte-size, or mode.>,1
04200 JRST RESTR
04300
04400 CHOLIT:
04500 DOBOUT: MOVE 2,-1(P)
04600 JSYS BOUT
04700 JRST RESTR
04800
04900 BEND CHAROUT
00100
00200 DSCR SIMPLE PROCEDURE OUT(INTEGER JFN; STRING S)
00300
00400 HERE(OUT)
00500 BEGIN OUT
00600 PUSHJ P,SAVE
00700 MOVE LPSA,X22
00800 LITCHN 1,-1(P),CHKTTY
00900 DOSIMIO:SIMIO 2,TABL,CERR ;HRRZ 3,-1(SP)
01000 JUMPE 3,SOURET ;DONT SEND EMPTY STRING
01100 LOOP: SOSGE IOCNT(CDB) ;DECREMENT BUFFER COUNT
01200 PUSHJ P,ADCO1 ;GET NEW BUFFER
01300 ILDB 2,(SP) ;NEXT CHAR ON STRING
01400 IDPB 2,IOBP(CDB) ;AND COPY THE CHARACTER
01500 SOJG 3,LOOP ;STRING CHAR COUNT
01600
01700 SOURET: SUB SP,X22 ;ADJUST STRING STACK
01800 JRST RESTR
01900
02000 DOSOUT:
02100 SKIPE CTLOSW ;IF CONTROL-O AND
02200 SKIPN TTYINF(CDB) ;THE CONTROLLING TERMINAL
02300 JRST .+2
02400 JRST SOURET ;THEN DONT DO OUTPUT
02500 REPEAT 0,<;BUGS IN SOUT JSYS -- ARE THEY STILL THERE??
02600 DOSOU1: HRRZ 3,-1(SP)
02700 JUMPE 3,SOURET
02800 SOUT1: ILDB 2,(SP) ;NEXT CHAR
02900 JSYS BOUT
03000 SOJG 3,SOUT1 ;STRING CHAR COUNT
03100 JRST SOURET
03200 >;REPEAT 0
03300 DOSOU1:
03400 HRRZ 3,-1(SP) ;COUNT
03500 JUMPE 3,SOURET ;DONT SEND NULL STRING
03600 MOVE 2,(SP) ;STRING BP
03700 MOVN 3,3 ;NEGATIVE COUNT
03800 JSYS SOUT ;STRING OUTPUT
03900 JRST SOURET ;AND RETURN
04000
04100 CERR: ERR <OUT: Illegal JFN, byte-size, or mode>,1
04200 JRST SOURET
04300
04400 TABL: JRST DOSETCO ;0 -- XNULL
04500 JRST .CISCO ;1 -- XICHAR
04600 HRRZ 3,-1(SP) ;2 -- XOCHAR
04700 JRST .WISCO ;3 -- XIWORD
04800 JRST .WOSCO ;4 -- XOWORD
04900 JRST CERR ;5 -- XCICHAR
05000 HRRZ 3,-1(SP) ;6 -- XCOCHAR
05100 JRST CERR ;7 -- XCWORD
05200 JRST DOSOUT ;10 -- XBYTE7
05300 JRST CERR ;11 -- XDICHAR
05400 HRRZ 3,-1(SP) ;12 -- XDOCHAR
05500 JRST CERR ;13 -- XDARR
05600
05700 DOSETCO:
05800 PUSHJ P,SETCO
05900 JRST DOSIMIO
06000
06100 .CISCO: PUSHJ P,CISCO
06200 JRST DOSIMIO
06300
06400 .WISCO: PUSHJ P,WISCO
06500 JRST DOSIMIO
06600
06700 .WOSCO: PUSHJ P,WOSCO
06800 JRST DOSIMIO
06900
07000 CHKTTY:
07100 SKIPN CTLOSW ;CONTROL-O SWITCH ON?
07200 JRST DOSOU1 ;NO
07300 CAIE 1,100 ;CONTROLLING TERMINAL?
07400 CAIN 1,101
07500 JRST SOURET ;YES, RETURN
07600 JRST DOSOU1 ;NO, JUST DO IT
07700
07800
07900 BEND OUT
08000
00100 DSCR PROCEDURE LINOUT(INTEGER JFN,VALUE)
00200
00300
00400 HERE(LINOUT)
00500 BEGIN LINOUT
00600
00700 PUSHJ P,SAVE
00800 VALCHN A,-2(P),LINBAD
00900 DOSIMIO:SIMIO B,TABL,LINBAD ;SKIPG B,IOCNT(CDB)
01000 PUSHJ P,ADCO ;NO, SEND (OR PERHAPS JUST INITIALIZE)
01100 MOVE TEMP,IOBP(CDB) ;GET BP
01200
01300 LINOPL: TLNN TEMP,760000 ;LINED BP?
01400 JRST OKLIGN
01500 IBP TEMP
01600 SOJA B,LINOPL
01700
01800 OKLIGN: MOVEM TEMP,IOBP(CDB)
01900 MOVEM B,IOCNT(CDB)
02000 CAIGE B,=10 ;ENOUGH FOR 10 CHARS?
02100 PUSHJ P,ADCO ;NO
02200 SKIPGE B,-1(P) ;GET LINE-NO
02300 JRST [MOVNS B
02400 MOVNI A,5
02500 JRST NOCONV]
02600 MOVNI A,6
02700 MOVE C,[<ASCII /00000/>/2]
02800 EXCH B,C
02900 PUSH P,LNBAK
03000 LNCONV: IDIVI C,=10
03100 IORI D,"0"
03200 DPB D,[POINT 7,(P),6]
03300 SKIPE C
03400 PUSHJ P,LNCONV ;THE RECURSIVE PRINTER
03500 HLL C,(P)
03600 LSHC B,7
03700 LNBAK: POPJ P,.+1
03800 LSH B,1
03900 TRO B,1
04000 NOCONV: AOS C,IOBP(CDB) ;MOVE A WORD OUT
04100 MOVEM B,(C)
04200 ADDM A,IOCNT(CDB)
04300 MOVEI B,11
04400 CAME A,[-5]
04500 IDPB B,IOBP(CDB) ;OUTPUT A TAB
04600 NOTAB: MOVE LPSA,X33
04700 JRST RESTR
04800
04900 LINBAD: ERR <LINOUT: Illegal JFN, byte-size, or mode>,1
05000 JRST NOTAB
05100
05200 TABL: JRST DOSETCO ;0 -- XNULL
05300 JRST .CISCO ;1 -- XICHAR
05400 SKIPG B,IOCNT(CDB) ;2 -- XOCHAR
05500 JRST .WISCO ;3 -- XIWORD
05600 JRST .WOSCO ;4 -- XOWORD
05700 JRST LINBAD ;5 -- XCIWORD
05800 SKIPG B,IOCNT(CDB) ;6 -- XCOWORD
05900 JRST LINBAD ;7 -- XCWORD
06000 JRST LINBAD ;10 -- XBYTE7
06100 JRST LINBAD ;11 -- XDICHAR
06200 SKIPG B,IOCNT(CDB) ;12 -- XDOCHAR
06300 JRST LINBAD ;13 -- XDARR
06400
06500 DOSETCO:
06600 PUSHJ P,SETCO
06700 JRST DOSIMIO
06800
06900 .CISCO: PUSHJ P,CISCO
07000 JRST DOSIMIO
07100
07200 .WISCO: PUSHJ P,WISCO
07300 JRST DOSIMIO
07400
07500 .WOSCO: PUSHJ P,WOSCO
07600 JRST DOSIMIO
07700
07800
07900 BEND LINOUT
08000
00100 HERE(RCHPTR)
00200 BEGIN RCHPTR
00300 PUSHJ P,SAVE
00400 MOVE LPSA,X22
00500 VALCHN 1,-1(P),CERR
00600 SETZM .SKIP.
00700 DOSIMIO:SIMIO 2,TABL,CERR
00800 STOAC2: MOVEM 2,RACS+A(USER)
00900 JRST RESTR
01000
01100 TABL: JRST RNULL ;0 -- XNULL
01200 REPEAT 4,<PUSHJ P,GETCPT> ;1-4
01300 REPEAT 3,<JRST CERR> ;5-7
01400 JRST DORFPTR ;10 -- XBYTE7
01500 REPEAT 3,<JRST CERR>
01600
01700 DORFPTR:
01800 JSYS RFPTR
01900 JRST .+2
02000 JRST STOAC2
02100 ;HERE WITH AN ERROR FROM RFPTR
02200 MOVEM 1,.SKIP.
02300 JRST RNULL
02400
02500 CERR: ERR <RCHPTR: Illegal jfn, mode, or byte size>,1
02600 SETOM .SKIP.
02700 SETZM RACS+A(USER)
02800 JRST RESTR
02900
03000 RNULL:
03100 PUSHJ P,SETCIO
03200 JRST DOSIMIO
03300
03400 BEND RCHPTR
00100 HERE(SCHPTR)
00200 BEGIN SCHPTR
00300 PUSHJ P,SAVE
00400 MOVE LPSA,X33
00500 VALCHN 1,-2(P),CERR
00600 SETZM .SKIP.
00700 DOSIMIO:MOVE 2,-1(P) ;POINTER
00800 SIMIO 3,TABL,CERR
00900 JRST RESTR
01000
01100 TABL: JRST RNULL ;0 -- XNULL . Remember arg in 2
01200 PUSHJ P,SETCPT ;1 -- XICHAR
01300 PUSHJ P,SETCPT ;2 -- XOCHAR
01400 PUSHJ P,SETCPT ;3 -- XIWORD
01500 PUSHJ P,SETCPT ;4 -- XOWORD
01600 REPEAT 3,<JRST CERR> ;5-7
01700 JRST DOSFPTR ;10 -- XBYTE7
01800 REPEAT 3,<JRST CERR> ;11-13
01900
02000 RNULL:
02100 PUSHJ P,SETCIO
02200 JRST DOSIMIO ;BUT GET ARGUMENT AGAIN
02300
02400 DOSFPTR:
02500 JSYS SFPTR
02600 JRST .+2 ;ERROR IN 1
02700 JRST RESTR
02800 MOVEM 1,.SKIP.
02900 ERR <SCHPTR: Cannot do SFPTR>,1
03000 JRST RESTR
03100
03200 CERR: ERR <Dryrout at SCHPTR>,1
03300 SETOM .SKIP.
03400 JRST RESTR
03500
03600
03700 BEND SCHPTR
00100 DSCR Auxiliary routines for character i/o.
00200
00300
00400 SETCND:
00500 ;sets the FDB so tht the byte size is 7 and the number of bytes is as in 2
00600 ;1, CHNL, CDB loaded
00700 ;call is PUSHJ
00800 PUSH P,2
00900 PUSH P,3
01000 MOVEM 2,FDBEOF(CDB)
01100 HRLI 1,12 ;OFFSET
01200 MOVEM 2,3 ;NEW COUNT
01300 SETO 2, ;MASK FOR CHANGED BITS
01400 JSYS CHFDB ;NEW NUMBER OF BYTES TO END
01500 MOVEI 2,=7
01600 MOVEM 2,FDBSZ(CDB)
01700 HRLI 1,11
01800 MOVSI 2,007700 ;MASK
01900 MOVSI 3,000700 ;AND CHANGED BITS
02000 JSYS CHFDB ;NEW BYTE SIZE
02100 HRLI 1,0 ;LEAVE JFN IN 1
02200 POP P,3
02300 POP P,2
02400 POPJ P,
02500
02600 GETCND:
02700 ;returns in 2 the character count that addresses EOF according to the FDB
02800 ;1, CDB loaded
02900 BEGIN GETCND
03000 PUSH P,3
03100 SKIPN 3,FDBSZ(CDB)
03200 JRST RET0
03300 CAIN 3,=36 ;36 BITS?
03400 JRST RET2 ;YES
03500 CAIN 3,=7 ;7 BIT?
03600 JRST RET1 ;YES
03700 CAILE 3,=36 ;BETTER BE LEQ 36
03800 ERR <GETCND: Byte size bigger than 36 bits>,1
03900 PUSH P,4
04000 MOVEI 2,=36
04100 IDIVI 2,(3) ;GET THE NUMBER OF BYTES IN EACH 36-BIT WORD
04200 MOVE 3,FDBEOF(CDB) ;GET THE NUMBER OF BYTES IN THE FILE
04300 IDIVI 3,(2) ;THIS MANY WORDS -- EXTRA BYTES TO 3
04400 IMULI 3,5 ;THIS MANY CHARACTERS IN THE WORDS
04500 PUSH P,3 ;SAVE ON STACK
04600 MOVEI 2,(4) ;EXTRA BYTES
04700 IMUL 2,FDBSZ(CDB) ;EXTRA BITS
04800 IDIVI 2,5 ;CHARACTERS
04900 JUMPE 3,.+2 ;ANYTHING LEFT OVER?
05000 AOJ 2, ;YES
05100 POP P,3 ;GET BACK NUMBER OF CHARACTERS
05200 ADD 2,3 ;PLUS THE ADDITIONAL ONES HERE -- ANSWER IN 2
05300 POP P,4 ;RESTORE
05400 POPBACK:
05500 POP P,3
05600 POPJ P, ;RETURN ANSWER IN 2
05700
05800 RET0: SETZ 2,
05900 JRST POPBACK
06000
06100 RET1: MOVE 2,FDBEOF(CDB) ;7 BIT ALREADY
06200 JRST POPBACK
06300
06400 RET2: MOVE 2,FDBEOF(CDB) ;36 BIT BYTES
06500 IMULI 2,5 ;5 CHARACTERS PER BYTE
06600 JRST POPBACK ;RETURN IT
06700
06800 BEND GETCND
06900
07000 BEGIN GETCPT
07100 ;ROUTINES FOR CHAR EOB
07200
07300 ^^GETCPT:
07400 ;1,CDB LOADED
07500 ;RETURNS IN 2 THE END OF BUFFER CHARACTER
07600 SKIPN 2,IOBP(CDB)
07700 POPJ P, ;RETURN 0
07800 PUSH P,3
07900 TLZ 2,007700
08000 TLO 2,000700 ;MAKE A 7-BIT POINTER
08100 IBP 2 ;INCREMENT
08200 HRRZM 2,3 ;ADDRESS
08300 HRRI 2,BYTES
08400 LDB 2,2
08500 SUB 3,IOADDR(CDB) ;SUBTRACT
08600 IMULI 3,5 ;CHARACTERS
08700 ADDI 3,(2) ;PLUS THESE IN EXTRA WORD
08800 MOVE 2,IOPAGE(CDB)
08900 IMULI 2,1000*5 ;PREVIOUS PAGES IN THE FILE
09000 ADDI 2,(3) ;PLUS THESE
09100 POP P,3
09200 POPJ P, ;RETURN IN 2
09300
09400
09500 ^^GTCPT1:
09600 ;1, CHNL, CDB loaded
09700 ;call PUSHJ
09800 ;returns the following
09900 ; 2 how many characters until the end of the buffer
10000 ; 3 bp to first free character
10100 ; 4 count for character output
10200 ; 5 count for character input
10300 SKIPN 3,IOBP(CDB)
10400 JRST RET
10500 TLZ 3,007700
10600 TLO 3,000700 ;MAKE A 7-BIT POINTER
10700 MOVEM 3,2 ;COPY IN 2
10800 IBP 2
10900 HRRZM 2,4 ;ADDRESS
11000 HRRI 2,BYTES
11100 LDB 2,2 ;NUMBER OF ADDTL CHARS
11200 SUB 4,IOADDR(CDB) ;ADDRESS OF BUFFER
11300 IMULI 4,5
11400 ADDI 4,(2)
11500 MOVE 2,IOPAGE(CDB)
11600 IMULI 2,1000*5
11700 ADDI 2,(4)
11800 MOVNI 4,(4)
11900 ADDI 4,1000*5
12000 MOVEM 2,5 ;SAVE 2
12100 PUSHJ P,GETCND ;GET CHAR EOF
12200 EXCH 5,2
12300 SUB 5,2
12400 CAML 5,4
12500 MOVEM 4,5
12600 POPJ P,
12700
12800 BYTES: BYTE (7) 0,1,2,3,4
12900
13000 RET: SETZB 2,3 ;NOT INITIALIZED
13100 SETZB 4,5
13200 POPJ P,
13300
13400 BEND GETCPT
13500
13600 CHCEOF:
13700 ;CHECKS TO SEE IF CHARACTER EOF POINTER NEEDS RESETTING
13800 ;1, CDB LOADED
13900 SKIPN IOBP(CDB) ;DONT CHECK IF NOTHING THERE
14000 POPJ P,
14100 PUSH P,2
14200 PUSH P,3
14300 PUSHJ P,GETCND ;GET CHARACTER EOF IN 2
14400 MOVEM 2,3 ;SAVE IN 6
14500 PUSHJ P,GETCPT ;GET CHARACTER EOB IN 2
14600 CAML 2,3 ;NEED RESETTING?
14700 PUSHJ P,SETCND ;YES
14800 POP P,3
14900 POP P,2
15000 POPJ P,
15100
00100 SETCPT:
00200 ;1,CDB LOADED
00300 ;2 HAS THE BYTE IN THE FILE TO SET TO
00400 BEGIN SETCPT
00500
00600 MOVE 3,IOSTT(CDB)
00700 CAIN 3,XOWORD ;PREVIOUSLY DOING WORD OUTPUT?
00800 PUSHJ P,CHWEOF ;YES CHECK EOF
00900 CAIN 3,XOCHAR ;PREVIOUSLY DOING CHAR OUTPUT
01000 PUSHJ P,CHCEOF ;CHECK EOF
01100 CAMN 2,[-1] ;WANT EOF?
01200 PUSHJ P,GETCND ;YES, GET IN 2
01300 IDIVI 2,1000*5 ;PAGE BEING REQUESTED
01400 CAME 2,IOPAGE(CDB) ;SAME AS CURRENT
01500 PUSHJ P,SETPAGE ;NO GET NEW PAGE
01600 MOVE 2,IOADDR(CDB)
01700 MOVEM 3,5 ;NUMBER OF CHARS IN THIS BUFFER
01800 IDIVI 3,5 ;WORDS TO 3, BYTES TO 4
01900 ADDI 2,(3) ;3 STILL HAS THE CHAR IN THIS PAGE
02000 HLL 2,BPS(4)
02100 MOVEM 2,IOBP(CDB)
02200 MOVE 3,IOSTT(CDB)
02300 CAIE 3,XICHAR
02400 CAIN 3,XIWORD
02500 JRST ASSUMIN
02600 MOVEI 3,XOCHAR
02700 MOVEM 3,IOSTT(CDB)
02800 FULBUF: MOVEI 3,1000*5
02900 SUBI3: SUBI 3,(5)
03000 STOAC3: MOVEM 3,IOCNT(CDB)
03100 POPJ P,
03200 ASSUMIN:
03300 MOVEI 3,XICHAR
03400 MOVEM 3,IOSTT(CDB)
03500 PUSHJ P,GETCND ;GET THE CHARACTER END OF FILE
03600 IDIVI 2,1000*5 ;PAGES IN 2, CHARS IN 3
03700 CAMGE 2,IOPAGE(CDB) ;IS REQUESTED PAGE BEYOND EOF?
03800 JRST EMPBUF ;YES, NO INPUT THERE
03900 CAME 2,IOPAGE(CDB) ;ON THIS PAGE?
04000 JRST FULBUF ;NO
04100 JRST SUBI3 ;SUBTRACT ALREADY COMMITTED
04200
04300 EMPBUF: SETZ 3,
04400 JRST STOAC3
04500
04600 BPS: POINT 7,0,-1
04700 POINT 7,0,6
04800 POINT 7,0,13
04900 POINT 7,0,20
05000 POINT 7,0,27
05100
05200 BEND SETCPT
00100 SETCIO:
00200 ;1,CDB LOADED
00300 ;DECIDE WHETHER TO SETCI OR SETCO
00400 MOVEI 3,SETCI ;ASSUME CHARACTER INPUT
00500 MOVE 2,OFL(CDB)
00600 TESTN 2,RDBIT ;DOING INPUT?
00700 MOVEI 3,SETCO ;NOPE ASSUME OUTPUT
00800 JRST (3) ;AND POPJ RETURN
00100 DSCR
00200 ADCI
00300
00400 Accepts: 1 jfn
00500 CDB channel data block
00600
00700 Call: PUSHJ
00800
00900 Returns: +1 for eof
01000 +2 for good input
01100
01200 Resets values in the CDB
01300
01400
01500 BEGIN ADCI
01600
01700 ^^ADCI: PUSH P,1
01800 PUSH P,2
01900 PUSH P,3
02000 SIMIO 2,TABL,ADCERR ;MOVE 3,IOPAGE(CDB)
02100 AOJ 3, ;NEXT PAGE
02200 IMULI 3,1000*5 ;NEXT CHARACTER
02300 PUSHJ P,GETCND ;CHARACTER EOF IN 2
02400 CAML 3,2 ;IS IT BEYOND
02500 JRST ADEOF ;YES -- CONFESS THAT IT IS
02600 SUB 2,3 ;COUNT CHARACTERS IN NEW BUFFER
02700 CAILE 2,1000*5 ;LESS THAN A FULL BUFFER
02800 MOVEI 2,1000*5 ;NO
02900 MOVEM 2,IOCNT(CDB)
02950 NOCRYPT<
03000 AOS 2,IOPAGE(CDB) ;INCREMENT PAGE COUNTER, GET IN 2
03050 >
03060 CRYPT<
03070 MOVE 2,IOPAGE(CDB) ;say which page we want
03080 ADDI 2,1
03090 >
03100 PUSHJ P,SETPAGE ;GET NEXT PAGE
03200 MOVE 2,IOADDR(CDB)
03300 HRLI 2,440700 ;MAKE A BYTE-POINTER
03400 MOVEM 2,IOBP(CDB)
03500 ADRET: AOS -3(P) ;INCREMENT PC WORD
03600 ADEOF: POP P,3 ;EOF -- DONT INCREMENT
03700 POP P,2
03800 POP P,1
03900 POPJ P, ;RETURN
04000
04100 TABL: JRST ADCERR ;0 -- XNULL
04200 MOVE 3,IOPAGE(CDB) ;1 -- XICHAR
04300 REPEAT 3,<JRST ADCERR> ;2-4
04400 JRST DOSIN ;5 -- XCICHAR
04500 REPEAT 3,<JRST ADCERR> ;6-10
04600 JRST DODUMPI ;11 -- XDICHAR
04700 REPEAT 2,<JRST ADCERR> ;12,13
04800
04900 ADCERR: ERR <Dryrot at ADCI>,1
05000 JRST ADEOF
05100
05200
05300 DOSIN: MOVE 2,IOADDR(CDB)
05400 HRL 3,2
05500 HRRI 3,1(2)
05600 SETZM (2)
05700 BLT 3,777(2)
05800 HRLI 2,444400
05900 MOVNI 3,1000
06000 JSYS SIN
06100 CAMG 3,[-1000]
06200 JRST [CAMN 3,[-1000] ;EOF?
06300 JRST ADEOF
06400 JRST .+1]
06500 ADDI 3,1000 ;NUMBER OF WORDS READ
06600 IMULI 3,5 ;NUMBER OF CHARACTERS
06700 STOCNT: MOVEM 3,IOCNT(CDB)
06800 MOVE 2,IOADDR(CDB)
06900 HRLI 2,440700
07000 MOVEM 2,IOBP(CDB)
07100 JRST ADRET ;AND RETURN
07200
07300 DODUMPI:
07400 PUSH P,1 ;SAVE JFN OVER POSSIBLE DUMPI ERROR
07500 PUSH P,4
07600 MOVE 3,IOADDR(CDB)
07700 HRL 2,3
07800 HRRI 2,1(3)
07900 SETZM (3)
08000 BLT 2,777(3)
08100 SOJ 3,
08200 HRLI 3,-1000 ;MAKE AN IOWD
08300 MOVEI 2,3 ;COMMAND LIST STARTS AT 3
08400 SETZ 4, ;AND ENDS AT 4
08500 JSYS DUMPI
08600 JRST DMIERR
08700 MOVEI 3,1000*5
08800 POP P,4
08900 POP P,1
09000 JRST STOCNT
09100
09200 DMIERR: CAIE 1,600220 ;EOF?
09300 ERR <ADCI: Dump mode input error>,1
09400 POP P,4 ;RESTORE
09500 POP P,1 ;PRECIOUS JFN
09600 MOVE 2,DVTYP(CDB) ;GET DEVICE TYPE
09700 CAIE 2,3 ;MAGTAPE?
09800 JRST ADEOF ;NO, JUST INDICATE EOF
09900 SETZ 2, ;MTOPR RESET
10000 JSYS MTOPR
10100 JRST ADEOF ;AND SAY WE ARE AT THE END OF THE FILE
10200
10300
10400 BEND ADCI
10500 DOINP:
10600 ;CHNL has the JFN
10700 ;CDB has the channel data block
10800 ;returns +1 for good buffered input
10900 ; +2 for 7-bit input with char in D
11000 ; +3 for eof or error
11100 BEGIN DOINP
11200 PUSH P,1 ;SAVE 1
11300 PUSH P,2
11400 MOVE 1,CHNL ;JFN
11500 MOVE D,IOSTT(CDB) ;D IS FREE
11600 CAIE D,XBYTE7 ;7-BIT?
11700 JRST DOBUFF
11800 SKIPE TTYINF(CDB) ;CONTROLLING TERMINAL?
11900 JRST CHKTTY ;YES
12000 DOBIN: JSYS BIN
12100 JUMPE 2,CHKEOF ;IF 0 MAY BE EOF
12200 MOVEM 2,D ;STORE
12300 JRST DOB7
12400 ;;; MOVE 2,DVTYP(CDB) ;IS THE DEVICE A TTY?
12500 ;;; CAIE 2,12 ;
12600 ;;; JRST DOB7
12700 ;;; CAIE 2,12 ;
12800 ;;; JRST DOB7 ;NO
12900 ;;; CAIN D,32 ;A CONTROL-Z?
13000 ;;; JRST DOIEOF ;YES INDICATE EOF
13100 ;;; CAIN D,37 ;PHONEY BBN EOL?
13200 ;;; MOVEI D,12 ;A LINE-FEED
13300 ;;; JRST DOB7 ;AND RETURN
13400
13500 CHKEOF: JSYS GTSTS ;BETTER CHECK
13600 TESTE 2,1B8
13700 JRST DOIEOF ;YEP
13800 SETZ D,
13900 JRST DOB7
14000
14100 DOIEOF: SETOM .SKIP.
14200 SKIPE ENDFL(CDB) ;SPECIFIED?
14300 SETOM @ENDFL(CDB) ;YES
14400 AOS -2(P)
14500 DOB7: AOS -2(P)
14600 DORET: POP P,2
14700 POP P,1
14800 POPJ P,
14900
15000
15100 DOBUFF:
15200 PUSHJ P,ADCI
15300 JRST DOIEOF ;INDICATE EOF
15400 JRST DORET
15500
15600 CHKTTY:
15700 MOVE 2,TTYINF(CDB) ;CHECK STATUS OF TTY
15800 TESTE 2,QTTEOF ;EOF QUED?
15900 JRST DOIEOF ;YES
16000 SETZM CTLOSW ;INDICATE REQUEST
16100 ;FOR INPUT
16200 HRRZ 2,2
16300 CAIN 2,TNXINP ;TENEX DEFAULT
16400 JRST DOBIN
16500 CAIN 2,TENXED ;TENEX STYLE EDITING?
16600 JRST TNXBUF ;YES
16700 CAIN 2,DECLED ;DEC STYLE BUFFERING?
16800 JRST DECBUF
16900 ERR <DOINP: Illegal buffering request for terminal>,1
17000
17100 IMSSS<
17200 TNXBUF:
17300 BEGIN TNXBUF
17400 ORIGCNT__ =1000
17500
17600 PUSH P,1
17700 PUSH P,2
17800 PUSH P,3
17900 HRRO 1,IOADDR(CDB) ;BP TO BUFFER FOR CHAN
18000 SETZ 3,
18100 MOVEI 2,ORIGCNT ;DEFAULT LENGTH
18200 JSYS PSTIN
18300 MOVEI 3,ORIGCNT ;MAXIMUM
18400 SUBI 3,(2) ;GET NUMBER RECEIVED IN 3
18500 LDB 2,1 ;GET THE LAST CHAR
18600 CAIE 2,15 ;CARRIAGE RETURN (PROB!!)
18700 JRST NOTCR
18800 MOVEI 2,12 ;INSERT A 12 AFTER IT
18900 IDPB 2,1
19000 AOJ 3, ;INCREMENT COUNT
19100 JRST GOTBRK ;BREAK TENDED
19200
19300 NOTCR:
19400 CAIE 2,32 ;EOF?
19500 JRST GOTBRK
19600 MOVE 2,[QTTEOF]
19700 ORM 2,TTYINF(CDB) ;QUE THE END OF FILE
19800 SOJ 3, ;SUBTRACT ONE FROM COUNT -- CTRL-Z
19900
20000 GOTBRK: MOVEM 3,IOCNT(CDB) ;SAVE COUNT
20100 MOVE 1,IOADDR(CDB)
20200 HRLI 1,440700 ;MAKE A BP
20300 MOVEM 1,IOBP(CDB) ;SAVE IT FOR USER
20400 POP P,3 ;RESTORE
20500 POP P,2
20600 POP P,1
20700 JRST DORET ;AND RETURN
20800
20900 BEND TNXBUF
21000 >;IMSSS
21100
21200 NOIMSSS<;NON-IMSSS VERSION OF INTTY FOR THOSE WHO SUFFER
21300 ;UNDER BBN'S LACK OF A SYSTEM LINE EDITOR
21400 ; March, 1978
21500 ; R. Smith
21600 ; Rutgers University
21700 ; Runtime-test added for TOPS20, to use RDTTY JSYS
21800 ;instead of buffering code. If a conditional-assembly switch
21900 ;is ever added for TOPS20, this should be accomplished at
22000 ;assembly time.
22100
22200 TNXBUF:
22300 BEGIN TNXBUF
22400 ORIGCNT__ =200
22500 ;AC USES A,B,C JSYS TEMPORARIES
22600 ; D BYTEPOINTER
22700 ; E COUNT, INITIALLY 0
22800 ; Q1 (=6) ORIGINAL BP
22900 PUSH P,A ;SAVE
23000 PUSH P,B
23100 PUSH P,C
23200 PUSH P,D
23300 PUSH P,E
23400 PUSH P,Q1
23500 MOVE Q1,IOADDR(CDB)
23600 HRLI Q1,440700 ;MAKE A BP
23700 TSTT20: SKIPN $OSTYP ;[CLH] SKIP IF TOPS-20
23800 JRST ISTENEX ;TENEX
23900 IST20: MOVE A,Q1 ;USE BP
24000 HRLI B,(1B1) ;BREAK OF ALL TOPS-10
24100 HRRI B,ORIGCNT ;COUNT
24200 SETZ C, ;NO CONTROL-R FEATURE
24300 OPDEF RDTTY [104000000523]
24400 RDTTY ;DO IT
24500 JRST [ERR <RDTTY FAILED ON TOPS20?>,0]
24600 MOVEI E,ORIGCNT ;CALCULATE NUMBER OF BYTES LONG
24700 SUBI E,(B) ;SINCE RH(B) CONTAINS UPDATED CONT
24800 LDB A,A ;[CLH] GET TERMINATOR
24900 CAIN A,32 ;[CLH] IF ^Z
25000 JRST TEOF20 ;[CLH] THEN END OF FILE
25100 JRST CNTEXH ;STORE COUNT,BP, AND RETURN
25200
25300 ISTENEX:
25400 RESTRT: MOVE D,Q1 ;GET THE ORIGINAL BP
25500 SETZ E, ;ZERO THE COUNT
25600 INLUP: CAIL E,ORIGCNT
25700 JRST CNTEXH ;COUNT EXHAUSTED
25800 JSYS PBIN ;GET A CHAR
25900 CAIN A,37 ;EOL?
26000 JRST DOEOL ;YES
26100 CAIN A,12 ;LINE FEED (ON TOPS 20)
26200 JRST DONE ;YES
26300 CAIN A,33 ;ESCAPE?
26400 JRST DONE
26500 CAIN A,7 ;CTRL-G
26600 JRST DONE
26700 CAIN A,32 ;CTRL-Z
26800 JRST TTYEOF ;INDICATE EOF
26900 CAIN A,"R"-100 ;CTRL-R FOR REPEAT
27000 JRST DOCTR
27100 CAIN A,"X"-100 ;CTRL-Z FOR DELETE LINE
27200 JRST DOCTX ;YES
27300 CAIE A,177 ;EITHER RUBOUT
27400 CAIN A,"A"-100 ;OR CTRL-A
27500 JRST DOCTA ;FOR DELETE CHARACTER
27600 IDPB A,D
27700 AOJA E,INLUP ;CONTINUE
27800
27900 DOCTR: HRROI A,[ASCIZ/
28000 /]
28100 JSYS PSOUT
28200 JUMPE E,INLUP
28300 MOVEI A,101
28400 MOVE B,Q1 ;ORIG BP
28500 MOVN C,E ;COUNT THUS FAR
28600 JSYS SOUT
28700 JRST INLUP ;AND CONTINUE
28800
28900 DOCTX: HRROI A,[ASCIZ/
29000 /]
29100 JSYS PSOUT
29200 JRST RESTRT ;AND START ALL OVER
29300
29400 DOCTA: JUMPLE E,DOCTX ;IF NO CHARS THEN DO A CONTROL-X
29500 MOVEI A,"\"
29600 JSYS PBOUT
29700 LDB A,D ;LAST CHAR
29800 JSYS PBOUT
29900 SOJ D,
30000 IBP D
30100 IBP D
30200 IBP D
30300 IBP D
30400 SOJA E,INLUP ;SUBTRACT 1 AND CONTINUE
30500
30600 DOEOL:
30700 MOVEI A,15
30800 IDPB A,D
30900 AOJ E,
31000 MOVEI A,12
31100 DONE: IDPB A,D
31200 AOJ E,
31300 CNTEXH:
31400 MOVEM E,IOCNT(CDB) ;COUNT
31500 MOVEM Q1,IOBP(CDB) ;BP
31600 POP P,Q1 ;RESTORE
31700 POP P,E
31800 POP P,D
31900 POP P,C
32000 POP P,B
32100 POP P,A
32200 JRST DORET ;RETURN
32300
32400 TEOF20: SUBI E,1 ;[CLH] DON'T COUNT ^Z
32500
32600 TTYEOF: MOVE A,[QTTEOF]
32700 ORM A,TTYINF(CDB) ;QUE END-OF-FILE
32800 JRST CNTEXH ;AND RETURN
32900 BEND TNXBUF
33000 >;NOIMSSS
33100
33200 DECBUF:
33300 BEGIN DECBUF
33400
33500 ORIGCNT __ =1000 ;LOTS OF ROOM
33600
33700 PUSH P,A
33800 PUSH P,B
33900 PUSH P,C
34000 PUSH P,D
34100 PUSH P,E
34200 PUSH P,Q1
34300
34400 MOVE Q1,IOADDR(CDB)
34500 HRLI Q1,440700 ;MAKE A BP
34600
34700 RESTRT: MOVE D,Q1
34800 SETZ E, ;COUNT
34900 INLUP: CAIL E,ORIGCNT ;BEYOND?
35000 JRST CNTEXH ;YES
35100 JSYS PBIN
35200 CAIN A,DELLINE ;DELETE ENTIRE LINE?
35300 JRST CTRLU ;YES
35400 CAIN A,RUBCHAR ;RUBOUT?
35500 JRST RUBOUT ;YES
35600 CAIN A,37 ;PHONEY BBN EOL?
35700 JRST SAWEOL
35800 CAIN A,33
35900 JRST SAWESC
36000 CAIN A,32 ;CONTROL-Z?
36100 JRST TTYEOF ;YES, EOF
36200 CAIE A,7 ;CONTROL-G
36300 CAIN A,12 ;OR LF
36400 JRST DONE
36500 IDPB A,D
36600 AOJA E,INLUP ;CONTINUE
36700
36800 CTRLU: HRROI A,[BYTE (7) 7,15,12,0,0]
36900 JSYS PSOUT
37000 JRST RESTRT ;START OVER
37100
37200 RUBOUT: JUMPE E,CTRLU ;NOTHING, DO CTRLU
37300 IMSSS <
37400 MOVEI 1,101
37500 JSYS DELCH
37600 JFCL
37700 JRST DLTED
37800 JRST DLTED
37900 >;IMSSS
38000 MOVEI A,"\"
38100 JSYS PBOUT
38200 LDB A,D ;LAST CHAR
38300 JSYS PBOUT
38400 DLTED:
38500 SOJ D, ;DECREMENT BP
38600 IBP D
38700 IBP D
38800 IBP D
38900 IBP D
39000 SOJA E,INLUP ;DECREMENT COUNT AND CONTINUE
39100
39200 DONE:
39300 IDPB A,D
39400 AOJ E,
39500 CNTEXH:
39600 MOVEM E,IOCNT(CDB)
39700 MOVEM Q1,IOBP(CDB)
39800 POP P,Q1
39900 POP P,E
40000 POP P,D
40100 POP P,C
40200 POP P,B
40300 POP P,A
40400 JRST DORET
40500
40600 SAWEOL: MOVEI A,15 ;SIMULATE CR
40700 IDPB A,D
40800 AOJ E,
40900 MOVEI A,12 ;SIMULATE LF
41000 JRST DONE
41100
41200 SAWESC: MOVEI A,ALTMODE ;DEC ALTMODE
41300 JRST DONE
41400
41500 TTYEOF: MOVE A,[QTTEOF]
41600 ORM A,TTYINF(CDB) ;QUE AN EOF
41700 JRST CNTEXH ;AND RETURN
41800
41900 BEND DECBUF
42000
42100 BEND DOINP
00100 DSCR ADCO,ADCO1
00200 CAL PUSHJ
00300 SID SAVES ALL ACS
00400 ARGS
00500 1 JFN
00600 CDB address of channel data block
00700
00800
00900 BEGIN ADCO
01000 ;HERE IF THE COUNT ALREADY PROMISES A CHARACTER
01100 ^^ADCO1:
01200 AOS IOCNT(CDB) ;MAKE THE COUNT HONEST, TEMPORARILY
01300 PUSHJ P,ADCO ;CALL ADCO
01400 SOS IOCNT(CDB) ;REFLECT THE FACT THAT A CHARACTER IS PROMISED
01500 POPJ P, ;AND RETURN (TO CHARACTER OUTPUT CODE)
01600
01700 ^^ADCO:
01800 PUSH P,2 ;SAVE ACS
01900 PUSH P,3
02000 PUSH P,4
02100 MOVE 2,IOSTT(CDB) ;GET STATUS
02200 CAIE 2,XOCHAR ;PMAPPING THE DSK?
02300 JRST NOPMAP ;GUESS NOT
02350 NOCRYPT<
02400 AOS 2,IOPAGE(CDB) ;NEXT PAGE
02450 >
02460 CRYPT<
02465 MOVE 2,IOPAGE(CDB) ;say we want next page
02470 ADDI 2,1
02480 >
02500 PUSHJ P,SETPAGE
02600 MOVEI 2,1000*5
02700 MOVEM 2,IOCNT(CDB) ;CAN WRITE THIS MANY
02800 MOVE 2,IOADDR(CDB)
02900 HRLI 2,440700
03000 MOVEM 2,IOBP(CDB) ;OK
03100 ADRET: POP P,4
03200 POP P,3
03300 POP P,2
03400 POPJ P,
03500
03600
03700 NOPMAP:
03800 CAIN 2,XCOCHAR ;36-BIT ETC.?
03900 JRST STRSOU ;USE SOUT
04000 CAIE 2,XDOCHAR ;BETTER BE DUMP-MODE
04100 ERR <Dryrot at ADCO>,1
04200 SKIPN IOBP(CDB) ;SET UP YET?
04300 JRST DMPINIT
04400 MOVE 3,IOADDR(CDB)
04500 MOVEI 4,DMOCNT*5
04600 CAMG 4,IOCNT(CDB) ;ANY CHARS TO SEND
04700 JRST ADRET
04800
04900 MOVEI 2,3
05000 SUBI 3,1
05100 MOVNI 4,DMOCNT ;WORD COUNT FOR DUMP MODE OUTPUT
05200 HRL 3,4 ;MAKE AN IOWD
05300 SETZ 4, ;MAKE A COMMAND LIST
05400 JSYS DUMPO
05500 ERR <DUMPOUT: CANNOT WRITE DATA IN DUMP MODE>,1
05600 SETOM DMPED(CDB) ;AND INDICATE DONE
05700 DMPINIT:
05800 MOVE 3,IOADDR(CDB)
05900 HRL 2,3
06000 HRRI 2,1(3)
06100 SETZM (3)
06200 BLT 2,DMOCNT-1(3) ;ZERO OUT
06300 MOVEI 2,DMOCNT*5
06400 MOVEM 2,IOCNT(CDB) ;SAVE COUNT
06500 HLL 3,[POINT 7,0,-1];FIX A BYTE-POINTER
06600 MOVEM 3,IOBP(CDB) ;AND SAVE BYTE-POINTER
06700 JRST ADRET
06800
06900 STRSOU:
07000 SKIPN IOBP(CDB)
07100 JRST SOUINIT
07200 MOVEI 3,1000*5
07300 SUB 3,IOCNT(CDB) ;NUMBER OF CHARACTERS ACTUALLY IN BUFFER
07400 IDIVI 3,5 ;NUMBER OF WORDS
07500 SKIPE 4 ;ANY REMAINDER?
07600 AOJ 3, ;YES, ANOTHER WORD FOR EXTRA CHARACTERS
07700 JUMPE 3,ADRET ;RETURN IF NO CHARACTERS TO SEND
07800 MOVN 3,3 ;NEGATIVE WORD COUNT FOR SOUT
07900 MOVE 2,IOADDR(CDB)
08000 HRLI 2,444400 ;MAKE A BP
08100 JSYS SOUT
08200 SOUINIT:
08300 MOVE 2,IOADDR(CDB)
08400 HRL 3,2
08500 HRRI 3,1(2)
08600 SETZM (2)
08700 BLT 3,777(2) ;CLEAR OUT PAGE
08800 HRLI 2,440700
08900 MOVEM 2,IOBP(CDB)
09000 MOVEI 3,1000*5
09100 MOVEM 3,IOCNT(CDB)
09200 JRST ADRET
09300
09400 BEND ADCO
00100 DSCR SETIO
00200 Master routine to set up the file io possibilities.
00300
00400 Arguments:
00500 1,CHNL,CDB set up
00600
00700 There are four entries to the function, depending on the kind of IO that
00800 appears to be desired. They are:
00900
01000 SETCI character input
01100 SETCO character output
01200 SETWI word input
01300 SETWO word output
01400
01500
01600 This routine does the following things:
01700 (1) sets up IOSTT
01800
01900
02000 It does so by first deciding each of these
02100 (1) input or output immediately desired
02200 (2) chars or words immediately desired
02300 (3) 7 or 36 bit bytes open
02400 (4) mode 0 or 17
02500 (5) dsk or non-dsk
02600
02700 An additional consideration is that the file, if on the disk,
02800 may need to be CLOSFed and reOPENFed to allow reading (and writing
02900 if appending).
03000 This facilitates (indeed, makes possible) PMAPping the file and
03100 doing I/O directly into pages of the file. Should this reOPENF
03200 fail (as when protection does not allow it), it will be necessary
03300 to restrict the possibility of doing data mixed and random I/O
03400 to the file. Such is the design of TENEX. (Example: MESSAGE.TXT
03500 is ordinarily such that you can append to it but not read and
03600 write, when it is someone else's file.)
03700
03800
03900 BEGIN SETIO
04000 ^SETWI: SKIPA 6,[=8] ;wants word input
04100 ^SETWO: MOVEI 6,=24 ;wants word output
04200 JRST SETIO ;
04300
04400 ^SETCI: TDZA 6,[-1] ;wants character input
04500 ^SETCO: MOVEI 6,=16 ;wants character output
04600
04700 SETIO: LDB 2,[POINT 6,OFL(CDB),5] ;7-36 BIT BYTES?
04800 CAIN 2,=36
04900 ADDI 6,4 ;36
05000 LDB 2,[POINT 4,OFL(CDB),9]
05100 JUMPE 2,.+2 ;MODE 0 OR 17?
05200 ADDI 6,2 ;17
05300 SKIPE DVTYP(CDB) ;DSK OR NON-DSK?
05400 AOJ 6, ;NON-DSK
05500 IDIVI 6,7 ;SET UP FOR LDB
05600 LDB 6,BPS(7)
05700 JUMPN 6,.+2
05800 ERR <DRYROT at SETIO: Nonsense combination of bytes and modes for io request.>,1
05900 MOVEM 6,IOSTT(CDB) ;THAT IS THE ANSWER
06000 CAIL 6,XICHAR ;PMAPPED DISK FILE?
06100 CAILE 6,XOWORD
06200 JRST NOPMAP
06300 MOVE 2,OFL(CDB)
06400 TESTN 2,WRBIT ;WRITING
06500 TESTE 2,APPBIT ;OR APPENDING?
06600 JRST .+2 ;THEN BETTER BE READING
06700 JRST CHKED1
06800 TESTO 2,RDBIT ;MUST BE READING
06900 TESTN 2,APPBIT ;REMEMBER IF APPENDING
07000 JRST NOAPP ;NOT APPENDING
07100 TESTZ 2,APPBIT ;TURN OFF APPENDING
07200 TESTO 2,WRBIT ;INDICATE WRITING
07300 SKIPA 3,[-1] ;APPENDING
07400 NOAPP: SETZ 3, ;NOT APPENDING
07500 CAMN 2,OFL(CDB) ;DIFFERENT?
07600 JRST CHKED ;NO
07700 TESTO 1,1B0 ;DONT RELEASE
07800 JSYS CLOSF
07900 ERR <SETIO: Cannot do CLOSF>
08000 TESTZ 1,1B0 ;RESET DONT RELEASE BIT
08100 PUSH P,1 ;SAVE JFN
08200 JSYS OPENF
08300 JRST NOROPN ;CANNOT RE-OPEN FILE
08400 POP P,1 ;RESTORE JFN
08500 MOVEM 2,OFL(CDB) ;AND REMEMBER NEW FLAGS
08600 CHKED: SKIPA 2,3 ;PICK UP SAVED POINTER
08700 CHKED1: SETZ 2,
08800 PUSH P,2 ;SAVE POINTER
08900 SETOM IOPAGE(CDB) ;DENY THAT THERE IS A PAGE THERE
09000 MOVE 2,[XWD 2,11] ;READ FDB
09100 MOVEI 3,2
09200 JSYS GTFDB
09300 MOVEM 3,FDBEOF(CDB) ;SAVE EOF
09400 LDB 2,[POINT 6,2,11]
09500 MOVEM 2,FDBSZ(CDB)
09600 POP P,2 ;GET POINTER BACK
09700 CAIE 6,XIWORD ;SEE IF WORDS
09800 CAIN 6,XOWORD
09900 JRST SETWPT ;WORDS POPJ BACK
10000 JRST SETCPT ;CHARACTERS POPJ BACK
10100
10200 NOROPN: POP P,1 ;CLOBBERED JFN
10300 MOVE 2,OFL(CDB) ;FLAGS AS THEY WERE -- CANT DO NO BETTER
10400 JSYS OPENF
10500 ERR <SETIO: Cannot do OPENF>
10600 MOVE 2,IOSTT(CDB) ;STATUS -- MUST BE CHANGED
10700 CAIN 2,XICHAR
10800 MOVEI 3,XCICHAR
10900 CAIN 2,XOCHAR
11000 MOVEI 3,XCOCHAR
11100 CAIE 2,XIWORD
11200 CAIN 2,XOWORD
11300 MOVEI 3,XCIWORD
11400 MOVEM 3,IOSTT(CDB) ;SAVE STATUS -- BEST WE CAN DO
11500 ;FALL THRU AND RETURN
11600 NOPMAP: SETZM IOCNT(CDB)
11700 SETZM IOBP(CDB)
11800 POPJ P,
11900
12000
12100 BPS: POINT 5,TABL(6),4 ;BYTE POINTERS
12200 POINT 5,TABL(6),9
12300 POINT 5,TABL(6),14
12400 POINT 5,TABL(6),19
12500 POINT 5,TABL(6),24
12600 POINT 5,TABL(6),29
12700 POINT 5,TABL(6),34
12800
12900 TABL: BYTE (5) XBYTE7,XBYTE7,0,0,XICHAR,XCICHAR,XDICHAR
13000 BYTE (5) XDICHAR,0,0,0,0,XIWORD,XCIWORD
13100 BYTE (5) XDARR,XDARR,XBYTE7,XBYTE7,0,0,XOCHAR
13200 BYTE (5) XCOCHAR,XDOCHAR,XDOCHAR,0,0,0,0
13300 BYTE (5) XOWORD,XCIWORD,XDARR,XDARR
13400
13500
13600 BEND SETIO
00100 DSCR
00200 FINIO
00300
00400 Finishes the io.
00500 Mainly does the following:
00600
00700 (1) outputs any remaining buffers
00800 (2) checks eof pointer in FDB of dsk files
00900 (3) writes EOF marks to magtape
01000
01100 CAL PUSHJ from runtimes (CFILE and CLOSF)
01200 ARGS 1,CDB
01300 SID nothing saved
01400
01500 HERE(FINIO)
01600 BEGIN FINIO
01700 PUSH P,1
01800 PUSH P,2
01900 PUSH P,3
02000 PUSH P,4
02100 PUSH P,5
02200 PUSH P,6
02300 SIMIO 2,TABL,POPBACK
02400 UNMAP:
02500 CRYPT< ;Possibly Encrypt current page
02600 SKIPE NCRYPT(CDB) ;ENCRYPTING?
02700 PUSHJ P,CALNCR ;call user's routine
02800 SETZM NCRYPT(CDB)
02900 SETZM DCRYPT(CDB)
03000 >; CRYPT
03100 SETZM DMPED(CDB) ;RESET VALUES TO ORIGINALS
03200 SETZM IOCNT(CDB)
03300 SETZM IOBP(CDB)
03400 SETZM IOSTT(CDB)
03500 SETOM IOPAGE(CDB)
03600 SETO 1, ;N.B. DESTROY PAGE--NOTE: CLOBBERS JFN
03700 MOVE 2,FKPAGE(CDB) ;UNTIL POP BELOW
03800 SETZ 3,
03900 JSYS PMAP
04000 POPBACK:POP P,6
04100 POP P,5
04200 POP P,4
04300 POP P,3
04400 POP P,2
04500 POP P,1
04600 POPJ P,
04700
04800 TABL: JRST POPBACK ;0 -- XNULL
04900 JFCL ;1 -- XICHAR
05000 PUSHJ P,CHCEOF ;2 -- XOCHAR -- POPJ RETURN
05100 JFCL ;3 -- XIWORD
05200 PUSHJ P,CHWEOF ;4 -- XOWORD
05300 JFCL ;5 -- XCICHAR
05400 PUSHJ P,ADCO ;6 -- XCOCHAR
05500 JFCL ;7 -- XCWORD
05600 JRST DOB7 ;10 -- XBYTE7
05700 JFCL ;11 -- XDICHAR
05800 JRST XDO1 ;12 -- XDOCHAR
05900 JRST XDO2 ;13 -- XDARR
06000
06100 DOB7: SKIPN 2,TTYINF(CDB) ;A TELETYPE?
06200 JRST UNMAP ;NOPE
06300 TESTZ 2,QTTEOF ;TURN OFF QUED EOF
06400 MOVEM 2,TTYINF(CDB)
06500 JRST UNMAP ;AND UNBUFFER
06600
06700 XDO1: PUSHJ P,ADCO ;WRITE OUT WHATEVER IS THERE
06800 XDO2: SKIPN DMPED(CDB) ;DUMP MODE OUTPUT SEEN?
06900 JRST UNMAP ;NOPE
07000 MOVE 2,DVTYP(CDB) ;DEVICE TYPE
07100 CAIE 2,2 ;MAGTAPE?
07200 JRST UNMAP ;NOPE
07300 MOVEI 2,3 ;EOF
07400 JSYS MTOPR ;WRITE TWO
07500 JSYS MTOPR
07600 MOVEI 2,17 ;BACKSPACE OVER 1 EOF
07700 JSYS MTOPR
07800 JRST UNMAP
07900
08000
08100 BEND FINIO
00100 ENDCOM(IOROU)
00200
00300 COMPIL(BINROU,<SFPTR,RFPTR,MTOPR,BKJFN,RFBSZ>
00400 ,<SAVE,RESTR,X22,X33,X44,.SKIP.,JFNTBL,CDBTBL>
00500 ,<BINROU -- Binary routines generally to not be used>)
00600
00100 DSCR SIMPLE PROCEDURE SFPTR(INTEGER JFN,POINTER)
00200 Sets the file open on JFN to byte POINTER (-1 for EOF).
00300 Errors returned in .SKIP.
00400 WARNING: presently not compatible with special character
00500 mode.
00600
00700 HERE(SFPTR)
00800 PUSHJ P,SAVE
00900 MOVE LPSA,X33
01000 VALCHN 1,-2(P),SFBAD
01100 SETZM .SKIP.
01200 MOVE 2,-1(P)
01300 JSYS SFPTR
01400 MOVEM 1,.SKIP.
01500 SFRET: JRST RESTR
01600
01700 SFBAD: ERR <Illegal JFN>,1
01800 SETOM .SKIP.
01900 JRST SFRET
02000
02100
00100 DSCR INTEGER SIMPLE PROCEDURE RFPTR(INTEGER JFN)
00200 Reads the pointer of JFN. Error codes to .SKIP.
00300 WARNING: presently does not work for files in special character
00400 mode.
00500
00600 HERE(RFPTR)
00700 PUSHJ P,SAVE
00800 MOVE LPSA,X22
00900 VALCHN 1,-1(P),RFBAD
01000 SETZM .SKIP.
01100 JSYS RFPTR
01200 MOVEM 1,.SKIP.
01300 MOVEM 2,RACS+A(USER) ;ANSWER IN 2
01400 RFRET: JRST RESTR
01500
01600 RFBAD: ERR <Illegal JFN>,1
01700 SETOM .SKIP.
01800 JRST RFRET
01900
00100 DSCR SIMPLE PROCEDURE MTOPR(INTEGER JFN,FUNCTION,VALUE)
00200 Does the MTOPR jsys.
00300
00400 HERE(MTOPR)
00500 BEGIN MTOPR
00600 PUSHJ P,SAVE
00700 MOVE LPSA,X44
00800 VALCHN 1,-3(P),MTBAD
00900 MOVE 2,-2(P)
01000 MOVE 3,-1(P)
01100 JSYS MTOPR
01200 MTRET: JRST RESTR
01300
01400 MTBAD: ERR <Illegal JFN>,1
01500 JRST MTRET
01600
01700 BEND MTOPR
01800
00100 DSCR SIMPLE PROCEDURE BKJFN(INTEGER JFN)
00200 Does the BKJFN jsys on JFN, error code to .SKIP.
00300
00400 HERE(BKJFN)
00500 PUSHJ P,SAVE
00600 MOVE LPSA,X22
00700 VALCHN 1,-1(P),BKBAD
00800 SETZM .SKIP.
00900 BKJF1: JSYS BKJFN
01000 MOVEM 1,.SKIP. ;ERROR RETURN
01100 BKRET: JRST RESTR
01200
01300 BKBAD: MOVE 1,-1(P) ;USE LITERALLY
01400 JRST BKJF1
00100 DSCR INTEGER SIMPLE PROCEDURE RFBSZ(INTEGER JFN);
00200 Reads the byte-size of the file open on JFN.
00300
00400 HERE(RFBSZ)
00500 PUSHJ P,SAVE
00600 MOVE LPSA,X22
00700 VALCHN 1,-1(P),RFBBAD
00800 JSYS RFBSZ
00900 JFCL ;TOPS 20 ERROR RETURN
01000 MOVEM 2,RACS+A(USER) ;ANSWER IN 2
01100 RFBRET: JRST RESTR
01200
01300 RFBBAD: ERR <Illegal JFN>,1
01400 JRST RFBRET
01500
01600 ENDCOM(BINROU)
01700
00100 COMPIL(DSKOPS,<DSKIN,DSKOUT>
00200 ,<JFNTBL,CDBTBL,.SKIP.>
00300 ,<DSKOPS -- DIRECT DSK ROUTINES>)
00400
00500 DSCR SIMPLE PROCEDURE
00600 DSKIN(INTEGER MODULE,RECNO,COUNT; REFERENCE INTEGER LOC);
00700
00800 IMSSS only.
00900 Does direct IO from the DSK (formerly device "PAK").
01000 Modules 4-7 are legal for everyone. Other modules require enabled
01100 status.
01200 Count words are read into user's core at location LOC, from
01300 MODULE, record RECNO. Error bits are in .SKIP.
01400 Does the DSKOP jsys (as modified at IMSSS).
01500
01600
01700 BEGIN DSKOPS
01800 HERE(DSKIN)
01900 NOIMSSS<
02000 ERR <DSKIN: Only defined in IMSSS system>
02100 >;NOIMSSS
02200 PUSHJ P,SAVE
02300 SETZ 4, ;INDICATE READ ONLY
02400
02500 DSK1: HRRZ 2,-2(P)
02600 JUMPLE 2,DSBAD ;LEQ 0 -- ERROR
02700 CAILE 2,1000 ;DONT READ MORE THAN 1000 WORDS
02800 JRST DSBAD
02900 IOR 2,4 ;PICK UP READ OR WRITE (SET IN 4)
03000 HRLZ 1,-4(P) ;MODULE
03100 HRR 1,-3(P) ;RECORD NO. IN RIGHT HALF
03200 TLO 1,600000 ;SOFTWARD ADDRESS, IMSSS FORMAT (BITS 0 AND 1 RES.)
03300 HRRZ 3,-1(P) ; GET THE USER LOCATION
03400 JSYS DSKOP
03500 DSDUN: MOVEM 1,.SKIP. ; SAVE ERROR BITS
03600 DSRET: MOVE LPSA,[XWD 5,5] ; TO ADJUST STACK
03700 JRST RESTR
03800 DSBAD: ERR <DSKIN OR DSKOUT: WORD COUNT EITHER <= 0 OR > '1000>,1
03900 SETOM .SKIP.
04000 JRST DSRET
04100
04200
04300
00100 DSCR SIMPLE PROCEDURE
00200 DSKOUT(INTEGER MODULE,RECNO,COUNT; REFERENCE INTEGER LOC)
00300 DESR Similar to DSKIN, except that a write is done.
00400
00500
00600 HERE(DSKOUT)
00700 NOIMSSS<
00800 ERR <DSKOUT: Only defined at IMSSS>
00900 >;NOIMSSS
01000 PUSHJ P,SAVE
01100 MOVSI 4,(1B14) ;INDICATE WRITE (TO BE IOR'ED INTO AC 2)
01200 JRST DSK1 ;AND TO THE ABOVE CODE
01300
01400 BEND DSKOPS
01500
01600 ENDCOM(DSKOP)
01700
00100 COMPIL(DEVS,<DEVTYPE,DVCHR,ERSTR,ERSTRING>
00200 ,<X22,X44,.SKIP.,JFNTBL,CDBTBL>
00300 ,<DEVS -- DEVICE HANDLERS, ERROR ROUTINE>)
00400 DSCR INTEGER SIMPLE PROCEDURE DEVTYPE(INTEGER JFN);
00500 Returns (via the DEVCHR jsys) the device type of
00600 the device open on JFN. The more general DEVCHR call is
00700 also implemented (below).
00800
00900 HERE(DEVTYPE)
01000 VALCHN 1,-1(P),DEVBAD
01100 JSYS DVCHR
01200 HLRZ 1,2
01300 ANDI 1,777
01400 DEVRET: SUB P,X22
01500 JRST @2(P)
01600 DEVBAD: ERR <Illegal JFN>,1
01700 JRST DEVRET
00100 DSCR INTEGER SIMPLE PROCEDURE DVCHR(INTEGER JFN; REFERENCE INTEGER AC1,AC3);
00200 Does the DEVCHR jsys, returning the flags from AC2 as the
00300 value of the call, and AC1 and AC3 get the contents of ac's 1 and 3.;
00400
00500 HERE(DVCHR)
00600 VALCHN 1,-3(P),DVBAD
00700 JSYS DVCHR
00800 MOVEM 1,@-2(P)
00900 MOVEM 3,@-1(P)
01000 MOVE 1,2
01100 DVRET: SUB P,X44
01200 JRST @4(P)
01300 DVBAD: ERR <Illegal JFN>,1
01400 JRST DVRET
01500
01600
00100 DSCR SIMPLE PROCEDURE ERSTR(INTEGER ERRNO,FORK)
00200 Using the ERSTR jsys, types out on the console the TENEX error string
00300 associated with ERRNO for FORK fork (0 for the current fork). Parameters (in
00400 the sense of the ERSTR jsys) are expanded.
00500 Types out the string ERSTR: UNDEFINED ERROR number if
00600 something is with your error number or fork (and sets .SKIP. to -1).
00700
00800 HERE(ERSTR)
00900 SETZM .SKIP.
01000 MOVEI 1,101 ;PRIMARY OUTPUT
01100 SKIPN 2,-1(P) ;ANY FORK MENTIONED?
01200 MOVEI 2,400000 ;ASSUME CURRENT FORK
01300 HRLZ 2,2 ;IN LEFT HALF
01400 HRR 2,-2(P) ;THE ERROR NUMBER
01500 SETZ 3, ;NO LIMIT TO SIZE OF STRING
01600 JSYS ERSTR
01700 JRST ERSERR
01800 JRST ERSERR ;ERROR RETURNS
01900 ERSRET: SUB P,X33
02000 JRST @3(P)
02100 ERSERR: HRROI 1,[ASCIZ/
02200 ERSTR: UNDEFINED ERROR NUMBER
02300 /]
02400 JSYS PSOUT
02500 SETOM .SKIP. ;INDICATE ERROR
02600 JRST ERSRET
02700
02800 ;[clh] add erstring
02900 DSCR SIMPLE STRING PROCEDURE ERSTRING(INTEGER ERRNO,FORK)
03000 Using the ERSTR jsys, returns the TENEX error string
03100 associated with ERRNO for FORK fork (0 for the current fork). Parameters (in
03200 the sense of the ERSTR jsys) are expanded.
03300 Returns null if
03400 something is with your error number or fork (and sets .SKIP. to -1).
03500
03600
03700 HEREFK(ERSTRING,ERSTR.)
03800 PUSH P,[=100] ;MAKE SPACE TO RETURN THE VALUE
03900 PUSHJ P,ZSETST ;BYTE POINTER TO 1
04000 SETZM .SKIP.
04100 SKIPN 2,-1(P) ;ANY FORK MENTIONED?
04200 MOVEI 2,400000 ;ASSUME CURRENT FORK
04300 HRLZ 2,2 ;IN LEFT HALF
04400 HRR 2,-2(P) ;THE ERROR NUMBER
04500 TRNN 2,777777 ;NON-ZERO ERROR NUMBER?
04600 HRRI 2,-1 ;NO - USE LAST ERROR
04700 HRLZI 3,-100 ;MAX STRING SIZE
04800 JSYS ERSTR
04900 JFCL
05000 SETOM .SKIP. ;ERRORS - SET .SKIP., RETURN NULL
05100 PUSH P,[=100] ;ORIGINAL LENGTH
05200 PUSH P,1 ;UPDATED STRING
05300 PUSHJ P,ZADJST ;PUT RESULT ON SP
05400 SUB P,X33
05500 JRST @3(P)
05600
05700 ;[clh] ^^
05800
05900 ENDCOM(DEVS)
06000
00100 COMPIL(UTILITY,<SETCHN,ZSETST,ZADJST,.RESET,RDSEG>
00200 ,<CORGET,GOGTAB,JFNTBL,CDBTBL,STRNGC,INSET,SAVE,RESTR,X33>
00300 ,<UTILITY -- UTILITY TENEX ROUTINES>)
00400 DSCR
00500 SETCHN accepts in A the JFN, and returns in A the channel number associated with a JFN.
00600 It sets up the JFNTBL, the CDBTBL table, and returns the address of the
00700 file command block in ac CDB. Other acs are not modified (except USER).
00800 In order to accommodate the OPEN statement, a channel will be
00900 considered allocated when it has a CDB, even if it does not yet have a jfn.
01000
01100
01200 HERE(SETCHN)
01300 MOVE USER,GOGTAB
01400 PUSH P,B
01500 PUSH P,C
01600 PUSH P,D
01700 MOVEI B,JFNSIZE ;FOR COMPARISON TO RH OF A
01800 CAILE B,(A) ;IS THE JFN BEYOND THE NUMBER OF CHANNELS
01900 SKIPE CDBTBL(A) ;OR IS IT ALLOCATED OR USED?
02000 JRST FNDCHN ;PERHAPS NOT, FIND ONE SOMEHOW
02100 HRRZ D,A ;USE JFN NO. AS CHANNEL
02200 ;MUST GET A CHANNEL DATA BLOCK
02300 GTCDB: MOVEI C,TIOTLN
02400 PUSHJ P,CORGET
02500 ERR <SETCHN: NO CORE>
02600 MOVE CDB,B
02700 MOVEM CDB,CDBTBL(D) ;SAVE ADDR OF CDB
02800 ;HERE WITH B,CDB, D LOADED WITH: CDBADDR,CDBADDR,CHANNEL
02900 CLCDB:
03000 HRL B,B
03100 ADDI B,1
03200 SETZM (CDB)
03300 BLT B,TIOTLN-1(CDB)
03400
03500 GOTCHN:
03600 MOVEM A,JFNTBL(D)
03700 HRRZ 1,A ;JFN
03800 JSYS DVCHR ;CLOBBERS 1,2,3
03900 MOVEM 1,DVDSG(CDB) ;SAVE DESIGNATOR
04000 MOVEM 2,DVCH(CDB) ;AND CHARACTERISTICS
04100 HLRZ 1,2
04200 ANDI 1,777 ;GET DEVICE TYPE
04300 MOVEM 1,DVTYP(CDB) ;AND SAVE IT
04400 CAIE 1,12 ;IS IT A TTY?
04500 JRST NOTTTY ;NOPE
04600 ;CHECK THAT IT IS DEVICE "TTY" (IN WHICH CASE IT IS THE CONTROLLING TERM)
04700 HRRZ 2,JFNTBL(D) ;GET JFN
04800 TRNE 2,400000 ;A TERMINAL SPECIFIER FROM SETCHAN?
04900 JRST NOTTTY ;YES, NOT DEVICE "TTY"
05000 PUSH P,3 ;SOME SPACE
05100 PUSH P,4
05200 PUSH P,5
05300 PUSH P,6
05400 HRROI 1,4
05500 MOVSI 3,200000 ;DEVICE FIELD ONLY
05600 SETZ 4,
05700 JSYS JFNS
05800 MOVEM 4,2 ;SAVE IN 2
05900 POP P,6 ;RESTORE ACS
06000 POP P,5
06100 POP P,4
06200 POP P,3
06300 CAME 2,[ASCIZ/TTY/] ;DEVICE TTY?
06400 JRST NOTTTY ;NOT THE CONTROLLING TERMINAL
06500 MOVE 2,[ISCTRM+TENXED] ;DEFAULT -- TENEX STYLE
06600 MOVEM 2,TTYINF(CDB)
06700
06800 NOTTTY: MOVEI 2,STARTPAGE(D) ;PAGE FOR BUFFER
06900 HRLI 2,400000 ;THIS FORK
07000 MOVEM 2,FKPAGE(CDB) ;XWD FORK,PAGE FOR PMAPPING
07100 LSH 2,9 ;MAKE AN ADDRESS
07200 MOVEM 2,IOADDR(CDB) ;AND SAVE IT AS WELL
07300 SETOM IOPAGE(CDB) ;DENY THAT THERE IS A PAGE THERE
07400 HRRZ A,D ;CHANNEL INTO A
07500 POP P,D ;RESTORE
07600 POP P,C
07700 POP P,B
07800 POPJ P,
07900
08000
08100 ;FIND AN OPEN CHANNEL AND RETURN THE NUMBER IN D
08200 ;A HAS THE JFN NO. IN IT, SO CHECK TO SEE IF THE SAME
08300 ;B MAY BE CLOBBERED
08400 FNDCHN: HRRZ D,JFNTBL(A) ;CHECK OLD JFN
08500 CAIE D,(A) ;SAME AS THE NEW?
08600 JRST FNDCH2 ;NO
08700 MOVE CDB,CDBTBL(D) ;GET OLD CDB
08800 MOVE B,CDB ;COPY CDB ADDR FOR BLT
08900 JRST CLCDB
09000
09100 FNDCH2: SETZ D,
09200 FNDCH1: CAIL D,JFNSIZE
09300 ERR <SETCHN: JFN TABLE IS FULL (SHOULD NEVER HAPPEN)>
09400 SKIPE CDBTBL(D) ;IS IT EMPTY?
09500 AOJA D,FNDCH1 ;NO LOOK SOME MORE
09600 JRST GTCDB ;YES, USE IT
09700
09800
09900 DSCR SIMPLE INTEGER PROCEDURE ZSETST(INTEGER I);
10000
10100 Internal book-keeping routine not intended for
10200 use from SAIL. Causes liberation from SAIL.
10300
10400 THE ARGUMENT IS THE MAXIMUM SIZE OF THE EXPECTED STRING.
10500 THE RETURN IS THE BYTEPOINTER POINTING INTO THE TOP OF STRING SPACE
10600
10700
10800 HERE(ZSETST)
10900 MOVE USER,GOGTAB ; GET USER
11000 SKIPE SGLIGN(USER)
11100 PUSHJ P,INSET ;ASSUMING THAT IT IS TRANSPARENT FOR THE ACS
11200 MOVE 1,-1(P) ;GET EXPECTED LENGTH
11300 ADDM 1,REMCHR(USER) ; ADD ON
11400 SKIPLE REMCHR(USER) ; NEED TO COLLECT?
11500 PUSHJ P,GOCOLLECT ; YES
11600 MOVE 1,TOPBYTE(USER) ; RETURN BP
11700 SUB P,X22 ; ADJUST STACK
11800 JRST @2(P) ; RETURN
11900
12000 GOCOLLECT:
12100 MOVEM RF,RACS+RF(USER) ;SAVE RF
12200 PUSHJ P,STRNGC ;
12300 POPJ P, ; RETURN TO ABOVE
12400
00100 DSCR STRING SIMPLE PROCEDURE ZADJST(INTEGER CNTEST,BP)
00200 Internal book-keeping routine.
00300 ADJUSTS THE PARAMETERS ASSOCIATED WITH STRING SPACE.
00400 BP IS OUR NEW TOPBYTE. CNTEST IS THE COUNT ESTIMATE WE
00500 ORIGINALLY MADE.
00600 FIRST, WE MUST MAKE REMCHR HONEST, THEN WE
00700 CAN FIX TOPSTR AND THE USER'S LENGTH WORD.
00800
00900 HERE(ZADJST)
01000 BEGIN ZADJST
01100
01200
01300 MOVE USER,GOGTAB;
01400 PUSH P,1
01500 PUSH P,2
01600 PUSH P,3
01700 PUSH P,4
01800
01900 DEFINE CNTARG <-6(P)>
02000 DEFINE BPARG <-5(P)>
02100
02200 MOVE 2,BPARG ;UPDATED BP
02300 MOVE 1,TOPBYTE(USER) ; GET OLD TOPBYTE
02400 CAMN 1,2 ; THE NULL STRING?
02500 JRST NULRET; ;YES
02600 ;P. KANERVA'S BYTE ROUTINE
02700 LDB 3,[POINT 6,1,5] ;BITS TO THE RIGHT OF BYTE 1
02800 LDB 4,[POINT 6,2,5] ;BITS TO THE RIGHT OF BYTE 2
02900 SUBI 3,(4) ;BIT DIFFERENCE
03000 IDIVI 3,7 ;WITHIN-WORD BYTE DIFFERENCE
03100
03200 SUBI 2,(1) ;WORDS BETWEEN BYTES
03300 HRRE 2,2 ;FULL WORD DIFFERENCE
03400 IMULI 2,5 ;CONVERT IT TO BYTE DIFFERENCE
03500 ADD 2,3 ;ADD COUNT DERIVED FROM WITHIN-WORD
03600 ;DIFFERENCE
03700
03800 CAMLE 2,CNTARG ;WITHIN RANGE?
03900 ERR <ZADJST: TENEX WROTE TOO LONG A STRING, MAY BE FATAL>,1
04000 GOTLNG: HRRO 1,2 ; XWD -1,COUNT
04100 PUSH SP,1 ; XWD -1,COUNT
04200 PUSH SP,TOPBYTE(USER) ; OLD TOPBYTE FOR BP FOR STRING
04300 JUMPE 2,NOLNG
04400 MOVE 1,BPARG
04500 MOVEM 1,TOPBYTE(USER)
04600 NOLNG:
04700 SUB 2,CNTARG ; SUBTRACT THE COUNT ESTIMATE
04800 ADDM 2,REMCHR(USER) ; MAKE REMCHR HONEST
04900 POP P,4
05000 POP P,3
05100 POP P,2
05200 POP P,1
05300 SUB P,X33 ; ADJUST STACK
05400 JRST @3(P) ;
05500
05600 NULRET: SETZ 2,;
05700 JRST GOTLNG ; BE SURE TO FIX UP ALL THE GOODIES
05800
05900 BEND ZADJST
06000
00100 DSCR
00200 .RESET
00300 SID SAVES ALL ACS
00400 CAL JSP P,.RESET from SAILOR
00500
00600 RESETS TENEX IO AND BOOKKEEPING, AND SETS THE TTY MODE TO WAKEUP
00700 ON EVERY CHARACTER. TTY WAKEUP IS NOT DONE IF THE JOB IS DETACHED.
00800 THIS SHOULD ONLY BE CALLED FROM SAILOR.
00900
01000 HERE(.RESET)
01100 BEGIN RESET
01200 ;ZERO OUT BOOKKEEPING
01300 SETZM JFNTBL
01400 MOVE 1,[XWD JFNTBL,JFNTBL+1]
01500 BLT 1,JFNTBL+JFNSIZE-1
01600 SETZM CDBTBL
01700 MOVE 1,[XWD CDBTBL,CDBTBL+1]
01800 BLT 1,CDBTBL+JFNSIZE-1
01900
02000 ;RELEASE PAGES ASSOCIATED WITH FILES (FROM STARTPAGE TO STARTPAGE+JFNSIZE-1)
02100 SKIPE $OSTYP ;[04] TOPS20?
02200 JRST .RESE3 ;[04] Yes, use faster code
02300
02400 ;TENEX version uses a loop
02500 SETO 1, ;RELEASE PAGE
02600 SETZ 3, ;FLAGS WORD
02700 MOVE 2,[XWD 400000,STARTPAGE]
02800 .RESE1: CAMN 2,[XWD 400000,STARTPAGE+JFNSIZE] ;THIS WOULD BE TOO MANY PAGES
02900 JRST .RESE2
03000 JSYS PMAP
03100 AOJA 2,.RESE1 ;NEXT?
03200
03300 ;TOPS20 version: [RNG: July 16, 1980, Use single PMAP call]
03400 .RESE3: SETO 1, ;[04] Release page
03500 MOVE 2,[XWD 400000,STARTPAGE];[04] Start of I/O buffers
03600 HRRI 3,JFNSIZE ;[04] Repeat count
03650 HRLI 3,400000 ;[04] say it's there!
03700 JSYS PMAP ;[04]
03800
03900 .RESE2:
04000 JSYS RESET ;CLEAR ALL IO
04100
04200 ;SET UP PSI SYSTEM
04300 HRRZI 1,400000 ;USE EXISTING TABLE IF THERE
04400 ;; JSYS RIR
04500 ;; JUMPN 2,.+3 ;ALREADY THERE
04600 MOVE 2,[XWD LEVTAB,CHNTAB]
04700 JSYS SIR
04800 JSYS EIR ;TURN ON INTERRUPTS
04900
05000 ;CHECK AND SEE IF WE ARE DETACHED
05100 JSYS GJINF
05200 CAMN 4,[-1] ;-1 FOR DETACHED JOBS
05300 JRST DTCHED ;YES IT IS DETACHED
05400
05500 ;SET PRIMARY INPUT TO WAKE UP ON EVERY CHARACTER
05600 ;THE USER MAY RESET THIS.
05700 MOVEI 1,100 ;PRIMARY INPUT
05800 JSYS RFMOD
05900 TRO 2,170000 ;WAKEUP ON ALL CHARS
06000 JSYS SFMOD
06100 DTCHED: SETZM CTLOSW ;CLEAR OUTPUT-SUPPRESSION SWITCH
06200
06300 JRST (P) ;AND RETURN
06400 BEND RESET
06500
06600 ;ROUTINE TO CHECK IF A JFN HAS BEEN CLOSED BY ONE OF
06700 ;THE DEC-STYLE CLOSE ROUTINES (IN WHICH CASE IT
06800 ;MUST BE AVAILABLE FOR RE-OPENING)
06900 ;ARGS:
07000 ; 1 JFN
07100 ; CDB THE CHANNEL DATA BLOCK
07200 ^OPNCHK:
07300 SKIPL IOSTT(CDB) ;CLOSED BY DEC?
07400 POPJ P, ;NO
07500 PUSH P,2 ;SAVE 2
07600 MOVE 2,OFL(CDB) ;PREVIOUSLY USED FLAGS
07700 JSYS OPENF ;OPEN
07800 ERR <OPNCHK: Cannot OPENF file>,1
07900 SETZM IOSTT(CDB)
08000 POP P,2 ;RESTORE 2
08100 POPJ P, ;RETURN
08200
08300 HERE(RDSEG)
08400 PUSHJ P,SAVE ;
08500 MOVE LPSA,X33 ;FOR RESTR BELOW
08600 HRRZ A,SEGPAGE*1000 + 12 ;ADDRESS OF LAST WORD OF SEGMENT IS HERE
08700 LSH A,-=9 ;MAKE IT A PAGE NUMBER
08800 HRLI A,SEGPAGE ;FIRST PAGE OF SEGMENT
08900 MOVEM A,@-2(P) ;STORE
09000 HRLI A,STARTPAGE ;FIRST WORD OF BUFFER REGION
09100 HRRI A,STARTPAGE+JFNSIZE-1 ;LAST PAGE OF BUFFER REGION
09200 MOVEM A,@-1(P) ;STORE
09300 JRST RESTR ;AND RETURN
09400
09500 ENDCOM(UTILITY)
00100 COMPIL(TTM,<RFMOD,SFMOD,STPAR,STI,RFCOC,SFCOC,GTTYP,STTYP,SETEDIT>
00200 ,<SAVE,RESTR,X22,X33,X44>
00300 ,<TTM -- TERMINAL MODE ROUTINES>)
00400
00500 DSCR INTEGER PROCEDURE RFMOD(INTEGER CHAN)
00600
00700 Reads a file's mode word.
00800
00900 PROCEDURE SFMOD(INTEGER CHAN,AC2)
01000
01100 Sets a file's mode word to argument AC2.
01200
01300 PROCEDURE STPAR(INTEGER CHAN,BITS)
01400
01500 Executes the STPAR jsys on CHAN with arguments BITS
01600
01700 PROCEDURE STI(INTEGER CHAN,CHAR)
01800
01900 Executes the STI jsys on CHAN with character CHAR.
02000
02100 PROCEDURE RFCOC(INTEGER CHAN; REFERENCE INTEGER AC2,AC3)
02200
02300 Does RFCOC jsys, returning values in AC2 and AC3.
02400
02500 PROCEDURE SFCOC(INTEGER CHAN,AC2,AC3)
02600
02700 Does SFCOC jsys, setting to AC2 and AC3.
02800
02900 INTEGER PROCEDURE GTTYP(INTEGER CHAN; REFERENCE INTEGER BUFS)
03000
03100 Does GTTYP jsys on CHAN/TTY and returns the
03200 typ information as the value of the call. BUFS is the
03300 result from AC 3.
03400
03500 PROCEDURE STTYP(INTEGER CHAN,NEWTYPE)
03600
03700 Sets the terminal type of CHAN to NEWTYPE
03800
03900
04000
04100 HERE(RFMOD)
04200 PUSHJ P,SAVE
04300 MOVE LPSA,X22
04400 VALCH1 1,-1(P),RFMO1
04500 RFMO2: JSYS RFMOD
04600 MOVEM 2,RACS+A(USER)
04700 JRST RESTR
04800 RFMO1: MOVE 1,-1(P) ;USE LITERALLY
04900 JRST RFMO2
05000
05100
05200
05300 HERE(SFMOD)
05400 PUSHJ P,SAVE
05500 MOVE LPSA,X33
05600 VALCH1 1,-2(P),SFMO1
05700 SFMO2: MOVE 2,-1(P)
05800 JSYS SFMOD
05900 JRST RESTR
06000 SFMO1: MOVE 1,-2(P)
06100 JRST SFMO2
06200
06300 HERE(STPAR)
06400 PUSHJ P,SAVE
06500 MOVE LPSA,X33
06600 VALCH1 1,-2(P),STPAR1
06700 STPAR2: MOVE 2,-1(P) ;PARAMETERS TO SET
06800 JSYS STPAR ;EXECUTE JSYS
06900 JRST RESTR
07000 STPAR1: MOVE 1,-2(P) ;USE LITERALLY
07100 JRST STPAR2
07200
07300 HERE(STI)
07400 PUSHJ P,SAVE
07500 MOVE LPSA,X33
07600 VALCH1 1,-2(P),STI1
07700 STI2: MOVE 2,-1(P)
07800 JSYS STI
07900 JRST RESTR
08000 STI1: MOVE 1,-2(P) ;USE LITERALLY
08100 JRST STI2
08200
08300
08400 HERE(RFCOC)
08500 PUSHJ P,SAVE
08600 MOVE LPSA,X44
08700 VALCH1 1,-3(P),RFCO1
08800 RFCO2: JSYS RFCOC
08900 MOVEM 2,@-2(P)
09000 MOVEM 3,@-1(P)
09100 JRST RESTR
09200 RFCO1: MOVE 1,-3(P) ;USE LITERALLY
09300 JRST RFCO2
09400
09500 HERE(SFCOC)
09600 PUSHJ P,SAVE
09700 MOVE LPSA,X44
09800 VALCH1 1,-3(P),SFCO1
09900 SFCO2: MOVE 2,-2(P)
10000 MOVE 3,-1(P)
10100 JSYS SFCOC
10200 JRST RESTR
10300 SFCO1: MOVE 1,-3(P) ;USE LITERALLY
10400 JRST SFCO2
10500
10600 HERE(GTTYP)
10700 PUSHJ P,SAVE
10800 MOVE LPSA,X33
10900 VALCH1 1,-2(P),GTTYP1
11000 GTTYP2: JSYS GTTYP
11100 MOVEM 2,RACS+A(USER) ;TERMINAL TYPE NUMBER FOR RETURN
11200 MOVEM 3,@-1(P) ;XWD INBUFS, OUTBUFS
11300 JRST RESTR
11400 GTTYP1: MOVE 1,-2(P) ;USE LITERALLY
11500 JRST GTTYP2
11600
11700 HERE(STTYP)
11800 PUSHJ P,SAVE
11900 MOVE LPSA,X33
12000 VALCH1 1,-2(P),STTYP1
12100 STTYP2: MOVE 2,-1(P) ;NEW TERMINAL TYPE
12200 JSYS STTYP
12300 JRST RESTR
12400 STTYP1: MOVE 1,-2(P) ;USE LITERALLY
12500 JRST STTYP2
12600
12700 HERE(SETEDIT)
12800 PUSHJ P,SAVE
12900 MOVE LPSA,X33
13000 VALCHN 1,-2(P),SETTT1
13100 SKIPL 2,TTYINF(CDB) ;IS IT THE CONTROLLING TERMINAL?
13200 JRST SETTT2 ;NO RETURN(0);
13300 HRRZ 2,2 ;OLD VALUE
13400 MOVE 2,["B"
13500 "D"
13600 "T"](2)
13700 HRRZM 2,RACS+A(USER) ;RETURN OLD VALUE
13800 MOVE 2,-1(P) ;NEW VALUE
13900 CAIL 2,"a"
14000 CAILE 2,"z"
14100 JRST .+2
14200 SUBI 2," " ;UPPER CASE
14300 CAIN 2,"B"
14400 JRST [MOVEI 2,TNXINP
14500 JRST SETTT3]
14600 CAIN 2,"D"
14700 JRST [MOVEI 2,DECLED
14800 JRST SETTT3]
14900 CAIN 2,"T"
15000 JRST [MOVEI 2,TENXED
15100 JRST SETTT3]
15200 ERR <SETEDIT: Buffering mode must be "B", "D" or "T">,1
15300 MOVEI 2,TENXED ;ASSUME THIS FOR USER
15400 SETTT3: HRRM 2,TTYINF(CDB)
15500 JRST RESTR ;AND RETURN
15600
15700 SETTT1: ERR <SETEDIT: Channel argument must be a SAIL channel>,1
15800 JRST RESTR
15900
16000 SETTT2: SETZM RACS+A(USER)
16100 JRST RESTR
16200
16300 ENDCOM(TTM)
16400
00100 COMPIL(PAGES,<PMAP>,<SAVE,RESTR,X44>
00200 ,<PAGES -- PAGE MANAGEMENT>)
00300 DSCR SIMPLE PROCEDURE PMAP(INTEGER AC1,AC2,AC3);
00400 DESR
00500 Does the PMAP jsys, with these parameters:
00600
00700 ARGUMENTS:
00800 AC1 contents of AC1
00900 AC2 " of AC2
01000 AC3 " of AC3
01100
01200
01300 HERE(PMAP)
01400 PUSHJ P,SAVE
01500 MOVE LPSA,X44
01600 MOVE 1,-3(P) ;FILEPAGE
01700 MOVE 2,-2(P) ;XWD FORK,PAGE
01800 MOVE 3,-1(P) ;ACCESS BITS
01900 JSYS PMAP
02000 JRST RESTR
02100 ENDCOM(PAGES)
00100 COMPIL(TT2,<PBTIN,INTTY>
00200 ,<X22,.SKIP.,ZSETST,ZADJST,CTLOSW,$OSTYP>
00300 ,<TT2 -- IMSSS TTY ROUTINES>)
00400
00500 DSCR INTEGER SIMPLE PROCEDURE PBTIN(INTEGER SECONDS);
00600 DESR
00700 Executes the PBTIN jsys, with timing of SECONDS.
00800
00900 HERE(PBTIN)
01000 NOIMSSS<
01100 ERR <PBTIN: Only defined at IMSSS>
01200 >;NOIMSSS
01300 SETZM CTLOSW ;PROGRAM REQUESTS INPUT
01400 MOVE 1,-1(P) ;TIME IN SECONDS
01500 JSYS PBTIN
01600 SUB P,X22
01700 JRST @2(P)
01800
00100 DSCR STRING SIMPLE PROCEDURE INTTY;
00200 Using the PSTIN jsys, accepts as many as 200 characters from
00300 the user's Teletype, with the standard system breakcharacters. The
00400 breakcharacter itself is removed from the string, and
00500 no timing is available.
00600
00700 IMSSS<
00800 HERE(INTTY)
00900 PUSH P,1
01000 PUSH P,2
01100 PUSH P,3
01200 SETZB 3,CTLOSW ;PROGRAM REQUESTS INPUT
01300 MOVEI 2,=200 ;DEFAULT LENGTH
01400 INTT2: PUSH P,2 ;LENGTH
01500 PUSHJ P,ZSETST ;GET BP IN 1
01600 JSYS PSTIN
01700 CAIL 2,=200 ;DID WE GET 200 CHARS?
01800 JRST [SETOM .SKIP.
01900 JRST INTT1]
02000 LDB 3,1 ;GET THE LAST CHAR
02100 MOVEM 3,.SKIP. ;AND SAVE IT
02200 SOJ 1, ;BACK UP BYTE-POINTER (OVER LAST CHAR)
02300 IBP 1
02400 IBP 1
02500 IBP 1
02600 IBP 1
02700 INTT1: PUSH P,[=200]
02800 PUSH P,1
02900 PUSHJ P,ZADJST ;GET STRING ON STACK
03000 POP P,3
03100 POP P,2
03200 POP P,1
03300 POPJ P, ;RETURN
03400 >;IMSSS
03500
03600
00100 NOIMSSS<;NON-IMSSS VERSION OF INTTY FOR THOSE WHO SUFFER
00200 ;UNDER BBN'S LACK OF A SYSTEM LINE EDITOR
00300
00400 DSCR INTTY
00500 Simulation of the above routine, doing something
00600 that looks like "TENEX" line editing.
00700 ;
00800 HERE(INTTY)
00900 BEGIN INTTY
01000 ORIGCNT__=200
01100 ;AC USES A,B,C JSYS TEMPORARIES
01200 ; D BYTEPOINTER
01300 ; E COUNT, INITIALLY 0
01400 ; Q1 (=6) ORIGINAL BP
01500
01600
01700 PUSHJ P,SAVE
01800 SETZM CTLOSW
01900 ;GACK--TEST FOR TOPS20 OR TENEX. THIS CODE SHOULD BE REMOVED
02000 ;SOMEDAY, WHEN TENEX GOES AWAY, OR WHEN A CONDITIONAL
02100 ;COMPILATION SWITCH IS PUT IN FOR TOPS20
02200 SKIPN $OSTYP ;[CLH] TEST FOR TENEX
02300 JRST ISTENEX ;IT IS TENEX
02400 IST20:
02500 PUSH P,[ORIGCNT]
02600 PUSHJ P,ZSETST ;GET A BP IN A
02700 HRLI B,(1B1) ;[clh] BREAK ON CHARS
02800 HRRI B,ORIGCNT ;COUNT IN RH(B)
02900 SETZ C,
03000 OPDEF RDTTY [104000000523]
03100 RDTTY ;READ TTY INPUT
03200 JRST [ERR <RDTTY FAILED ON TOPS20?>,0]
03300 LDB C,A ;GET THE LAST CHAR
03400 INTT2: MOVEM C,.SKIP. ;AND SAVE IT
03500 SOJ A, ;BACK UP BYTE-POINTER (OVER LAST CHAR)
03600 IBP A
03700 IBP A
03800 IBP A
03900 IBP A
04000 ;[clh] if last char is lf, see if cr preceeded it. If so, use the cr as brk
04100 CAIE C,12 ;LF?
04200 JRST INTT1 ;NO, THEN WE HAVE THE RIGHT BREAK
04300 LDB C,A ;GET NEXT TO LAST CHAR
04400 CAIN C,15 ;CR?
04500 JRST INTT2 ;YES, USE IT AS BREAK
04600 ;[clh]^^
04700 INTT1: PUSH P,[=200] ;ADJUST STRING SPACE
04800 PUSH P,A
04900 PUSHJ P,ZADJST ;GET STRING ON STACK
05000 MOVE LPSA,X11
05100 JRST RESTR ;AND RETURN
05200
05300 ISTENEX:
05400 MOVEI A,101
05500 JSYS RFMOD
05600 PUSH P,B ;SAVE THE TTY MODE
05700 TRO B,170000 ;WAKEUP ON EVERYTHING
05800 JSYS SFMOD
05900
06000 PUSH P,[ORIGCNT] ;
06100 PUSHJ P,ZSETST ;GET A GOOD BP IN A
06200 MOVE Q1,A
06300 RESTRT: MOVE D,Q1 ;GET THE ORIGINAL BP
06400 SETZ E, ;ZERO THE COUNT
06500 INLUP: CAIL E,ORIGCNT
06600 JRST CNTEXH ;COUNT EXHAUSTED
06700 INLU1: JSYS PBIN ;GET A CHAR
06800 CAIN A,15 ;CARRIAGE RETURN?
06900 JRST INLU1 ;YES, IGNORE
07000 CAIN A,37 ;EOL?
07100 MOVEI A,12 ;MAKE LINEFEED
07200 CAIN A,12
07300 JRST DONE ;IS A BREAK CHARACTER
07400 CAIN A,33 ;ESCAPE?
07500 JRST DONE
07600 CAIE A,32 ;CTRL-Z
07700 CAIN A,7 ;CTRL-G
07800 JRST DONE
07900 CAIE A,"R"-100 ;CTRL-R FOR REPEAT
08000 JRST NOCTR
08100 HRROI A,[ASCIZ/
08200 /]
08300 JSYS PSOUT
08400 JUMPE E,INLUP
08500 MOVEI A,101
08600 MOVE B,Q1 ;ORIG BP
08700 MOVN C,E ;COUNT THUS FAR
08800 JSYS SOUT
08900 JRST INLUP ;AND CONTINUE
09000 NOCTR: CAIE A,"X"-100 ;CONTROL-X FOR DELETE LINE
09100 JRST NOCTX
09200 DOCTX: HRROI A,[ASCIZ/
09300 /]
09400 JSYS PSOUT
09500 JRST RESTRT ;AND START ALL OVER
09600 NOCTX: CAIE A,177 ;RUBOUT OR
09700 CAIN A,"A"-100 ;CONTROL-A
09800 JRST .+2
09900 JRST NOCTA
10000 JUMPLE E,DOCTX ;IF NO CHARS THEN DO A CONTROL-X
10100 MOVEI A,"\"
10200 JSYS PBOUT
10300 LDB A,D ;LAST CHAR
10400 JSYS PBOUT
10500 MOVE A,D
10600 JSYS BKJFN
10700 JFCL
10800 MOVEM A,D ;BACK UP BP
10900 SOJA E,INLUP ;SUBTRACT 1 AND CONTINUE
11000 NOCTA: IDPB A,D
11100 AOJA E,INLUP ;ONE MORE CHAR
11200
11300 CNTEXH: SETO A, ;INDICATE NO COUNT
11400 DONE: MOVEM A,.SKIP. ;BREAK CHAR, -1 FOR EXHAUSTED
11500 PUSH P,[ORIGCNT]
11600 PUSH P,D ;NEW BP
11700 PUSHJ P,ZADJST ;FIX UP STRING SPACE, PUT STRING ON STACK
11800 MOVEI A,101
11900 POP P,B ;MODE SETTING
12000 JSYS SFMOD ;RESET
12100 MOVE LPSA,X11
12200 JRST RESTR ;AND RETURN
12300
12400 BEND INTTY
12500 >;NOIMSSS
12600
12700 ENDCOM(TT2)
00100 COMMENT TTY FUNCTIONS
00200
00300
00400 DSCR TTY FUNCTIONS
00500 CAL SAIL
00600
00700
00800 Comment
00900 INTEGER PROCEDURE INCHRW;
01000 RETURN A CHAR FROM PBIN
01100
01200 INTEGER PROCEDURE INCHRS;
01300 RETURN -1 IF NO CHAR WAITING, ELSE FIRST CHAR (SIBE FOLLOWED BY PBIN)
01400
01500 STRING PROCEDURE INCHWL;
01600 WAIT FOR A LINE, THEN RETURN IT (PBINs, LINE EDITING)
01700
01800 STRING PROCEDURE INCHSL(REFERENCE INTEGER FLAG);
01900 FLAG_-1, STR_NULL IF NO LINE, ELSE FLAG_0,
02000 STR_LINE (SIBE, FOLLOWED BY PBINs)
02100
02200 STRING PROCEDURE INSTR(INTEGER BRCHAR);
02300 RETURN ALL CHARS TO AND NOT INCLUDING BRCHAR (PBINs)
02400
02500 STRING PROCEDURE INSTRL(INTEGER BRCHAR);
02600 WAIT FOR ONE LINE, THEN DO INSTR (PBINs WITH EDITING)
02700
02800 STRING PROCEDURE INSTRS(REFERENCE INTEGER FLAG; INTEGER BRCHAR);
02900 FLAG_-1, STR_NULL IF NO LINES, ELSE FLAG_0,
03000 STR_INSTR(BRCHAR)
03100
03200
03300 PROCEDURE OUTCHR(INTEGER CHAR);
03400 OUTPUT CHAR (PBOUT)
03500
03600 PROCEDURE OUTSTR(STRING STR);
03700 OUTPUT STR (SOUT)
03800
03900
04000 PROCEDURE CLRBUF;
04100 CLEARS INPUT BUFFER (CFIBF)
04200
04300 TTYIN, TTYINS, TTYINL (TABLE, @BRCHAR);
04400 TTYIN WORKS WITH TTCALL 0'S; TTYINS DOES A SKIP
04500 ON LINE FIRST, RETURNING NULL AND -1 IN BREAK IF NO LINES
04600 TTYINL DOES A WAIT FOR LINE FIRST.
04700 FULL BREAKSET CAPABILITIES EXCEPT FOR
04800 "R" MODE (AND OF COURSE, LINE NUM. STUFF)
04900
05000 TITLE TTYUUO
05100
05200
05300 COMPIL(TTY,<PBIN,PBOUT,PSOUT,INCHRW,INCHRS,INCHWL,INCHSL,INSTR,OUTCHR,OUTSTR,INSTRL,INSTRS,CLRBUF,TTYIN,TTYINS,TTYINL,TTYUP,RSCAN
05400 >
05500 ,<SAVE,RESTR,X11,X22,X33,INSET,CAT,CATCHR,STRNGC,GOGTAB,BRKMSK,.SKIP.,CTLOSW>
05600 ,<TELETYPE FUNCTIONS>)
05700 ;;#GF# DCS 2-1-72 (1-3) INCHWL BREAKS ON ALL ACTIVATION, TELLS WHICH IN .SKIP.
05800 ; .SKIP. EXTERNAL ABOVE
05900 ;;#GF#
06000
00100 HERE(PBIN)
00200 HERE (INCHRW)
00300 SETZM CTLOSW ;INPUT REQUESTED
00400 INCHR1: JSYS PBIN
00500 POPJ P,
00600
00700 HERE (INCHRS)
00800 SETZM CTLOSW ;INPUT REQUESTED
00900 MOVEI 1,100
01000 JSYS SIBE
01100 JRST INCHR1
01200 SETO 1, ;RETURN -1
01300 POPJ P,
01400
01500 HERE(PBOUT)
01600 HERE (OUTCHR)
01700 SKIPE CTLOSW ;DOING OUTPUT?
01800 JRST OUTCRE ;NO
01900 EXCH 1,-1(P) ;GET PARAMETER, SAVING AC 1
02000 JSYS PBOUT ;OUTPUT CHAR
02100 EXCH 1,-1(P) ;GET BACK 1
02200 OUTCRE: SUB P,X22
02300 JRST @2(P) ;RETURN
02400
02500
02600 HERE(PSOUT)
02700 HERE (OUTSTR)
02800 SKIPE CTLOSW ;DOING OUTPUT?
02900 JRST [SUB SP,X22
03000 POPJ P,
03100 ]
03200 EXCH 2,(SP) ;BP WORD
03300 EXCH 3,-1(SP) ;LENGTH WORD
03400 PUSH P,1 ;ALSO NEED 1
03500 HRRZ 3,3 ;COUNT
03600 JUMPE 3,NULSTR ;DONT SEND EMPTY STR
03700 MOVEI 1,101 ;TERMINAL OUTPUT
03800 MOVN 3,3
03900 JSYS SOUT
04000 NULSTR: POP P,1
04100 POP SP,2
04200 POP SP,3 ;ADJUSTS STACK AUTOMATICALLY
04300 POPJ P, ;RETURN
04400
04500 ;REDSTR (0) MARKS CTLOSW THAT INPUT WAS REQUESTED
04600 ;(1) PREPARES TO MAKE A STRING OF 200 CHARS,
04700 ;(2) ZEROS C FOR COUNT
04800 ;(3) SETS UP D WITH THE ORIGINAL BYTE-POINTER
04900
05000 REDSTR: SETZM CTLOSW ;INPUT REQUESTED
05100 SKIPE SGLIGN(USER)
05200 PUSHJ P,INSET
05300 MOVEI A,=200
05400 ADDM A,REMCHR(USER)
05500 SKIPLE REMCHR(USER)
05600 PUSHJ P,STRNGC
05700 SETZ C, ;COUNT HERE
05800 MOVE D,TOPBYTE(USER) ;ORIGINAL BYTE-POINTER, IF NEEDED
05900 PUSH SP,[0] ;NULL STRING IF NOTHING DONE
06000 PUSH SP,TOPBYTE(USER)
06100 POPJ P,
06200
06300 FINSTR: MOVEI A,=200
06400 SUB A,C ;NUMBER USED
06500 ADDM A,REMCHR(USER)
06600 HRROM C,-1(SP) ;STRING COUNT WORD
06700 MOVEM D,TOPBYTE(USER) ;NEW TOPBYTE
06800 JRST RESTR
06900
07000 ;CALL TO HERE WITH A PUSHJ TO GET A CHAR IN AC1
07100 ;AC 3 HAS THE COUNT, D THE BYTE-POINTER
07200 EDICHR:
07300 JSYS PBIN ;GET A CHARACTER
07400 CAIN 1,DELLINE ;DELETE LINE CHAR
07500 JRST CTRLU
07600 CAIN 1,RUBCHAR ;RUBOUT?
07700 JRST RUBOUT
07800 CAIN 1,37 ;PHONEY TENEX EOL?
07900 MOVEI 1,12
08000 CAIN 1,33 ;PHONEY TENEX ALTMODE?
08100 MOVEI 1,ALTMODE ;DEC ALTMODE
08200 POPJ P, ;GOOD CHAR FOR USER
08300
08400 CTRLU:
08500 ;AC 1 IS FREE
08600 HRROI 1,[BYTE (7) 7,15,12,0,0]
08700 JSYS PSOUT
08800 JUMPE C,EDICHR ;IF NO CHARS THEN DO NOTHING
08900 SETZ C,
09000 MOVE D,TOPBYTE(USER)
09100 JRST EDICHR
09200
09300 RUBOUT: JUMPE C,CTRLU ;IF NO CHARS THEN DO CTRLU
09400 ;AC 1 IS AVAILABLE
09500 IMSSS<
09600 MOVEI 1,101 ;PRIMARY OUTPUT
09700 JSYS DELCH
09800 JFCL
09900 JRST DLTED ;DISPLAY -- LINE EMPTY
10000 JRST DLTED ;DISPLAY -- DELETE DONE
10100 >;IMSSS
10200 MOVEI 1,"\"
10300 JSYS PBOUT
10400 LDB 1,D ;GET LAST CHAR
10500 JSYS PBOUT ;AND SEND IT
10600 DLTED:
10700 SOJ D, ;BACK UP BP TO LAST CHAR
10800 IBP D
10900 IBP D
11000 IBP D
11100 IBP D
11200 SOJA C,EDICHR ;AND GET ANOTHER CHAR
11300
11400 HERE(INSTRL)
11500 HERE (INSTR)
11600 PUSHJ P,SAVE
11700 PUSHJ P,REDSTR
11800 MOVE B,-1(P) ;BREAK CHAR
11900 MOVE LPSA,X22 ;# TO REMOVE
12000
12100 INS1: CAIL C,=200 ;COUNT EXHAUSTED?
12200 JRST FINSTR ;YES
12300 INS2: PUSHJ P,EDICHR ;GET A CHAR IN 1, USING EDITING
12400 CAMN 1,B ;BREAK?
12500 JRST FINSTR ; YES, ALL DONE
12600 IDPB 1,D ;PUT IT AWAY AND
12700 AOJA C,INS1
12800
12900 HERE (INCHWL) PUSHJ P,SAVE
13000 PUSHJ P,REDSTR
13100 MOVE LPSA,X11
13200
13300 INS3: CAIL C,=200 ;COUNT EXHAUSTED?
13400 JRST DNSTR1 ;YES
13500 PUSHJ P,EDICHR ;GET A CHAR
13600 CAIE 1,ALTMODE
13700 CAIN 1,12
13800 JRST DNSTR
13900 CAIN 1,15 ;CR?
14000 JRST INS3 ;IGNORE
14100 IDPB 1,D ;PUT IT AWAY AND
14200 AOJA C,INS3 ;NEXT CHARACTER
14300
14400 DNSTR: MOVEM 1,.SKIP. ;SET BREAK CHAR
14500 JRST FINSTR
14600 DNSTR1: SETOM .SKIP. ;INDICATE COUNT EXHAUSTED
14700 JRST FINSTR
14800
14900
15000 HERE (INCHSL) PUSHJ P,SAVE
15100 MOVE LPSA,X22 ;PARAM (FLAG) AND RETURN
15200 PUSHJ P,REDSTR
15300 SETOM @-1(P) ;ASSUME FAILED
15400 MOVEI 1,100 ;PRIMARY INPUT
15500 JSYS SIBE ;CHARACTERS WAITING?
15600 SKIPA ;YES
15700 JRST FINSTR ;NO, FIX UP AND RETURN
15800 SETZM @-1(P)
15900 JRST INS3 ;AND USE INCHWL'S LOOP
16000
16100
16200 HERE(INSTRS)
16300 PUSHJ P,SAVE
16400 MOVE LPSA,X33
16500 PUSHJ P,REDSTR
16600 SETOM @-2(P) ;ASSUME FAILED
16700 MOVEI 1,100 ;RIMARY INPUT
16800 JSYS SIBE ;CHARACTERS WAITING
16900 SKIPA ;YES
17000 JRST FINSTR ;NO, FIX UP AND RETURN
17100 SETZM @-2(P) ;INDICATE SUCCESS
17200 MOVE B,-1(P) ;GET BREAK CHARACTER
17300 JRST INS2
17400
17500 HERE (CLRBUF)
17600 PUSH P,1
17700 MOVEI 1,100 ;PRIMARY INPUT
17800 JSYS CFIBF ;CLEAR BUFFER
17900 POP P,1
18000 POPJ P,
18100
18200 HERE (TTYINS) PUSHJ P,SAVE
18300 PUSHJ P,REDSTR ;PREPARE TO MAKE A STRING
18400 MOVE LPSA,X33
18500 SETOM @-1(P) ;ASSUME NO CHARS
18600 MOVEI 1,100 ;PRIMARY INPUT
18700 JSYS SIBE ;CHARS WAITING?
18800 SKIPA ;YES
18900 JRST FINSTR ;NONE WAITING
19000 JRST TYIN1 ;GO AHEAD
19100
19200
19300 HERE(TTYINL)
19400 HERE (TTYIN) PUSHJ P,SAVE
19500 TYIN: PUSHJ P,REDSTR ;PREPARE STACK,A,STRNGC FOR A STRING
19600 MOVE LPSA,X33 ;PREPARE TO RETURN
19700 TYIN1: SETZM @-1(P) ;ASSUME NO BREAK CHAR
19800 MOVE X,-2(P) ;TABLE #
19900 MOVEI TEMP,-1 ;BLOCK MUST BE THERE AND TABLE MUST BE INIT'ED
20000 PUSHJ P,BKTCHK ;CHECK TABLE #
20100 JRST FINSTR ;ERROR
20200 MOVE FF,BRKMSK(CHNL) ;BITS FOR THIS TABLE
20300 ADD CHNL,CDB ;RELOCATE RANGE 1 TO 18
20400 MOVEI Z,1 ;FOR TESTING LINE NUMBERS
20500 SKIPN LINTBL(CHNL) ;DON'T LET TEST SUCCEED IF
20600 MOVEI Z,0 ;WE'RE TO LET LINE NUMBERS THRU
20700 MOVE Y,CDB
20800 ADD Y,[XWD 1,BRKTBL] ;BRKTBL+RLC(CDB)
20900 TTYN: CAIL C,=200 ;COUNT EXCEEDED?
21000 JRST FINSTR ;YES
21100 PUSHJ P,EDICHR ;GET A CHAR
21200 TTYN1: TDNE FF,@Y ;BREAK OR OMIT?
21300 JRST TTYSPC ; YES, FIND OUT WHICH
21400 TTYC: IDPB 1,D ;PUT IT AWAY
21500 AOJA C,TTYN ;COUNT AND CONTINUE
21600 JRST FINSTR ;DONE
21700 TTYSPC: HLLZ TEMP,@Y ;WHICH?
21800 TDNN TEMP,FF
21900 JRST TTYN ;OMIT
22000 MOVEM 1,@-1(P)
22100 SKIPN Y,DSPTBL(CHNL) ;WHAT TO DO WITH IT
22200 JRST FINSTR ;DONE, NO SAVE
22300 JUMPL Y,TTYAPP ;APPEND
22400 PUSH P,1 ;SAVE
22500 MOVEI 1,100 ;PRIMARY INPUT
22600 JSYS BKJFN
22700 ERR <CAN'T RETAIN BREAK CHAR FROM TTYIN>,1
22800 POP P,1
22900 JRST FINSTR ;AND RETURN
23000 TTYAPP: IDPB 1,D ;COUNT THE BREAK CHAR
23100 ADDI C,1 ;ONE MORE HAPPY CHAR
23200 JRST FINSTR
23300
23400
23500 DSCR INTEGER PROCEDURE TTYUP(INTEGER NEWVALUE)
23600
23700 Using the RFMOD and SFMOD jsyses, sets lower-to-upper
23800 case conversion to NEWVALUE, returning the oldvalue. Tests
23900 and modifies bit 31 of the RFMOD word for the primary input
24000 file.
24100 ;
24200 HERE(TTYUP)
24300 PUSHJ P,SAVE
24400 MOVE LPSA,X22 ;SET FOR RETURN
24500 MOVEI A,101 ;PRIMARY INPUT FILE
24600 JSYS RFMOD ;GET THE CURRENT SETTINGS
24700 SETZ C, ;ASSUME NOT CURRENTLY SET
24800 TRNE B,1B31 ;IS IT SET?
24900 SETO C, ;IT WAS
25000 MOVEM C,RACS+A(USER)
25100 MOVE C,[TRO B,1B31] ;ASSUME WE WANT TO SET UP
25200 SKIPN -1(P) ;DID WE REALLY?
25300 MOVE C,[TRZ B,1B31] ;NO, DONT
25400 XCT C
25500 JSYS STPAR
25600 JRST RESTR ;AND RETURN
25700
25800 ;[clh/daw]
25900 DSCR BOOLEAN SIMPLE PROCEDURE RSCAN(INTEGER FUNCTION; STRING STR);
26000 Depending upon function, the string may be put into the rescan
26100 buffer.
26200
26300
26400 HEREFK(RSCAN,$RSCAN)
26500
26600 push p,b
26700 skipn -1(sp) ;if string not null
26800 jrst rscan1
26900 push p,[0] ;make it ASCIZ
27000 pushj p,catchr
27100 rscan1: move a,-2(p) ;get function code
27200 skipe -1(sp) ;but if string not null
27300 move a,(sp) ; use string pointer
27400 jsys rscan
27500 ercal rscan2
27600 pop p,b ;restore ac's
27700 sub sp,x22 ;clean up
27800 sub p,x22
27900 jrst @2(p)
28000
28100 rscan2: movei a,400000 ;get most recent error
28200 jsys geter ;don't trust jsys, could go away
28300 hrrm a,.skip. ;save it
28400 setz a, ;return zero for error
28500 popj p,
28600
28700 ;[clh/daw] ^^
28800
28900 ENDCOM(TTY)
29000 COMPIL(PTY)
29100 ENDCOM(PTY)
29200
29300 COMPIL(FIL,<FILNAM>,<FLSCAN,X22>,<FILNAM SCANNING ROUTINE>)
00100 COMMENT Filnam
00200
00300 DSCR FILNAM
00400 CAL PUSHJ
00500 PAR file name string on SP stack
00600 of form FILENAME<.EXT><[PROJ,PROG]>
00700 RES FNAME(USER) : SIXBIT /filename/
00800 EXT(USER): SIXBIT /extension,,0/
00900 0
01000 PRPN(USER): SIXBIT /PRJ PRG/ (or zero)
01100 SID uses D,X,Y (4-6), REMOVES STRING FROM STACK
01200
01300
01400 ^^FILNAM:
01500 SUB SP,X22 ;ADJUST STACK
01600 FOR II_1,3 <
01700 SETZM FNAME+II(USER)>
01800 MOVEI X,FNAME(USER) ;WHERE TO PUT IT
01900 PUSHJ P,FLSCAN ;GET FILE NAME
02000 JUMPE Y,FLDUN ;FILE NAME ONLY
02100 CAIE Y,"." ;EXTENSION?
02200 JRST FLEXT ;NO, CHECK PPN
02300 MOVEI X,FNAME+1(USER)
02400 PUSHJ P,FLSCAN
02500 FLEXT: JUMPE Y,FLDUN ;NO PPN SPECIFIED
02600 CAIE Y,"["
02700 JRST FLERR ;INVALID CHARACTER
02800 PUSHJ P,[
02900
03000 RJUST: SETZM PROJ(USER)
03100 MOVEI X,PROJ(USER)
03200 PUSHJ P,FLSCAN ;GET PROJ OR PROG IN SIXBIT
03300 IFN SIXSW,<
03400 MOVE X,PROJ(USER)
03500 IMULI D,-6 ;SHIFT FACTOR
03600 LSH X,(D) ;RIGHT-JUSTIFY THE PROJ OR PROG
03700 >;IF SIXSW (SET IN HEAD, USUALLY CONDITIONED ON NOEXPO)
03800
03900 IFE SIXSW,<
04000 MOVEI X,0
04100 ;;#GT# DCS 5-11-72 ALLOW LARGE OCTAL NUMBERS AT STD DEC SYSTEMS
04200 MOVE D,PROJ(USER) ;WAS A HLLZ
04300 ;;
04400 FBACK: MOVEI C,0
04500 LSHC C,6 ;GET A SIXBIT CHAR
04600 CAIL C,'0'
04700 CAILE C,'7'
04800 JRST FLERR ;INVALID OCTAL
04900 LSH X,3
05000 IORI X,-'0'(C)
05100 JUMPN D,FBACK
05200 >;NOT SIXSW (USUALLY CONDITIONED ON EXPO)
05300 FPOP: POPJ P,]
05400
05500 HRLZM X,FNAME+3(USER)
05600 CAIE Y,","
05700 JRST FLERR ;INVALID CHAR
05800 PUSHJ P,RJUST ;JUSTIFY(AND CONVERT IF EXPORT) PROG #
05900 HRRM X,FNAME+3(USER)
06000 CAIN Y,"]"
06100 FLDUN: AOS (P) ;SUCCESSFUL
06200 FLERR: POPJ P, ;DONE, NOT NECESSARILY RIGHT
06300
06400 ENDCOM(FIL)
06500 COMPIL(FLS,<FLSCAN>,,<FLSCAN ROUTINE>)
00100 COMMENT Flscan
00200
00300 DSCR FLSCAN
00400 CAL PUSHJ
00500 PAR X -- addr of destination SIXBIT
00600 1(SP), 2(SP) -- input string
00700 RES sixbit for next filename, etc in word addressed by X
00800 break (punctuation) char in Y (0 if string exhausted)
00900 D,X, input string adjusted
01000 SID only those AC changes listed above (Y, for instance)
01100
01200
01300 ^^FLSCAN:
01400 HRRZS 1(SP) ;WANT ONLY LENGTH PART
01500 MOVEI D,6 ;MAX NUMBER PICKED UP
01600 SETZM (X) ;ZERO DESTINATION
01700 HRLI X,440600 ;BYTE POINTER NOW
01800 FLN1: MOVEI Y,0 ;ASSUME NO STRING LEFT
01900 SOSGE 1(SP) ;TEST 0-LENGTH STRING
02000 POPJ P,
02100 ILDB Y,2(SP) ;GET BYTE
02200 CAIE Y,"." ;CHECK VALID BRE0 CAIE Y,
02300 CAIN Y,"["
02400 POPJ P,
02500 CAIE Y,"]"
02600 CAIN Y,","
02700 POPJ P,
02800 JUMPE D,FLN1 ;NEED NO MORE CHARS
02900 TRZN Y,100 ;MOVE 100 BIT TO 40 BIT
03000 TRZA Y,40 ; TO CONVERT TO SIXBIT
03100 TRO Y,40 ; (NO CHECKING)
03200 IDPB Y,X ;PUT IT AWAY
03300 SOJA D,FLN1 ;CONTINUE
03400
03500 ENDCOM(FLS)
00100 COMPIL(CAS,<CSERR,LPRYER>,<GOGTAB>
00200 ,<CSERR, LPRYER -- SUPPORT ROUTINES>)
00300 HERE(CSERR) MOVE USER,GOGTAB
00400 POP P,UUO1(USER) ;STANDARD PLACE
00500 ERR <CASE INDEX OVERFLOW, VALUE IS >,13
00600 JRST @UUO1(USER) ;RETURN OK
00700
00800 HERE (LPRYER) ERR <DATUM OF ARRAY NOT THERE>,1
00900 POPJ P,
01000
01100 ENDCOM(CAS)
01200
01300
01400 IFN ALWAYS, <BEND IOSER>
01500 DSCR BEND IOSER
01600 >;TENX
00100
00200
00300
00400
00500
00600
00700
00100
00200
00300
00400
00500
00600
00700
00100
00100