perm filename IOSER.TNX[10X,AIL]17 blob
sn#211486 filedate 1976-04-11 generic text, type T, neo UTF8
00100 COMMENT ⊗ VALID 00117 PAGES
00200 C REC PAGE DESCRIPTION
00300 C00001 00001
00400 C00010 00002
00500 C00011 00003
00600 C00012 00004
00700 C00013 00005 TENX<THE ENTIRE FILE IS FOR TENEX ONLY
00800 C00016 00006 DSCR IOSTT(CDB) values.
00900 C00019 00007
01000 C00023 00008 COMPIL(PAT,<OPEN,LOOKUP,ENTER,USETI,USETO,MTAPE,TENXFI,RELEASE,CLOSE,CLOSIN,CLOSO,GETCHAN,CVJFN,RENAME>
01100 C00032 00009 DSCR PROCEDURE LOOKUP(INTEGER CHNL STRING FILE REFERENCE INTEGER FLAG)
01200 C00036 00010 HERE(ENTER)
01300 C00039 00011 DSCR
01400 C00042 00012 DSCR PROCEDURE USETI,USETO(INTEGER CHANNEL,BLOCK)
01500 C00044 00013 DSCR PROCEDURE CLOSE(INTEGER CHANNEL,[CLOSE_INHIBIT_BITS])
01600 C00045 00014 HERE(RELEASE)
01700 C00046 00015 DSCR
01800 C00047 00016 DSCR STRING PROCEDURE TENXFI(STRING DECFILE)
01900 C00051 00017 DSCR
02000 C00053 00018 COMPIL(JOBINF,<ODTIM,IDTIM,RUNTM,GTAD,GJINF>,<ZSETST,ZADJST,X22,X33,X44,.SKIP.,CATCHR>
02100 C00054 00019
02200 C00055 00020 DSCR INTEGER SIMPLE PROCEDURE RUNTM(INTEGER FORK REFERENCE INTEGER CONSOLE)
02300 C00056 00021 DSCR INTEGER SIMPLE PROCEDURE GTAD
02400 C00057 00022 DSCR INTEGER SIMPLE PROCEDURE GJINF(REFERENCE INTEGER LOGDIR,CONDIR,TTYNO)
02500 C00058 00023 ENDCOM(JOBINF)
02600 C00059 00024 COMPIL(DIRECT,<STDIR,DIRST>,<X22,X33,CATCHR,ZSETST,ZADJST.SKIP.>
02700 C00061 00025 DSCR STRING SIMPLE PROCEDURE DIRST(INTEGER I)
02800 C00062 00026 COMPIL(RUNPRG,<RUNPRG>,<X22,X33,CATCHR>,<RUNPRG -- RUN A PROGRAM>)
02900 C00067 00027 COMPIL(OPF,<OPENFILE,SETINPUT,SETPL,INDEXFILE,SETCHAN>,<.SKIP.>,<OPENFILE -- OPEN A FILE>)
03000 C00076 00028 DSCR PROCEDURE SETINPUT(INTEGER CHAN REFERENCE INTEGER COUNT,BR,EOF)
03100 C00077 00029 DSCR
03200 C00079 00030 DSCR
03300 C00081 00031 DSCR SETCHAN(JFN,GTFLAGS,OPFLAGS)
03400 C00082 00032 COMPIL(GTJFN,<GTJFN,GTJFNL>,<.SKIP.,SETCHN,CATCHR,X11,X22,X44>,<GTJFN -- GET A JFN>)
03500 C00084 00033 DSCR INTEGER PROCEDURE GTJFNL(STRING ORIG INTEGER FLAGS, XWDJFN!JFN
03600 C00087 00034 COMPIL(FILINF,<GNJFN,DELF,UNDELETE,DELNF,SIZEF,JFNS,JFNSL,OPENF,CFILE,CLOSF,RLJFN,GTSTS,STSTS,RNAMF>
03700 C00089 00035 DSCR PROCEDURE DELF(INTEGER CHAN)
03800 C00090 00036 DSCR PROCEDURE UNDELETE(INTEGER CHAN)
03900 C00091 00037 DSCR INTEGER PROCEDURE SIZEF(INTEGER JFN)
04000 C00092 00038
04100 C00094 00039 DSCR SIMPLE PROCEDURE OPENF(INTEGER JFN,FLAGS)
04200 C00096 00040
04300 C00099 00041 DSCR SIMPLE PROCEDURE CLOSF(INTEGER JFN)
04400 C00101 00042 DSCR SIMPLE PROCEDURE RLJFN(INTEGER JFN)
04500 C00102 00043 DSCR INTEGER SIMPLE PROCEDURE GTSTS(INTEGER JFN)
04600 C00103 00044 DSCR BOOLEAN SIMPLE PROCEDURE STSTS(INTEGER JFN,STATUS)
04700 C00104 00045 DSCR BOOLEAN SIMPLE PROCEDURE RNAMF(INTEGER EXISTINGJFN,NEWJFN)
04800 C00105 00046 COMPIL(DEVINF,<CNDIR,ASND,RELD,GDSTS,SDSTS,STDEV,DEVST,GTFDB,CHFDB>
04900 C00107 00047 DSCR BOOLEAN PROCEDURE ASND(INTEGER DEVICE)
05000 C00108 00048 DSCR BOOLEAN PROCEDURE RELD(INTEGER DEVICE)
05100 C00109 00049 DSCR INTEGER SIMPLE PROCEDURE GDSTS(INTEGER CHAN REFERENCE INTEGER WORDCNT)
05200 C00110 00050 DSCR PROCEDURE SDSTS(INTEGER JFN,NEWSTATUS)
05300 C00111 00051 DSCR INTEGER PROCEDURE STDEV(STRING S)
05400 C00112 00052
05500 C00113 00053 DSCR SIMPLE PROCEDURE GTFDB(INTEGER JFN REFERENCE INTEGER ARRAY BUF)
05600 C00114 00054
05700 C00115 00055 DSCR INTEGER SIMPLE PROCEDURE WORDIN(INTEGER JFN)
05800 C00117 00056 HERE(ARRYIN)
05900 C00121 00057 HERE(WORDOUT)
06000 C00123 00058 HERE(ARRYOUT)
06100 C00126 00059
06200 C00128 00060 HERE(SWDPTR)
06300 C00130 00061
06400 C00137 00062 SETWPT:
06500 C00141 00063 SETWIO:
06600 C00142 00064 ADWI:
06700 C00144 00065 DSCR CHAR←CHARIN(CHANNEL)
06800 C00147 00066 DSCR STRING SIMPLE PROCEDURE SINI(INTEGER JFN,MAXLENGTH,BRKCHAR)
06900 C00151 00067 Input
07000 C00158 00068 .DOINP: PUSHJ P,DOINP
07100 C00159 00069
07200 C00163 00070 Realin, Realscan
07300 C00165 00071 Intin, Intscan
07400 C00167 00072 DSCR NUMIN
07500 C00170 00073 NUMIN -- CONTD.
07600 C00174 00074 SCAN (CALLED BY NUMIN AND STRIN)
07700 C00179 00075 Character table for SCAN (Realscan,Intscan,Realin,Intin)
07800 C00181 00076 DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
07900 C00182 00077
08000 C00184 00078
08100 C00187 00079 DSCR PROCEDURE LINOUT(INTEGER JFN,VALUE)
08200 C00190 00080 HERE(RCHPTR)
08300 C00191 00081 HERE(SCHPTR)
08400 C00193 00082 DSCR Auxiliary routines for character i/o.
08500 C00199 00083 SETCPT:
08600 C00202 00084 SETCIO:
08700 C00203 00085 DSCR
08800 C00216 00086 DSCR ADCO,ADCO1
08900 C00220 00087 DSCR SETIO
09000 C00227 00088 DSCR
09100 C00230 00089 ENDCOM(IOROU)
09200 C00231 00090 DSCR SIMPLE PROCEDURE SFPTR(INTEGER JFN,POINTER)
09300 C00232 00091 DSCR INTEGER SIMPLE PROCEDURE RFPTR(INTEGER JFN)
09400 C00233 00092 DSCR SIMPLE PROCEDURE MTOPR(INTEGER JFN,FUNCTION,VALUE)
09500 C00234 00093 DSCR SIMPLE PROCEDURE BKJFN(INTEGER JFN)
09600 C00235 00094 DSCR INTEGER SIMPLE PROCEDURE RFBSZ(INTEGER JFN)
09700 C00236 00095 COMPIL(DSKOPS,<DSKIN,DSKOUT>
09800 C00238 00096 DSCR SIMPLE PROCEDURE
09900 C00239 00097 COMPIL(DEVS,<DEVTYPE,DVCHR,ERSTR>
10000 C00240 00098 DSCR INTEGER SIMPLE PROCEDURE DVCHR(INTEGER JFN REFERENCE INTEGER AC1,AC3)
10100 C00241 00099 DSCR SIMPLE PROCEDURE ERSTR(INTEGER ERRNO,FORK)
10200 C00243 00100 COMPIL(UTILITY,<SETCHN,ZSETST,ZADJST,.RESET,RDSEG>
10300 C00249 00101 DSCR STRING SIMPLE PROCEDURE ZADJST(INTEGER CNTEST,BP)
10400 C00252 00102 DSCR
10500 C00256 00103 COMPIL(TTM,<RFMOD,SFMOD,STPAR,STI,RFCOC,SFCOC,GTTYP,STTYP,SETEDIT>
10600 C00262 00104 COMPIL(PAGES,<PMAP>,<SAVE,RESTR,X44>
10700 C00263 00105 COMPIL(TT2,<PBTIN,INTTY>
10800 C00264 00106 DSCR STRING SIMPLE PROCEDURE INTTY
10900 C00266 00107 NOIMSSS<NON-IMSSS VERSION OF INTTY FOR THOSE WHO SUFFER
11000 C00269 00108 TTY FUNCTIONS
11100 C00272 00109 HERE(PBIN)
11200 C00282 00110 Filnam
11300 C00285 00111 Flscan
11400 C00287 00112 COMPIL(CAS,<CSERR,LPRYER>,<GOGTAB>
11500 C00288 00113
11600 C00289 00114
11700 C00290 00115
11800 C00291 00116
11900 C00292 00117
12000 C00293 ENDMK
12100 C⊗;
00100
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
04100 ;ADDITIONS TO CDB NUMBERS SHOULD INCLUDE CHANGE TO IOTLEN BELOW
04200
04300 ?IOTLEN←←26 ;CURRENT LENGTH OF CDB BLOCK
04400
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
02800 ;MACROS FOR BIT TESTING
02900
03000 DEFINE .ZZZ $ (X,Y,Z)<
03100 IFN Z&777777000000, <TL$X Y,Z⊗-=18> ;Z LSH -=18
03200 IFN Z&777777, <TR$X Y,Z>
03300 >
03400
03500 DEFINE TESTE (Y,Z) <.ZZZ NE,Y,Z> ;TDNE Y,[Z]
03600 DEFINE TESTN (Y,Z) <.ZZZ NN,Y,Z> ;TDNN Y,[Z]
03700 DEFINE TESTO (Y,Z) <.ZZZ O,Y,Z> ;TDO Y,[Z]
03800 DEFINE TESTZ (Y,W) <.ZZZ Z,Y,W> ;TDZ Y,[Z]
03900
04000
04100 ;MACRO TO GET THE JFN NUMBER IN X FROM Y. IF INVALID, JUMP TO LABEL Z
04200 ;LOADS CDB (I.E., 11) WITH THE CDB ADDRESS
04300 ;LOADS CHNL WITH THE CHANNEL NUMBER
04400 DEFINE VALCHN(X,Y,Z) <
04500
04600 SKIPL CHNL,Y
04700 CAIL CHNL,JFNSIZE
04800 JRST Z
04900 MOVE CDB,CDBTBL(CHNL)
05000 HRRZ X,JFNTBL(CHNL)
05100 JUMPE X,Z
05200 >;VALCHN
05300
05400 DEFINE LITCHN(X,Y,Z) <
05500 SKIPL X,Y
05600 CAIL X,JFNSIZE
05700 JRST Z
05800 MOVEM X,CHNL
05900 MOVE CDB,CDBTBL(CHNL)
06000 HRRZ X,JFNTBL(CHNL)
06100 >;LITCHN
06200
06300 ;ONLY USES AC X
06400 DEFINE VALCH1(X,Y,Z) <
06500 SKIPL X,Y
06600 CAIL X,JFNSIZE
06700 JRST Z
06800 HRRZ X,JFNTBL(X)
06900 JUMPE X,Z
07000 >
07100
07200 ;TTY STUFF
07300 ;FOR DEC-STYLE I/O
07400 ;CHAR FOR LINE DELETION (DELLINE) AND CHARACTER DELETION (RUBCHAR)
07500 IFNDEF DELLINE,<?DELLINE←←"U"-100> ;CTRL-U
07600 IFNDEF RUBCHAR,<?RUBCHAR←←177> ;RUBOUT
07700 IFNDEF ALTMODE,<?ALTMODE←←33 ;ONE OF MANY VERSIONS>
07800
07900 DSCR
08000 TTYINF for information about the controlling terminal.
08100 ⊗
08200
08300 ?ISCTRM←← 1B0 ;CHANNEL IS THE CONTROLLING TERM
08400 ?TNXINP←← 0 ;DO STANDARD TENEX INPUT
08500 ?DECLED←← 1 ;DO DEC-STYLE INPUT
08600 ?TENXED←← 2 ;DO TENEX-STYLE INPUT
08700 ?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 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,IOTLEN
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,IOTLEN-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 JRST GUDRET ;AND RETURN
08600
08700 ;MOUNT AND OPEN DECTAPE IN DUMP MODE
08800 DOMNT: MOVE A,DVDSG(CDB) ;GET DEVICE DESIGNATOR
08900 TLO A,(1B3) ;DONT READ DIRECTORY FOR DUMP MODE
09000 JSYS MOUNT
09100 JRST BADOPN ;CANNOT MOUNT
09200 MOVSI GTFLAGS,100001
09300 MOVE 1,GTFLAGS
09400 MOVE 2,(SP)
09500 JSYS GTJFN
09600 JRST BADOPN
09700 MOVEM 1,JFNTBL(CHNL)
09800 MOVEM GTFLAGS,GFL(CDB)
09900 MOVE OPFLAGS,[447400000000!RDBIT!WRBIT]
10000 MOVE 2,OPFLAGS
10100 JSYS OPENF
10200 JRST CNTOPN
10300 JRST OPOK
10400
10500 GTNOW:
10600 MOVSI GTFLAGS,100001
10700 MOVE 1,GTFLAGS
10800 MOVE 2,(SP) ;DEVICE STRING
10900 JSYS GTJFN
11000 JRST BADOPN ;NOPE CANNOT GET
11100 MOVEM 1,JFNTBL(CHNL) ;SAVE JFN
11200 MOVEM GTFLAGS,GFL(CDB) ;AND SAVE THEM
11300 ;CHECK IF IT IS THE CONTROLLING TERMINAL (DEVICE "TTY" ONLY )
11400 MOVE 2,DVTYP(CDB) ;GET DEVICE TYPE
11500 CAIE 2,12 ;IS IT A TERMINAL?
11600 JRST NOTTTY ;NO
11700 PUSH P,3
11800 PUSH P,4
11900 PUSH P,5
12000 PUSH P,6
12100 HRRZ 2,JFNTBL(CHNL)
12200 HRROI 1,4 ;WRITE IN 4
12300 MOVSI 3,200000 ;DEVICE ONLY
12400 SETZ 4,
12500 JSYS JFNS ;GET STRING
12600 MOVEM 4,2 ;SAVE IN 2
12700 POP P,6
12800 POP P,5 ;RESTORE
12900 POP P,4
13000 POP P,3
13100 CAME 2,[ASCIZ/TTY/] ;DEVICE TTY?
13200 JRST NOTTTY ;NO
13300 MOVE 2,[ISCTRM+DECLED] ;THE CONTROLLING TERMINAL
13400 MOVEM 2,TTYINF(CDB) ;REMEMBER
13500 NOTTTY:
13600 ;COMPUTE OPENF FLAGS
13700 SETZ OPFLAGS,
13800 MOVE 2,DVCH(CDB) ;DEVICE CHARACTERISTICS
13900 TESTE 2,<1B1> ;CAN DO INPUT?
14000 TESTO OPFLAGS,RDBIT
14100 TESTE 2,<1B0> ;CAN DO OUTPUT?
14200 TESTO OPFLAGS,WRBIT
14300 MOVE 1,DVTYP(CDB) ;CHECK DEVICE TYPE
14400 CAIE 1,7 ;IS IT THE LPT?
14500 CAIN 1,12 ;IS IT A TTY?
14600 JRST OP7BT ;USE 7 BIT BYTES
14700 ;NOW TRY VARIOUS THINGS, LOOKING FOR SOMETHING THAT WORKS
14800
14900 HRRZ 1,JFNTBL(CHNL)
15000 HRLI OPFLAGS,440000
15100 MOVE 2,OPFLAGS ;36-BIT, MODE 0
15200 JSYS OPENF
15300 SKIPA
15400 JRST OPOK
15500 HRRZ 1,JFNTBL(CHNL)
15600 HRLI OPFLAGS,447400 ;36-BIT, MODE 17
15700 MOVE 2,OPFLAGS
15800 JSYS OPENF
15900 SKIPA
16000 JRST OPOK
16100 OP7BT: HRRZ 1,JFNTBL(CHNL)
16200 HRLI OPFLAGS,70000 ;7-BIT, MODE 0
16300 MOVE 2,OPFLAGS
16400 JSYS OPENF
16500 JRST NOOPN
16600 OPOK: MOVEM OPFLAGS,OFL(CDB) ;SAVE OP FLAGS
16700 GUDRET:
16800 ;SAVE FLAGS
16900 SETOM OPNDUN(CDB) ;INDICATE OPENED WITH OPEN
17000 POP P,TEMP ;RETURN ADDRESS
17100 POP P,ENDFL(CDB) ;SAVE GOOD THINGS
17200 POP P,BRCHAR(CDB)
17300 POP P,ICOUNT(CDB)
17400 SETZM @ENDFL(CDB) ;INDICATE GOOD OPENING
17500 SUB SP,X22 ;CLEAN UP STACKS
17600 SUB P,X44
17700 JRST RESTR ;AND RETURN
17800
17900
18000 NOOPN:
18100 CNTOPN: SKIPN 1,JFNTBL(CHNL) ;RELEASE JFN
18200 JSYS RLJFN
18300 JFCL
18400 BADOPN:
18500 SKIPE B,CDBTBL(CHNL) ;CORE ALLOCATED?
18600 PUSHJ P,CORREL ;RELEASE CORE
18700 SETZM JFNTBL(CHNL)
18800 SETZM CDBTBL(CHNL)
18900 SKIPN @-1(P) ;USER WANTS ERROR?
19000 ERR <OPEN: IO ERROR OR ILLEGAL SPECIFICATIONS>,1
19100 SETOM @-1(P)
19200 POP P,TEMP
19300 SUB P,[XWD 7,7]
19400 SUB SP,X22
19500 JRST RESTR
19600
19700
19800
19900
20000 BEND OPEN
20100
20200 ;MAKE UPPER CASE LETTERS
20300 MAKUP: PUSHJ P,SAVE
20400 SKIPE SGLIGN(USER)
20500 PUSHJ P,INSET
20600 HRRZ A,-1(SP) ;LENGTH OF STRING
20700 ADDM A,REMCHR(USER)
20800 SKIPLE REMCHR(USER) ;OK?
20900 PUSHJ P,STRNGC ;NO, COLLECT
21000 MOVE B,A
21100 HRRO A,A
21200 PUSH SP,A
21300 PUSH SP,TOPBYTE(USER)
21400 UPPER1: JUMPLE B,UPPER2 ;DONE YET?
21500 ILDB C,-2(SP) ;NEXT CHAR
21600 CAIL C,141
21700 CAILE C,172
21800 SKIPA
21900 SUBI C,40 ;CONVERT TO UPPER CASE
22000 IDPB C,TOPBYTE(USER)
22100 SOJA B,UPPER1
22200 UPPER2: POP SP,-2(SP)
22300 POP SP,-2(SP)
22400 SETZ LPSA,
22500 POP P,TEMP ;RETURN ADDR
22600 JRST RESTR ;RETURN
22700
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 PUSH P,[=100]
07900 PUSHJ P,ZSETST ;BP IN 1
08000 MOVE 2,DVDSG(CDB) ;DEVICE DESIGNATOR
08100 JSYS DEVST
08200 ERR <LOOKUP, ENTER, OR RENAME: CANNOT DO DEVST>
08300 PUSH P,[=100]
08400 PUSH P,1 ;UPDATED BP
08500 PUSHJ P,ZADJST
08600 PUSH P,[":"]
08700 PUSHJ P,CATCHR
08800 PUSHJ P,CAT.RV
08900 PUSH P,[0]
09000 PUSHJ P,CATCHR
09100 POP P,2
09200 POP P,1
09300 POPJ P,
09400
09500 ;RELEASE JFN ALREADY THERE
09600 RELNOW:
09700 PUSH P,CHNL ;CHANNEL
09800 PUSHJ P,CLOSF ;CLOSE DANCE
09900 PUSH P,1
10000 MOVE 1,JFNTBL(CHNL) ;GET JFN
10100 JSYS RLJFN ;RELEASE
10200 ERR <CANNOT RELEASE JFN>,1
10300 SETZM JFNTBL(CHNL) ;AND ZERO OUT
10400 SETZM IOSTT(CDB) ;NO STATUS
10500 POP P,1
10600 POPJ P,
10700
10800
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: JSYS DELF ;JFN IN 1
07200 JRST RENERR
07300 JRST RENRET
07400 BEND RENAME
07500
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,[CLOSE_INHIBIT_BITS])
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,IOTLEN
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,IOTLEN-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,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)
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 PUSH P,[0]
01100 PUSHJ P,CATCHR
01200 MOVE 1,(SP) ;BYTE-POINTER
01300 SETZB 2,.SKIP. ;NO SPECIAL FORMAT, ASSUME NO ERROR
01400 JSYS IDTIM
01500 MOVEM 2,.SKIP. ;ERROR TO USER
01600 MOVE 1,2 ;ANSWER
01700 SUB SP,X22 ;ADJUST SP STACK
01800 POPJ P, ;RETURN
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 ENDCOM(JOBINF)
00200
00100 COMPIL(DIRECT,<STDIR,DIRST>,<X22,X33,CATCHR,ZSETST,ZADJST.SKIP.>
00200 ,<DIRECT -- TENEX DIRECTORY SPECS>)
00300 DSCR INTEGER SIMPLE PROCEDURE STDIR(STRING S; BOOLEAN DORECOGNITION)
00400 DESR
00500 Returns the directory number associated with a string.
00600 Any problems are returned in .SKIP. with the code:
00700 1 string does not match
00800 2 string is ambiguous.
00900 ⊗
01000 HERE(STDIR)
01100 PUSH P,[0]
01200 PUSHJ P,CATCHR ;TACK ON 0
01300 SETZ 3, ;
01400 MOVEI 1,1 ; ASSUME NO RECOGNITION
01500 SKIPE -1(P) ; DO WE WANT IT?
01600 SETO 1, ; YES AFTER ALL
01700 MOVE 2,(SP) ;BYTE-POINTER
01800 JSYS STDIR
01900 SKIPA 3,[1] ; NO MATCH;
02000 MOVEI 3,2 ; AMBIGUOUS
02100 MOVEM 3,.SKIP. ; SAVE IT FOR USER
02200 HRRZ 1,1 ; SAVE DIR NO. (ONLY)
02300 SUB SP,X22 ;ADJUST STRING STACK
02400 SUB P,X22
02500 JRST @2(P) ;RETURN
02600
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 PUSH P,[=100]
00800 PUSHJ P,ZSETST
00900 SETZM .SKIP.
01000 MOVE 2,-1(P) ;DIRECTORY NO.
01100 JSYS DIRST
01200 SETOM .SKIP.
01300 PUSH P,[=100]
01400 PUSH P,1 ;UPDATED BP
01500 PUSHJ P,ZADJST ;GET STRING ON STACK
01600 SUB P,X22
01700 JRST @2(P)
01800
01900 ENDCOM(DIRECT)
00100 COMPIL(RUNPRG,<RUNPRG>,<X22,X33,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 Remember to say .SAV as the PROGRAM extension.
01400 ⊗
01500
01600
01700 HERE(RUNPRG)
01800 BEGIN
01900 JFN←←0
02000 FORK←←14
02100 PUSH P,[0]
02200 PUSHJ P,CATCHR
02300 MOVSI 1,100001 ; OLD FILE, PTR IN 2
02400 MOVE 2,(SP) ; STRING POINTER
02500 JSYS GTJFN ; TRY FOR JFN
02600 JRST RUNERR ; ERROR
02700 MOVEM 1,JFN ; SAVE JFN
02800
02900 SKIPN -1(P) ; USER WANTS FORK?
03000 JRST SWP ; NO, REPLACE CURRENT PRG
03100
03200 MOVSI 1,100000 ; XMIT CAPABILITIES
03300 JSYS CFORK
03400 JRST RUNERR ; CANNOT CREATE FORK
03500 MOVEM 1,FORK ; SAVE HANDLE
03600 SETOB 2,3 ; INDICATE ALL PRIVILEDGES
03700 JSYS EPCAP
03800 HRLZ 1,1 ; FORK HANDLE
03900 HRR 1,JFN ; THE JFN
04000 JSYS GET ; JSYS GET THE FILE
04100 MOVEI 1,400000 ; CURRENT FORK
04200 JSYS GPJFN ;PRIMARY JFNS IN 2
04300 MOVE 1,FORK ; SET PRIMARY IO
04400 JSYS SPJFN ;FOR NEW FORK
04500 MOVE 1,FORK ; FORK
04600 MOVE 2,-2(P) ; USER VALUE FOR ENTRY VECTOR
04700 JSYS SFRKV ;START THE FORK
04800 MOVE 1,FORK ;
04900 JSYS WFORK
05000 SKIPE 1,FORK ; SET TO KILL
05100 JSYS KFORK ;KILL THE FORK
05200 HRRZ 1,JFN ;
05300 JSYS RLJFN ; RELEASE
05400 JFCL ; IGNORE
05500 JRST RUNRET ; AND RETURN SAFELY
05600
05700 SWP:
05800 IMSSS,< ;DESTROY EMULATOR INFO AT IMSSS
05900 SETO 1,
06000 MOVE 2,[XWD 400000,711] ;PAGE 711
06100 JSYS PMAP ;DESTROY
06200 >;IMSSS
06300 PUSH P,JFN ;SAVE THE JFN
06400 HRLI A1 ; BLT INTO ACS
06500 HRRI 1 ;
06600 BLT 15 ; THE INSTRUCTIONS -- NOTE THAT RF IS NOW CLOBBERED
06700 POP P,0 ; RESTORE JFN TO AC0
06800 HRLI 0,400000 ; XWD FORK, JFN
06900 MOVE 16,-2(P) ; THE INCREMENT -- NOTE THAT SP IS NOW CLOBBERED
07000 MOVE 17,[254000400010] ; FOR COMPARISON -- NOTE THAT THE P STACK IS GONE
07100 JRST 4 ; AND GO
07200 A1: -1 ; FOR PMAP
07300 A2: 400000000677 ; THIS FORK, START AT 677 (LEAVING EMULATOR)
07400 A3: 0 ;
07500 A4: JSYS PMAP
07600 A5: SOJL 2,4 ; LOOP THROUGH PAGES
07700 A6: MOVE 1,0 ; XWD 400000,JFN
07800 A7: JSYS GET ;
07900 A10: MOVEI 1,400000 ; THIS FORK
08000 A11: JSYS GEVEC ; JSYS GET ENTRY VECTOR
08100 A12: CAMN 2,17 ; DEC STYLE??
08200 A13: HRRZ 2,120 ; YES
08300 A14: ADD 2,16 ; ADD THE INCREMREMENT
08400 A15: JRST (2) ; AND START THE JOB
08500
08600 RUNERR: TDZA 1,[-1] ;ZERO 1 AND SKIP
08700 RUNRET: SETO 1, ;INDICATE SUCCESS
08800 SUB SP,X22
08900 SUB P,X33
09000 JRST @3(P)
09100
09200
09300 BEND;RUNPRG
09400 ENDCOM(RUNPRG)
00100 COMPIL(OPF,<OPENFILE,SETINPUT,SETPL,INDEXFILE,SETCHAN>,<.SKIP.>,<OPENFILE -- OPEN A FILE>)
00200 DSCR INTEGER SIMPLE PROCEDURE OPENFILE(STRING NAME,OPTIONS)
00300
00400 Name is the name of the file to be opened. If it is null, then
00500 OPENFILE goes to the user's console for the filname (with recognition).
00600 The value of the call is the jfn returned to the user.
00700 OPTIONS is a string of options available to the user. Legal
00800 characters are:
00900
01000 One of these:
01100 R read
01200 W write
01300 A append
01400 Version numbering
01500 O old file
01600 N new file
01700 T temporary file
01800 * index with INDEXFILE routine
01900
02000 Independent:
02100 C require confirmation
02200 D ignore deleted bit
02300 H "thawed" access
02400 Error handling
02500 E return errors to user in the external
02600 integer !skip!. TENEX error codes are used.
02700 (JFN will be released in this case.)
02800 OPENFILE does a GTJFN followed by a OPENF. If GTJFN fails, a new
02900 attempt is made, from the user's console.
03000 ⊗
03100
03200 BEGIN OPENFILE
03300 JFN←3 ;WHERE TO PUT THINGS
03400 FLAGS←4
03500 GTFLAGS←5
03600 OPFLAGS←6
03700
03800 DEFINE EQ $ (X,Y) <
03900 CAIE A,"$X$"
04000 JRST .+3
04100 TESTO FLAGS,Y
04200 JRST OPCONT
04300 >
04400
04500 DEFINE JTRUE $ (X) <
04600 TESTN FLAGS,X
04700 >
04800 DEFINE JFALSE (X) <
04900 TESTE FLAGS,X
05000 >
05100
05200 DEFINE SGT (X) <
05300 TESTO GTFLAGS,X
05400 >
05500 DEFINE SOF (X) <
05600 TESTO OPFLAGS,X
05700 >
05800 DEFINE TGT (X) <
05900 TESTE FLAGS,X
06000 TESTO GTFLAGS,X
06100 >
06200 DEFINE TOP (X) <
06300 TESTE FLAGS,X
06400 TESTO OPFLAGS,X
06500 >
06600
06700 HERE(OPENFILE)
06800 SETZB FLAGS,.SKIP.
06900 SETZB GTFLAGS,OPFLAGS
07000 HRRZ B,-1(SP) ;COUNT OF OPTIONS WORD
07100
07200 WHIOPT: JUMPE B,OPTDUN
07300 ILDB A,(SP) ;GET AN OPTION
07400 CAIGE A,141
07500 JRST .+3
07600 CAIG A,172
07700 SUBI A,40 ;CONVERT TO UPPER CASE
07800 ;ANY NON-ALPHABETIC CHARS GO HERE
07900
08000 EQ *,STARBIT
08100 ;NOW ALLOW ONLY ALPHABETIC CHARS
08200 CAIL A,101 ;MUST BE
08300 CAILE A,132
08400 JRST OPTERR
08500 SKIPN BITTBL-"A"(A) ;SOMETHING THERE?
08600 JRST OPTERR ;NOPE, ERROR
08700 TDO FLAGS,BITTBL-"A"(A) ;RIGHT SPOT IN TABLE
08800 SOJGE B,WHIOPT
08900 JRST OPTDUN
09000 ;HERE ON ERROR
09100 OPTERR: ERR <OPENFILE: ILLEGAL OPTION >,1
09200 TESTO FLAGS,ERSNBIT
09300
09400 OPCONT:
09500 SOJGE B,WHIOPT
09600
09700 ;NOW SET UP GTFLAGS ACCORDING TO THE SCANNED INFORMATION
09800 OPTDUN:
09900 TGT OLDBIT ;INSIST ON OLD?
10000 TGT NEWBIT ;INSIST ON NEW?
10100 JTRUE OLDBIT
10200 JFALSE NEWBIT ;IF NEITHER
10300 JRST OPTDU1 ;WELL, ONE
10400 JTRUE WRBIT ;IF WRITING
10500 JRST OPTDU1
10600 JFALSE RDBIT ;AND READING
10700 JTRUE APPBIT ;BUT NOT APPENDING
10800 SGT OUTBIT ;THEN SET OUTPUT BIT
10900 OPTDU1:
11000 JFALSE RDBIT ;IF READING
11100 JFALSE WRBIT ;AND NOT WRITING
11200 JRST OPTDU2
11300 JTRUE APPBIT ;AND NOT APPENDING
11400 SGT OLDBIT ;THEN INSIST ON OLD
11500 OPTDU2:
11600 ;NOW TEST FOR INDEPENDANT THINGS
11700 TOP RDBIT
11800 TOP WRBIT
11900 TOP APPBIT
12000 TGT TEMBIT
12100 TGT STARBIT
12200 TGT DELBIT
12300 TOP THAWBIT
12400 JFALSE CONFBIT
12500 JRST [SGT CONFB1
12600 SGT CONFB2
12700 JRST .+1]
12800 TLO GTFLAGS,1 ;SHORT CALL OF GTJFN
12900 GTAGAIN:
13000 HRRZ A,-3(SP) ;LENGTH OF NAME
13100 JUMPE A,[TRYAGN:
13200 TLO GTFLAGS,2
13300 MOVE 2,[XWD 100,101]
13400 JRST GT]
13500 AND GTFLAGS,[717777777777]
13600
13700 PUSH SP,-3(SP)
13800 PUSH SP,-3(SP)
13900 PUSH P,[0]
14000 PUSHJ P,CATCHR ;CONCATENATE A NULL CHAR
14100 MOVE 2,(SP) ;BYTE-POINTER
14200 SUB SP,X22 ;ADJUST STACK
14300 GT: MOVE 1,GTFLAGS
14400 JSYS GTJFN
14500 JRST GTERR
14600 MOVEM 1,JFN ;REMEMBER JFN
14700 PUSHJ P,SETCHN ;SET A CHANNEL, ALLOCATE, GET CDB, SET DVTYP, RETURN CHANNEL
14800 MOVEM 1,CHNL ;REMEMBER CHANNEL
14900 MOVEM GTFLAGS,GFL(CDB)
15000
15100
15200 COMMENT ⊗ Do the open.
15300 ⊗
15400 MOVE 1,DVTYP(CDB) ;CHECK THE DEVICE TYPE
15500 CAIE 1,7 ;IS IT THE LPT?
15600 CAIN 1,12 ;IS IT A TTY?
15700 JRST B7 ;YES, USE 7 BIT
15800 B36: HRRZ 1,JFN ;JFN
15900 HRRZ 2,OPFLAGS
16000 HRLI 2,440000 ;36-BIT, MODE 0
16100 JSYS OPENF
16200 JRST B36DMP ;TRY 36-BIT, DUMP MODE
16300 JRST OPNOK
16400 B36DMP: HRRZ 1,JFN
16500 HRRZ 2,OPFLAGS
16600 HRLI 2,447400 ;36 BITS, DUMP MODE
16700 JSYS OPENF
16800 JRST B7
16900 JRST OPNOK
17000 B7: HRRZ 1,JFN
17100 HRRZ 2,OPFLAGS
17200 HRLI 2,70000 ;7 BIT
17300 JSYS OPENF
17400 JRST OPERR ;NOPE
17500 OPNOK: MOVEM 2,OFL(CDB) ;SAVE
17600 MOVE 1,CHNL ;RETURN CHANNEL NO
17700 OPFRET: SUB SP,X44 ;ADJUST
17800 POPJ P, ;AND RETURN
17900
18000
18100
18200
18300 GTERR:
18400 ;HERE WITH ERROR ON GTJFN
18500 JTRUE ERTNBIT ;USER WANT'S ERRORS?
18600 JRST GTER1 ;NO
18700 ERRRET: MOVEM 1,.SKIP. ;STORE FOR USER
18800 SETO 1, ;SOMETHING SUSPICIOUS
18900 JRST OPFRET ;AND RETURN
19000
19100 GTER1: PUSHJ P,SERSTR ;SHOW ERSTR
19200 HRROI 1,[ASCIZ/
19300 Cannot GTJFN file /]
19400 JSYS PSOUT
19500 PUSH SP,-3(SP)
19600 PUSH SP,-3(SP)
19700 PUSHJ P,OUTSTR
19800 HRROI 1,[ASCIZ/, try again */]
19900 JSYS PSOUT
20000 JRST TRYAGN
20100
20200
20300
20400 OPERR: JTRUE ERTNBIT
20500 JRST OPER1
20600 PUSH P,1 ;SAVE ERROR BITS
20700 PUSH P,CHNL
20800 PUSHJ P,CFILE
20900 POP P,1 ;RESTORE ERROR BITS
21000 JRST ERRRET
21100
21200 OPER1: PUSHJ P,SERSTR ;SHOW ERSTR
21300 HRROI 1,[ASCIZ/
21400 Cannot OPENF file /]
21500 JSYS PSOUT
21600 PUSH SP,-3(SP)
21700 PUSH SP,-3(SP)
21800 PUSHJ P,OUTSTR
21900 HRROI 1,[ASCIZ/, try again */]
22000 JSYS PSOUT
22100 PUSH P,CHNL ;CLOSE AND RELEASE FILE AND CDB BLOCK
22200 PUSHJ P,CFILE
22300 JRST TRYAGN
22400
22500 ;HERE WITH THE TENEX ERROR CODE IN 1 -- 1 MAY BE CLOBBERED
22600 SERSTR:
22700 PUSH P,2 ;SAVE ACS
22800 PUSH P,3
22900 HRRZ 2,1
23000 HRLI 2,400000 ;THIS FORK
23100 HRROI 1,[ASCIZ/
23200 /]
23300 JSYS PSOUT
23400 MOVEI 1,101 ;PRIMARY OUTPUT
23500 SETZ 3, ;FLAGS
23600 JSYS ERSTR
23700 JFCL
23800 JFCL
23900 POP P,3
24000 POP P,2
24100 POPJ P,
24200
24300
24400 BITTBL: APPBIT ;A
24500 BINBIT ;B
24600 CONFBIT ;C
24700 DELBIT ;D
24800 ERTNBIT ;E
24900 0 ;F
25000 0 ;G
25100 THAWBIT ;H
25200 0 ;I
25300 0 ;J
25400 0 ;K
25500 0 ;L
25600 0 ;M
25700 NEWBIT ;N
25800 OLDBIT ;O
25900 0 ;P
26000 0 ;Q
26100 RDBIT ;R
26200 0 ;S
26300 TEMBIT ;T
26400 0 ;U
26500 0 ;V
26600 WRBIT ;W
26700 0 ;X
26800 0 ;Y
26900 0 ;Z
27000
27100
27200 BEND OPENFILE
27300
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
02900
03000
03100
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,UNDELETE,DELNF,SIZEF,JFNS,JFNSL,OPENF,CFILE,CLOSF,RLJFN,GTSTS,STSTS,RNAMF>
00200 ,<JFNTBL,CDBTBL,X11,X22,X33,CORREL,.SKIP.,ZSETST,ZADJST,FINIO>
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)
00200 Deletes file open on CHAN. Errors to .SKIP.
00300 ⊗
00400 HERE(DELF)
00500 PUSH P,1
00600 VALCH1 1,-2(P),DELF1
00700 JSYS DELF
00800 JRST DELF2
00900 SETZM .SKIP. ;NO ERROR
01000 DELFRE: POP P,1
01100 SUB P,X22
01200 JRST @2(P)
01300 DELF1: SETO 1,
01400 DELF2: MOVEM 1,.SKIP.
01500 JRST DELFRE
01600
01700 DSCR INTEGER PROCEDURE DELNF(INTEGER CHAN,NUM)
01800 ⊗
01900 HERE(DELNF)
02000 PUSHJ P,SAVE
02100 MOVE LPSA,X33
02200 VALCH1 1,-2(P),DLNERR
02300 MOVE 2,-1(P)
02400 SETZM .SKIP.
02500 JSYS DELNF
02600 JRST DLNERR
02700 MOVEM 2,RACS+A(USER) ;NUMBER OF FILES DELETED
02800 JRST RESTR
02900 DLNERR: MOVEM 1,.SKIP.;
03000 SETZM RACS+A(USER) ;INDICATE NO FILES DELETED
03100 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: SKIPE B,CDBTBL(CHNL) ; ANY CORE TO RELEASE?
02500 PUSHJ P,CORREL ; RELEASE THE BLOCK
02600 TLZ 1,400000 ; BE SURE TO RELEASE
02700 JSYS CLOSF ; CLOSE (AND RELEASE)
02800 JFCL ; ERROR RETURN
02900 HRRZ 1,JFNTBL(CHNL) ; GET JFN AGAIN
03000 JSYS RLJFN ; RELEASE (FOR GOOD MEASURE IF FILE NOT OPEN)
03100 JFCL ; ERROR RETURN
03200 SETO 1, ; RETURN TRUE FOR GOOD RELEASE
03300 SETZM CDBTBL(CHNL)
03400 SETZM JFNTBL(CHNL)
03500 CFRET: POP P,CDB
03600 POP P,CHNL
03700 POP P,3
03800 POP P,2
03900 SUB P,X22 ; ADJUST
04000 JRST @2(P) ; RETURN
04100
04200 CFBAD: SETZ 1, ; RETURN FALSE
04300 JRST CFRET ;
04400
04500 CFBA1: SKIPE B,CDB
04600 PUSHJ P,CORREL ;RELEASE CORE BLOCK
04700 SETZM CDBTBL(CHNL) ;REMOVE ALL TRACE
04800 SETZM JFNTBL(CHNL)
04900 SETZ 1, ; RETURN FALSE
05000 JRST CFRET
05100
00100 DSCR SIMPLE PROCEDURE CLOSF(INTEGER JFN)
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. This writes
00800 a standard end-of-file on the tape.
00900 ⊗
01000 HERE(CLOSF)
01100 PUSHJ P,SAVE
01200 MOVE LPSA,X22
01300 VALCHN 1,<-1(P)>,CLOERR
01400 PUSHJ P,FINIO ;WRITE OUT BUFFERS, SET FDB, WRITE MAGT EOFS, CLEAR BUFFERS
01500
01600 DOCLO: SETZM .SKIP. ;ASSUME NO ERROR
01700 TLO 1,400000 ; DO NOT RELEASE THE JFN
01800 JSYS CLOSF
01900 MOVEM 1,.SKIP. ;ERROR
02000 CLORET: JRST RESTR
02100
02200 CLOERR:
02300 SETOM .SKIP.
02400 JRST CLORET
02500
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 SKIPE B,CDBTBL(C)
01600 PUSHJ P,CORREL
01700 SETZM CDBTBL(C)
01800 SETZM .SKIP. ;ASSUME NO ERROR
01900 JSYS RLJFN
02000 MOVEM 1,.SKIP. ;ERROR RETURN
02100 RLJRET: JRST RESTR
02200
02300 RLJBAD: ERR <Illegal JFN>,1
02400 SETOM .SKIP.
02500 JRST RLJRET
02600
02700
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 ENDCOM(FILINF)
00100 COMPIL(DEVINF,<CNDIR,ASND,RELD,GDSTS,SDSTS,STDEV,DEVST,GTFDB,CHFDB>
00200 ,<JFNTBL,CDBTBL,X11,X22,X33,CORREL,.SKIP.,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
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 [MOVEM 2,.SKIP.
01400 SETZ 1,
01500 JRST .+2]
01600 MOVE 1,2
01700 POPJ P,
01800
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,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 PUSH P,1 ;SAVE JFN
05800 PUSH P,2
05900 PUSH P,3
06000 MOVEM 2,IOPAGE(CDB) ;PAGE BEING INSERTED
06100 PUSH P,1 ;SAVE JFN OVER SFPTR
06200 LSH 2,9 ;MAKE INTO WORDS
06300 JSYS SFPTR
06400 ERR <SETPAGE: Cannot do SFPTR>,1
06500 POP P,1
06600 HRL 1,1
06700 HRR 1,IOPAGE(CDB) ;XWD JFN,FILEPAGE
06800 HRLZI 3,140000 ;BITS 2 AND 3 FOR READ, WRITE -- ASSUME THIS
06900 MOVE 2,OFL(CDB) ;BUT BETTER CHECK:
07000 TESTN 2,WRBIT ;IF WRITING OR
07100 TESTE 2,APPBIT ;APPENDING
07200 JRST .+2 ;THEN DONT DO
07300 TESTO 3,1B9 ;THE COPY ON WRITE -- DO IT FOR READING THOUGH
07400 MOVE 2,FKPAGE(CDB) ;BUFFER IN CORE
07500 JSYS PMAP
07600 POP P,3
07700 POP P,2
07800 POP P,1 ;RESTORE THE JFN
07900 POPJ P,
08000
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)
02200 AOS 2,IOPAGE(CDB) ;INCREMEMT PAGE, GET IN 2
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
04000 AOS 2,IOPAGE(CDB) ;NEXT PAGE OF THE FILE
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 DOSIMIO:
01100 SIMIO E,TABL,CERR ;SOSGE IOCNT(CDB)
01200 JRST .DOINP
01300 ILDB 2,IOBP(CDB)
01400 STOAC2: MOVEM 2,RACS+A(USER)
01500 JRST RESTR
01600
01700 TABL: JRST DOSETCI ;0 -- XNULL
01800 SOSGE IOCNT(CDB) ;1 -- XICHAR
01900 JRST .COSCI ;2 -- XOCHAR
02000 JRST .WISCI ;3 -- XIWORD
02100 JRST .WOSCI ;4 -- XOWORD
02200 SOSGE IOCNT(CDB) ;5 -- XCICHAR
02300 REPEAT 2,<JRST CERR> ;6,7 -- XCOCHAR,XCOWORD
02400 JRST DOBIN ;10 -- XBYTE7
02500 SOSGE IOCNT(CDB) ;11 -- XDICHAR
02600 REPEAT 2,<JRST CERR> ;12,13 -- XDOCHAR,XDARR
02700
02800 .DOINP:
02900 PUSHJ P,ADCI
03000 JRST ADCIEOF ;EOF
03100 JRST DOSIMIO
03200
03300 ADCIEOF:SETZM RACS+A(USER) ;RETURN 0
03400 JRST INPEOF ;AND SAY EOF
03500 DOSETCI:
03600 PUSHJ P,SETCI
03700 JRST DOSIMIO
03800
03900
04000 .COSCI: PUSHJ P,COSCI
04100 JRST DOSIMIO
04200
04300 .WISCI: PUSHJ P,WISCI
04400 JRST DOSIMIO
04500
04600 .WOSCI: PUSHJ P,WOSCI
04700 JRST DOSIMIO
04800
04900 CERR: ERR <CHARIN: Illegal JFN, byte-size, or mode>,1
05000 JRST INPEOF ;INDICATE EOF AND RETURN
05100
05200 CHALIT: SETZM .SKIP.
05300 MOVE 1,-1(P) ;PICK UP JFN LITERALLY
05400 JSYS BIN
05500 JUMPN 2,STOAC2
05600 SETZM RACS+A(USER)
05700 JSYS GTSTS
05800 TESTE 2,1B8
05900 SETOM .SKIP.
06000 JRST RESTR
06100
06200 DOBIN: JSYS BIN
06300 JUMPN 2,STOAC2
06400
06500 SETZM RACS+A(USER) ;ASSUME RETURN 0
06600 JSYS GTSTS
06700 TESTE 2,1B8
06800 JRST INPEOF ;INDICATE EOF
06900 JRST RESTR ;NOT EOF, JUST RETURN
07000
07100 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 DOSIMIO:SKIPG C,-2(P)
01400 JRST NULRET
01500 SIMIO 2,TABL,CERR ;EXCH 1,C
01600 SKIPE SGLIGN(USER)
01700 PUSHJ P,INSET
01800 ADDM 1,REMCHR(USER)
01900 SKIPLE REMCHR(USER)
02000 PUSHJ P,STRNGC
02100 MOVE E,TOPBYTE(USER) ;BYTE POINTER TO TOP OF STRING SPACE
02200 PUSH SP,[0]
02300 PUSH SP,E
02400 EXCH 1,C ;1 HAS JFN, C HAS COUNT
02500 MOVN C,C
02600 IN1: SOSGE IOCNT(CDB)
02700 JRST .DOINP
02800 IN2: ILDB D,IOBP(CDB)
02900 JUMPE D,IN1 ;IF EMPTY KEEP LOOKING
03000 CAMN D,-1(P) ;BREAK CHAR?
03100 JRST DOBRK ;YES
03200 IDPB D,E
03300 IN3: AOJL C,IN1 ;SUBTRACT 1 AND JUMP IF GREATER
03400
03500 SETOM .SKIP. ;INDICATE TERMINATED FOR COUNT
03600 DONE: ADDM C,REMCHR(USER) ;MAKE REMCHR HONEST
03700 MOVEM E,TOPBYTE(USER)
03800 ADD C,-2(P) ;GET ACTUAL NUMBER OF CHARACTERS
03900 ;TRANSFERRED
04000 HRROM C,-1(SP) ;SAVE COUNT FOR USER
04100 JRST RESTR
04200
04300 DOBRK: IDPB D,E ;SAVE THE BREAK CHARACTER (AS DOES THE SIN JSYS)
04400 MOVEM D,.SKIP. ;SAVE BREAK CHARACTER IN .SKIP. AS DOC. SAYS
04500 AOJ C, ;ADD 1 TO THE COUNT
04600 JRST DONE ;AND FINISH UP
04700
04800 B7: MOVEM 1,2 ;SAVE JFN IN 2
04900 PUSH P,-2(P) ;MAXLENGTH
05000 PUSHJ P,ZSETST
05100 EXCH 1,2 ;JFN TO 1, BP TO 2
05200 MOVE 3,-2(P) ;MAXLENGTH
05300 MOVE 4,-1(P) ;OPTIONAL BREAKCHARACTER
05400 JSYS SIN
05500 PUSH P,-2(P) ;MAXLENGTH
05600 PUSH P,2 ;UPDATED BYTE-POINTER
05700 PUSHJ P,ZADJST ;GET STRING ON STACK
05800 JSYS GTSTS ;CHECK STATUS
05900 TESTN 2,1B8 ;EOF?
06000 JRST RESTR ;NO EOF
06100 JRST INPEOF ;YES, AT THE END
06200
06300 CERR: ERR <SINI: Illegal JFN, illegal mode or byte size>,1
06400 NULRET: PUSH SP,[0] ;RETURN NULL STRING
06500 PUSH SP,[0]
06600 JRST RESTR
06700
06800 TABL: JRST DOSETCI ;0 -- XNULL
06900 EXCH 1,C ;1 -- XICHAR
07000 JRST .COSCI ;2 -- XOCHAR
07100 JRST .WISCI ;3 -- XIWORD
07200 JRST .WOSCI ;4 -- XOWORD
07300 EXCH 1,C ;5 -- XCICHAR
07400 JRST CERR ;6 -- XCOCHAR
07500 JRST CERR ;7 -- XCWORD
07600 JRST B7 ;10 -- XBYTE7
07700 EXCH 1,C ;11 -- XDICHAR
07800 REPEAT 2,<JRST CERR> ;12,13 -- XDOCHAR,XDARR
07900
08000 .DOINP: PUSHJ P,DOINP ;READ IN THE NEXT BUFFER
08100 JRST IN1 ;GOT IT
08200 JRST CERR ;IMPOSSIBLE
08300 DOEOF: SETOEOF ;END OF FILE
08400 JRST DONE
08500
08600 DOSETCI:
08700 PUSHJ P,SETCI
08800 JRST DOSIMIO
08900
09000 .COSCI: PUSHJ P,COSCI
09100 JRST DOSIMIO
09200
09300 .WISCI: PUSHJ P,WISCI
09400 JRST DOSIMIO
09500
09600 .WOSCI: PUSHJ P,WOSCI
09700 JRST DOSIMIO
09800
09900
10000 BEND SINI
10100
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 TRNE FF,@BRKCVT(LPSA) ;DOING UC COERCION?
06300 TLOA C,400000 ;YES
06400 TLZ C,400000 ;NO
06500
06600 .IN: SOSGE IOCNT(CDB) ;BUFFER EMPTY?
06700 JRST .DOINP
06800 IN1:
06900 ILDB D,IOBP(CDB) ;GET NEXT CHARACTER
07000 TDNE Z,@IOBP(CDB) ;LINE NUMBER (ALWAYS SKIPS IF NOT WORRIED)?
07100 JRST INLINN ;YES, GO SEE WHAT TO DO
07200 IN2:
07300 INB: JUMPE D,.IN ;ALWAYS IGNORE 0'S
07400 CAILE D,14 ;FIRST CHECK
07500 JRST INB1 ;IF IN RANGE AT ALL
07600 CAIN D,12
07700 JRST INB2
07800 CAIE D,14 ;LF OR FF?
07900 JRST INB1 ;NO
08000 INB2: SKIPN LINNUM(CDB) ;COUNTING VIA SETPL FUNCTION??
08100 JRST INB1 ;NO
08200 TDNN FF,@Y ;SOMETHING SPECIAL FOR THIS CHARACTER?
08300 JRST INCR ;NO NOTHING SPECIAL
08400 HLLZ TEMP,@Y ;GET BITS FOR THIS CHAR
08500 TDNN TEMP,FF ;IGNORE?
08600 JRST INCR ;YES
08700 MOVE TEMP,-1(P) ;BREAKTABLE (RELOCATED)
08800 SKIPLE DSPTBL(TEMP) ;APPEND OR SKIP?
08900 JRST INB1 ;YES
09000 INCR: CAIN D,12 ;LINE-FEED?
09100 AOS @LINNUM(CDB) ;INDICATE ANOTHER LINE
09200 CAIE D,14 ;FORM-FEED?
09300 JRST INB1 ;NO
09400 SKIPE PAGNUM(CDB)
09500 AOS @PAGNUM(CDB) ;COUNT PAGES ALSO
09600 SKIPE LINNUM(CDB)
09700 SETZM @LINNUM(CDB) ;SET LINNUM TO ZERO (NEW PAGE)
09800
09900 INB1: JUMPGE C,NOCV.I ;NOT COERCING?
10000 CAIL D,"a" ;ONLY COERCE LOWER CASE
10100 CAILE D,"z" ;
10200 JRST .+2 ;SPECIAL RHT "FAST SKIP"
10300 TRZ D,40 ;MAKE UPPER CASE
10400
10500 NOCV.I: TDNE FF,@Y ;MUST WE DO SOMETHING SPECIAL?
10600 JRST INSPC ;YES, HANDLE
10700
10800 MOVEC: IDPB D,TOPBYTE(USER) ;LENGTHEN STRING
10900 AOJL B,.IN ;GET SOME MORE
11000 JRST DONE1
11100
11200 INSPC: HLLZ TEMP,@Y ;IGNORE OR BREAK?
11300 TDNN TEMP,FF ; (CHOOSE ONE)
11400 JRST .IN ;IGNORE
11500
11600 ; BREAK -- STORE BREAK CHAR, FINISH OFF
11700
11800 DONE: SKIPE BRCHAR(CDB) ;USER BRCHAR VAR?
11900 MOVEM D,@BRCHAR(CDB) ;STORE BREAK CHAR
12000 MOVE TEMP,-1(P) ;RELOCATED 1 TO 18
12100 SKIPN Y,DSPTBL(TEMP) ;WHAT TO DO WITH BREAK CHAR?
12200 JRST DONE1 ;SKIP IT
12300 JUMPL Y,APPEND ;ADD TO END OF INPUT STRING
12400
12500 RETAIN: PUSHJ P,BACKUP
12600 JRST DONE1
12700
12800 APPEND: IDPB D,TOPBYTE(USER) ;PUT ON END
12900 AOJA B,DONE1 ;ONE MORE TO COUNT
13000
13100
13200 ; DONE -- MARK STRING COUNT WORD
13300
13400 DONE1: ADDM B,REMCHR(USER) ;GIVE UP THOSE NOT USED
13500 SKIPN ICOUNT(CDB) ;USER SUPPLIED COUNT?
13600 JRST [ADDI B,=200 ;USER DEFAULT
13700 JRST .+2]
13800 ADD B,@ICOUNT(CDB) ;HOW MANY DID WE ACTUALLY GET?
13900 ;;#GI# DCS 2-5-72 REMOVE TOPSTR
14000 HRROM B,-1(SP) ;MARK RESULT, NON-CONSTANT
14100 ;;#GI#
14200 MOVE RF,RACS+RF(USER);GET F-REGISTER BACK
14300 SUB P,X33 ;REMOVE INPUT PARAMETER, RETURN ADDRESS
14400 JRST @3(P) ;RETURN
14500
14600 ; CAN EITHER DELETE LINE NUMBER (Y GT 0) OR STOP,
14700 ; TELL THE USER (BRCHAR=-1), AND MARK LINE NUMBER
14800 ; NOT A LINE NUMBER FOR NEXT TIME
14900
15000
15100
15200
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
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
00700 HERE (REALIN)
00800 IFN ALWAYS,<BEGIN NUMIN>
00900
01000 PUSHJ P,SAVE
01100 PUSHJ P,NUMIN; GET NUMBER IN A AND TEN EXPONENT IN C
01200 MOVE LPSA,X22
01300 JRST REALFN
01400
01500 DSCR REAL←REALSCAN(@"STRING");
01600 CAL SAIL
01700 ⊗
01800
01900 HERE (REALSCAN)
02000 PUSHJ P,SAVE
02100 PUSHJ P,STRIN
02200 MOVE LPSA,X33
02300 REALFN: SETZ D,; POS SIGN
02400 JUMPE A,ADON
02500 JUMPG A,FPOS
02600 SETO D,; NUMBER NEGATIVE
02700 MOVNS A
02800 FPOS: ;WE NOW HAVE A POSITIVE NUMBER IN A WITH SIGN IN D
02900 JFFO A,.+1; NUMBER OF LEADING ZEROS IN B
03000 ASH A,-1(B); BIT0=0, BIT1=1
03100 MOVN X,B; BIN EXPONENT -2
03200 JUMPE C,FLO; IF TEN EXPONENT ZERO THEN FINISH
03300 JUMPL C,FNEG
03400 CAIL C,100; CHECK BOUND OF EXPOENT
03500 JRST ERROV1
03600 SETZ Y,
03700 JRST TEST
03800 FNEG: MOVNS C
03900 CAIL C,100
04000 JRST ERROV1
04100 MOVEI Y,6
04200 TEST: TRNE C,1; DEPENDING ON LOW ORDER BIT OF EXP
04300 JRST MULT; EITHER MULTIPLY
04400 NEXT: ASH C,-1; OR DON'T.
04500 AOJA Y,TEST; INDEX INTO MULTIPLIER TABLE
04600 MULT: ADD X,.CH.(Y); EXPONENT
04700 MUL A,.MT.(Y) ;MULTIPLY AND NORMALIZE
04800 TLNE A,200000
04900 JRST DTEST
05000 ASHC A,1
05100 SOJA X,.+1
05200 DTEST: SOJG C,NEXT
05300 FLO: IDIVI A,1B18
05400 FSC A,255
05500 FSC B,234
05600 FADR A,B
05700 SKIPE D
05800 MOVNS A
05900 FSC A,(X); SCALE
06000 JRST ALLDON
06100 SUBTTL INTIN INTEGER NUMBER INPUT ROUTINE LOU PAUL
00100 COMMENT ⊗Intin, Intscan ⊗
00200
00300 DSCR INTEGER←INTIN(CHANNEL NUMBER);
00400 CAL SAIL
00500 ⊗
00600
00700 HERE (INTIN)
00800 ;INTEGER NUMBER INPUT ROUTINE RETURNS VALUE IN A
00900 ;USES NUMIN TO PERFORM FREE FIELD SCAN
01000
01100 PUSHJ P,SAVE
01200 PUSHJ P,NUMIN; GET NUMBER IN A, TEN EXPONENT IN C
01300 MOVE LPSA,X22
01400 JRST INTFN
01500
01600 DSCR INTEGER←INTSCAN("STRING");
01700 CAL SAIL
01800 ⊗
01900
02000 HERE (INTSCAN)
02100 PUSHJ P,SAVE
02200 PUSHJ P,STRIN
02300 MOVE LPSA,X33
02400 INTFN: JUMPE A,ADON
02500 JUMPE C,ADON
02600 JUMPL C,DIVOUT; IF EXPONENT NEG WE WILL DIVIDE
02700 CAIL C,13
02800 JRST ERROV1
02900 IMUL A,.TEN.(C)
03000 JRST ALLDON
03100 DIVOUT: MOVNS C
03200 CAIL C,13
03300 JRST [SETZ A,
03400 JRST ADON ]
03500 MOVE C,.TEN.(C)
03600 IDIV A,C
03700 ASH C,-1
03800 CAML B,C; ROUND POSITIVELY
03900 AOJA A,ALLDON
04000 MOVNS B
04100 CAML B,C
04200 SOJ A,
04300 ALLDON: JOV ERROV1; CHECK FOR OVERFLOW
04400 ADON: MOVEM A,RACS+1(USER)
04500 JRST RESTR
04600 ERROV1: PUSHJ P,ERROV
04700 JRST ADON
04800 SUBTTL FREE FIELD NUMBER SCANNER LOU PAUL
00100 DSCR NUMIN
00200 DES THE COMMON ROUTINE USED BY REALIN, REALSCAN, INTIN, ETC.
00300 ⊗
00400 ;NUMIN PERFORMS A FREE FIELD READ AND RETURNS THE MOST SIGNIFICIANT
00500 ;PART OF THE NUMBER IN A AND THE APPROPIATE TENS EXPONENT IN C
00600 ;TAKING CARE OF LEADING ZEROS AND TRUNCATION ETC.
00700 ;SCANNING IS ACCORDING TO THE FOLLOWING BNF
00800 ;<NUMBER>::=<DEL><SIGN><NUM><DEL>
00900 ;<NUM> ::=<NO>|<NO><EXP>|<EXP>
01000 ;<NO> ::=<INTEGER>|<INTEGER>.|
01100 ; <INTEGER>.<INTEGER>|.<INTEGER>
01200 ;<INTEGER>::=<DIGIT>|<INTEGER><DIGIT>
01300 ;<EXP> ::=E<SIGN><INTEGER>|@<SIGN><INTEGER>
01400 ;<DIGIT>::=0|1|2|3|4|5|6|7|8|9
01500 ;<SIGN> ::=+|-|<EMPTY>
01600 ;NULL AND CARR. RET. ARE IGNORED.
01700 ;SCANNING IS FACILITATED BY A CHARACTER CLASS TABLE "TAB" AND
01800 ;TWO MACROS AHEAD AND ASTERN. THE LEFT HALF OF THE 200+1 WORD TABLE
01900 ;CONTAINS -1 IF NOT A DIGIT AND THE VALUE OF THE DIGIT IF IT IS A DIGIT
02000 ;THE RIGHT HALF CONTAINS -1 IF A DIGIT AND THE CLASS NUMBER IF NOT.
02100 ;CLASS 0 NULL, CARR RET, NOTHING
02200 ;CLASS 1 .
02300 ;CLASS 2 -
02400 ;CLASS 3 +
02500 ;CLASS 4 @,E
02600 ;CLASS 5 ANY OTHER CHARACETR
02700 ;CLASS 6 END OF FILE
02800 ;TAB(200) IS USED FOR FND OF FILE
02900 ;MACRO AHEAD IS USED FOR FORWARD SCANNING, ASTERN FOR SCANNING
03000 ;THE STACK CONSISTING OF AC Y WHICH HAS CLASS SYMBOLS SHIFTED INTO IT.
03100 DEFINE AHEAD(DIG,POINT,MINUS,PLUS,E,CHA,EOF)<
03200 HRRE X,TAB(D)
03300 JRST @.+2(X)
03400 JUMP DIG
03500 JRST .-4
03600 JUMP POINT
03700 JUMP MINUS
03800 JUMP PLUS
03900 JUMP E
04000 JUMP CHA
04100 JUMP EOF>
04200
04300 DEFINE ASTERN(NULL,POINT,MINUS,PLUS,E,CHA)<
04400 SETZ X,
04500 LSHC X,3
04600 JRST @.+1(X)
04700 JUMP NULL
04800 JUMP POINT
04900 JUMP MINUS
05000 JUMP PLUS
05100 JUMP E
05200 JUMP CHA
05300 JUMP CHA>
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 LPSA,[JSP X,NCH]
01400 MOVEI Z,1 ;FOR LINE NUMBER TEST
01500 PUSHJ P,SCAN
01600 SKIPE BRCHAR(CDB) ;USER WANTS BREAK CHARACTER?
01700 MOVEM D,@BRCHAR(CDB) ;FIX UP BREAK CHARACTER
01800 SOS IOBP(CDB) ;BACK UP TO GET IT NEXT TIME
01900 FOR II←1,4 <
02000 IBP IOBP(CDB)>
02100 AOS IOCNT(CDB)
02200 POPJ P,
02300
02400 ; READ A CHARACTER FROM INPUT FILE -- FOR SCAN.
02500 NCH: SOSGE IOCNT(CDB); DECREMENT CHARACTER COUNT
02600 JRST NUMINP
02700
02800 NCH1: ILDB D,IOBP(CDB); LOAD BYTE
02900 TDNE Z,@IOBP(CDB); CHECK FOR LINE NUMBER
03000 JRST NCH5
03100 NCH1.1: SKIPN LINNUM(CDB) ;WANT SETPL THINGS?
03200 JRST (X) ;NO RETURN
03300 CAIN D,12 ;LINE FEED?
03400 AOS @LINNUM(CDB) ;YES
03500 CAIE D,14 ;FORM FEED?
03600 JRST (X) ;NOPE, NOTHING
03700 SKIPE PAGNUM(CDB)
03800 AOS @PAGNUM(CDB) ;INCREMENT PAGE COUNTER
03900 SKIPE LINNUM(CDB)
04000 SETZM @LINNUM(CDB) ;AND ZERO LINE COUNTER
04100 JRST (X); RETURN
04200
04300 NCH7: MOVEI D,200 ;EOF OR DATA ERROR.
04400 JRST (X)
04500
04600 NCH5: SKIPE SOSNUM(CDB) ;WANT SETPL STUFF?
04700 JRST [MOVE D,@IOBP(CDB)
04800 MOVEM D,@SOSNUM(CDB) ;INFORM USER ABOUT LINE NUMBER
04900 JRST .+1]
05000 AOS IOBP(CDB); WE HAVE A LINE NUMBER
05100 MOVNI D,5; MOVE OVER IT
05200 ADDB D,IOCNT(CDB)
05300 SKIPL D ;NOTHING LEFT?
05400 JRST NCH ;DO ANOTHER INPUT
05500 PUSHJ P,DOINP ;
05600 JRST NCH6 ;36-BIT RETURN -- MUST BE
05700 PUSHJ P,NUMBAD ;IMPOSSIBLE
05800 JRST NCH7 ;EOF OR SOME SUCH
05900
06000 NCH6: SOSGE IOCNT(CDB); REMOVE TAB
06100 JRST NCH7 ;NONE THERE OR ERROR
06200 IBP IOBP(CDB)
06300 JRST NCH
06400
06500 ;SETUP FOR STRING INPUT (REALSCAN, INTSCAN)
06600 STRIN: MOVE LPSA,[JSP X,NCHA]
06700 HRRZ Z,-3(P)
06800 HRRZ Z,-1(Z)
06900 HRRZS -3(P) ;SO CAN INDIRECT THROUGH IT.
07000 PUSHJ P,SCAN
07100 HRRZ X,-3(P)
07200 SOS (X) ;BACK UP BYTE POINTER
07300 FOR II←1,4<
07400 IBP (X)>
07500 AOJ Z,
07600 HRRM Z,-1(X)
07700 MOVEM D,@-2(P) ;STORE BREAK CHARACTER
07800 POPJ P,
07900
08000 ;READ A CHARACTER ROUTINE FOR STRINGS.
08100 NCHA: SOJL Z,NCH7
08200 ILDB D,@-4(P)
08300 JRST (X)
08400
00100 ;SCAN (CALLED BY NUMIN AND STRIN)
00200
00300 SCAN: JOV .+1
00400 SETO TEMP, ;FLAG REGISTER.
00500 SETZ Y,
00600 SETZB A,C; NUMBER EXPOENT
00700 MORE: XCT LPSA; THIS GETS A CHARACTER IN D,200 IF FO EOF
00800 AHEAD(DIG1,STACK,STACK,STACK,STACK,STACK,DONE)
00900 STACK: LSHC X,-3; PUSH SYMBOL ONTO STACK "AC Y"
01000 JRST MORE
01100
01200 DIG1: SETZ TEMP,; FLAG REG.
01300 ASTERN(INT1,FRA1,SIG1,SIG2,EXP1,INT1)
01400
01500 SIG1: TRO TEMP,4; NEGATIVE SIGN
01600 SIG2: ASTERN(INT1,ERR2,ERR5,ERR5,EXP1,INT1)
01700
01800 EXP1: MOVEI A,1
01900 ASTERN(EXP2,ERR2,SIG3,SIG4,ERR1,EXP2)
02000
02100 SIG3: MOVNS A
02200 SIG4: ASTERN(EXP2,ERR2,ERR5,ERR5,ERR1,EXP2)
02300
02400 FRA1: TRO TEMP,1; DECIMAL POINT
02500 SOJ C,
02600 ASTERN(INT1,ERR2,SIG5,SIG6,ERR1,INT1)
02700
02800 SIG5: TRO TEMP,4; NEGATIVE SIGN
02900 SIG6: ASTERN(INT1,ERR2,ERR5,ERR5,ERR1,INT1)
03000
03100 EXP2: HLRE FF,TAB(D); FIRST DIGIT
03200 EXP5: XCT LPSA; GET NEXT CHARACTER
03300 EXP9: HLRE B,TAB(D)
03400 JUMPL B,EEXP; NEGATIVE IF NOT A DIGIT
03500 IMULI FF,12
03600 ADD FF,B
03700 JRST EXP5
03800
03900 XCT LPSA
04000 ;;#QD# SEE DONE5: BELOW
04100 EEXP: AHEAD(EXP9,ERR2,DONE5,DONE5,ERR1,EN,EN)
04200 EN: TRNE TEMP,4; SIGN OF EXPONENT
04300 MOVNS FF
04400 ADD C,FF; FIX UP EXPONENT
04500 JOV ERR3
04600
04700 ;#QD# CHANGE ALL 'ERR5'S IN AHEAD MACROS DO 'DONE5'S, TO AVOID SNARFING EXTRA
04800 ;SIGNS ..... RFS 12-15-73 (TWO PLACES BELOW AND ONE ABOVE ALSO)
04900 DONE5:
05000 DONE: ANDI D,177
05100 JUMPGE TEMP,.+2
05200 SETO D,
05300 POPJ P,
05400
05500 INT1: HLRE A,TAB(D); FIRST DIGIT
05600 TRNE TEMP,4
05700 MOVNS A; NEGATE IF NECESSARY
05800 INT2: XCT LPSA; GET NEXT CHARACTER
05900 INT5: HLRE B,TAB(D)
06000 JUMPL B,EON; NEGATIVE IF NOT A NUMBER
06100 TRNE TEMP,1; IF PASSED DECIMAL POINT THEN DEC EXP BY ONE
06200 SOJ C,
06300 TRNE TEMP,2; IF ENOUGH DIGITS THEN INC EXP BY ONE
06400 INT3: AOJA C,INT2
06500 MOVE X,A
06600 IMULI A,12
06700 TRNE TEMP,4; NEGATE DIGIT IS SIGN NEGATIVE
06800 MOVNS B
06900 ADD A,B
07000 JOV INT4; CHECK FOR OVERFLOW
07100 JRST INT2; IF SO USE LAST VALUE
07200
07300 INT4: TRO TEMP,2
07400 MOVE A,X
07500 JRST INT3
07600
07700 XCT LPSA
07800 EON: AHEAD(INT5,DP1,DONE,DONE,EXP6,DONE,DONE)
07900
08000 DP1: TROE TEMP,1
08100 JRST ERR2
08200 XCT LPSA
08300 ;#QD# (SEE DONE5: ABOVE)
08400 AHEAD(INT5,ERR2,DONE5,DONE5,EXP6,DONE,DONE)
08500
08600 EXP6: SETZ TEMP,
08700 XCT LPSA
08800 AHEAD(EXP2,ERR2,EXP7,EXP8,ERR1,ERR1,ERR1)
08900
09000 EXP7: TRO TEMP,4
09100 EXP8: XCT LPSA
09200 ;#QD# (SEE DONE5: ABOVE)
09300 AHEAD(EXP2,ERR2,DONE5,DONE5,ERR1,ERR1,ERR1)
09400
09500 ERR1: ERR(<NUMIN: IMPROPER EXPONENT>,1,RZ)
09600
09700 ERR2: ERR(<NUMIN: MISPLACED DECIMAL POINT>,1,RZ)
09800
09900 ERR3: ERR(<NUMIN: EXPONENT OUT OF BOUND>,1,RZ)
10000
10100 ERR5: ERR(<NUMIN: MISPLACED SIGN>,1,RZ)
10200
10300 ERROV: ERR(<NUMIN: NUMBER OUT OF BOUND>,1,RZ)
10400
10500 NUMBAD: ERR<NUMIN: Illegal JFN, byte-size or mode>
10600 POPJ P,
10700
10800
10900 BEGIN NUMTBL
11000
11100 ↑NUMTBL:JRST DOSETCI ;0 -- XNULL
11200 MOVE CHNL,1 ;1 -- XICHAR
11300 JRST .COSCI ;2 -- XOCHAR
11400 JRST .WISCI ;3 -- XIWORD
11500 JRST .WOSCI ;4 -- XOWORD
11600 MOVE CHNL,1 ;5 -- XCICHAR
11700 REPEAT 2,<JRST NUMBAD> ;6,7
11800 MOVE CHNL,1 ;10 -- XBYTE7
11900 MOVE CHNL,1 ;11 -- XDICHAR
12000 REPEAT 2,<JRST NUMBAD> ;12,13
12100
12200 DOSETCI:
12300 PUSHJ P,SETCI
12400 JRST NUMSIM
12500
12600 .COSCI: PUSHJ P,COSCI
12700 JRST NUMSIM
12800
12900 .WISCI: PUSHJ P,WISCI
13000 JRST NUMSIM
13100
13200 .WOSCI: PUSHJ P,WOSCI
13300 JRST NUMSIM
13400
13500 BEND NUMTBL
13600
13700 NUMINP: PUSHJ P,DOINP
13800 JRST NCH ;BUFFERED INPUT
13900 JRST NCH1.1 ;7-BIT
14000 JRST NCH7 ;EOF OR ERROR
14100
14200
14300 RZ: SETZ A,
14400 JRST DONE
00100 ; Character table for SCAN (Realscan,Intscan,Realin,Intin)
00200 TAB: FOR A IN (0,5,5,5,5,5,5,5)<XWD -1,A
00300 >
00400 FOR A IN (5,5,5,5,5,0,5,5)<XWD -1,A
00500 >
00600 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
00700 >
00800 ;#QC# MAKE 32 (CONTROL Z) IGNORED
00900 FOR A IN (5,5,0,5,5,5,5,5)<XWD -1,A
01000 >
01100 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
01200 >
01300 FOR A IN (5,5,5,3,5,2,1,5)<XWD -1,A
01400 >
01500 FOR A IN (0,1,2,3,4,5,6,7,10,11)<XWD A,-1
01600 >
01700 FOR A IN (5,5,5,5,5,5)<XWD -1,A
01800 >
01900 FOR A IN (4,5,5,5,5,5,5,5)<XWD -1,A
02000 >
02100 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
02200 >
02300 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
02400 >
02500 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
02600 >
02700 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
02800 >
02900 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
03000 >
03100 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
03200 >
03300 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
03400 >
03500 XWD -1,6
03600
03700 ENDCOM(NUM)
03800 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)
03000 AOS 2,IOPAGE(CDB) ;INCREMENT PAGE COUNTER, GET IN 2
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
21500 TNXBUF:
21600 BEGIN TNXBUF
21700 ORIGCNT←← =200
21800 ;AC USES A,B,C JSYS TEMPORARIES
21900 ; D BYTEPOINTER
22000 ; E COUNT, INITIALLY 0
22100 ; Q1 (=6) ORIGINAL BP
22200 PUSH P,A ;SAVE
22300 PUSH P,B
22400 PUSH P,C
22500 PUSH P,D
22600 PUSH P,E
22700 PUSH P,Q1
22800 MOVE Q1,IOADDR(CDB)
22900 HRLI Q1,440700 ;MAKE A BP
23000
23100 RESTRT: MOVE D,Q1 ;GET THE ORIGINAL BP
23200 SETZ E, ;ZERO THE COUNT
23300 INLUP: CAIL E,ORIGCNT
23400 JRST CNTEXH ;COUNT EXHAUSTED
23500 JSYS PBIN ;GET A CHAR
23600 CAIN A,37 ;EOL?
23700 JRST DOEOL ;YES
23800 CAIN A,33 ;ESCAPE?
23900 JRST DONE
24000 CAIN A,7 ;CTRL-G
24100 JRST DONE
24200 CAIN A,32 ;CTRL-Z
24300 JRST TTYEOF ;INDICATE EOF
24400 CAIN A,"R"-100 ;CTRL-R FOR REPEAT
24500 JRST DOCTR
24600 CAIN A,"X"-100 ;CTRL-Z FOR DELETE LINE
24700 JRST DOCTX ;YES
24800 CAIE A,177 ;EITHER RUBOUT
24900 CAIN A,"A"-100 ;OR CTRL-A
25000 JRST DOCTA ;FOR DELETE CHARACTER
25100 IDPB A,D
25200 AOJA E,INLUP ;CONTINUE
25300
25400 DOCTR: HRROI A,[ASCIZ/
25500 /]
25600 JSYS PSOUT
25700 JUMPE E,INLUP
25800 MOVEI A,101
25900 MOVE B,Q1 ;ORIG BP
26000 MOVN C,E ;COUNT THUS FAR
26100 JSYS SOUT
26200 JRST INLUP ;AND CONTINUE
26300
26400 DOCTX: HRROI A,[ASCIZ/
26500 /]
26600 JSYS PSOUT
26700 JRST RESTRT ;AND START ALL OVER
26800
26900 DOCTA: JUMPLE E,DOCTX ;IF NO CHARS THEN DO A CONTROL-X
27000 MOVEI A,"\"
27100 JSYS PBOUT
27200 LDB A,D ;LAST CHAR
27300 JSYS PBOUT
27400 SOJ D,
27500 IBP D
27600 IBP D
27700 IBP D
27800 IBP D
27900 SOJA E,INLUP ;SUBTRACT 1 AND CONTINUE
28000
28100 DOEOL:
28200 MOVEI A,15
28300 IDPB A,D
28400 AOJ E,
28500 MOVEI A,12
28600 DONE: IDPB A,D
28700 AOJ E,
28800 CNTEXH:
28900 MOVEM E,IOCNT(CDB) ;COUNT
29000 MOVEM Q1,IOBP(CDB) ;BP
29100 POP P,Q1 ;RESTORE
29200 POP P,E
29300 POP P,D
29400 POP P,C
29500 POP P,B
29600 POP P,A
29700 JRST DORET ;RETURN
29800
29900 TTYEOF: MOVE A,[QTTEOF]
30000 ORM A,TTYINF(CDB) ;QUE END-OF-FILE
30100 JRST CNTEXH ;AND RETURN
30200 BEND TNXBUF
30300 >;NOIMSSS
30400
30500 DECBUF:
30600 BEGIN DECBUF
30700
30800 ORIGCNT ←← =1000 ;LOTS OF ROOM
30900
31000 PUSH P,A
31100 PUSH P,B
31200 PUSH P,C
31300 PUSH P,D
31400 PUSH P,E
31500 PUSH P,Q1
31600
31700 MOVE Q1,IOADDR(CDB)
31800 HRLI Q1,440700 ;MAKE A BP
31900
32000 RESTRT: MOVE D,Q1
32100 SETZ E, ;COUNT
32200 INLUP: CAIL E,ORIGCNT ;BEYOND?
32300 JRST CNTEXH ;YES
32400 JSYS PBIN
32500 CAIN A,DELLINE ;DELETE ENTIRE LINE?
32600 JRST CTRLU ;YES
32700 CAIN A,RUBCHAR ;RUBOUT?
32800 JRST RUBOUT ;YES
32900 CAIN A,37 ;PHONEY BBN EOL?
33000 JRST SAWEOL
33100 CAIN A,33
33200 JRST SAWESC
33300 CAIN A,32 ;CONTROL-Z?
33400 JRST TTYEOF ;YES, EOF
33500 CAIE A,7 ;CONTROL-G
33600 CAIN A,12 ;OR LF
33700 JRST DONE
33800 IDPB A,D
33900 AOJA E,INLUP ;CONTINUE
34000
34100 CTRLU: HRROI A,[BYTE (7) 7,15,12,0,0]
34200 JSYS PSOUT
34300 JRST RESTRT ;START OVER
34400
34500 RUBOUT: JUMPE E,CTRLU ;NOTHING, DO CTRLU
34600 IMSSS <
34700 MOVEI 1,101
34800 JSYS DELCH
34900 JFCL
35000 JRST DLTED
35100 JRST DLTED
35200 >;IMSSS
35300 MOVEI A,"\"
35400 JSYS PBOUT
35500 LDB A,D ;LAST CHAR
35600 JSYS PBOUT
35700 DLTED:
35800 SOJ D, ;DECREMENT BP
35900 IBP D
36000 IBP D
36100 IBP D
36200 IBP D
36300 SOJA E,INLUP ;DECREMENT COUNT AND CONTINUE
36400
36500 DONE:
36600 IDPB A,D
36700 AOJ E,
36800 CNTEXH:
36900 MOVEM E,IOCNT(CDB)
37000 MOVEM Q1,IOBP(CDB)
37100 POP P,Q1
37200 POP P,E
37300 POP P,D
37400 POP P,C
37500 POP P,B
37600 POP P,A
37700 JRST DORET
37800
37900 SAWEOL: MOVEI A,15 ;SIMULATE CR
38000 IDPB A,D
38100 AOJ E,
38200 MOVEI A,12 ;SIMULATE LF
38300 JRST DONE
38400
38500 SAWESC: MOVEI A,ALTMODE ;DEC ALTMODE
38600 JRST DONE
38700
38800 TTYEOF: MOVE A,[QTTEOF]
38900 ORM A,TTYINF(CDB) ;QUE AN EOF
39000 JRST CNTEXH ;AND RETURN
39100
39200 BEND DECBUF
39300
39400 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
02400 AOS 2,IOPAGE(CDB) ;NEXT PAGE
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: SETZM DMPED(CDB) ;RESET VALUES TO ORIGINALS
02500 SETZM IOCNT(CDB)
02600 SETZM IOBP(CDB)
02700 SETZM IOSTT(CDB)
02800 SETOM IOPAGE(CDB) ;N.B.
02900 SETO 1, ;DESTROY PAGE -- NOTE: CLOBBERS JFN
03000 MOVE 2,FKPAGE(CDB) ;UNTIL POP BELOW
03100 SETZ 3,
03200 JSYS PMAP
03300 POPBACK:POP P,6
03400 POP P,5
03500 POP P,4
03600 POP P,3
03700 POP P,2
03800 POP P,1
03900 POPJ P,
04000
04100 TABL: JRST POPBACK ;0 -- XNULL
04200 JFCL ;1 -- XICHAR
04300 PUSHJ P,CHCEOF ;2 -- XOCHAR -- POPJ RETURN
04400 JFCL ;3 -- XIWORD
04500 PUSHJ P,CHWEOF ;4 -- XOWORD
04600 JFCL ;5 -- XCICHAR
04700 PUSHJ P,ADCO ;6 -- XCOCHAR
04800 JFCL ;7 -- XCWORD
04900 JRST DOB7 ;10 -- XBYTE7
05000 JFCL ;11 -- XDICHAR
05100 JRST XDO1 ;12 -- XDOCHAR
05200 JRST XDO2 ;13 -- XDARR
05300
05400 DOB7: SKIPN 2,TTYINF(CDB) ;A TELETYPE?
05500 JRST UNMAP ;NOPE
05600 TESTZ 2,QTTEOF ;TURN OFF QUED EOF
05700 MOVEM 2,TTYINF(CDB)
05800 JRST UNMAP ;AND UNBUFFER
05900
06000 XDO1: PUSHJ P,ADCO ;WRITE OUT WHATEVER IS THERE
06100 XDO2: SKIPN DMPED(CDB) ;DUMP MODE OUTPUT SEEN?
06200 JRST UNMAP ;NOPE
06300 MOVE 2,DVTYP(CDB) ;DEVICE TYPE
06400 CAIE 2,2 ;MAGTAPE?
06500 JRST UNMAP ;NOPE
06600 MOVEI 2,3 ;EOF
06700 JSYS MTOPR ;WRITE TWO
06800 JSYS MTOPR
06900 MOVEI 2,17 ;BACKSPACE OVER 1 EOF
07000 JSYS MTOPR
07100 JRST UNMAP
07200
07300
07400 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 MOVEM 2,RACS+A(USER) ;ANSWER IN 2
01000 RFBRET: JRST RESTR
01100
01200 RFBBAD: ERR <Illegal JFN>,1
01300 JRST RFBRET
01400
01500 ENDCOM(BINROU)
01600
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>
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 ENDCOM(DEVS)
02800
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,IOTLEN
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,IOTLEN-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 SETO 1, ;RELEASE PAGE
02200 SETZ 3, ;FLAGS WORD
02300 MOVE 2,[XWD 400000,STARTPAGE]
02400 .RESE1: CAMN 2,[XWD 400000,STARTPAGE+JFNSIZE] ;THIS WOULD BE TOO MANY PAGES
02500 JRST .RESE2
02600 JSYS PMAP
02700 AOJA 2,.RESE1 ;NEXT?
02800
02900 .RESE2:
03000 JSYS RESET ;CLEAR ALL IO
03100
03200 ;SET UP PSI SYSTEM
03300 HRRZI 1,400000 ;USE EXISTING TABLE IF THERE
03400 ;; JSYS RIR
03500 ;; JUMPN 2,.+3 ;ALREADY THERE
03600 MOVE 2,[XWD LEVTAB,CHNTAB]
03700 JSYS SIR
03800 JSYS EIR ;TURN ON INTERRUPTS
03900
04000 ;CHECK AND SEE IF WE ARE DETACHED
04100 JSYS GJINF
04200 CAMN 4,[-1] ;-1 FOR DETACHED JOBS
04300 JRST DTCHED ;YES IT IS DETACHED
04400
04500 ;SET PRIMARY INPUT TO WAKE UP ON EVERY CHARACTER
04600 ;THE USER MAY RESET THIS.
04700 MOVEI 1,100 ;PRIMARY INPUT
04800 JSYS RFMOD
04900 TRO 2,170000 ;WAKEUP ON ALL CHARS
05000 JSYS SFMOD
05100 DTCHED: SETZM CTLOSW ;CLEAR OUTPUT-SUPPRESSION SWITCH
05200
05300 JRST (P) ;AND RETURN
05400 BEND RESET
05500
05600 ;ROUTINE TO CHECK IF A JFN HAS BEEN CLOSED BY ONE OF
05700 ;THE DEC-STYLE CLOSE ROUTINES (IN WHICH CASE IT
05800 ;MUST BE AVAILABLE FOR RE-OPENING)
05900 ;ARGS:
06000 ; 1 JFN
06100 ; CDB THE CHANNEL DATA BLOCK
06200 ↑OPNCHK:
06300 SKIPL IOSTT(CDB) ;CLOSED BY DEC?
06400 POPJ P, ;NO
06500 PUSH P,2 ;SAVE 2
06600 MOVE 2,OFL(CDB) ;PREVIOUSLY USED FLAGS
06700 JSYS OPENF ;OPEN
06800 ERR <OPNCHK: Cannot OPENF file>,1
06900 SETZM IOSTT(CDB)
07000 POP P,2 ;RESTORE 2
07100 POPJ P, ;RETURN
07200
07300 HERE(RDSEG)
07400 PUSHJ P,SAVE ;
07500 MOVE LPSA,X33 ;FOR RESTR BELOW
07600 HRRZ A,SEGPAGE*1000 + 12 ;ADDRESS OF LAST WORD OF SEGMENT IS HERE
07700 LSH A,-=9 ;MAKE IT A PAGE NUMBER
07800 HRLI A,SEGPAGE ;FIRST PAGE OF SEGMENT
07900 MOVEM A,@-2(P) ;STORE
08000 HRLI A,STARTPAGE ;FIRST WORD OF BUFFER REGION
08100 HRRI A,STARTPAGE+JFNSIZE-1 ;LAST PAGE OF BUFFER REGION
08200 MOVEM A,@-1(P) ;STORE
08300 JRST RESTR ;AND RETURN
08400
08500 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>
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 MOVEI A,101
02000 JSYS RFMOD
02100 PUSH P,B ;SAVE THE TTY MODE
02200 TRO B,170000 ;WAKEUP ON EVERYTHING
02300 JSYS SFMOD
02400
02500 PUSH P,[ORIGCNT] ;
02600 PUSHJ P,ZSETST ;GET A GOOD BP IN A
02700 MOVE Q1,A
02800
02900
03000
03100 RESTRT: MOVE D,Q1 ;GET THE ORIGINAL BP
03200 SETZ E, ;ZERO THE COUNT
03300 INLUP: CAIL E,ORIGCNT
03400 JRST CNTEXH ;COUNT EXHAUSTED
03500 JSYS PBIN ;GET A CHAR
03600 CAIE A,37 ;EOL?
03700 CAIN A,33 ;ESCAPE?
03800 JRST DONE
03900 CAIE A,32 ;CTRL-Z
04000 CAIN A,7 ;CTRL-G
04100 JRST DONE
04200 CAIE A,"R"-100 ;CTRL-R FOR REPEAT
04300 JRST NOCTR
04400 HRROI A,[ASCIZ/
04500 /]
04600 JSYS PSOUT
04700 JUMPE E,INLUP
04800 MOVEI A,101
04900 MOVE B,Q1 ;ORIG BP
05000 MOVN C,E ;COUNT THUS FAR
05100 JSYS SOUT
05200 JRST INLUP ;AND CONTINUE
05300 NOCTR: CAIE A,"X"-100 ;CONTROL-X FOR DELETE LINE
05400 JRST NOCTX
05500 DOCTX: HRROI A,[ASCIZ/
05600 /]
05700 JSYS PSOUT
05800 JRST RESTRT ;AND START ALL OVER
05900 NOCTX: CAIE A,177 ;RUBOUT OR
06000 CAIN A,"A"-100 ;CONTROL-A
06100 JRST .+2
06200 JRST NOCTA
06300 JUMPLE E,DOCTX ;IF NO CHARS THEN DO A CONTROL-X
06400 MOVEI A,"\"
06500 JSYS PBOUT
06600 LDB A,D ;LAST CHAR
06700 JSYS PBOUT
06800 MOVE A,D
06900 JSYS BKJFN
07000 JFCL
07100 MOVEM A,D ;BACK UP BP
07200 SOJA E,INLUP ;SUBTRACT 1 AND CONTINUE
07300 NOCTA: IDPB A,D
07400 AOJA E,INLUP ;ONE MORE CHAR
07500
07600 CNTEXH: SETO A, ;INDICATE NO COUNT
07700 DONE: MOVEM A,.SKIP. ;BREAK CHAR, -1 FOR EXHAUSTED
07800 PUSH P,[ORIGCNT]
07900 PUSH P,D ;NEW BP
08000 PUSHJ P,ZADJST ;FIX UP STRING SPACE, PUT STRING ON STACK
08100 MOVEI A,101
08200 POP P,B ;MODE SETTING
08300 JSYS SFMOD ;RESET
08400 MOVE LPSA,X11
08500 JRST RESTR ;AND RETURN
08600
08700 BEND INTTY
08800 >;NOIMSSS
08900
09000 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
05400 >
05500 ,<SAVE,RESTR,X11,X22,X33,INSET,CAT,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
25900 ENDCOM(TTY)
26000 COMPIL(PTY)
26100 ENDCOM(PTY)
26200
26300 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 BREAK CHAR
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