perm filename IOSER.TNX[NEW,AIL] blob
sn#408290 filedate 1979-01-08 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00112 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00010 00002 TENX<THE ENTIRE FILE IS FOR TENEX ONLY
C00013 00003 DSCR IOSTT(CDB) values.
C00016 00004
C00020 00005 COMPIL(PAT,<OPEN,LOOKUP,ENTER,USETI,USETO,MTAPE,TENXFI,RELEASE,CLOSE,CLOSIN,CLOSO,GETCHAN,CVJFN,RENAME>
C00029 00006 DSCR PROCEDURE LOOKUP(INTEGER CHNL STRING FILE REFERENCE INTEGER FLAG)
C00033 00007 HERE(ENTER)
C00036 00008 DSCR
C00039 00009 DSCR PROCEDURE USETI,USETO(INTEGER CHANNEL,BLOCK)
C00041 00010 DSCR PROCEDURE CLOSE(INTEGER CHANNEL,[CLOSE_INHIBIT_BITS])
C00042 00011 HERE(RELEASE)
C00043 00012 DSCR
C00044 00013 DSCR STRING PROCEDURE TENXFI(STRING DECFILE)
C00048 00014 DSCR
C00050 00015 COMPIL(JOBINF,<ODTIM,IDTIM,RUNTM,GTAD,GJINF>,<ZSETST,ZADJST,X22,X33,X44,.SKIP.,CATCHR>
C00051 00016
C00052 00017 DSCR INTEGER SIMPLE PROCEDURE RUNTM(INTEGER FORK REFERENCE INTEGER CONSOLE)
C00053 00018 DSCR INTEGER SIMPLE PROCEDURE GTAD
C00054 00019 DSCR INTEGER SIMPLE PROCEDURE GJINF(REFERENCE INTEGER LOGDIR,CONDIR,TTYNO)
C00055 00020 ENDCOM(JOBINF)
C00056 00021 COMPIL(DIRECT,<STDIR,DIRST>,<X22,X33,CATCHR,ZSETST,ZADJST.SKIP.>
C00058 00022 DSCR STRING SIMPLE PROCEDURE DIRST(INTEGER I)
C00060 00023 COMPIL(RUNPRG,<RUNPRG>,<X22,X33,CATCHR>,<RUNPRG -- RUN A PROGRAM>)
C00065 00024 COMPIL(OPF,<OPENFILE,SETINPUT,SETPL,INDEXFILE,SETCHAN>,<.SKIP.>,<OPENFILE -- OPEN A FILE>)
C00074 00025 DSCR PROCEDURE SETINPUT(INTEGER CHAN REFERENCE INTEGER COUNT,BR,EOF)
C00075 00026 DSCR
C00077 00027 DSCR
C00079 00028 DSCR SETCHAN(JFN,GTFLAGS,OPFLAGS)
C00080 00029 COMPIL(GTJFN,<GTJFN,GTJFNL>,<.SKIP.,SETCHN,CATCHR,X11,X22,X44>,<GTJFN -- GET A JFN>)
C00082 00030 DSCR INTEGER PROCEDURE GTJFNL(STRING ORIG INTEGER FLAGS, XWDJFN!JFN
C00085 00031 COMPIL(FILINF,<GNJFN,DELF,UNDELETE,DELNF,SIZEF,JFNS,JFNSL,OPENF,CFILE,CLOSF,RLJFN,GTSTS,STSTS,RNAMF>
C00087 00032 DSCR PROCEDURE DELF(INTEGER CHAN)
C00089 00033 DSCR PROCEDURE UNDELETE(INTEGER CHAN)
C00090 00034 DSCR INTEGER PROCEDURE SIZEF(INTEGER JFN)
C00091 00035
C00093 00036 DSCR SIMPLE PROCEDURE OPENF(INTEGER JFN,FLAGS)
C00095 00037
C00098 00038 DSCR SIMPLE PROCEDURE CLOSF(INTEGER JFN)
C00100 00039 DSCR SIMPLE PROCEDURE RLJFN(INTEGER JFN)
C00101 00040 DSCR INTEGER SIMPLE PROCEDURE GTSTS(INTEGER JFN)
C00102 00041 DSCR BOOLEAN SIMPLE PROCEDURE STSTS(INTEGER JFN,STATUS)
C00103 00042 DSCR BOOLEAN SIMPLE PROCEDURE RNAMF(INTEGER EXISTINGJFN,NEWJFN)
C00104 00043 COMPIL(DEVINF,<CNDIR,ASND,RELD,GDSTS,SDSTS,STDEV,DEVST,GTFDB,CHFDB>
C00106 00044 DSCR BOOLEAN PROCEDURE ASND(INTEGER DEVICE)
C00107 00045 DSCR BOOLEAN PROCEDURE RELD(INTEGER DEVICE)
C00108 00046 DSCR INTEGER SIMPLE PROCEDURE GDSTS(INTEGER CHAN REFERENCE INTEGER WORDCNT)
C00109 00047 DSCR PROCEDURE SDSTS(INTEGER JFN,NEWSTATUS)
C00110 00048 DSCR INTEGER PROCEDURE STDEV(STRING S)
C00111 00049
C00112 00050 DSCR SIMPLE PROCEDURE GTFDB(INTEGER JFN REFERENCE INTEGER ARRAY BUF)
C00113 00051
C00114 00052 DSCR INTEGER SIMPLE PROCEDURE WORDIN(INTEGER JFN)
C00116 00053 HERE(ARRYIN)
C00120 00054 HERE(WORDOUT)
C00122 00055 HERE(ARRYOUT)
C00125 00056
C00127 00057 HERE(SWDPTR)
C00129 00058
C00136 00059 SETWPT:
C00140 00060 SETWIO:
C00141 00061 ADWI:
C00143 00062 DSCR CHAR←CHARIN(CHANNEL)
C00146 00063 DSCR STRING SIMPLE PROCEDURE SINI(INTEGER JFN,MAXLENGTH,BRKCHAR)
C00150 00064 Input
C00158 00065 .DOINP: PUSHJ P,DOINP
C00159 00066
C00163 00067 Realin, Realscan
C00170 00068 NUMIN -- CONTD.
C00177 00069 LNUMIN NUMBER INPUT
C00188 00070
C00190 00071 DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
C00191 00072
C00193 00073
C00196 00074 DSCR PROCEDURE LINOUT(INTEGER JFN,VALUE)
C00199 00075 HERE(RCHPTR)
C00200 00076 HERE(SCHPTR)
C00202 00077 DSCR Auxiliary routines for character i/o.
C00208 00078 SETCPT:
C00211 00079 SETCIO:
C00212 00080 DSCR
C00225 00081 DSCR ADCO,ADCO1
C00229 00082 DSCR SETIO
C00236 00083 DSCR
C00239 00084 ENDCOM(IOROU)
C00240 00085 DSCR SIMPLE PROCEDURE SFPTR(INTEGER JFN,POINTER)
C00241 00086 DSCR INTEGER SIMPLE PROCEDURE RFPTR(INTEGER JFN)
C00242 00087 DSCR SIMPLE PROCEDURE MTOPR(INTEGER JFN,FUNCTION,VALUE)
C00243 00088 DSCR SIMPLE PROCEDURE BKJFN(INTEGER JFN)
C00244 00089 DSCR INTEGER SIMPLE PROCEDURE RFBSZ(INTEGER JFN)
C00245 00090 COMPIL(DSKOPS,<DSKIN,DSKOUT>
C00247 00091 DSCR SIMPLE PROCEDURE
C00248 00092 COMPIL(DEVS,<DEVTYPE,DVCHR,ERSTR>
C00249 00093 DSCR INTEGER SIMPLE PROCEDURE DVCHR(INTEGER JFN REFERENCE INTEGER AC1,AC3)
C00250 00094 DSCR SIMPLE PROCEDURE ERSTR(INTEGER ERRNO,FORK)
C00252 00095 COMPIL(UTILITY,<SETCHN,ZSETST,ZADJST,.RESET,RDSEG>
C00258 00096 DSCR STRING SIMPLE PROCEDURE ZADJST(INTEGER CNTEST,BP)
C00261 00097 DSCR
C00265 00098 COMPIL(TTM,<RFMOD,SFMOD,STPAR,STI,RFCOC,SFCOC,GTTYP,STTYP,SETEDIT>
C00271 00099 COMPIL(PAGES,<PMAP>,<SAVE,RESTR,X44>
C00272 00100 COMPIL(TT2,<PBTIN,INTTY>
C00273 00101 DSCR STRING SIMPLE PROCEDURE INTTY
C00275 00102 NOIMSSS<NON-IMSSS VERSION OF INTTY FOR THOSE WHO SUFFER
C00279 00103 TTY FUNCTIONS
C00282 00104 HERE(PBIN)
C00292 00105 Filnam
C00295 00106 Flscan
C00297 00107 COMPIL(CAS,<CSERR,LPRYER>,<GOGTAB>
C00298 00108
C00299 00109
C00300 00110
C00301 00111
C00302 00112
C00303 ENDMK
C⊗;
TENX<;THE ENTIRE FILE IS FOR TENEX ONLY
COMMENT ⊗ TENEX-IOSER -- R. SMITH ⊗
LSTON (IOSER)
IFN ALWAYS, <BEGIN IOSER>
COMMENT ⊗ INDICES, BITS FOR TENEX VERSION OF IOSER ⊗
;WORDS IN CDB BLOCK FOR EACH CHANNEL
?GFL←←0 ;FLAGS FOR GTJFN
?OFL←←1 ;FLAGS FOR OPENF
?BRCHAR←←2 ;BRCHAR ADDRESS
?ICOUNT←←3 ;COUNT ADDRESS
?ENDFL←←4 ;EOF ADDRESS
?IOCNT←←5 ;I/O COUNT
?IOBP←←6 ;I/O BP
?IOSTT←←7 ;STATUS OF THE IO (SEE FLAGS BELOW)
?IOADDR←←10 ;ADDRESS OF THE IO BUFFER IF THERE IS ONE
?DVTYP←←11 ;DEVICE TYPE
?DVDSG←←12 ;DEVICE DESIGNATOR
?OPNDUN←←13 ;TRUE IF OPENED WITH THE OPEN STATEMENT
?DVCH←←14 ;DEVICE CHARACTERISTICS
?DMPED←←15 ;TRUE IF DUMP MODE OUTPUT SEEN
;IN PARTICULAR USED TO NOTE IF A MAGTAPE
;HAS BEEN WRITTEN BUT NOT YET CLOSED,
;SINCE EOF'S ARE WRITTEN AT THE CLOSE
;BY CLOSF,CFILE,CLOSE,ETC.
?LINNUM←←16 ;LINE NO (FOR INPUT FUNCTION)
?PAGNUM←←17 ;PAGE NO (FOR INPUT FUNCTION)
?SOSNUM←←20 ;SOS LINE NO (FOR INPUT FUNCTION)
?FKPAGE←←21 ;XWD FORK,PAGE FOR PMAPPING TO DSK
?IOPAGE←←22 ;PAGE OF THE FILE (IF PMAPPED)
?FDBSZ←←23 ;BYTE SIZE OF FILE AS IN FDB
?FDBEOF←←24 ;NO. OF BYTES TO EOF AS IN FDB
?TTYINF←←25 ;TTY BUFFERING INFO--
;ADDITIONS TO CDB NUMBERS SHOULD INCLUDE CHANGE TO IOTLEN BELOW
?IOTLEN←←26 ;CURRENT LENGTH OF CDB BLOCK
DSCR IOSTT(CDB) values.
The following numbers can be in IOSTT(CDB). They indicate
the current state of the IO for the associated channel.
These numbers are set up by SETIO, which is called by
the first IO that happens on the channel. Each routine has
a dispatch table, usually called TABL, and the SIMIO macro
does an XCT on those tables.
⊗
?XNULL←←0 ;NOTHING HAPPENING YET
?XICHAR←←1 ;PMAPPING INPUT CHARS
?XOCHAR←←2 ;PMAPPING OUTPUT CHARS
?XIWORD←←3 ;PMAPPING INPUT WORDS
?XOWORD←←4 ;PMAPPING OUTPUT WORDS
?XCICHAR←←5 ;36 BIT BUFFERING, INPUT CHARS
?XCOCHAR←←6 ;36 BIT BUFFERING, OUTPUT CHARS
?XCIWORD←←7 ;36 BIT BUFFERING, INPUT OR OUTPUT WORDS
?XBYTE7←←10 ;7 BIT BIN, SIN ETC
?XDICHAR←←11 ;DUMP MODE CHARACTER INPUT
?XDOCHAR←←12 ;DUMP MODE CHARACTER OUTPUT
?XDARR←←13 ;DUMP MORE ARRAY INPUT OR OUTPUT
DEFINE SIMIO(AC,TABL,ERR) <
SKIPGE AC,IOSTT(CDB)
JRST [PUSHJ P,OPNCHK
MOVE AC,IOSTT(CDB)
JRST .+1]
CAILE AC,13 ;MAXIMUM THAT IOSTT CAN BE
JRST ERR
XCT TABL(AC)
>;SIMIO
DEFINE CHKDECCLZ <
SKIPGE IOSTT(CDB)
PUSHJ P,OPNCHK
>;CHKDECCLZ
DEFINE SETZEOF <
SETZM .SKIP.
SKIPE ENDFL(CDB)
SETZM @ENDFL(CDB)
>;SETZEOF
DEFINE SETOEOF <
SETOM .SKIP.
SKIPE ENDFL(CDB)
SETOM @ENDFL(CDB)
>;SETOEOF
IFNDEF JFNSIZE, <?JFNSIZE←←20> ;NUMBER OF CHANNELS ALLOWED
?DMOCNT←←200 ;(DEFAULT) COUNT FOR DUMP MODE OUTPUT
IFNDEF STARTPAGE,<?STARTPAGE←←610 ;STARTING PAGE FOR BUFFERS>
;BITS FOR SCAN FLAGS FOR OPENFILE ROUTINE
;THE BITS OF THE FLAGS WORD ARE THE SAME AS THE BITS OF GTJFN AND OPENF
;HOPEFULLY (WHERE APPLICABLE)
?STARBIT←←1B11 ;B11 OF GTJFN FOR INDEXED FILES
?TEMBIT←←1B5 ;B5 OF GTJFN FOR TEMPORARY FILE
?DELBIT←←1B8 ;GTJFN -- IGNORE DELETED BIT
?RDBIT←←1B19 ;B19 OF OPENF FOR READING
?WRBIT←←1B20 ;B20 OF OPENF FOR WRITING
?APPBIT←←1B22 ;B22 OF OPENF FOR APPEND
?CONFB1←←1B3 ;GTJFN BIT TO PRINT [CONFIRM] ETC
?CONFB2←←1B4 ;GTJFN BIT TO REQUIRE CONFIRMATION FROM USER
;ODDLY ENOUGH 3 AND 4 ARE ILLEGAL
?OUTBIT←←1B0 ;GTJFN -- FILE FOR OUTPUT USE
?OLDBIT←←1B2 ;GTJFN -- OLD FILE
?NEWBIT←←1B1 ;GTJFN -- NEW FILE
?ERTNBIT←←1B27 ;ERROR RETURN BIT -- INTERNAL
?BINBIT←←1B26 ;BINARY BIT -- INTERNAL
?THAWBIT←←1B25 ;THAWBIT GTJFN
?ERSNBIT←←1B28 ;ERROR SEEN -- INTERNAL
?CONFBIT←←1B29 ;CONFIRMATION -- INTERNAL
;MACROS FOR BIT TESTING
DEFINE .ZZZ $ (X,Y,Z)<
IFN Z&777777000000, <TL$X Y,Z⊗-=18> ;Z LSH -=18
IFN Z&777777, <TR$X Y,Z>
>
DEFINE TESTE (Y,Z) <.ZZZ NE,Y,Z> ;TDNE Y,[Z]
DEFINE TESTN (Y,Z) <.ZZZ NN,Y,Z> ;TDNN Y,[Z]
DEFINE TESTO (Y,Z) <.ZZZ O,Y,Z> ;TDO Y,[Z]
DEFINE TESTZ (Y,W) <.ZZZ Z,Y,W> ;TDZ Y,[Z]
;MACRO TO GET THE JFN NUMBER IN X FROM Y. IF INVALID, JUMP TO LABEL Z
;LOADS CDB (I.E., 11) WITH THE CDB ADDRESS
;LOADS CHNL WITH THE CHANNEL NUMBER
DEFINE VALCHN(X,Y,Z) <
SKIPL CHNL,Y
CAIL CHNL,JFNSIZE
JRST Z
MOVE CDB,CDBTBL(CHNL)
HRRZ X,JFNTBL(CHNL)
JUMPE X,Z
>;VALCHN
DEFINE LITCHN(X,Y,Z) <
SKIPL X,Y
CAIL X,JFNSIZE
JRST Z
MOVEM X,CHNL
MOVE CDB,CDBTBL(CHNL)
HRRZ X,JFNTBL(CHNL)
>;LITCHN
;ONLY USES AC X
DEFINE VALCH1(X,Y,Z) <
SKIPL X,Y
CAIL X,JFNSIZE
JRST Z
HRRZ X,JFNTBL(X)
JUMPE X,Z
>
;TTY STUFF
;FOR DEC-STYLE I/O
;CHAR FOR LINE DELETION (DELLINE) AND CHARACTER DELETION (RUBCHAR)
IFNDEF DELLINE,<?DELLINE←←"U"-100> ;CTRL-U
IFNDEF RUBCHAR,<?RUBCHAR←←177> ;RUBOUT
IFNDEF ALTMODE,<?ALTMODE←←33 ;ONE OF MANY VERSIONS>
DSCR
TTYINF for information about the controlling terminal.
⊗
?ISCTRM←← 1B0 ;CHANNEL IS THE CONTROLLING TERM
?TNXINP←← 0 ;DO STANDARD TENEX INPUT
?DECLED←← 1 ;DO DEC-STYLE INPUT
?TENXED←← 2 ;DO TENEX-STYLE INPUT
?QTTEOF←←1B17 ;QUE AN EOF FOR THE TTY
COMPIL(PAT,<OPEN,LOOKUP,ENTER,USETI,USETO,MTAPE,TENXFI,RELEASE,CLOSE,CLOSIN,CLOSO,GETCHAN,CVJFN,RENAME>
,<SAVE,RESTR,RELEASE,CORGET,INSET>
,<PAT -- TENEX ROUTINES EMULATING DEC CALLS>)
BEGIN PAT
DSCR PROCEDURE OPEN(INTEGER CHAN; STRING DEV; INTEGER MODE,IBUF,OBUF;
REFERENCE INTEGER COUNT,BR,EOF)
⊗
HERE(OPEN)
BEGIN OPEN
GTFLAGS←←4
OPFLAGS←←5
PUSH P,-7(P)
PUSH P,[0] ;CLOSE INHIBIT
PUSHJ P,RELEASE ;RELEASE IF ALREADY OPEN
;SEE WHAT KIND OF DEVICE WE HAVE
PUSH SP,-1(SP)
PUSH SP,-1(SP)
PUSH P,[0]
PUSHJ P,CATCHR ;PUT ON A NULL CHAR
PUSHJ P,MAKUP ;MAKE UPPER CASE (DAMMIT)
PUSH SP,-3(SP)
PUSH SP,-3(SP)
PUSH SP,[3]
PUSH SP,[POINT 7,[ASCIZ/:
/]]
PUSHJ P,CAT ;PUT ON A STRING
POP SP,-4(SP)
POP SP,-4(SP) ;SAVE ABOVE
PUSHJ P,SAVE ;NOW SAVE ACS
SETZ LPSA, ;NO PARAMETERS TO REMOVE
MOVE CHNL,-7(P) ;USER CHANNEL NUMBER
MOVE 1,(SP) ;STRING FOR DEVICE
SUB SP,X22 ;ADJUST STACK
JSYS STDEV
JRST BADOPN ;NOT A PLAUSIBLE DEVICE
PUSH P,2 ;SAVE DEVICE DESIGNATOR
;ITS A PLAUSIBLE DEVICE
MOVEI C,IOTLEN
PUSHJ P,CORGET
ERR <OPEN: CANNOT GET CORE>
MOVE CDB,B ;IO BLOCK ADDRESS
MOVEM CDB,CDBTBL(CHNL) ;SAVE
;ZERO OUT CORE (SINCE CORGET DOESNT!!!)
HRL B,B
ADDI B,1
SETZM (CDB)
BLT B,IOTLEN-1(CDB)
POP P,1 ;GET DEVICE DESIGNATOR
MOVEM 1,DVDSG(CDB) ;AND SAVE IT
JSYS DVCHR
MOVEM 2,DVCH(CDB) ;SAVE DEVICE CHARACTERISTICS
HLRZ 1,2
ANDI 1,777 ;DEVICE TYPE
MOVEM 1,DVTYP(CDB) ;SAVE IT
MOVEI 2,STARTPAGE(CHNL) ;PAGE BUFFERING
HRLI 2,400000 ;XWD FORK,PAGE
MOVEM 2,FKPAGE(CDB)
LSH 2,9 ;ADDRESS
MOVEM 2,IOADDR(CDB)
SETOM IOPAGE(CDB) ;AT (MYTHICAL) PAGE -1
MOVE 2,DVCH(CDB) ;DEVICE CHARS
TLNN 2,100000 ;IS DEVICE A DIRECTORY DEVICE
JRST GTNOW ;NOPE, DO GTJFN AND OPENF NO
HASDIR:
;GET THE MODE IN 4
MOVE 4,-6(P) ;MODE
ANDI 4,17 ;FORGET OTHER JUNK
;IF DEVICE IS A DECTAPE IN DUMP MODE THEN DO IT NOW ALSO
CAIE 1,3 ;IS IT A DECTAPE?
JRST HASDI1 ;NO
CAIN 4,17 ;IN DUMP MODE?
JRST DOMNT ;YES MOUNT AND THEN OPEN
;SO DONT DO GTJFN NOW, BUT WAIT
HASDI1: SETZM JFNTBL(CHNL) ;BE SURE
MOVEM 4,GFL(CDB) ;SAVE THE MODE AS THE GTJFN FLAGS
HRL 4,-5(P) ;INPUT BUFFERS
HRR 4,-4(P) ;OUTPUT BUFFERS
MOVEM 4,OFL(CDB) ;SAVE AS THE OPENF FLAGS
JRST GUDRET ;AND RETURN
;MOUNT AND OPEN DECTAPE IN DUMP MODE
DOMNT: MOVE A,DVDSG(CDB) ;GET DEVICE DESIGNATOR
TLO A,(1B3) ;DONT READ DIRECTORY FOR DUMP MODE
JSYS MOUNT
JRST BADOPN ;CANNOT MOUNT
MOVSI GTFLAGS,100001
MOVE 1,GTFLAGS
MOVE 2,(SP)
JSYS GTJFN
JRST BADOPN
MOVEM 1,JFNTBL(CHNL)
MOVEM GTFLAGS,GFL(CDB)
MOVE OPFLAGS,[447400000000!RDBIT!WRBIT]
MOVE 2,OPFLAGS
JSYS OPENF
JRST CNTOPN
JRST OPOK
GTNOW:
MOVSI GTFLAGS,100001
MOVE 1,GTFLAGS
MOVE 2,(SP) ;DEVICE STRING
JSYS GTJFN
JRST BADOPN ;NOPE CANNOT GET
MOVEM 1,JFNTBL(CHNL) ;SAVE JFN
MOVEM GTFLAGS,GFL(CDB) ;AND SAVE THEM
;CHECK IF IT IS THE CONTROLLING TERMINAL (DEVICE "TTY" ONLY )
MOVE 2,DVTYP(CDB) ;GET DEVICE TYPE
CAIE 2,12 ;IS IT A TERMINAL?
JRST NOTTTY ;NO
PUSH P,3
PUSH P,4
PUSH P,5
PUSH P,6
HRRZ 2,JFNTBL(CHNL)
HRROI 1,4 ;WRITE IN 4
MOVSI 3,200000 ;DEVICE ONLY
SETZ 4,
JSYS JFNS ;GET STRING
MOVEM 4,2 ;SAVE IN 2
POP P,6
POP P,5 ;RESTORE
POP P,4
POP P,3
CAME 2,[ASCIZ/TTY/] ;DEVICE TTY?
JRST NOTTTY ;NO
MOVE 2,[ISCTRM+DECLED] ;THE CONTROLLING TERMINAL
MOVEM 2,TTYINF(CDB) ;REMEMBER
NOTTTY:
;COMPUTE OPENF FLAGS
SETZ OPFLAGS,
MOVE 2,DVCH(CDB) ;DEVICE CHARACTERISTICS
TESTE 2,<1B1> ;CAN DO INPUT?
TESTO OPFLAGS,RDBIT
TESTE 2,<1B0> ;CAN DO OUTPUT?
TESTO OPFLAGS,WRBIT
MOVE 1,DVTYP(CDB) ;CHECK DEVICE TYPE
CAIE 1,7 ;IS IT THE LPT?
CAIN 1,12 ;IS IT A TTY?
JRST OP7BT ;USE 7 BIT BYTES
;NOW TRY VARIOUS THINGS, LOOKING FOR SOMETHING THAT WORKS
HRRZ 1,JFNTBL(CHNL)
HRLI OPFLAGS,440000
MOVE 2,OPFLAGS ;36-BIT, MODE 0
JSYS OPENF
SKIPA
JRST OPOK
HRRZ 1,JFNTBL(CHNL)
HRLI OPFLAGS,447400 ;36-BIT, MODE 17
MOVE 2,OPFLAGS
JSYS OPENF
SKIPA
JRST OPOK
OP7BT: HRRZ 1,JFNTBL(CHNL)
HRLI OPFLAGS,70000 ;7-BIT, MODE 0
MOVE 2,OPFLAGS
JSYS OPENF
JRST NOOPN
OPOK: MOVEM OPFLAGS,OFL(CDB) ;SAVE OP FLAGS
GUDRET:
;SAVE FLAGS
SETOM OPNDUN(CDB) ;INDICATE OPENED WITH OPEN
POP P,TEMP ;RETURN ADDRESS
POP P,ENDFL(CDB) ;SAVE GOOD THINGS
POP P,BRCHAR(CDB)
POP P,ICOUNT(CDB)
SETZM @ENDFL(CDB) ;INDICATE GOOD OPENING
SUB SP,X22 ;CLEAN UP STACKS
SUB P,X44
JRST RESTR ;AND RETURN
NOOPN:
CNTOPN: SKIPN 1,JFNTBL(CHNL) ;RELEASE JFN
JSYS RLJFN
JFCL
BADOPN:
SKIPE B,CDBTBL(CHNL) ;CORE ALLOCATED?
PUSHJ P,CORREL ;RELEASE CORE
SETZM JFNTBL(CHNL)
SETZM CDBTBL(CHNL)
SKIPN @-1(P) ;USER WANTS ERROR?
ERR <OPEN: IO ERROR OR ILLEGAL SPECIFICATIONS>,1
SETOM @-1(P)
POP P,TEMP
SUB P,[XWD 7,7]
SUB SP,X22
JRST RESTR
BEND OPEN
;MAKE UPPER CASE LETTERS
MAKUP: PUSHJ P,SAVE
SKIPE SGLIGN(USER)
PUSHJ P,INSET
HRRZ A,-1(SP) ;LENGTH OF STRING
ADDM A,REMCHR(USER)
SKIPLE REMCHR(USER) ;OK?
PUSHJ P,STRNGC ;NO, COLLECT
MOVE B,A
HRRO A,A
PUSH SP,A
PUSH SP,TOPBYTE(USER)
UPPER1: JUMPLE B,UPPER2 ;DONE YET?
ILDB C,-2(SP) ;NEXT CHAR
CAIL C,141
CAILE C,172
SKIPA
SUBI C,40 ;CONVERT TO UPPER CASE
IDPB C,TOPBYTE(USER)
SOJA B,UPPER1
UPPER2: POP SP,-2(SP)
POP SP,-2(SP)
SETZ LPSA,
POP P,TEMP ;RETURN ADDR
JRST RESTR ;RETURN
DSCR PROCEDURE LOOKUP(INTEGER CHNL; STRING FILE; REFERENCE INTEGER FLAG)
⊗
HERE(LOOKUP)
BEGIN LOOKUP
PUSHJ P,TENXFI ;MAKE THE FILE SPEC TENEX
PUSH P,1
PUSH P,2
PUSH P,3
PUSH P,CHNL
PUSH P,CDB
DEFINE CHNARG <-7(P)>
DEFINE FLGARG <-6(P)>
SETZM @FLGARG ;CLEAR FLAG
SKIPL CHNL,CHNARG
CAIL CHNL,JFNSIZE
JRST BADLU1
MOVE CDB,CDBTBL(CHNL)
SKIPN OPNDUN(CDB) ;ERROR IF NOT OPENED
JRST BADLU1
MOVE 2,DVCH(CDB) ;GET DEVICE CHARACTERISTICS
TLNN 2,100000 ;DOES DEVICE HAVE A DIRECTORY?
JRST LUKRET ;NO, NO LOOKUP
SKIPE JFNTBL(CHNL) ;JFN ALREADY ASSIGNED?
PUSHJ P,RELNOW ;YES, RELEASE IT
PUSHJ P,DEVCAT
MOVSI 1,100001 ;OLD FILE
MOVE 2,(SP)
JSYS GTJFN
JRST BADLUK
MOVEM 1,JFNTBL(CHNL)
MOVSI 3,100001
MOVEM 3,GFL(CDB)
MOVE 2,[XWD 440000,200000] ;36-BIT
JSYS OPENF
SKIPA
JRST GUDLUK
MOVE 1,JFNTBL(CHNL)
MOVE 2,[XWD 447400,200000] ;36-BIT, DUMP
JSYS OPENF
SKIPA
JRST GUDLUK
MOVE 1,JFNTBL(CHNL)
MOVE 2,[XWD 70000,200000] ;7-BIT
JSYS OPENF
JRST BADLUK
GUDLUK: MOVEM 2,OFL(CDB)
SETZM @FLGARG
LUKRET: POP P,CDB
POP P,CHNL
POP P,3
POP P,2
POP P,1
SUB SP,X22
SUB P,X33
JRST @3(P)
BADLUK: MOVEM 1,@FLGARG
JRST LUKRET
BADLU1: SETOM @FLGARG
JRST LUKRET
BEND LOOKUP
DEVCAT:
;HERE WITH CDB LOADED, FILENAME ON THE SP STACK
;RETURN WITH "DEV:FILE" & 0 ON THE SP STACK
;MUST NOT HAVE CALLED SAVE WHEN THIS IS CALLED
PUSH P,1
PUSH P,2
PUSH P,[=100]
PUSHJ P,ZSETST ;BP IN 1
MOVE 2,DVDSG(CDB) ;DEVICE DESIGNATOR
JSYS DEVST
ERR <LOOKUP, ENTER, OR RENAME: CANNOT DO DEVST>
PUSH P,[=100]
PUSH P,1 ;UPDATED BP
PUSHJ P,ZADJST
PUSH P,[":"]
PUSHJ P,CATCHR
PUSHJ P,CAT.RV
PUSH P,[0]
PUSHJ P,CATCHR
POP P,2
POP P,1
POPJ P,
;RELEASE JFN ALREADY THERE
RELNOW:
PUSH P,CHNL ;CHANNEL
PUSHJ P,CLOSF ;CLOSE DANCE
PUSH P,1
MOVE 1,JFNTBL(CHNL) ;GET JFN
JSYS RLJFN ;RELEASE
ERR <CANNOT RELEASE JFN>,1
SETZM JFNTBL(CHNL) ;AND ZERO OUT
SETZM IOSTT(CDB) ;NO STATUS
POP P,1
POPJ P,
HERE(ENTER)
BEGIN ENTER
PUSHJ P,TENXFI
PUSH P,1
PUSH P,2
PUSH P,3
PUSH P,CHNL
PUSH P,CDB
DEFINE CHNARG <-7(P)>
DEFINE FLGARG <-6(P)>
SETZM @FLGARG ;CLEAR FLAG FOR USER
SKIPL CHNL,CHNARG
CAIL CHNL,JFNSIZE
JRST BADEN1
MOVE CDB,CDBTBL(CHNL)
SKIPN OPNDUN(CDB)
JRST BADEN1 ;WAS AN OPEN PERFORMED HERE?
SKIPN 1,JFNTBL(CHNL)
JRST NOTOPN
MOVE 2,DVCH(CDB) ;GET DEVICE CHARACTERISTICS
TLNN 2,100000 ;DOES DEVICE HAVE DIRECTORY?
JRST ENTRET ;NO
SKIPGE IOSTT(CDB) ;A DEC-STYLE CLOSE DONE? CHKDECCLZ
JRST [PUSHJ P,RELNOW ;RELEASE JFN
JRST NOTOPN ;AND PROCEED
]
PUSH P,1 ;SAVE JFN
SETO 1, ;UNMAP THE BUFFER PAGE
MOVE 2,FKPAGE(CDB)
SETZ 3,
JSYS PMAP ;REMOVE PAGE
POP P,1
SETOM IOPAGE(CDB)
SETZM IOSTT(CDB)
PUSH P,1 ;SAVE JFN
TLO 1,400000 ;DO NOT RELEASE THE JFN
JSYS CLOSF
JFCL ;IGNORE
POP P,1
MOVE 2,OFL(CDB)
TESTO 2,WRBIT ;TURN ON WRITE BIT
MOVEM 2,OFL(CDB) ;AND SAVE NEW FLAGS
JSYS OPENF
JRST BADENT ;ERROR IN 1
JRST ENTRET ;RETURN
NOTOPN:
PUSHJ P,DEVCAT
MOVSI 1,600001 ;NEW FILE
MOVE 2,(SP)
JSYS GTJFN
JRST BADENT ;CANNOT GTJFN
MOVEM 1,JFNTBL(CHNL)
MOVSI 2,600001 ;THE
MOVEM 2,GFL(CDB) ;SAVE THE GTJFN FLAGS
B36: HRRZ 1,JFNTBL(CHNL)
MOVE 2,[XWD 440000,100000] ;36-BIT
JSYS OPENF
SKIPA
JRST ENT1
HRRZ 1,JFNTBL(CHNL)
MOVE 2,[XWD 447400,100000] ;36-BIT, DUMP
JSYS OPENF
SKIPA
JRST ENT1
HRRZ 1,JFNTBL(CHNL)
MOVE 2,[XWD 70000,100000]
JSYS OPENF
JRST BADENT
ENT1: MOVEM 2,OFL(CDB)
ENTRET: SETZM @FLGARG
ENTPOP: POP P,CDB
POP P,CHNL
POP P,3
POP P,2
POP P,1
SUB SP,X22
SUB P,X33
JRST @3(P)
BADENT: MOVEM 1,@FLGARG
JRST ENTPOP
BADEN1: SETOM @FLGARG
JRST ENTPOP
BEND ENTER
DSCR
RENAME(CHNL,"STR",PROT,@FLAG)
Since protection is not implemented in TENEX,
the feature will be ignored.
⊗
HERE(RENAME)
BEGIN RENAME
PUSH P,1
PUSH P,2
PUSH P,3
PUSH P,CHNL
PUSH P,CDB
DEFINE CHNARG <-10(p)>
DEFINE FLGARG <-6(P)>
VALCHN 1,CHNARG,RENBAD
PUSHJ P,OPNCHK ;MAKE SURE OPEN (SOMEWHAT REDUNDANT)
MOVE 2,DVCH(CDB) ;DEVICE CHARS
TLNN 2,100000 ;DIRECTORY DEVICE?
JRST RENRET ;NO, NOP
PUSHJ P,TENXFI ;MAKE A TENEX FILE NAME
;PERHAPS ONLY A DELETE?
HRRZ 2,-1(SP) ;NULL FILE SPEC?
JUMPE 2,RENDEL ;YES, DELETE
;ACTUALLY RENAME (ON THE SAME DEVICE)
PUSH P,CHNARG
PUSHJ P,CLOSF ;FIRST CLOSE THE FILE
PUSHJ P,DEVCAT
MOVE 3,1 ;SAVE FIRST JFN
MOVE 1,GFL(CDB) ;USE SAME FLAGS
TESTZ 1,OLDBIT ;EXCEPT NOT OLD
TESTO 1,NEWBIT ;BUT DO WANT NEW
TESTO 1,OUTBIT ;AND VERSION DEFAULTING
MOVEM 1,GFL(CDB) ;SAVE FLAGS
MOVE 2,(SP)
JSYS GTJFN
JRST RENERR ;ERROR BITS IN 1
MOVE 2,1 ;NEW JFN
MOVE 1,3 ;OLD JFN
JSYS RNAMF
JRST RENERR ;ERROR BITS IN 1
MOVE 1,2 ;NEW JFN
MOVE 2,OFL(CDB) ;OPENF FLAGS
JSYS OPENF
JRST RENERR ;ERROR BITS IN 1
MOVEM 1,JFNTBL(CHNL) ;SAVE THE NEW JFN
RENRET: SETZM @FLGARG ;INDICATE A GOOD RETURN
RENRE1: POP P,CDB
POP P,CHNL
POP P,3
POP P,2
POP P,1
SUB SP,X22
SUB P,X44
JRST @4(P)
RENERR: MOVEM 1,@FLGARG
JRST RENRE1
RENBAD: SETOM @FLGARG
JRST RENRE1
RENDEL: TLO 1,400000 ;TURN ON BIT 0 FOR NO RELEASE
JSYS DELF ;JFN IN 1
JRST RENERR
JRST RENRET
BEND RENAME
DSCR PROCEDURE USETI,USETO(INTEGER CHANNEL,BLOCK)
⊗
HERE(USETI)
HERE(USETO)
BEGIN USETS
PUSH P,1
PUSH P,2
PUSH P,3
PUSH P,CHNL
SETZM .SKIP.
VALCHN 1,-6(P),USETERR
MOVE 2,DVTYP(CDB)
CAIN 2,3 ;IS IT A DECTAPE
JRST USEDTA
MOVE 2,-5(P) ;ARGUMENT
SOJ 2,
LSH 2,7 ;CONVERT BLOCK TO WORD NUMBER
PUSH P,-6(P) ;CHANNEL ARG
PUSH P,2 ;WORD TO SET TO
PUSHJ P,SWDPTR ;SET THE WORD POINTER
USETRET:POP P,CHNL
POP P,3
POP P,2
POP P,1
SUB P,X33
JRST @3(P)
USEDTA:
MOVEI 2,30 ;OPERATION 30 FOR DECTAPES
HRRZ 3,-5(P) ;TAPE BLOCK
JSYS MTOPR ;SET DIRECTLY
JRST USETRET ;AND RETURN
USETER: ERR<Illegal JFN>,1
SETOM .SKIP.
JRST USETRET ;AND RETURN
BEND USETS
DSCR PROCEDURE CLOSE(INTEGER CHANNEL,[CLOSE_INHIBIT_BITS])
procedure closo(integer chan; integer bits(0))
procedure closin(integer chan; integer bits(0))
⊗
BEGIN CLOSES
HERE(CLOSIN)
HERE(CLOSO)
PUSH P,-2(P)
PUSHJ P,CLOSF
PUSHJ P,SAVE
VALCHN 1,-2(P),.+2
SETOM IOSTT(CDB) ;MARK AS BEING CLOSED
MOVE LPSA,X33
JRST RESTR
HERE(CLOSE)
DOOPN: PUSH P,-2(P)
PUSHJ P,CLOSF ;FORCE BUFFERS OUT, WRITE MAGT EOFS, CLOSF
PUSHJ P,SAVE
VALCHN 1,-2(P),CLORET
SETOM IOSTT(CDB) ;MARK AS BEING CLOSED
CLORET: MOVE LPSA,X33
JRST RESTR
BEND CLOSES
HERE(RELEASE)
DSCR
Ignores the close inhibit bits that are available in
the STANFORD SAIL, until we decide what to do with them.
⊗
PUSH P,1
PUSH P,-3(P) ;CHANNEL
PUSHJ P,CFILE
POP P,1 ;RESTORE 1
SUB P,X33
JRST @3(P) ;RETURN
DSCR
PROCEDURE MTAPE(INTEGER CHAN,OPERATION)
(the operation is a character e.g., "U" to unload)
as in the SAIL manual.
⊗
HERE(MTAPE)
BEGIN MTAPE
PUSHJ P,SAVE
MOVE LPSA,X33
LDB C,[POINT 5,-1(P),35]
MOVE A,OPTAB
MOVE B,OPTAB+1
TRZE C,30 ;COMPRESS TABLE
ADDI C,5
LSH C,2
ROTC A,(C)
ANDI B,17
VALCHN 1,-2(P),MTAERR
PUSHJ P,OPNCHK ;MAKE SURE OPEN
JSYS MTOPR
JRST RESTR
MTAERR: ERR <Illegal JFN>,1
JRST RESTR
OPTAB: BYTE (4) 16,17,0,0,3,6,7,13,10 ;A,B,E,F,R,S,T
BYTE (4) 11,0,1 ;U,W
BEND MTAPE
DSCR STRING PROCEDURE TENXFI(STRING DECFILE)
Converts the string to a TENEX file specification.
A la Alex Cannara.
⊗
HERE(TENXFI)
BEGIN TENXFI
CTRLV←←"V"-100
FIND←←2
PUSH P,1
PUSH P,2
PUSH P,3
SETZM FIND
PUSH SP,[0] ;DEVICE TEMPORARY
PUSH SP,[0]
PUSH SP,[0] ;DIR TEMPORARY
PUSH SP,[0]
PUSH SP,[0] ;NAM TEMPORARY
PUSH SP,[0]
DEFINE ORIG <-7(SP)>
DEFINE ORIG1 <-6(SP)>
DEFINE DEV <-5(SP)>
DEFINE DEV1 <-4(SP)>
DEFINE DIR <-3(SP)>
DEFINE DIR1 <-2(SP)>
DEFINE NAM <-1(SP)>
DEFINE NAM1 <0(SP)>
;SIMPLE SINCE NAME IS AT THE TOP OF SP
DEFINE CATNAM (X) <
PUSH P,X
PUSHJ P,CATCHR
>
DEFINE CATDIR (X) <
PUSH P,X
PUSH SP,DIR
PUSH SP,DIR
PUSHJ P,CATCHR
POP SP,-4(SP)
POP SP,-4(SP)
>
DEFINE GCH <
HRRZ 1,ORIG
JUMPE 1,TENDUN
ILDB 3,ORIG1
SOS ORIG
>
TENX1: GCH
CAIE 3,CTRLV
JRST NOQUOTE
SKIPE FIND
JRST QUODIR
PUSHJ P,CATNA3
GCH
PUSHJ P,CATNA3 ;AND THE CHAR FOLLOWING THE CTRLV
JRST TENX1
QUODIR: PUSHJ P,CATDI3
GCH
PUSHJ P,CATDI3
JRST TENX1 ;AND CONTINUE
NOQUOTE:
CAIN 3,":" ;COLON -- DEVICE
JRST ISDEV ;ITS BEEN A DEVICE ALL ALONG!!
CAIN 3,","
JRST TENX1 ;IGNORE COMMA
CAIE 3,40 ;SPACE
CAIN 3,11 ;OR TAB
JRST TENX1
CAIE 3,"<" ;THESE START THE DIRECTORY NAME
CAIN 3,"["
JRST STDIR
CAIE 3,">" ;THESE FINISH THE DIR. NAME
CAIN 3,"]"
JRST ENDDIR
SKIPE FIND ;DOING DIRECTORY?
JRST .+3 ;YES
PUSHJ P,CATNA3
JRST TENX1
PUSHJ P,CATDI3
JRST TENX1
STDIR: SETOM FIND
SKIPE DIR ;ANYTHING THERE?
JRST TENX1 ;YES, IGNORE
CATDIR <[74]>
JRST TENX1
ENDDIR: SETZM FIND
JRST TENX1
ISDEV: PUSHJ P,CATNA3 ;PUT THE COLON ON THE NAME
MOVE 3,NAM ;THE "NAME" HAS REALLY BEEN A DEV
MOVEM 3,DEV
MOVE 3,NAM1
MOVEM 3,DEV1
SETZM NAM ;SO CLEAR THE NAME -- START OVER
SETZM NAM1
JRST TENX1
TENDUN:
;CHECK TO SEE WHAT LAST CHAR OF DIR IS
SKIPN DIR
JRST GOTDIR ;NO DIRECTORY THERE
CATDIR <[76]> ;PUT ON A ">"
;NOW STACK HAS ORIG,DEV,DIR,NAM
GOTDIR:
PUSHJ P,CAT
;NOW STACK HAS ORIG,DEV,<DIR>NAM
PUSHJ P,CAT
;NOW STACK HAS ORIG,DEV:<DIR>NAM
GOTDI1: POP SP,-2(SP)
POP SP,-2(SP)
TXFRET:
POP P,3
POP P,2
POP P,1
POPJ P,
;CALL CAT MACROS WITH AC 3 AS THE ARG
CATNA3: CATNAM 3
POPJ P,
CATDI3: CATDIR 3
POPJ P,
BEND TENXFI
DSCR
INTEGER PROCEDURE GETCHAN(INTEGER I)
RETURNS AN UNUSED CHANNEL NUMBER, AND MARKS IT
FOR USE, SO THAT NO ONE WILL TRY TO USE IT.
⊗
HERE(GETCHAN)
MOVE A,[XWD -JFNSIZE+1,1] ;START AT CHANNEL 1
GETCH1: SKIPN CDBTBL(A) ;ALLOCATED YET?
JRST GETCH2 ;NO, TAKE IT
AOBJN A,GETCH1 ;YES
SETOM A ;INDICATE ERROR
POPJ P,
GETCH2: HRRZ A,A
PUSH P,B ;NOW ALLOCATE A TABLE
PUSH P,C
MOVEI C,IOTLEN
PUSHJ P,CORGET
ERR <GETCHAN: CANNOT GET CORE>
MOVEM B,CDBTBL(A)
HRL C,B ;ZERO OUT BLOCK
HRRI C,1(B)
SETZM (B)
BLT C,IOTLEN-1(B)
SETZM JFNTBL(A) ;BUT NO JFN (YET)
POP P,C
POP P,B
POPJ P,
DSCR
INTEGER PROCEDURE CVJFN(INTEGER CHAN)
Returns the JFN (XWD flags,jfn) associated
with a logical channel, -1 if no jfn assigned.
Hereby, the user of these routines can access
the system directly if the need arises.
⊗
HERE(CVJFN)
SKIPL 1,-1(P)
CAIL 1,JFNSIZE
JRST CVJFER
SKIPN 1,JFNTBL(1)
JRST CVJFER
CVJFR: SUB P,X22
JRST @2(P)
CVJFER: SETO 1,
JRST CVJFR
BEND PAT
ENDCOM(PAT)
COMPIL(JOBINF,<ODTIM,IDTIM,RUNTM,GTAD,GJINF>,<ZSETST,ZADJST,X22,X33,X44,.SKIP.,CATCHR>
,<JOBINF -- JOB UTILITY ROUTINES>)
DSCR STRING SIMPLE PROCEDURE ODTIM(INTEGER DT,FORMAT)
Returns the string representation of DT
(which is in internal TENEX representation). If DT
is -1 the current date and time are used. If format
is -1, the standard format is used.
⊗
HERE(ODTIM)
PUSH P,[=100] ; 100 CHARS
PUSHJ P,ZSETST ;GET BP IN 1
MOVE 2,-2(P) ;TIME
MOVE 3,-1(P) ;FORMAT
JSYS ODTIM
PUSH P,[=100]
PUSH P,1 ;UPDATED BP
PUSHJ P,ZADJST ;GET STRING
SUB P,X33 ;ADJUST STACK
JRST @3(P) ;RETURN
DSCR INTEGER SIMPLE PROCEDURE IDTIM(STRING S)
Returns the internal TENEX representation of S, which
is assumed to be the date and time in some reasonable format.
If the format cannot be scanned, the error is returned in .SKIP.
⊗
HERE(IDTIM)
PUSH P,[0]
PUSHJ P,CATCHR
MOVE 1,(SP) ;BYTE-POINTER
SETZB 2,.SKIP. ;NO SPECIAL FORMAT, ASSUME NO ERROR
JSYS IDTIM
MOVEM 2,.SKIP. ;ERROR TO USER
MOVE 1,2 ;ANSWER
SUB SP,X22 ;ADJUST SP STACK
POPJ P, ;RETURN
DSCR INTEGER SIMPLE PROCEDURE RUNTM(INTEGER FORK; REFERENCE INTEGER CONSOLE);
Returns the runtime of a fork. If FORK=-5, then then
whole job. Time is returned as milliseconds for you. Console time,
similarly converted, is returned in CONSOLE.
⊗
HERE(RUNTM)
MOVE 1,-2(P)
JSYS RUNTM
MOVEM 3,@-1(P)
SUB P,X33
JRST @3(P)
DSCR INTEGER SIMPLE PROCEDURE GTAD;
Returns the current date and time. See Jsys manual,
3-3.
⊗
HERE(GTAD)
JSYS GTAD
POPJ P,
DSCR INTEGER SIMPLE PROCEDURE GJINF(REFERENCE INTEGER LOGDIR,CONDIR,TTYNO);
Returns the TENEX jobnumber. LOGDIR is the directory
no. logged in, CONDIR is the connected directory number. TTYNO is the
TENEX teletype number, which is -1 if the job is detached.
See the DIRST routine for converting directory numbers to
directory strings.
⊗
HERE(GJINF)
JSYS GJINF
MOVEM 1,@-3(P)
MOVEM 2,@-2(P)
MOVEM 4,@-1(P)
MOVE 1,3;
SUB P,X44
JRST @4(P)
ENDCOM(JOBINF)
COMPIL(DIRECT,<STDIR,DIRST>,<X22,X33,CATCHR,ZSETST,ZADJST.SKIP.>
,<DIRECT -- TENEX DIRECTORY SPECS>)
DSCR INTEGER SIMPLE PROCEDURE STDIR(STRING S; BOOLEAN DORECOGNITION)
DESR
Returns the directory number associated with a string.
Any problems are returned in .SKIP. with the code:
1 string does not match
2 string is ambiguous.
⊗
HERE(STDIR)
PUSH P,[0]
PUSHJ P,CATCHR ;TACK ON 0
SETZ 3, ;
MOVEI 1,1 ; ASSUME NO RECOGNITION
SKIPE -1(P) ; DO WE WANT IT?
SETO 1, ; YES AFTER ALL
MOVE 2,(SP) ;BYTE-POINTER
JSYS STDIR
SKIPA 3,[1] ; NO MATCH;
MOVEI 3,2 ; AMBIGUOUS
MOVEM 3,.SKIP. ; SAVE IT FOR USER
HRRZ 1,1 ; SAVE DIR NO. (ONLY)
SUB SP,X22 ;ADJUST STRING STACK
SUB P,X22
JRST @2(P) ;RETURN
DSCR STRING SIMPLE PROCEDURE DIRST(INTEGER I)
Returns the string name for directory I. Any problems
cause .SKIP. to be set TRUE.
⊗
HERE(DIRST)
BEGIN DIRST
PUSH P,[=100]
PUSHJ P,ZSETST
SETZM .SKIP.
MOVE 2,-1(P) ;DIRECTORY NO.
PUSH P,1 ;SAVE STRING POINTER
JSYS DIRST
JRST DIRERR ;ERROR RETURN
SUB P,X11 ;CLEAR STACK, DONT NEED STRING POINTER
DOADJ: PUSH P,[=100]
PUSH P,1 ;UPDATED STRING POINTER
PUSHJ P,ZADJST ;GET SAIL STRING ON STACK
SUB P,X22
JRST @2(P)
DIRERR: MOVEM 1,.SKIP. ;ERROR NUMBER IN TOPS 20, STRING POINTER IN TENEX
;ALWAYS TRUE
POP P,1 ;GET BACK ORIGINAL BP
JRST DOADJ ;AND FIX STRINGS
BEND DIRST
ENDCOM(DIRECT)
COMPIL(RUNPRG,<RUNPRG>,<X22,X33,CATCHR>,<RUNPRG -- RUN A PROGRAM>)
DSCR INTEGER SIMPLE PROCEDURE RUNPRG(STRING PROGRAM; INTEGER INCREM; BOOLEAN NEWFORK)
This does two entirely different things depending on whether
NEWFORK is true or not.
If NEWFORK then a new fork is created, capabilities transmitted,
and PROGRAM is run there. INCREM is added to the entry vector. Any problems
cause the routine to return FALSE, otherwise it returns TRUE.
If not NEWFORK then the current job is destroyed and replaced
with PROGRAM, with INCREM added to the entry vector location. This is
like the DEC RUN uuo, and hence if the increment is 1, the program is
started at the CCL address. If the routine returns at all, there was a problem
with the file.
Remember to say .SAV as the PROGRAM extension.
⊗
HERE(RUNPRG)
BEGIN
JFN←←0
FORK←←14
PUSH P,[0]
PUSHJ P,CATCHR
MOVSI 1,100001 ; OLD FILE, PTR IN 2
MOVE 2,(SP) ; STRING POINTER
JSYS GTJFN ; TRY FOR JFN
JRST RUNERR ; ERROR
MOVEM 1,JFN ; SAVE JFN
SKIPN -1(P) ; USER WANTS FORK?
JRST SWP ; NO, REPLACE CURRENT PRG
MOVSI 1,100000 ; XMIT CAPABILITIES
JSYS CFORK
JRST RUNERR ; CANNOT CREATE FORK
MOVEM 1,FORK ; SAVE HANDLE
SETOB 2,3 ; INDICATE ALL PRIVILEDGES
JSYS EPCAP
HRLZ 1,1 ; FORK HANDLE
HRR 1,JFN ; THE JFN
JSYS GET ; JSYS GET THE FILE
MOVEI 1,400000 ; CURRENT FORK
JSYS GPJFN ;PRIMARY JFNS IN 2
MOVE 1,FORK ; SET PRIMARY IO
JSYS SPJFN ;FOR NEW FORK
MOVE 1,FORK ; FORK
MOVE 2,-2(P) ; USER VALUE FOR ENTRY VECTOR
JSYS SFRKV ;START THE FORK
MOVE 1,FORK ;
JSYS WFORK
SKIPE 1,FORK ; SET TO KILL
JSYS KFORK ;KILL THE FORK
HRRZ 1,JFN ;
JSYS RLJFN ; RELEASE
JFCL ; IGNORE
JRST RUNRET ; AND RETURN SAFELY
SWP:
IMSSS,< ;DESTROY EMULATOR INFO AT IMSSS
SETO 1,
MOVE 2,[XWD 400000,711] ;PAGE 711
JSYS PMAP ;DESTROY
>;IMSSS
PUSH P,JFN ;SAVE THE JFN
HRLI A1 ; BLT INTO ACS
HRRI 1 ;
BLT 15 ; THE INSTRUCTIONS -- NOTE THAT RF IS NOW CLOBBERED
POP P,0 ; RESTORE JFN TO AC0
HRLI 0,400000 ; XWD FORK, JFN
MOVE 16,-2(P) ; THE INCREMENT -- NOTE THAT SP IS NOW CLOBBERED
MOVE 17,[254000400010] ; FOR COMPARISON -- NOTE THAT THE P STACK IS GONE
JRST 4 ; AND GO
A1: -1 ; FOR PMAP
A2: 400000000677 ; THIS FORK, START AT 677 (LEAVING EMULATOR)
A3: 0 ;
A4: JSYS PMAP
A5: SOJL 2,4 ; LOOP THROUGH PAGES
A6: MOVE 1,0 ; XWD 400000,JFN
A7: JSYS GET ;
A10: MOVEI 1,400000 ; THIS FORK
A11: JSYS GEVEC ; JSYS GET ENTRY VECTOR
A12: CAMN 2,17 ; DEC STYLE??
A13: HRRZ 2,120 ; YES
A14: ADD 2,16 ; ADD THE INCREMREMENT
A15: JRST (2) ; AND START THE JOB
RUNERR: TDZA 1,[-1] ;ZERO 1 AND SKIP
RUNRET: SETO 1, ;INDICATE SUCCESS
SUB SP,X22
SUB P,X33
JRST @3(P)
BEND;RUNPRG
ENDCOM(RUNPRG)
COMPIL(OPF,<OPENFILE,SETINPUT,SETPL,INDEXFILE,SETCHAN>,<.SKIP.>,<OPENFILE -- OPEN A FILE>)
DSCR INTEGER SIMPLE PROCEDURE OPENFILE(STRING NAME,OPTIONS)
Name is the name of the file to be opened. If it is null, then
OPENFILE goes to the user's console for the filname (with recognition).
The value of the call is the jfn returned to the user.
OPTIONS is a string of options available to the user. Legal
characters are:
One of these:
R read
W write
A append
Version numbering
O old file
N new file
T temporary file
* index with INDEXFILE routine
Independent:
C require confirmation
D ignore deleted bit
H "thawed" access
Error handling
E return errors to user in the external
integer !skip!. TENEX error codes are used.
(JFN will be released in this case.)
OPENFILE does a GTJFN followed by a OPENF. If GTJFN fails, a new
attempt is made, from the user's console.
⊗
BEGIN OPENFILE
JFN←3 ;WHERE TO PUT THINGS
FLAGS←4
GTFLAGS←5
OPFLAGS←6
DEFINE EQ $ (X,Y) <
CAIE A,"$X$"
JRST .+3
TESTO FLAGS,Y
JRST OPCONT
>
DEFINE JTRUE $ (X) <
TESTN FLAGS,X
>
DEFINE JFALSE (X) <
TESTE FLAGS,X
>
DEFINE SGT (X) <
TESTO GTFLAGS,X
>
DEFINE SOF (X) <
TESTO OPFLAGS,X
>
DEFINE TGT (X) <
TESTE FLAGS,X
TESTO GTFLAGS,X
>
DEFINE TOP (X) <
TESTE FLAGS,X
TESTO OPFLAGS,X
>
HERE(OPENFILE)
SETZB FLAGS,.SKIP.
SETZB GTFLAGS,OPFLAGS
HRRZ B,-1(SP) ;COUNT OF OPTIONS WORD
WHIOPT: JUMPE B,OPTDUN
ILDB A,(SP) ;GET AN OPTION
CAIGE A,141
JRST .+3
CAIG A,172
SUBI A,40 ;CONVERT TO UPPER CASE
;ANY NON-ALPHABETIC CHARS GO HERE
EQ *,STARBIT
;NOW ALLOW ONLY ALPHABETIC CHARS
CAIL A,101 ;MUST BE
CAILE A,132
JRST OPTERR
SKIPN BITTBL-"A"(A) ;SOMETHING THERE?
JRST OPTERR ;NOPE, ERROR
TDO FLAGS,BITTBL-"A"(A) ;RIGHT SPOT IN TABLE
SOJGE B,WHIOPT
JRST OPTDUN
;HERE ON ERROR
OPTERR: ERR <OPENFILE: ILLEGAL OPTION >,1
TESTO FLAGS,ERSNBIT
OPCONT:
SOJGE B,WHIOPT
;NOW SET UP GTFLAGS ACCORDING TO THE SCANNED INFORMATION
OPTDUN:
TGT OLDBIT ;INSIST ON OLD?
TGT NEWBIT ;INSIST ON NEW?
JTRUE OLDBIT
JFALSE NEWBIT ;IF NEITHER
JRST OPTDU1 ;WELL, ONE
JTRUE WRBIT ;IF WRITING
JRST OPTDU1
JFALSE RDBIT ;AND READING
JTRUE APPBIT ;BUT NOT APPENDING
SGT OUTBIT ;THEN SET OUTPUT BIT
OPTDU1:
JFALSE RDBIT ;IF READING
JFALSE WRBIT ;AND NOT WRITING
JRST OPTDU2
JTRUE APPBIT ;AND NOT APPENDING
SGT OLDBIT ;THEN INSIST ON OLD
OPTDU2:
;NOW TEST FOR INDEPENDANT THINGS
TOP RDBIT
TOP WRBIT
TOP APPBIT
TGT TEMBIT
TGT STARBIT
TGT DELBIT
TOP THAWBIT
JFALSE CONFBIT
JRST [SGT CONFB1
SGT CONFB2
JRST .+1]
TLO GTFLAGS,1 ;SHORT CALL OF GTJFN
GTAGAIN:
HRRZ A,-3(SP) ;LENGTH OF NAME
JUMPE A,[TRYAGN:
TLO GTFLAGS,2
MOVE 2,[XWD 100,101]
JRST GT]
AND GTFLAGS,[717777777777]
PUSH SP,-3(SP)
PUSH SP,-3(SP)
PUSH P,[0]
PUSHJ P,CATCHR ;CONCATENATE A NULL CHAR
MOVE 2,(SP) ;BYTE-POINTER
SUB SP,X22 ;ADJUST STACK
GT: MOVE 1,GTFLAGS
JSYS GTJFN
JRST GTERR
MOVEM 1,JFN ;REMEMBER JFN
PUSHJ P,SETCHN ;SET A CHANNEL, ALLOCATE, GET CDB, SET DVTYP, RETURN CHANNEL
MOVEM 1,CHNL ;REMEMBER CHANNEL
MOVEM GTFLAGS,GFL(CDB)
COMMENT ⊗ Do the open.
⊗
MOVE 1,DVTYP(CDB) ;CHECK THE DEVICE TYPE
CAIE 1,7 ;IS IT THE LPT?
CAIN 1,12 ;IS IT A TTY?
JRST B7 ;YES, USE 7 BIT
B36: HRRZ 1,JFN ;JFN
HRRZ 2,OPFLAGS
HRLI 2,440000 ;36-BIT, MODE 0
JSYS OPENF
JRST B36DMP ;TRY 36-BIT, DUMP MODE
JRST OPNOK
B36DMP: HRRZ 1,JFN
HRRZ 2,OPFLAGS
HRLI 2,447400 ;36 BITS, DUMP MODE
JSYS OPENF
JRST B7
JRST OPNOK
B7: HRRZ 1,JFN
HRRZ 2,OPFLAGS
HRLI 2,70000 ;7 BIT
JSYS OPENF
JRST OPERR ;NOPE
OPNOK: MOVEM 2,OFL(CDB) ;SAVE
MOVE 1,CHNL ;RETURN CHANNEL NO
OPFRET: SUB SP,X44 ;ADJUST
POPJ P, ;AND RETURN
GTERR:
;HERE WITH ERROR ON GTJFN
JTRUE ERTNBIT ;USER WANT'S ERRORS?
JRST GTER1 ;NO
ERRRET: MOVEM 1,.SKIP. ;STORE FOR USER
SETO 1, ;SOMETHING SUSPICIOUS
JRST OPFRET ;AND RETURN
GTER1: PUSHJ P,SERSTR ;SHOW ERSTR
HRROI 1,[ASCIZ/
Cannot GTJFN file /]
JSYS PSOUT
PUSH SP,-3(SP)
PUSH SP,-3(SP)
PUSHJ P,OUTSTR
HRROI 1,[ASCIZ/, try again */]
JSYS PSOUT
JRST TRYAGN
OPERR: JTRUE ERTNBIT
JRST OPER1
PUSH P,1 ;SAVE ERROR BITS
PUSH P,CHNL
PUSHJ P,CFILE
POP P,1 ;RESTORE ERROR BITS
JRST ERRRET
OPER1: PUSHJ P,SERSTR ;SHOW ERSTR
HRROI 1,[ASCIZ/
Cannot OPENF file /]
JSYS PSOUT
PUSH SP,-3(SP)
PUSH SP,-3(SP)
PUSHJ P,OUTSTR
HRROI 1,[ASCIZ/, try again */]
JSYS PSOUT
PUSH P,CHNL ;CLOSE AND RELEASE FILE AND CDB BLOCK
PUSHJ P,CFILE
JRST TRYAGN
;HERE WITH THE TENEX ERROR CODE IN 1 -- 1 MAY BE CLOBBERED
SERSTR:
PUSH P,2 ;SAVE ACS
PUSH P,3
HRRZ 2,1
HRLI 2,400000 ;THIS FORK
HRROI 1,[ASCIZ/
/]
JSYS PSOUT
MOVEI 1,101 ;PRIMARY OUTPUT
SETZ 3, ;FLAGS
JSYS ERSTR
JFCL
JFCL
POP P,3
POP P,2
POPJ P,
BITTBL: APPBIT ;A
BINBIT ;B
CONFBIT ;C
DELBIT ;D
ERTNBIT ;E
0 ;F
0 ;G
THAWBIT ;H
0 ;I
0 ;J
0 ;K
0 ;L
0 ;M
NEWBIT ;N
OLDBIT ;O
0 ;P
0 ;Q
RDBIT ;R
0 ;S
TEMBIT ;T
0 ;U
0 ;V
WRBIT ;W
0 ;X
0 ;Y
0 ;Z
BEND OPENFILE
DSCR PROCEDURE SETINPUT(INTEGER CHAN; REFERENCE INTEGER COUNT,BR,EOF)
Sets up the variables associated with input (as in the DEC
open statement.)
⊗
HERE(SETINPUT)
PUSHJ P,SAVE
VALCHN 1,-4(P),SETERR
POP P,TEMP
POP P,ENDFL(CDB)
SKIPE ENDFL(CDB)
SETZM @ENDFL(CDB) ;ASSUME NOT EOF
POP P,BRCHAR(CDB)
SKIPE BRCHAR(CDB)
SETZM @BRCHAR(CDB) ;ASSUME NO BRCHAR
POP P,ICOUNT(CDB)
SETZ LPSA, ;NO PARAMETERS
SUB P,X11
JRST RESTR
SETERR: ERR <Illegal JFN>,1
MOVE LPSA,[XWD 5,5]
JRST RESTR
DSCR
SETPL(CHAN,@LINNUM,@PAGNUM,@SOSNUM)
Names the variables to be used by the INPUT
function for counting the line-feeds (12), formfeeds (14)
seen by INPUT, as well as keeping the current SOS line
number, if any. Useful when scanning a file, and
you want to know what page,line you are on.
Initializes all three variables to 0.
⊗
HERE(SETPL)
PUSHJ P,SAVE
VALCHN 1,-4(P),SETPER
POP P,TEMP ;RET ADR
POP P,SOSNUM(CDB)
SETZM @SOSNUM(CDB)
POP P,PAGNUM(CDB)
SETZM @PAGNUM(CDB)
POP P,LINNUM(CDB)
SETZM @LINNUM(CDB)
SUB P,X11 ;REMOVE CHANNEL NO.
SETRET: SETZ LPSA,
JRST RESTR
SETPER: ERR <Illegal JFN>,1
MOVE LPSA,[XWD 5,5]
JRST RESTR
DSCR
BOOLEAN PROCEDURE INDEXFILE(INTEGER JFN)
RETURNS TRUE AS LONG AS WE CAN GNJFN ANOTHER FILE
⊗
HERE(INDEXFILE)
PUSH P,-1(P)
PUSHJ P,CLOSF
PUSH P,-1(P)
PUSHJ P,GNJFN
JUMPE 1,INDRET ;RETURN FALSE IF NO OTHER FILES
PUSH P,2
PUSH P,CDB
PUSH P,CHNL
;CHANNEL ALREADY VALID
MOVE CHNL,-4(P) ;CHANNEL NUMBER
MOVE CDB,CDBTBL(CHNL) ;CDB LOC
HRRZ 1,JFNTBL(CHNL) ;JFN
MOVE 2,OFL(CDB) ;GET OPENFLAGS
JSYS OPENF ;TRY OPENING
JRST NOIND
SKIPE ENDFL(CDB) ;ZERO SETINPUT (or OPEN) VARIABLES IF HERE
SETZM @ENDFL(CDB)
SKIPE BRCHAR(CDB)
SETZM @BRCHAR(CDB)
SKIPE LINNUM(CDB) ;ZERO SETPL VARS
SETZM @LINNUM(CDB)
SKIPE PAGNUM(CDB)
SETZM @PAGNUM(CDB)
SKIPE SOSNUM(CDB)
SETZM @SOSNUM(CDB)
SETO 1,
INDPOP: POP P,CHNL
POP P,CDB
POP P,2
INDRET: SUB P,X22
JRST @2(P)
NOIND: ERR <INDEXFILE: CANNOT OPENF>,1
SETZ 1,
JRST INDPOP
DSCR SETCHAN(JFN,GTFLAGS,OPFLAGS)
JFN is a real TENEX jfn. It is inserted in the SAIL
runtime system, and the internal book-keeping is set to
believe that the GTJFN was done with GTFLAGS and the OPENF
with OPFLAGS. JFN may have come from some random source.
⊗
HERE(SETCHAN)
PUSHJ P,SAVE
MOVE LPSA,X44
MOVE A,-3(P) ;JFN
PUSHJ P,SETCHN
MOVEM A,RACS+A(USER) ;CHANNEL
HRROI A,-1(P) ;PREPARE FOR POPPING
POP A,OFL(CDB) ;MOVE FROM THE STACK
POP A,GFL(CDB)
JRST RESTR
ENDCOM(OPF)
COMPIL(GTJFN,<GTJFN,GTJFNL>,<.SKIP.,SETCHN,CATCHR,X11,X22,X44>,<GTJFN -- GET A JFN>)
DSCR INTEGER SIMPLE PROCEDURE GTJFN(STRING S; INTEGER FLAGS)
Does a GTJFN. If S is non-null, it is the filename, otherwise
the routine goes to the user's console for a file. FLAGS are used for
accumulator 1, and any error code is returned in .SKIP. The value
of the call is the JFN, if obtained.
Defaults for FLAGS: 0 means ordinary input, 1 means ordinary
output. Ordinarily the user will use the OPENFI routine.
⊗
HERE(GTJFN)
SKIPN 1,-1(P)
MOVSI 1,100001
CAIN 1,1
MOVSI 1,600001
TLO 1,1 ;MARK FOR SHORT CALL
HRRZ 2,-1(SP)
JUMPE 2,[MOVE 2,[100000101]
TLO 1,2 ;INDICATE XWD JFN,JFN IN 2
JRST GOTDEST]
TLZ 1,2 ;INDICATE BYTE-POINTER IN 2
PUSH P,[0]
PUSHJ P,CATCHR ;PUT ON A NULL
MOVE 2,(SP)
GOTDEST: SETZM .SKIP. ;ASSUME NO ERROR
PUSH P,1 ;SAVE FLAGS
JSYS GTJFN
JRST GTBAD ; SOMETHING IS WRONG
PUSHJ P,SETCHN ;SETUP A CHANNEL, AND ALLOCATE, GET STATUS, SET CDB
POP P,GFL(CDB) ;SAVE FLAGS
GTRET: SUB SP,X22
SUB P,X22
JRST @2(P)
GTBAD:
MOVEM 1,.SKIP. ; REMEMBER
POP P,1 ;ADJUST STACK
SETO 1, ; SOMETHING SUSPICIOUS TO RETURN TO USER
JRST GTRET
DSCR INTEGER PROCEDURE GTJFNL(STRING ORIG; INTEGER FLAGS, XWDJFN!JFN;
STRING DEV,DIR,NAM,EXT,PROT,ACCOUNT; INTEGER DESIRED!JFN)
Does the long form of GTJFN.
⊗
HERE(GTJFNL)
BEGIN GTJFNL
DEFINE STRPUT(X)<
PUSHJ P,.STPUT
MOVEM A,X
>
DEFINE FLG <-14(P)>
DEFINE IOJFN <-13(P)>
DEFINE DESJFN <-12(P)>
ADD P,[XWD 11,11] ;ROOM FOR LONG-FORM TABLE
TLNN P,400000 ;OVERFLOW?
ERR <GTJFNL: P-stack overflow>
MOVE A,DESJFN
MOVEM A,0(P) ;THE DESIRED JFN
STRPUT -1(P) ;ACCOUNT
STRPUT -2(P) ;PROTECTION
STRPUT -3(P) ;EXTENSION
STRPUT -4(P) ;NAME
STRPUT -5(P) ;DIRECTORY
STRPUT -6(P) ;DEVICE
MOVE A,IOJFN ;XWD INPUT JFN, OUTPUT JFN
MOVEM A,-7(P)
MOVE A,FLG
MOVEM A,-10(P)
STRPUT B ;MAIN STRING POINTER
MOVEI A,-10(P) ;ADDRESS OF BLOCK (ON STACK)
SETZM .SKIP. ;ASSUME NO ERROR
JSYS GTJFN ;LONG FORM
JRST GTLBAD ;NOPE
PUSHJ P,SETCHN ;SET UP CHANNEL TABLE, ALLOCATE, GET STATUS, SET CDB
MOVE B,-10(P) ;GTJFN FLAGS
MOVEM B,GFL(CDB) ;SAVE
GTLRET: SUB P,[XWD 11+4,11+4] ;ADJUST STACK FOR LONG-FORM TABLE, AND ARGUMENTS
JRST @4(P) ;AND RETURN
GTLBAD: MOVEM A,.SKIP. ;RETURN ERROR CODE TO USER
SETO A, ;SOMETHING SUSPICIOUS
JRST GTLRET ;AND RETURN
.STPUT: HRRZ A,-1(SP) ;GET THE COUNT
JUMPE A,[SUB SP,X22 ;ADJUST AND RETURN
POPJ P,]
PUSH P,[0]
PUSHJ P,CATCHR
POP SP,A
SUB SP,X11
POPJ P,
BEND GTJFNL
ENDCOM(GTJFN)
COMPIL(FILINF,<GNJFN,DELF,UNDELETE,DELNF,SIZEF,JFNS,JFNSL,OPENF,CFILE,CLOSF,RLJFN,GTSTS,STSTS,RNAMF>
,<JFNTBL,CDBTBL,X11,X22,X33,CORREL,.SKIP.,ZSETST,ZADJST,FINIO>
,<FILINF -- UTILITY FILE ROUTINES>)
DSCR INTEGER SIMPLE PROCEDURE GNJFN(INTEGER JFN)
Does the GNJFN jsys.
⊗
HERE(GNJFN)
PUSHJ P,SAVE
MOVE LPSA,X22
VALCHN 1,<-1(P)>,GNERR
MOVE 1,JFNTBL(CHNL) ;GET THE WHOLE JFN
JSYS GNJFN
JRST GNRLZ ;FAILURE TO INDEX, RELEASE JFN
MOVEM 1,.SKIP. ;SAVE BITS INDICATING CHANGE
SETOM RACS+A(USER) ;INDICATE SUCCESS
GNRET: JRST RESTR
GNERR: ERR <Illegal JFN>,1
SETZM RACS+A(USER)
JRST RESTR
GNRLZ: SETZM .SKIP. ;NOTHING THERE
SETZM RACS+A(USER) ;FAILURE TO INDEX
PUSH P,-1(P)
PUSHJ P,CFILE ;SO RELEASE FILE
JRST RESTR
DSCR PROCEDURE DELF(INTEGER CHAN)
Deletes file open on CHAN. Errors to .SKIP.
⊗
HERE(DELF)
PUSH P,1
VALCH1 1,-2(P),DELF1
TLO 1,400000 ;DONT RELEASE THE JFN
JSYS DELF
JRST DELF2
SETZM .SKIP. ;NO ERROR
DELFRE: POP P,1
SUB P,X22
JRST @2(P)
DELF1: SETO 1,
DELF2: MOVEM 1,.SKIP.
JRST DELFRE
DSCR INTEGER PROCEDURE DELNF(INTEGER CHAN,NUM)
⊗
HERE(DELNF)
PUSHJ P,SAVE
MOVE LPSA,X33
VALCH1 1,-2(P),DLNERR
MOVE 2,-1(P)
SETZM .SKIP.
JSYS DELNF
JRST DLNERR
MOVM 2,2 ;ABSOLUTE NUMBER OF
MOVEM 2,RACS+A(USER) ;FILES DELETED
JRST RESTR
DLNERR: MOVEM 1,.SKIP.;
SETZM RACS+A(USER) ;INDICATE NO FILES DELETED
JRST RESTR
DSCR PROCEDURE UNDELETE(INTEGER CHAN)
Undeletes file open on CHAN. Errors to .SKIP.
⊗
HERE(UNDELETE)
PUSHJ P,SAVE
MOVE LPSA,X22
VALCH1 1,-1(P),UNDEL1
HRLI 1,1 ;XWD 1,JFN
MOVSI 2,(1B3) ;DELETED BIT
SETZ 3, ;TURN IT OFF
JSYS CHFDB ;CHANGE THE FDB
JRST RESTR
UNDEL1: SETOM .SKIP.
JRST RESTR
DSCR INTEGER PROCEDURE SIZEF(INTEGER JFN)
Gets the size in pages of the file open on JFN, with error code to
.SKIP.
⊗
HERE(SIZEF)
PUSHJ P,SAVE
MOVE LPSA,X22
VALCHN 1,<-1(P)>,SIZERR
SETZM .SKIP.
JSYS SIZEF
JRST [MOVEM 1,.SKIP.
SETZM RACS+A(USER)
JRST SIZRET]
MOVEM 3,RACS+A(USER) ;ANSWER IN AC 3
SIZRET: JRST RESTR
SIZERR: ERR <Illegal JFN>
SETOM .SKIP.
JRST SIZRET
DSCR STRING SIMPLE PROCEDURE JFNS(INTEGER JFN,FLAGS)
Returns the name of the file associated with JFN.
FLAGS are for ac 3 as described in the jsys manual, with
0 the reasonable default.
⊗
HERE(JFNS)
VALCHN 2,<-2(P)>,JFNSER ;GET JFN IN AC2
PUSH P,[=400]
PUSHJ P,ZSETST ;GET BP IN AC 1
MOVE 3,-1(P)
JSYS JFNS
PUSH P,[=400]
PUSH P,1
PUSHJ P,ZADJST
JFNSRE: SUB P,X33
JRST @3(P)
JFNSER: ERR <Illegal JFN>,1
PUSH SP,[0] ;RETURN NULL STRING
PUSH SP,[0]
JRST JFNSRE
DSCR JFNSL is added to correct a design error in JFNS, which did
not allow full flexibility.
⊗
HERE(JFNSL)
BEGIN JFNSL
VALCHN 2,<-3(P)>,JFNSER ;VALIDATE, GETTING JFN IN 2
MOVE 1,-1(P) ;FLAGS FOR LH
CAMN 1,[-1] ;-1??
HLRZ 1,JFNTBL(CHNL) ;YES, GET THOSE USED BY GTJFN
HRL 2,1 ;NOW PUT FLAGS INTO LH(2)
PUSH P,[=400]
PUSHJ P,ZSETST ;GET BP IN AC 1
MOVE 3,-2(P) ;CONTROL FLAGS FOR FORMAT
JSYS JFNS
PUSH P,[=400]
PUSH P,1
PUSHJ P,ZADJST
JFNSRE: SUB P,[XWD 4,4]
JRST @4(P)
JFNSER: ERR <Illegal JFN>,1
PUSH SP,[0] ;RETURN NULL STRING
PUSH SP,[0]
JRST JFNSRE
BEND JFNSL
DSCR SIMPLE PROCEDURE OPENF(INTEGER JFN,FLAGS)
Does an OPENF.
PARAMETERS:
JFN the JFN
FLAGS for accumulator 2.
.SKIP. the error code (if pertinent)
Some defaults:
FLAGS ACTION
-----------------------
0 INPUT CHARACTERS
1 OUTPUT CHARACTERS
2 INPUT 36-BIT WORDS
3 OUTPUT 36-BIT WORDS
4 DUMP MODE INPUT (USE DUMPI FUNCTION)
5 DUMP MODE OUTPUT (USE DUMPO FUNCTION)
VALUES 6-10 ARE RESERVED FOR EXPANSION
Other values of FLAGS are interpreted literally.
Ordinarily the user will use the OPENFI routine.
⊗
HERE(OPENF)
PUSHJ P,SAVE
MOVE LPSA,X33
VALCHN 1,-2(P),OPNERR
SKIPL 2,-1(P) ;GET THE FLAGS
CAILE 2,5 ;CHECK IN RANGE 0-5
JRST GOTFLAGS
MOVE 2,OPNTBL(2) ;GET CORRECT WORD
GOTFLAGS:
SETZM .SKIP.
PUSH P,2 ;SAVE FLAGS
JSYS OPENF
JRST NOOPN
POP P,OFL(CDB) ;AND SAVE FLAGS
SETZM IOSTT(CDB) ;CLEAR STATUS
OPNRET: JRST RESTR
OPNERR: ERR <Illegal JFN>,1
SETOM .SKIP.
JRST OPNRET
NOOPN: MOVEM 1,.SKIP.
SUB P,X11 ;ADJUST STACK
JRST OPNRET
OPNTBL: 070000200000 ;7-BIT READ
070000100000 ;7-BIT WRITE
440000200000 ;36-BIT READ
440000100000 ;36-BIT WRITE
447400200000 ;36-BIT DUMP READ
447400100000 ;36-BIT DUMP WRITE
DSCR SIMPLE INTEGER PROCEDURE CFILE(INTEGER JFN)
Closes the file (CLOSF) and releases (RLFJN)
the jfn. This is the ordinary way the user will use
to dispense with a file.
Returns TRUE if JFN legal and released, FALSE o.w.
Always returns.
⊗
HERE(CFILE)
PUSH P,2
PUSH P,3
PUSH P,CHNL
PUSH P,CDB
SKIPL CHNL,-5(P)
CAIL CHNL,JFNSIZE
JRST CFBAD
MOVE CDB,CDBTBL(CHNL) ;GET CDB
SKIPN 1,JFNTBL(CHNL) ;JFN ASSIGNED?
JRST CFBA1 ;NO, JUST RELEASE CORE
HRRZ 1,1 ;JFN ONLY
PUSHJ P,FINIO ;WRITE OUT REMAINING STUFF, CHECK EOF, MAGTAPE
RLCOR: SKIPE B,CDBTBL(CHNL) ; ANY CORE TO RELEASE?
PUSHJ P,CORREL ; RELEASE THE BLOCK
TLZ 1,400000 ; BE SURE TO RELEASE
JSYS CLOSF ; CLOSE (AND RELEASE)
JFCL ; ERROR RETURN
HRRZ 1,JFNTBL(CHNL) ; GET JFN AGAIN
JSYS RLJFN ; RELEASE (FOR GOOD MEASURE IF FILE NOT OPEN)
JFCL ; ERROR RETURN
SETO 1, ; RETURN TRUE FOR GOOD RELEASE
SETZM CDBTBL(CHNL)
SETZM JFNTBL(CHNL)
CFRET: POP P,CDB
POP P,CHNL
POP P,3
POP P,2
SUB P,X22 ; ADJUST
JRST @2(P) ; RETURN
CFBAD: SETZ 1, ; RETURN FALSE
JRST CFRET ;
CFBA1: SKIPE B,CDB
PUSHJ P,CORREL ;RELEASE CORE BLOCK
SETZM CDBTBL(CHNL) ;REMOVE ALL TRACE
SETZM JFNTBL(CHNL)
SETZ 1, ; RETURN FALSE
JRST CFRET
DSCR SIMPLE PROCEDURE CLOSF(INTEGER JFN)
Does a CLOSF on the JFN. Ordinarily the user
will want to use the CFILE routine, which handles errors
internally. The CLOSF is accomplished in such a way that
the JFN is actually not released.
If the device is a magtape open for output, then
2 eof's are written, followed by a backspace. This writes
a standard end-of-file on the tape.
⊗
HERE(CLOSF)
PUSHJ P,SAVE
MOVE LPSA,X22
VALCHN 1,<-1(P)>,CLOERR
PUSHJ P,FINIO ;WRITE OUT BUFFERS, SET FDB, WRITE MAGT EOFS, CLEAR BUFFERS
DOCLO: SETZM .SKIP. ;ASSUME NO ERROR
TLO 1,400000 ; DO NOT RELEASE THE JFN
JSYS CLOSF
MOVEM 1,.SKIP. ;ERROR
CLORET: JRST RESTR
CLOERR:
SETOM .SKIP.
JRST CLORET
DSCR SIMPLE PROCEDURE RLJFN(INTEGER JFN)
Does the RLJFN jsys. Ordinarily the user will want
to use the CFILE routine, which handles errors internally.
⊗
HERE(RLJFN)
PUSHJ P,SAVE
MOVE LPSA,X22
SKIPL C,-1(P)
CAIL C,JFNSIZE
JRST RLJBAD
SKIPN 1,JFNTBL(C)
JRST RLJBAD
SETZM JFNTBL(C)
SKIPE B,CDBTBL(C)
PUSHJ P,CORREL
SETZM CDBTBL(C)
SETZM .SKIP. ;ASSUME NO ERROR
JSYS RLJFN
MOVEM 1,.SKIP. ;ERROR RETURN
RLJRET: JRST RESTR
RLJBAD: ERR <Illegal JFN>,1
SETOM .SKIP.
JRST RLJRET
DSCR INTEGER SIMPLE PROCEDURE GTSTS(INTEGER JFN);
Gets the file status.
WARNING: The results of this call are not necessarily appropriate
if the file is open in special character input mode. If you want to check
for end-of-file, examine the EOF variable instead.
⊗
HERE(GTSTS)
PUSHJ P,SAVE
MOVE LPSA,X22
VALCHN 1,<-1(P)>,GTSERR
JSYS GTSTS
MOVEM 2,RACS+A(USER)
GTSRET: JRST RESTR
GTSERR: ERR <Illegal JFN>,1
JRST GTSRET
DSCR BOOLEAN SIMPLE PROCEDURE STSTS(INTEGER JFN,STATUS);
Sets the status of JFN to STATUS using the STSTS jsys.
⊗
HERE(STSTS)
VALCH1 1,<-2(P)>,STSERR
MOVE 2,-1(P)
SETO 3, ;ASSUME SKIP
SETZM .SKIP.
JSYS STSTS
JRST [STERRT: SETZ 3, ;PROBLEM
MOVEM 1,.SKIP.
JRST .+1]
MOVE 1,3 ;RETURN
SUB P,X33
JRST @3(P)
STSERR: ERR <Illegal JFN>,1
JRST STERRT ;RETURN
DSCR BOOLEAN SIMPLE PROCEDURE RNAMF(INTEGER EXISTINGJFN,NEWJFN);
File open on EXISTINGJFN is renamed to file open
on NEWJFN.
⊗
HERE(RNAMF)
VALCH1 1,<-2(P)>,RNFERR
VALCH1 2,<-1(P)>,RNFERR
SETO 3, ;ASSUME OK
SETZM .SKIP.
JSYS RNAMF
JRST [RNERET: SETZ 3,
MOVEM 1,.SKIP.
JRST .+1]
RNFRET: MOVE 1,3 ;RETURN VALUE
SUB P,X33
JRST @3(P)
RNFERR: ERR <Illegal JFN>,1
JRST RNERET
ENDCOM(FILINF)
COMPIL(DEVINF,<CNDIR,ASND,RELD,GDSTS,SDSTS,STDEV,DEVST,GTFDB,CHFDB>
,<JFNTBL,CDBTBL,X11,X22,X33,CORREL,.SKIP.,ZSETST,ZADJST>
,<DEVINF -- DEVICE AND DIRECTORY ROUTINES>)
DSCR BOOLEAN SIMPLE PROCEDURE CNDIR(INTEGER DIR; STRING PASSWORD);
Using the CNDIR jsys, connects to TENEX directory DIR (for
AC1.) PASSWORD is the password, which will usually be null, as
in the EXEC CONNECT command.
⊗
HERE(CNDIR)
PUSH P,[0]
PUSHJ P,CATCHR ;PUT A NULL ON THE END OF THE PASSWORD
POP SP,2 ;GET BP IN 2
SUB SP,X11 ;CLEAN UP SP STACK
MOVE 1,-1(P) ;DIRECTORY NO
SETO 3, ;ASSUME SUCCESS
SETZM .SKIP.
JSYS CNDIR
JRST [SETZ 3,
MOVEM 1,.SKIP.
JRST .+1]
MOVE 1,3
SUB P,X22
JRST @2(P)
DSCR BOOLEAN PROCEDURE ASND(INTEGER DEVICE)
Assigns the device specified by DEVICE using the ASND jsys.
Returns TRUE if successful, else error code in .SKIP.
⊗
HERE(ASND)
MOVE 1,-1(P) ;GET DEVICE DESIGNATOR
JSYS ASND
JRST [MOVEM 1,.SKIP.
SETZ 1,
JRST .+2]
SETO 1,
SUB P,X22
JRST @2(P)
DSCR BOOLEAN PROCEDURE RELD(INTEGER DEVICE)
Releases DEVICE using the RELD jsys. If DEVICE is -1,
then releases all devices assigned to this job.
⊗
HERE(RELD)
MOVE 1,-1(P)
JSYS RELD
JRST [MOVEM 1,.SKIP.
SETZ 1,
JRST .+2]
SETO 1,
SUB P,X22
JRST @2(P)
DSCR INTEGER SIMPLE PROCEDURE GDSTS(INTEGER CHAN; REFERENCE INTEGER WORDCNT)
Returns the device status of device open on CHAN using the GDSTS
jsys. The LH of WORDCNT has the word count of the last transfer completed,
negative if the last transfer completed unsuccessful.
⊗
HERE(GDSTS)
VALCH1 1,<-2(P)>,GDSERR
SETZM .SKIP.
JSYS GDSTS
MOVEM 3,@-1(P) ;REFERENCE ARG
MOVE 1,2 ;RETURN VALUE
GDSRET: SUB P,X33
JRST @3(P)
GDSERR: ERR <Illegal JFN>,1
SETOM .SKIP.
SETZ 1,
JRST GDSRET
DSCR PROCEDURE SDSTS(INTEGER JFN,NEWSTATUS)
⊗
HERE(SDSTS)
VALCH1 1,<-2(P)>,SDSERR
SETZM .SKIP. ;INDICATE NO ERROR
MOVE 2,-1(P)
JSYS SDSTS
SDSRET: SUB P,X33
JRST @3(P)
SDSERR: ERR <Illegal JFN>,1
SETOM .SKIP.
JRST SDSRET
DSCR INTEGER PROCEDURE STDEV(STRING S)
S is a string pointer to a string of the form DTA1.
The device designator is returned.
⊗
HERE(STDEV)
PUSH P,[0]
PUSHJ P,CATCHR
POP SP,1
SUB SP,X11 ;CLEAN SP STACK
SETZM .SKIP.
JSYS STDEV
JRST [PUSHJ P,SAVE ;GET FRESH ACS
MOVEI 1,400000 ;THIS FORK
JSYS GETER ;GET ERROR NUMBER
HRRZM 2,.SKIP. ;SAVE IN .SKIP. FOR USER
SETZM RACS+1(USER) ;ZERO RETURN
SETZ LPSA, ;NOTHING TO REMOVE FROM STACK
JRST RESTR ;AND RETURN
]
MOVE 1,2
POPJ P,
DSCR STRING PROCEDURE DEVST(INTEGER DEVICE)
⊗
HERE(DEVST)
PUSH P,[=100]
PUSHJ P,ZSETST ;GET A BP FOR 100 CHARS
SETZM .SKIP.
MOVE 2,-1(P)
JSYS DEVST
MOVEM 2,.SKIP. ;INDICATE ERROR
PUSH P,[=100]
PUSH P,1 ;UPDATED BP
PUSHJ P,ZADJST
SUB P,X22
JRST @2(P)
DSCR SIMPLE PROCEDURE GTFDB(INTEGER JFN; REFERENCE INTEGER ARRAY BUF)
Entire FDB of JFN is read into BUF. No bounds checking,
so BUF should be at least '26 words.
⊗
HERE(GTFDB)
PUSHJ P,SAVE
MOVE LPSA,X33
VALCHN 1,<-2(P)>,FDBAD
MOVSI 2,25 ;ALL 25 WORDS
HRRZ 3,-1(P) ;ADDRESS OF ARRAY
JSYS GTFDB
JRST RESTR
FDBAD: ERR <Illegal JFN>,1
JRST RESTR
HERE(CHFDB)
DSCR
CHFDB(CHAN,DISPLACEMENT,MASK,CHANGED!BITS)
⊗
PUSHJ P,SAVE
MOVE LPSA,[XWD 5,5]
VALCHN 1,-4(P),FDBAD ;GET JFN TO 1
HRL 1,-3(P) ;DISPLACEMENT TO LEFT HALF OF ONE
MOVE 2,-2(P)
MOVE 3,-1(P)
JSYS CHFDB
JRST RESTR
ENDCOM(DEVINF)
DEFINE WORDROU < WORDIN,ARRYIN,WORDOUT,ARRYOUT,RWDPTR,SWDPTR >
DEFINE CHARROU < CHARIN,SINI,INPUT,LREALIN,LREALSCAN,REALIN,REALSCAN,INTIN,INTSCAN,CHAROUT,OUT,LINOUT,RCHPTR,SCHPTR >
DEFINE UTILROU < FINIO >
COMPIL(IOROU,<WORDROU,CHARROU,UTILROU>
,<JFNTBL,CDBTBL,X22,X33,X44,.SKIP.,SAVE,RESTR>
,<IOROU -- Input and output routines>)
DSCR INTEGER SIMPLE PROCEDURE WORDIN(INTEGER JFN);
Reads a word in from the file
⊗
HERE(WORDIN)
BEGIN WORDIN
PUSHJ P,SAVE
MOVE LPSA,X22
VALCHN 1,-1(P),WERR
SETZEOF ;INDICATE NO EOF
DOSIMIO:SIMIO 2,TABL,WERR ;SOSGE IOCNT(CDB)
JRST .ADWI
ILDB 2,IOBP(CDB)
STOAC2: MOVEM 2,RACS+A(USER)
JRST RESTR
DOBIN: JSYS BIN
JUMPN 2,STOAC2 ;CANNOT BE END OF FILE
CHKEOF: SETZM RACS+A(USER) ;RETURN 0 IN ANY EVENT
JSYS GTSTS
TESTE 2,1B8 ;EOF?
JRST INPEOF ;YES, INDICATE
JRST RESTR
TABL: JRST DOSETWI ;0 -- SET UP
JRST .CISWI ;1 -- XICHAR
JRST .COSWI ;2 -- XOCHAR
SOSGE IOCNT(CDB) ;3 -- XIWORD
JRST .WOSWI ;4 -- XOWORD
JRST WERR ;5 -- XCICHAR
JRST WERR ;6 -- XCOCHAR
JRST DOBIN ;7 -- XCWORD
REPEAT 4,<JRST WERR> ;10-13
DOSETWI:
PUSHJ P,SETWI
JRST DOSIMIO
.ADWI: PUSHJ P,ADWI
JRST .ADEOF ;END OF FILE
JRST DOSIMIO ;START OVER
.ADEOF: SETZM RACS+A(USER) ;RETURN 0 WORD
JRST INPEOF ;AND INDICATE EOF
WERR: ERR <Dryrot at WORDIN>,1
SETZM RACS+A(USER)
JRST INPEOF ;INDICATING EOF OR ERROR
.CISWI: PUSHJ P,CISWI
JRST DOSIMIO
.COSWI: PUSHJ P,COSWI
JRST DOSIMIO
.WOSWI: PUSHJ P,WOSWI
JRST DOSIMIO
BEND WORDIN
HERE(ARRYIN)
BEGIN ARRYIN
PUSHJ P,SAVE
MOVE LPSA,X44
VALCHN 1,-3(P),WERR
SETZEOF ;ASSUME OK
DOSIMIO:
SIMIO 2,TABL,WERR ;MOVE 6,-2(P)
SKIPGE 2,-1(P) ;EXTENT
ERR <ARRYIN: Negative word count>
WIN3: JUMPE 2,RESTR ;NOTHING LEFT TO TRANSFER
SKIPG E,IOCNT(CDB)
JRST WIN5
IBP IOBP(CDB) ;INCREMENT THE POINTER
HRL C,IOBP(CDB) ;SOURCE
MOVEI D,(6) ;FOR BLT
HRR C,6 ;"TO" ADDRESS
CAIG B,(E) ;ENOUGH HERE
JRST WIN4
ADDI D,-1(E) ;FINISH HERE
BLT C,(D)
SUBM E,IOCNT(CDB)
ADDM E,IOBP(CDB)
ADD 6,E ;FIX INPUT POINTER
SUB B,E ;FIX INPUT COUNT
WIN5: PUSHJ P,ADWI ;GET MORE
JRST ISEOF ;END OF FILE -- NO MORE THERE
JRST WIN3
WIN4: ADDI D,-1(B) ;
BLT C,(D) ;LAST BLT
SUB E,B ;FIX UP COUNT
SOJ B,
MOVEM E,IOCNT(CDB)
ADDM B,IOBP(CDB)
JRST RESTR
TABL: JRST DOSETWI ;0 -- SET UP
JRST .CISWI ;1 -- XICHAR
JRST .COSWI ;2 -- XOCHAR
MOVE 6,-2(P) ;3 -- XIWORD
JRST .WOSWI ;4 -- XOWORD
JRST WERR ;5 -- XCICHAR
JRST WERR ;6 -- XCOCHAR
JRST DOSIN ;7 -- XCWORD
JRST WERR ;10 -- XBYTE7
JRST WERR ;11 -- XDICHAR
JRST WERR ;12 -- XDOCHAR
JRST DODUMPI ;13 -- XDARR
ISEOF: MOVE TEMP,-1(P) ;NUMBER OF WORDS WANTED
SUBM TEMP,B ;INPUT IN RH
WIN2: HRROM B,.SKIP.
SKIPE ENDFL(CDB)
HRROM B,@ENDFL(CDB)
JRST RESTR
.CISWI: PUSHJ P,CISWI
JRST DOSIMIO
.COSWI: PUSHJ P,COSWI
JRST DOSIMIO
.WOSWI: PUSHJ P,WOSWI
JRST DOSIMIO
DOSETWI:
PUSHJ P,SETWI
JRST DOSIMIO
DOSIN:
MOVN 3,-1(P) ;WORD COUNT
MOVSI 2,444400
HRR 2,-2(P) ;ADDRESS OF BUFFER
JSYS SIN
JUMPE 3,RESTR ;DID WE GET IT ALL?
SINEOF: ADD 3,-1(P) ;CALCULATE NO OF WORDS READ
HRLI 3,-1 ;MAKE IT XWD -1,,COUNT
SKIPE ENDFL(CDB) ;EOF LOCATION?
MOVEM 3,@ENDFL(CDB) ;YES
MOVEM 3,.SKIP.
JRST RESTR ;AND RETURN
DODUMPI:
MOVN 3,-1(P)
MOVEI 2,3
HRL 3,3
HRR 3,-2(P) ;ADDRESS OF BUFFER
SUBI 3,1
SETZ 4, ;END OF DUMP MODE COMMAND LIST
JSYS DUMPI ;DO IT
JRST DMPERR
JRST RESTR ;ALL OK
DMPERR: CAIN 1,600220 ;EOF?
JRST DUMPEOF ;NO
ERR <ARRYIN: Dump mode error>,1
MOVEM 1,.SKIP.
JRST RESTR
DUMPEOF:
MOVE 1,DVTYP(CDB)
CAIE 1,2 ;MAGTAPE DEVICE?
JRST INPEOF ;NO JUST INDICATE EOF
HRRZ 1,JFNTBL(CHNL)
SETZ 2, ;MTOPR RESET
JSYS MTOPR
JRST INPEOF ;INDICATE EOF AND RETURN
WERR: ERR <ARRYIN: Illegal JFN, byte-size, or mode.>,1
JRST INPEOF
BEND ARRYIN
HERE(WORDOUT)
BEGIN WORDOUT
PUSHJ P,SAVE
MOVE LPSA,X33
VALCHN 1,-2(P),WERR
SETZEOF
DOSIMIO:SIMIO 2,TABL,WERR ;SOSGE IOCNT(CDB)
JRST .ADWO
MOVE 2,-1(P)
IDPB 2,IOBP(CDB)
JRST RESTR
TABL: JRST DOSETWO ;0 -- XNULL
JRST .CISWO ;1 -- XICHAR
JRST .COSWO ;2 -- XOCHAR
JRST .WISWO ;3 -- XIWORD
SOSGE IOCNT(CDB) ;4 -- XOWORD
JRST WERR ;5 -- XCICHAR
JRST WERR ;6 -- XCOCHAR
JRST DOBOUT ;7 -- XCWORD
REPEAT 4,<JRST WERR> ;10-13
.ADWO: PUSHJ P,ADWO
JRST DOSIMIO
DOSETWO:
PUSHJ P,SETWO
JRST DOSIMIO
.CISWO: PUSHJ P,CISWO
JRST DOSIMIO
.COSWO: PUSHJ P,COSWO
JRST DOSIMIO
.WISWO: PUSHJ P,WISWO
JRST DOSIMIO
WERR: ERR <WORDOUT: Illegal JFN, byte-size, mode, or combination>,1
JRST INPEOF ;AND INDICATE ERROR
DOBOUT: MOVE 2,-1(P)
JSYS BOUT
JRST RESTR
BEND WORDOUT
HERE(ARRYOUT)
BEGIN ARRYOUT
PUSHJ P,SAVE
MOVE LPSA,X44
VALCHN 1,-3(P),WERR
SKIPN 3,-1(P)
JRST RESTR ;NOTHING TO MOVE
JUMPGE 3,.+2
JRST WERR
SETZEOF
DOSIMIO:SIMIO 2,TABL ;MOVE 6-2(P)
SKIPGE B,-1(P)
ERR <ARRYOUT: Word count is negative>,1
WOUT2: SKIPG E,IOCNT(CDB)
JRST WOUT5
JUMPE B,RESTR ;NOTHING LEFT
IBP IOBP(CDB)
MOVE C,IOBP(CDB) ;TO ADDR
HRRZI D,(C) ;FOR BLT TERMINATION
HRLI C,(6)
CAIGE B,(E) ;ENOUGHT IN BUFFER
JRST WOUT3 ;YES
ADDI D,-1(E) ;FINAL ADDRESS
BLT C,(D)
ADDI 6,(E) ;UPDATE BP
SUBI B,(E)
SETZM IOCNT(CDB)
HRRM D,IOBP(CDB)
WOUT5: PUSHJ P,ADWO
JRST WOUT2
WOUT3: JUMPLE B,RESTR
SOJ B,
ADD D,B
BLT C,(D)
SUBI E,1(B)
MOVEM E,IOCNT(CDB)
ADDM B,IOBP(CDB)
JRST RESTR
TABL: JRST DOSETWO ;0 -- XNULL
JRST .CISWO ;1 -- XICHAR
JRST .COSWO ;2 -- XOCHAR
JRST .WISWO ;3 -- XIWORD
MOVE 6,-2(P) ;4 -- XOWORD
JRST WERR ;5 -- XCICHAR
JRST WERR ;6 -- XCOCHAR
JRST DOSOUT ;7 -- XBYTE36
JRST WERR ;10 -- XBYTE7
JRST WERR ;11 -- XDICHAR
JRST WERR ;12 -- XDOCHAR
JRST DODUMPO ;13 -- XDARR
DOSETWO:
PUSHJ P,SETWO
JRST DOSIMIO
.CISWO: PUSHJ P,CISWO
JRST DOSIMIO
.COSWO: PUSHJ P,COSWO
JRST DOSIMIO
.WISWO: PUSHJ P,WISWO
JRST DOSIMIO
DOSOUT:
MOVN 3,-1(P)
MOVSI 2,444400
HRR 2,-2(P)
JSYS SOUT
JRST RESTR
DODUMPO:
MOVN 3,-1(P)
MOVEI 2,3
HRL 3,3
HRR 3,-2(P)
SUBI 3,1
SETZ 4,
JSYS DUMPO
JRST DMPERR
SETOM DMPED(CDB)
JRST RESTR
WERR: ERR <ARRYOUT: Illegal JFN, byte-size, mode, or combination.>,1
JRST INPEOF
DMPERR: ERR <ARRYOUT: Dump mode error>,1
MOVEM 1,.SKIP. ;SAVE TENEX ERROR NUMBER
JRST RESTR
BEND ARRYOUT
HERE(RWDPTR)
BEGIN RWDPTR
PUSHJ P,SAVE
MOVE LPSA,X22
VALCHN 1,-1(P),WERR
SETZM .SKIP.
DOSIMIO:SIMIO 2,TABL,WERR ;PUSHJ P,GETWPT
STOAC2: MOVEM 2,RACS+A(USER)
JRST RESTR
TABL: JRST RNULL ;0 -- XNULL
PUSHJ P,GETWPT ;1 -- XICHAR
PUSHJ P,GETWPT ;2 -- XOCHAR
PUSHJ P,GETWPT ;3 -- XIWORD
PUSHJ P,GETWPT ;4 -- XOWORD
JRST WERR ;5 -- XCICHAR
JRST WERR ;6 -- XCOCHAR
JRST DORFPTR ;7 -- XCWORD
REPEAT 4,<JRST WERR> ;10-13
DORFPTR:
JSYS RFPTR
JRST .+2
JRST STOAC2
ERR <RWDPTR: Cannot do RFPTR.>,1
MOVEM 1,.SKIP.
JRST RNULL
WERR: ERR <RWDPTR: Illegal JFN, illegal mode or byte size.>,1
SETOM .SKIP.
RNULL:
PUSHJ P,SETWIO
JRST DOSIMIO ;AND LOOK AGAIN
BEND RWDPTR
HERE(SWDPTR)
BEGIN SWDPTR
PUSHJ P,SAVE
MOVE LPSA,X33
VALCHN 1,-2(P),WERR
SETZM .SKIP.
DOSIMIO:MOVE 2,-1(P) ;PICK UP NEW WORD IN 2
SIMIO 3,TABL,WERR
JRST RESTR
TABL: JRST RNULL ;0 -- XNULL
PUSHJ P,SETWPT ;1 -- XICHAR
PUSHJ P,SETWPT ;2 -- XOCHAR
PUSHJ P,SETWPT ;3 -- XIWORD
PUSHJ P,SETWPT ;4 -- XOWORD
JRST WERR ;5 -- XCICHAR
JRST WERR ;6 -- XCOCHAR
JRST DOSFPTR ;7 -- XCWORD
REPEAT 4,<JRST WERR> ;10-13
DOSFPTR:JSYS SFPTR
JRST SFERR
JRST RESTR
SFERR: ERR <SWDPTR: Cannot do SFPTR>,1
MOVEM 1,.SKIP.
JRST RESTR
WERR: ERR <SWDPTR: Illegal JFN, byte size, or mode.>,1
SETOM .SKIP.
JRST RESTR
RNULL: PUSHJ P,SETWIO
JRST DOSIMIO
BEND SWDPTR
DSCR
Some auxiliary routines, mostly for word i/o.
⊗
INPEOF:
;HERE IF WE HAVE HIT EOF ON INPUT AND WISH TO SIMPLY SAY SO AND RETURN
SETOEOF
JRST RESTR
;ROUTINES TO SET TO WORD OUTPUT
COSWO: PUSHJ P,CHCEOF ;CHECK FOR NEW CHARACTER EOF
CISWO:
WISWO:
PUSHJ P,GTWPT1
MOVEM 3,IOBP(CDB)
MOVEM 4,IOCNT(CDB)
MOVEI 3,XOWORD
MOVEM 3,IOSTT(CDB)
POPJ P,
;ROUTINES TO SET TO CHARACTER OUTPUT
WOSCO: PUSHJ P,CHWEOF ;CHECK FOR NEW WORD EOF
CISCO:
WISCO:
PUSHJ P,GTCPT1
MOVEM 3,IOBP(CDB)
MOVEM 4,IOCNT(CDB)
MOVEI 3,XOCHAR
MOVEM 3,IOSTT(CDB)
POPJ P,
;ROUTINES TO SET TO CHARACTER INPUT
WOSCI: PUSHJ P,CHWEOF ;CHECK FOR NEW WORD EOF
JRST .+2
COSCI: PUSHJ P,CHCEOF ;CHECK FOR NEW CHARACTER EOF
WISCI: PUSHJ P,GTCPT1
MOVEM 3,IOBP(CDB)
MOVEM 5,IOCNT(CDB)
MOVEI 3,XICHAR
MOVEM 3,IOSTT(CDB)
POPJ P,
;ROUTINES TO SET TO WORD INPUT
COSWI: PUSHJ P,CHCEOF ;CHECK FOR NEW CHARACTER EOF
JRST .+2
WOSWI: PUSHJ P,CHWEOF ;CHECK FOR NEW WORD EOF
CISWI: PUSHJ P,GTWPT1
MOVEM 3,IOBP(CDB)
MOVEM 5,IOCNT(CDB)
MOVEI 3,XIWORD
MOVEM 3,IOSTT(CDB)
POPJ P,
SETWND:
;1, CDB LOADED
;SETS THE FDB SO THAT THE BYTE SIZE IS 36 AND THE NUMBER OF BYTES IS AS IN 2
PUSH P,2 ;SAVE
PUSH P,3
MOVEM 2,FDBEOF(CDB)
HRLI 1,12 ;OFFSET FOR
MOVEM 2,3 ;NUMBER OF WORDS
SETO 2, ;BYTE MASK
JSYS CHFDB ;CHANGE THE EOF POINTER
MOVEI 2,=36
MOVEM 2,FDBSZ(CDB)
HRLI 1,11 ;OFFSET FOR BYTE SIZE
MOVSI 2,007700 ;MASK
MOVSI 3,004400 ;36 BIT BYTES
JSYS CHFDB
HRLI 1,0 ;RESTORE GOOD JFN IN 1
POP P,3 ;RESTORE
POP P,2
POPJ P, ;AND RETURN
GETWND:
;HERE WITH 1,CDB LOADED
;RETURN THE WORD THAT ADDRESSES EOF IN 2, ACCORDING TO THE SYSTEM
BEGIN GETWND
PUSH P,3
SKIPN 3,FDBSZ(CDB) ;IF BYTE SIZE IS ZERO
JRST RET0 ;THEN RETURN 0
CAIN 3,=36 ;ALREADY 36?
JRST RET1 ;RETURN WHAT WE ALREADY HAVE THERE
;THE BYTE SIZE OF A FILE CAN BE 0 TO =64. 0 IS ALREADY TAKEN CARE OF ABOVE
CAILE 3,=36
ERR <GETWND: File byte size is bigger than 36 bits>,1
MOVEI 2,=36
IDIVI 2,(3) ;NUMBER TO MULTIPLY BY -- CLOBBERS 3!!
MOVEM 2,3
MOVE 2,FDBEOF(CDB)
IDIVI 2,(3) ;NUMBER OF WORDS -- CLOBBERS 3!!
JUMPE 3,.+2 ;EXTRA WORDS?
AOJ 2, ;YES.
POPBACK:POP P,3
POPJ P,
RET0: SETZ 2,
JRST POPBACK
RET1: MOVE 2,FDBEOF(CDB)
JRST POPBACK
BEND GETWND
GETWPT:
;HERE WITH 1,CDB LOADED
;RETURNS IN 2 THE WORD THAT ADDRESSES EOB
BEGIN GETWPT
SKIPN 2,IOBP(CDB)
POPJ P, ;WORD ZERO
PUSH P,3
TLZ 2,007700
TLO 2,004400 ;MAKE 36 BIT
IBP 2
MOVE 3,IOADDR(CDB)
SUBI 3,(2)
MOVE 2,IOPAGE(CDB) ;CURRENT PAGE
LSH 2,9 ;NUMBER OF WORDS IN PREVIOUS PAGES
SUB 2,3 ;SUBTRACT SINCE 3 IS NEGATIVE
POP P,3 ;RESULT IN 2
POPJ P,
BEND GETWPT
GTWPT1:
;HERE WITH 1,CHNL,CDB LOADED
;RETURN IN 2 THE WORD THAT ADDRESSES EOB IN 2, ACCORDING TO THE CURRENT POINTER
;RETURN IN 3 THE UPDATED BYTE POINTER
;RETURN IN 4 THE COUNT REMAINING FOR OUTPUT
;RETURN IN 5 THE COUNT REMAINING FOR INPUT
BEGIN GTWPT1
SKIPN 3,IOBP(CDB)
JRST NULRET
TLZ 3,007700
TLO 3,004400 ;MAKE A 36-BIT BP
MOVEM 3,2 ;COPY INTO 2
IBP 2
MOVE 4,IOADDR(CDB) ;START OF BUFFER
SUBI 4,(2) ;NUMBER OF WORDS CURRENTLY COMMITTED TO
;IN THIS BUFFER
MOVE 2,IOPAGE(CDB) ;WHERE THE CURRENT IO IS
LSH 2,9
SUB 2,4 ;NUMBER OF WORDS TO ADDRESS EOF
ADDI 4,1000 ;NUMBER OF WORDS REMAINING IN THIS BUFFER
;FOR OUTPUT PURPOSES
MOVEM 2,5 ;SAVE CURRENT EOB POINTER
PUSHJ P,GETWND ;READ THE END OF FILE IN FDB
EXCH 5,2 ;EOB POINTER TO 2, EOF TO 5
SUB 5,2 ;SUBTRACT THE CURRENT EOB POINTER
CAML 5,4 ;IF LESS THAN OUTPUT COUNT THEN USE IT ELSE
MOVEM 4,5 ;USE OUTPUT COUNT
POPJ P,
NULRET: SETZB 2,3 ;EVERYTHING ZERO
SETZB 4,5
POPJ P,
BEND GTWPT1
CHWEOF:
;1,CDB LOADED
;SEES IF A CHANGE OF EOF IS NEEDED, AND DOES IT
SKIPN IOBP(CDB) ;ANYTHING THERE?
POPJ P, ;NO, DONT FIDDLE AROUND
PUSH P,2
PUSH P,3
PUSHJ P,GETWND ;GET WORD EOF
MOVEM 2,3 ;SAVE IN 6
PUSHJ P,GETWPT ;GET WORD EOB
CAML 2,3 ;IS EOB LESS THAN EOF?
PUSHJ P,SETWND ;BETTER RESET FDB -- ALSO IF TEST IS EQUAL
POP P,3
POP P,2
POPJ P,
SETWPT:
BEGIN SETWPT
;HERE WITH 1,CDB LOADED
;2 HAS THE WORD THAT WE WANT TO SET TO
MOVE 3,IOSTT(CDB)
CAIN 3,XOWORD ;DOING WORD OUTPUT?
PUSHJ P,CHWEOF ;YES CHECK
CAIN 3,XOCHAR ;DOING CHAR OUTPUT?
PUSHJ P,CHCEOF ;CHECK IT ALSO
CAMN 2,[-1] ;WANT EOF?
PUSHJ P,GETWND ;YES
PUSH P,2 ;SAVE ON STACK
LSH 2,-9
CAME 2,IOPAGE(CDB) ;SAME PAGE?
PUSHJ P,SETPAGE ;NO, SET THE PAGE
POP P,2
ANDI 2,777 ;PICK UP WORD IN PAGE
MOVE 3,IOADDR(CDB)
ADDI 3,(2)
HRLI 3,444400 ;MAKE A BYTE POINTER
MOVEM 3,IOBP(CDB)
MOVE 3,IOSTT(CDB) ;CHECK THE STATUS AT THE MOMENT
CAIE 3,XICHAR ;IF INPUTTING CHARS
CAIN 3,XIWORD ;OR WORDS
JRST ASSUMIN ;THEN ASSUME WE WILL CONTINUE TO INPUT
MOVEI 3,XOWORD ;WELL ASSUME OUTPUT
MOVEM 3,IOSTT(CDB)
FULBU1: MOVEI 3,1000 ;OTHERWISE ASSUME OUTPUT
SUBI 3,(2)
STOAC3: MOVEM 3,IOCNT(CDB)
POPJ P,
ASSUMIN:
MOVEI 3,XIWORD
MOVEM 3,IOSTT(CDB)
PUSH P,2 ;SAVE THE NUMBER OF WORDS
PUSHJ P,GETWND ;GET THE END OF THE FILE IN WORDS IN 2
IDIVI 2,1000 ;PAGES IN 2, WORDS IN 3
CAMGE 2,IOPAGE(CDB) ;IS REQUESTED PAGE BEYOND EOF?
JRST EMPBUF ;YES
CAME 2,IOPAGE(CDB) ;SOMEWHERE ON THIS PAGE?
JRST FULBUF ;NO
POP P,2
SUB 3,2
JRST STOAC3
FULBUF: POP P,2
JRST FULBU1
EMPBUF: POP P,2
SETZ 3, ;SAY EMPTY
JRST STOAC3
BEND SETWPT
SETPAGE:
;1,CDB,CHNL LOADED
;2 HAS THE NUMBER OF THE PAGE WE WANT MAPPED
PUSH P,1 ;SAVE JFN
PUSH P,2
PUSH P,3
MOVEM 2,IOPAGE(CDB) ;PAGE BEING INSERTED
PUSH P,1 ;SAVE JFN OVER SFPTR
LSH 2,9 ;MAKE INTO WORDS
JSYS SFPTR
ERR <SETPAGE: Cannot do SFPTR>,1
POP P,1
HRL 1,1
HRR 1,IOPAGE(CDB) ;XWD JFN,FILEPAGE
HRLZI 3,140000 ;BITS 2 AND 3 FOR READ, WRITE -- ASSUME THIS
MOVE 2,OFL(CDB) ;BUT BETTER CHECK:
TESTN 2,WRBIT ;IF WRITING OR
TESTE 2,APPBIT ;APPENDING
JRST .+2 ;THEN DONT DO
TESTO 3,1B9 ;THE COPY ON WRITE -- DO IT FOR READING THOUGH
MOVE 2,FKPAGE(CDB) ;BUFFER IN CORE
JSYS PMAP
POP P,3
POP P,2
POP P,1 ;RESTORE THE JFN
POPJ P,
SETWIO:
;1,CDB LOADED
;DECIDE WHETHER TO SETWI OR SETWO
;CLOBBERS 2,3
MOVEI 3,SETWI ;ASSUME WORD INPUT
MOVE 2,OFL(CDB)
TESTN 2,RDBIT ;DOING INPUT
MOVEI 3,SETWO ;NOPE ASSUME OUTPUT
JRST (3) ;AND POPJ BACK
ADWI:
;1,CDB LOADED
;CALL PUSHJ
;RETURN:
; +1 FOR EOF
; +2 FOR NORMAL
;ADVANCES WORD INPUT FROM DSK
BEGIN ADWI
PUSH P,2
PUSH P,3
MOVE 3,IOPAGE(CDB) ;CURRENT PAGE
AOJ 3, ;NEXT PAGE
LSH 3,9 ;WORDS IN THAT PAGE
PUSHJ P,GETWND ;END OF FILE POINTER
CAML 3,2 ;BEYOND
JRST ADEOF ;YES SAY SO
SUB 2,3
CAILE 2,1000 ;LESS THAN A FULL BUFFER?
MOVEI 2,1000 ;NO GIVE ENTIRE AMOUNT
MOVEM 2,IOCNT(CDB)
AOS 2,IOPAGE(CDB) ;INCREMEMT PAGE, GET IN 2
PUSHJ P,SETPAGE
MOVE 2,IOADDR(CDB)
HRLI 2,444400
MOVEM 2,IOBP(CDB)
ADRET: AOS -2(P)
ADEOF: POP P,3
POP P,2
POPJ P,
BEND ADWI
ADWO:
;1,CDB LOADED
;ADVANCES WORD OUTPUT FROM DSK
BEGIN ADWO
PUSH P,2
AOS 2,IOPAGE(CDB) ;NEXT PAGE OF THE FILE
PUSHJ P,SETPAGE
MOVEI 2,1000
MOVEM 2,IOCNT(CDB)
MOVE 2,IOADDR(CDB)
HRLI 2,444400
MOVEM 2,IOBP(CDB)
POP P,2
POPJ P,
BEND ADWO
DSCR CHAR←CHARIN(CHANNEL)
⊗
HERE(CHARIN)
BEGIN CHARIN
PUSHJ P,SAVE
MOVE LPSA,X22
LITCHN 1,-1(P),CHALIT
SETZEOF
DOSIMIO:
SIMIO E,TABL,CERR ;SOSGE IOCNT(CDB)
JRST .DOINP
ILDB 2,IOBP(CDB)
STOAC2: MOVEM 2,RACS+A(USER)
JRST RESTR
TABL: JRST DOSETCI ;0 -- XNULL
SOSGE IOCNT(CDB) ;1 -- XICHAR
JRST .COSCI ;2 -- XOCHAR
JRST .WISCI ;3 -- XIWORD
JRST .WOSCI ;4 -- XOWORD
SOSGE IOCNT(CDB) ;5 -- XCICHAR
REPEAT 2,<JRST CERR> ;6,7 -- XCOCHAR,XCOWORD
SOSGE IOCNT(CDB) ;10 -- XBYTE7
SOSGE IOCNT(CDB) ;11 -- XDICHAR
REPEAT 2,<JRST CERR> ;12,13 -- XDOCHAR,XDARR
.DOINP:
PUSHJ P,DOINP ;READ NEXT BUFFER
JRST DOSIMIO ;BUFFERED INPUT RETURN
JRST IND ;CHARACTER IN D--DID A BIN
JRST ADCIEOF ;EOF
ADCIEOF:SETZM RACS+A(USER) ;RETURN 0
JRST INPEOF ;AND SAY EOF
DOSETCI:
PUSHJ P,SETCI
JRST DOSIMIO
.COSCI: PUSHJ P,COSCI
JRST DOSIMIO
.WISCI: PUSHJ P,WISCI
JRST DOSIMIO
.WOSCI: PUSHJ P,WOSCI
JRST DOSIMIO
CERR: ERR <CHARIN: Illegal JFN, byte-size, or mode>,1
JRST INPEOF ;INDICATE EOF AND RETURN
CHALIT: SETZM .SKIP.
MOVE 1,-1(P) ;PICK UP JFN LITERALLY
JSYS BIN
JUMPN 2,STOAC2
SETZM RACS+A(USER)
JSYS GTSTS
TESTE 2,1B8
SETOM .SKIP.
JRST RESTR
IND: MOVEM D,2 ;PUT IN 2
JRST STOAC2 ;AND RETURN CHARACTER
BEND CHARIN
DSCR STRING SIMPLE PROCEDURE SINI(INTEGER JFN,MAXLENGTH,BRKCHAR);
Reads in a string of characters, terminated by BRKCHAR or
reaching maxlength, whichever happens first.
⊗
HERE(SINI)
BEGIN SINI
PUSHJ P,SAVE
MOVE LPSA,X44
VALCHN 1,-3(P),CERR
SETZEOF
DOSIMIO:SKIPG C,-2(P)
JRST NULRET
SIMIO 2,TABL,CERR ;EXCH 1,C
SKIPE SGLIGN(USER)
PUSHJ P,INSET
ADDM 1,REMCHR(USER)
SKIPLE REMCHR(USER)
PUSHJ P,STRNGC
MOVE E,TOPBYTE(USER) ;BYTE POINTER TO TOP OF STRING SPACE
PUSH SP,[0]
PUSH SP,E
EXCH 1,C ;1 HAS JFN, C HAS COUNT
MOVN C,C
IN1: SOSGE IOCNT(CDB)
JRST .DOINP
IN2: ILDB D,IOBP(CDB)
IND: JUMPE D,IN1 ;IF EMPTY KEEP LOOKING
CAMN D,-1(P) ;BREAK CHAR?
JRST DOBRK ;YES
IDPB D,E
IN3: AOJL C,IN1 ;SUBTRACT 1 AND JUMP IF GREATER
SETOM .SKIP. ;INDICATE TERMINATED FOR COUNT
DONE: ADDM C,REMCHR(USER) ;MAKE REMCHR HONEST
MOVEM E,TOPBYTE(USER)
ADD C,-2(P) ;GET ACTUAL NUMBER OF CHARACTERS
;TRANSFERRED
HRROM C,-1(SP) ;SAVE COUNT FOR USER
JRST RESTR
DOBRK: IDPB D,E ;SAVE THE BREAK CHARACTER (AS DOES THE SIN JSYS)
MOVEM D,.SKIP. ;SAVE BREAK CHARACTER IN .SKIP. AS DOC. SAYS
AOJ C, ;ADD 1 TO THE COUNT
JRST DONE ;AND FINISH UP
CERR: ERR <SINI: Illegal JFN, illegal mode or byte size>,1
NULRET: PUSH SP,[0] ;RETURN NULL STRING
PUSH SP,[0]
JRST RESTR
TABL: JRST DOSETCI ;0 -- XNULL
EXCH 1,C ;1 -- XICHAR
JRST .COSCI ;2 -- XOCHAR
JRST .WISCI ;3 -- XIWORD
JRST .WOSCI ;4 -- XOWORD
EXCH 1,C ;5 -- XCICHAR
JRST CERR ;6 -- XCOCHAR
JRST CERR ;7 -- XCWORD
EXCH 1,C ;10 -- XBYTE7
EXCH 1,C ;11 -- XDICHAR
REPEAT 2,<JRST CERR> ;12,13 -- XDOCHAR,XDARR
.DOINP: PUSHJ P,DOINP ;READ IN THE NEXT BUFFER
JRST IN1 ;GOT IT
JRST IND ;CHARACTER IN D
DOEOF: SETOEOF ;END OF FILE
JRST DONE
DOSETCI:
PUSHJ P,SETCI
JRST DOSIMIO
.COSCI: PUSHJ P,COSCI
JRST DOSIMIO
.WISCI: PUSHJ P,WISCI
JRST DOSIMIO
.WOSCI: PUSHJ P,WOSCI
JRST DOSIMIO
BEND SINI
COMMENT ⊗Input ⊗
DSCR "STRING"←INPUT(CHANNEL,BREAK TABLE NUMBER);
CAL SAIL
SID NO ACS SAVED BY INPUT!!!!!!
⊗
.IN.:
HERE (INPUT)
MOVE USER,GOGTAB ;GET TABLE POINTER
;;%##% FOR BENEFIT OF ERROR ROUTINE
MOVE TEMP,(P)
MOVEM TEMP,UUO1(USER)
;;%##%
MOVEM RF,RACS+RF(USER);SAVE F-REGISTER
SKIPE SGLIGN(USER)
PUSHJ P,INSET
VALCHN 1,-2(P),INPBAD ;MOSTLY EXTRA CODE REALLY
INPSIM:
SIMIO E,INPTBL,INPBAD ;MOVE X,-1(P) ; TABLE NUMBER
MOVEI TEMP,-1 ;ERROR IF BLOCK NOT THERE OR TABLE NOT INIT'ED
PUSHJ P,BKTCHK ;CHECK TABLE #
JRST [PUSH SP,[0] ;ERROR
PUSH SP,[0]
SUB P,X33
JRST @3(P)]
PUSH P,CDB ;SAVE POINTER TO CORGET BLOCK
PUSH P,CHNL ;SAVE RANGE 1 TO 18
MOVE CHNL,-4(P) ;CHANNEL NUMBER -- ALREADY CHECKED
MOVE CDB,CDBTBL(CHNL)
HRRZ CHNL,JFNTBL(CHNL);ALREADY CHECKED ABOVE
;;;; LDB E,[POINT 4,OFL(CDB),9] ;DATA MODE
SETZEOF
SKIPE BRCHAR(CDB) ;BRCHAR LOCATION
SETZM @BRCHAR(CDB) ;ASSUME NO BREAK CHAR
MOVEI A,=200 ;DEFAULT NO. OF CHARS
SKIPE ICOUNT(CDB) ;USER-SPECIFIED COUNT?
HRRZ A,@ICOUNT(CDB) ;MAX COUNT FOR INPUT STRING
ADDM A,REMCHR(USER)
SKIPLE REMCHR(USER) ;ENOUGH ROOM?
PUSHJ P,STRNGC ;NO, TRY TO GET SOME
POP P,TEMP
MOVE FF,BRKMSK(TEMP) ;BITS FOR THIS TABLE
POP P,LPSA ;LPSA POINTS AT CORGET BLOCK FOR BREAK TABLES
ADD TEMP,LPSA ;TEMP IS RELOCATED 1 TO 18
MOVEM TEMP,-1(P) ;SAVE RELOCATED 1 TO 18 ON STACK
MOVEI Z,1 ;FOR TESTING LINE NUMBERS
SKIPN LINTBL(TEMP) ;DON'T LET TEST SUCCEED IF
MOVEI Z,0 ;WE'RE TO LET LINE NUMBERS THRU
MOVN B,A ;NEGATE MAX CHAR COUNT
PUSH SP,[0] ;LEAVE ROOM FOR FIRST STR WORD
PUSH SP,TOPBYTE(USER) ;SECOND STRING WORD
MOVE Y,LPSA
ADD Y,[XWD D,BRKTBL] ;BRKTBL+RLC(LPSA)
JUMPE B,DONE1 ; BECAUSE THE AOJL WON'T
;;%DQ% JFR 8-17-76
TRNE FF,@BRKDUM(LPSA);TREAT NUL LIKE ORDINARY CITIZEN?
TROA C,1 ;YES
TRZ C,1 ;NO
;;%DQ% ↑
TRNE FF,@BRKCVT(LPSA) ;DOING UC COERCION?
TLOA C,400000 ;YES
TLZ C,400000 ;NO
.IN: SOSGE IOCNT(CDB) ;BUFFER EMPTY?
JRST .DOINP
IN1:
ILDB D,IOBP(CDB) ;GET NEXT CHARACTER
TDNE Z,@IOBP(CDB) ;LINE NUMBER (ALWAYS SKIPS IF NOT WORRIED)?
JRST INLINN ;YES, GO SEE WHAT TO DO
IN2:
INB:
;;%DQ% JFR 8-17-76
JUMPE D,[TRNN C,1 ;REALLY IGNORE 0'S ?
JRST .IN ;YES
JRST NOCV.I ];NO-- AND WE KNOW IT'S A 0, SO GET TO THE POINT
;;%DQ% ↑
CAILE D,14 ;FIRST CHECK
JRST INB1 ;IF IN RANGE AT ALL
CAIN D,12
JRST INB2
CAIE D,14 ;LF OR FF?
JRST INB1 ;NO
INB2: SKIPN LINNUM(CDB) ;COUNTING VIA SETPL FUNCTION??
JRST INB1 ;NO
TDNN FF,@Y ;SOMETHING SPECIAL FOR THIS CHARACTER?
JRST INCR ;NO NOTHING SPECIAL
HLLZ TEMP,@Y ;GET BITS FOR THIS CHAR
TDNN TEMP,FF ;IGNORE?
JRST INCR ;YES
MOVE TEMP,-1(P) ;BREAKTABLE (RELOCATED)
SKIPLE DSPTBL(TEMP) ;APPEND OR SKIP?
JRST INB1 ;YES
INCR: CAIN D,12 ;LINE-FEED?
AOS @LINNUM(CDB) ;INDICATE ANOTHER LINE
CAIE D,14 ;FORM-FEED?
JRST INB1 ;NO
SKIPE PAGNUM(CDB)
AOS @PAGNUM(CDB) ;COUNT PAGES ALSO
SKIPE LINNUM(CDB)
SETZM @LINNUM(CDB) ;SET LINNUM TO ZERO (NEW PAGE)
INB1: JUMPGE C,NOCV.I ;NOT COERCING?
CAIL D,"a" ;ONLY COERCE LOWER CASE
CAILE D,"z" ;
JRST .+2 ;SPECIAL RHT "FAST SKIP"
TRZ D,40 ;MAKE UPPER CASE
NOCV.I: TDNE FF,@Y ;MUST WE DO SOMETHING SPECIAL?
JRST INSPC ;YES, HANDLE
MOVEC: IDPB D,TOPBYTE(USER) ;LENGTHEN STRING
AOJL B,.IN ;GET SOME MORE
JRST DONE1
INSPC: HLLZ TEMP,@Y ;IGNORE OR BREAK?
TDNN TEMP,FF ; (CHOOSE ONE)
JRST .IN ;IGNORE
; BREAK -- STORE BREAK CHAR, FINISH OFF
DONE: SKIPE BRCHAR(CDB) ;USER BRCHAR VAR?
MOVEM D,@BRCHAR(CDB) ;STORE BREAK CHAR
MOVE TEMP,-1(P) ;RELOCATED 1 TO 18
SKIPN Y,DSPTBL(TEMP) ;WHAT TO DO WITH BREAK CHAR?
JRST DONE1 ;SKIP IT
JUMPL Y,APPEND ;ADD TO END OF INPUT STRING
RETAIN: PUSHJ P,BACKUP
JRST DONE1
APPEND: IDPB D,TOPBYTE(USER) ;PUT ON END
AOJA B,DONE1 ;ONE MORE TO COUNT
; DONE -- MARK STRING COUNT WORD
DONE1: ADDM B,REMCHR(USER) ;GIVE UP THOSE NOT USED
SKIPN ICOUNT(CDB) ;USER SUPPLIED COUNT?
JRST [ADDI B,=200 ;USER DEFAULT
JRST .+2]
ADD B,@ICOUNT(CDB) ;HOW MANY DID WE ACTUALLY GET?
;;#GI# DCS 2-5-72 REMOVE TOPSTR
HRROM B,-1(SP) ;MARK RESULT, NON-CONSTANT
;;#GI#
MOVE RF,RACS+RF(USER);GET F-REGISTER BACK
SUB P,X33 ;REMOVE INPUT PARAMETER, RETURN ADDRESS
JRST @3(P) ;RETURN
; CAN EITHER DELETE LINE NUMBER (Y GT 0) OR STOP,
; TELL THE USER (BRCHAR=-1), AND MARK LINE NUMBER
; NOT A LINE NUMBER FOR NEXT TIME
.DOINP: PUSHJ P,DOINP
JRST .IN ;NORMAL BUFFERED RETURN
JRST INB ;7-BIT, CHAR IN D
JRST DONE1 ;EOF OR ERROR
BEGIN INPTBL
↑INPTBL:JRST DOSETCI ;0 -- XNULL
MOVE X,-1(P) ;1 -- XICHAR
JRST .COSCI ;2 -- XOCHAR
JRST .WISCI ;3 -- XIWORD
JRST .WOSCI ;4 -- XOWORD
MOVE X,-1(P) ;5 -- XCICHAR
REPEAT 2,<JRST INPBAD> ;6,7
MOVE X,-1(P) ;10 -- XBYTE7
MOVE X,-1(P) ;11 -- XDICHAR
REPEAT 2,<JRST INPBAD> ;12,13
DOSETCI:
PUSHJ P,SETCI
JRST INPSIM
.COSCI: PUSHJ P,COSCI
JRST INPSIM
.WISCI: PUSHJ P,WISCI
JRST INPSIM
.WOSCI: PUSHJ P,WOSCI
JRST INPSIM
BEND INPTBL
COMMENT ⊗ BACKUP TO BACKUP JFN ⊗
;CALL TO HERE WITH A PUSHJ, WITH CDB,CHNL LOADED
↑BACKUP:
PUSH P,1
LDB 1,[POINT 6,OFL(CDB),5] ;BYTE-SIZE
CAIN 1,44
JRST BACKU1
SKIPE TTYINF(CDB) ;CONTROLLING TERMINAL?
JRST BACTTY ;YES
BACBKJ: HRRZ 1,CHNL ;THE JFN
JSYS BKJFN
ERR <BACKUP: Cannot do BKJFN jsys for RETAIN>,1
BACRET: POP P,1
POPJ P,
BACKU1: SOS IOBP(CDB)
IBP IOBP(CDB)
IBP IOBP(CDB)
IBP IOBP(CDB)
IBP IOBP(CDB)
AOS IOCNT(CDB)
JRST BACRET
BACTTY: HRRZ 1,TTYINF(CDB)
CAIN 1,TNXINP ;TENEX DEFAULT
JRST BACBKJ ;YES, USE BKJFN
CAIE 1,DECLED ;DEC STYLE?
CAIN 1,TENXED ;OR TENEX?
JRST BACKU1
ERR <BACKUP: Illegal editing mode for controlling terminal>,1
JRST BACKU1
;LINE NUMBER STUFF
INLINN:
NOPGNN:
SKIPE SOSNUM(CDB) ;WANT THE NUMBER?
JRST [MOVE TEMP,@IOBP(CDB) ;SAVE IT FOR THE USER
MOVEM TEMP,@SOSNUM(CDB)
JRST .+1]
MOVE TEMP,-1(P) ;RELOCATED TABLE
SKIPGE TEMP,LINTBL(TEMP) ;LINTBL+RLC+TABLE
JRST GIVLIN ; WANTS IT NEXT TIME OR SOMETHING
JSP TEMP,EATLIN ;TOSS IT OUT, AND
JRST .IN ; CONTINUE
EATLIN:
AOS IOBP(CDB) ;FORGET IT ENTIRELY
MOVNI A,5 ;INDICATE SKIPPING SIX
ADDB A,IOCNT(CDB) ;IN COUNT
JUMPGE A,(TEMP) ;OVERFLOW BUFFER??
PUSHJ P,DOINP
JRST OKLN ;36-BIT RETURN
ERR <INPUT: 7-BIT BYTES CANNOT HAVE LINE NUMBERS>
JRST DONE1 ;END-OF-FILE
OKLN:
IBP IOBP(CDB) ;GET OVER TAB FINALLY
SOS IOCNT(CDB) ;IS THIS RIGHT -- RLS 12/74
JRST (TEMP) ;AND CONTINUE
GIVLIN: TRNE TEMP,-1 ;WANT LINE NO IN BRCHAR WORD?
JRST GVLLN ;NO, WANTS IT NEXT TIME.
SKIPL TEMP,@IOBP(CDB) ;NEGATED LINE NO
MOVNS TEMP
SKIPE BRCHAR(CDB) ;USER LOCATION?
MOVEM TEMP,@BRCHAR(CDB) ;STORE WHERE HE WANTS IT
JSP TEMP,EATLIN ;GO EAT UP LINE NUMBER AND
JRST DONE1 ;FINISH UP
GVLLN:
SKIPE BRCHAR(CDB)
SETOM @BRCHAR(CDB) ;TELL THE USER
AOS IOCNT(CDB) ;REVERSE THE SOSLE
MOVE Y,OFL(CDB) ;NOW CHECK TO SEE IF WE CAN DO THIS WITHOUT DISASTER
TESTN Y,WRBIT ;WRITING?
TESTE Y,APPBIT ;OR APPENDING?
ERR <INPUT: Give line feature not implemented when reading and writing.
Continuation will cause the line number to be modified.>
MOVEI Y,1 ;TURN OFF LINE NUMBER
ANDCAM Y,@IOBP(CDB) ; BIT
MOVSI Y,070000 ;BACK UP BYTE POINTER
ADDM Y,IOBP(CDB)
JRST DONE1 ;FINISH OFF IN BAZE OF GORY
INPBAD: ERR <INPUT: Illegal JFN or bad input>
COMMENT ⊗Realin, Realscan ⊗
DSCR REAL←REALIN(CHANNEL NUMBER);
CAL SAIL
⊗
HERE (REALIN)
IFN ALWAYS,<BEGIN NUMIN>
PUSHJ P,SAVE
PUSHJ P,NUMIN ;SET UP TO GET CHARS FROM CHANNEL
PUSHJ P,RLNIN ;GOBBLE A REAL NUMBER
SNGL A,A
INRETA: MOVEM A,RACS+A(USER)
INRET: SKIPE BRCHAR(CDB) ;USER WANTS BREAK CHARACTER?
MOVEM Z,@BRCHAR(CDB) ;FIX UP BREAK CHARACTER
SOS IOBP(CDB) ;BACK UP TO GET IT NEXT TIME
FOR II←1,4 <
IBP IOBP(CDB)>
AOS IOCNT(CDB)
MOVE LPSA,X22 ;GET RID OF CHANNEL AND RET. WD
JRST RESTR
HERE (REALSCAN)
PUSHJ P,SAVE
PUSHJ P,STRIN ;SET UP TO GET CHARS FROM A STRING
PUSHJ P,RLNIN
SNGL A,A
STRRTA: MOVEM A,RACS+A(USER)
STRRET:
HRRZ X,-2(P)
SOJ CDB, ;BACK UP BYTE POINTER
FOR II←1,4<
IBP CDB>
MOVEM CDB,(X)
AOJ CHNL,
HRRM CHNL,-1(X)
MOVEM Z,@-1(P) ;STORE BREAK CHARACTER
MOVE LPSA,X33 ;GET RID OF BRK VAR, STR ADDR
JRST RESTR
FNDDIG: ;FIND DIGIT OR DECIMAL POINT, KEEP TRACK OF SIGN
EXCH A,(P) ;FIRST PUT "GET NEXT CHAR" INSTR ON STACK
PUSH P,A ;AHEAD OF RETURN WORD
FNDDI1: XCT -1(P) ;GET NEXT CHAR
CAIL D,"0"
CAILE D,"9"
CAIN D,"."
POPJ P,
JUMPL D,.-1 ;END OF FILE OR STRING
CAIN D,"-"
TLOA FF,NUMNEG
TLZ FF,NUMNEG ;SIGN MUST IMMEDIATELY PRECEDE NUMBER
JRST FNDDI1
RLNIN:
SETZ FF, ;ZERO FLAGS
PUSHJ P,FNDDIG
JUMPL D,.+2
TLO FF,NUMSAW
PUSHJ P,GETNUM ;TRY FOR AN INTEGER
CAIE D,"."
TRZA C,-1 ;NO DIGITS AFTER DEC PT.
PUSHJ P,GETN1D ;FINISH UP FRACTION
EXCH C,(P) ;DIGIT COUNTS ↔ NXTCHR INSTR
PUSH P,X ;PARTIAL RESULT
PUSH P,Y
PUSH P,FF ;FLAGS
PUSH P,C ;NXTCHR INSTR
SETZ FF, ;EXPONENT FLAGS
CAIE D,"@"
CAIN D,"E"
JRST [XCT (P) ;EAT A CHAR
CAIE D,"@"
CAIN D,"E"
RLNIN2: XCT (P) ;ALLOW FOR TWO OF THESE
CAIN D,"-"
TLOA FF,NUMNEG
CAIN D,"+"
XCT (P) ;PAST SIGN
PUSHJ P,GETNUM ;RECURSE FOR EXPONENT
PUSHJ P,TZMUL ;GET EXPONENT AS AN INTEGER
JUMPN C,RLNIN1
ERR <NUMIN: Improper exponent>,1 ;NO DIGITS APPEARED
JRST RLNIN1
]
CAIN D,"D"
JRST RLNIN2
SETZB X,Y ;EXPONENT IS ZERO
SETZ C, ;AND THERE WERE NO DIGITS IN IT
RLNIN1:
MOVE Z,D ;SAVE BRCHAR (COULD BE -1 FOR EOF)
SUB P,X11 ;GET RID OF NXTCHR INSTR
TLNN FF,NUMNEG
SKIPA D,Y ;LOW WD OF EXPONENT
MOVN D,Y ;EXPONENT WAS NEG
POP P,FF ;FLAGS OF FRACTION
;-2(P): FRACTION DIGIT COUNTS
;-1(P), -0(P): FRACTION
TLNN C,-1 ;IF ANY TRAILING ZEROES LEFT, A WHOPPING BIG EXP.
SKIPE X ;HIGH PART HAD BETTER BE ZERO
JRST [SUB P,X33 ;WIPE OUT FRACTION AND DIGIT COUNTS
JRST DFSERR] ;AND COMPLAIN
POP P,Y ;FRACTION PART
POP P,X
POP P,C ;DIGIT COUNTS OF FRACTON
JRST DFSC
HEREFK(LREALIN,LREA.IN)
PUSHJ P,SAVE
PUSHJ P,NUMIN
PUSHJ P,RLNIN
DMOVEM A,RACS+A(USER)
JRST INRET
HEREFK(LREALSCAN,LREA.SCAN)
PUSHJ P,SAVE
PUSHJ P,STRIN
PUSHJ P,RLNIN
DMOVEM A,RACS+A(USER)
JRST STRRET
DSCR INTEGER←INTIN(CHANNEL NUMBER);
CAL SAIL
⊗
HERE (INTIN)
PUSHJ P,SAVE
PUSHJ P,NUMIN
PUSHJ P,RLNIN
SNGL A,A
PUSHJ P,RFIX
JRST INRETA
RFIX: ;SIGN(A)*FLOOR(ABS(A)+0.5)
KI10< JUMPL A,.+3
FIXR A,A
POPJ P,
MOVN A,A
FIXR A,A
MOVN A,A
POPJ P,
>;KI10
NOKI10< JUMPL A,.+4
FADRI A,(0.5) ;SORRY, 166 !
FIX A,A
POPJ P,
MOVN A,A
FADRI A,(0.5)
FIX A,A
MOVN A,A
POPJ P,
>;NOKI10
DSCR INTEGER←INTSCAN("STRING");
CAL SAIL
⊗
HERE (INTSCAN)
PUSHJ P,SAVE
PUSHJ P,STRIN
PUSHJ P,RLNIN
SNGL A,A
PUSHJ P,RFIX
JRST STRRTA
;NUMIN -- CONTD.
NUMIN:
?NUMSIM:
VALCHN 1,-2(P),NUMBAD ;1,CDB, CHNL LOADED
SIMIO Z,NUMTBL,NUMBAD ;MOVE CHNL,1 ;JFN TO 1
SKIPE ENDFL(CDB)
SETZM @ENDFL(CDB)
SETZM .SKIP.
SKIPE BRCHAR(CDB)
SETZM @BRCHAR(CDB)
MOVE A,[JSP A,NCH]
MOVEI Z,1 ;FOR LINE NUMBER TEST
POPJ P,
; READ A CHARACTER FROM INPUT FILE -- FOR SCAN.
NCH: SOSGE IOCNT(CDB); DECREMENT CHARACTER COUNT
JRST NUMINP
NCH1: ILDB D,IOBP(CDB); LOAD BYTE
TDNE Z,@IOBP(CDB); CHECK FOR LINE NUMBER
JRST NCH5
NCH1.1: SKIPN LINNUM(CDB) ;WANT SETPL THINGS?
JRST (A) ;NO RETURN
CAIN D,12 ;LINE FEED?
AOS @LINNUM(CDB) ;YES
CAIE D,14 ;FORM FEED?
JRST (A) ;NOPE, NOTHING
SKIPE PAGNUM(CDB)
AOS @PAGNUM(CDB) ;INCREMENT PAGE COUNTER
SKIPE LINNUM(CDB)
SETZM @LINNUM(CDB) ;AND ZERO LINE COUNTER
JRST (A); RETURN
NCH7: SETO D, ;EOF OR DATA ERROR.
JRST (A)
NCH5: SKIPE SOSNUM(CDB) ;WANT SETPL STUFF?
JRST [MOVE D,@IOBP(CDB)
MOVEM D,@SOSNUM(CDB) ;INFORM USER ABOUT LINE NUMBER
JRST .+1]
AOS IOBP(CDB); WE HAVE A LINE NUMBER
MOVNI D,5; MOVE OVER IT
ADDB D,IOCNT(CDB)
SKIPL D ;NOTHING LEFT?
JRST NCH ;DO ANOTHER INPUT
PUSHJ P,DOINP ;
JRST NCH6 ;36-BIT RETURN -- MUST BE
PUSHJ P,NUMBAD ;IMPOSSIBLE
JRST NCH7 ;EOF OR SOME SUCH
NCH6: SOSGE IOCNT(CDB); REMOVE TAB
JRST NCH7 ;NONE THERE OR ERROR
IBP IOBP(CDB)
JRST NCH
;SETUP FOR STRING INPUT (REALSCAN, INTSCAN)
STRIN:
MOVE A,[JSP A,NCHA]
HRRZ CHNL,-3(P) ;ADDR OF WD2
MOVE CDB,(CHNL) ;BP
HRRZ CHNL,-1(CHNL) ;LENGTH
POPJ P,
;READ A CHARACTER ROUTINE FOR STRINGS.
NCHA: SOJL CHNL,NCH7
ILDB D,CDB
CAIN D,15
JRST NCHA ;IGNORE CR
JUMPE D,NCHA ;AND NUL
JRST (A)
;LNUMIN NUMBER INPUT
COMMENT ⊗
These routines form a character-string
to number conversion package. GETNUM eats characters one at a time
until a non-digit is eaten; GETNUM then returns intermediate information
which can be used by the other routines.
GETNU1 is the routine to call
after GETNUM when a decimal point is seen and you eventually want a floating
point number.
GETNUM: -1(P) instruction to XCT, gets next character in D
(P) return word
D first digit
result: as in GETNU1
GETNU1: X,Y double length partial integer result
-1(P) instruction to XCT, gets next character in D
(P) return word
C # trailing zeroes ,, power of 10 scale factor
D first digit
result: X,Y double length partial integer result
(P) instructin to XCT, gets next character in D
FF flags (sign, overflow)
C # trailing zeroes ,, scale factor + # digits since then
D break character
MAKINT: X,Y double length partial integer result
(P) return word
FF sign flag
C # trailing zeroes ,, junk
result: A integer value
DFSC:
X,Y double length partial integer result
(P) return word
FF flags
C # trailing zeroes ,, # digits since decimal point
D exponent
result: A,B floating point value
AC USAGE:
FF flags
A,B double temp return word for JSP NCH
C #tz ,, # digits
D char
X,Y double integer partial result
Z 1 (for testing line numbers)
CHNL channel number, or # chars left in string
CDB channel data block addr, or bp to string
RF res.
LPSA scale factor for DMUL gen.temp.
TEMP gen. temp.
USER res.
SP res.
P res.
⊗
;GETNUM GETNU1
NUMNEG←←400000
EXPNEG←←200000
NUMSAW←←100000
GETNUC: XCT -1(P) ;GET A CHAR FIRST
GETNUM:
SETZB X,Y ;INITIAL RESULT
SETZ C, ;DIGIT COUNTS
JRST 2,@.+1 ;CLEAR FLAGS
GETNU1
GETN1D: TRZA C,-1 ;NUMBER OF DIGITS SINCE DEC. PT IS ZERO
GETN1E: AOBJN C,.+1 ;A TRAILING ZERO
GETN1C: XCT -1(P) ;GET NEXT CHAR
GETNU1: CAIL D,"0"
CAILE D,"9"
POPJ P, ;NOT DIGIT
SUBI D,"0" ;CONVERT TO DIGIT NOW
JUMPE D,GETN1E ;A TRAILING ZERO
ADDI C,1 ;ANOTHER DIGIT
TLNE C,-1 ;WERE THERE TRAILING ZEROES BEFORE IT?
PUSHJ P,TZMUL ;YES
PUSHJ P,M10ADD ;MULT BY =10 AND ADD D
JRST GETN1C
TZMUL: HLRZ TEMP,C ;# TRAILING ZEROES
JUMPE TEMP,CPOPJ ;QUIT IF NONE
MOVEI C,(C) ;WILL BE NONE IF WE FINISH WITHOUT OVERFLOW
CAIN TEMP,(C)
JRST CPOPJ ;TRAILERS WERE ALSO LEADERS!
MOVEI LPSA,(D) ;SAVE DIGIT
SETZ D,
PUSHJ P,M10ADD ;ADJUST VALUE TO ACCOUNT FOR TRAILING ZEROES
SOJG TEMP,.-2
MOVEI D,(LPSA) ;RESTORE D
POPJ P,
M10ADD:
MOVE A,Y ;LOW HALF
MULI A,=10
TLO A+1,400000 ;PREVENT OVERFLOW
ADDI A+1,(D) ;ADD NEW DIGIT
TLZN A+1,400000 ;WOULD THERE HAVE BEEN AN OVERFLOW?
ADDI A,1 ;YES. (THIS CAN'T OVERFLOW; A WAS AT MOST 9)
MOVE D,X ;HIGH HALF
IMULI D,=10
JOV [ADD C,X11 ;PRETEND WE HAD A TRAILING ZERO
SOJA C,CPOPJ]
TLO D,400000 ;PREVENT OVERFLOW
ADDI D,(A) ;CARRY IN FROM LOW HALF
TLZN D,400000 ;WOULD THERE HAVE BEEN AN OVERFLOW?
JRST @.-4 ;YES
MOVEM A+1,Y ;STORE LOW HALF
MOVEM D,X ;AND HIGH HALF
CPOPJ: POPJ P,
;DFSC
; FF NUMNEG FLAG
; C # TRAILING ZEROES,, # DIGITS SINCE DECIMAL PT.
; D EXPONENT
; X,Y FRACTION
DFSC:
MOVE A,X ;BEGIN CONVERTING TO PURE FRACTION
JFFO A,DFSC1
MOVE A,X+1 ;HIGH WD WAS ZERO
JFFO A,.+1
ADDI A+1,=35
DFSC1: MOVEI LPSA,-1(A+1) ;# OF PLACES TO SHIFT (REMEMBER SIGN BIT)
ASHC X,(LPSA) ;MAKE INTO PURE FRACTION
SUBI LPSA,=70
MOVN LPSA,LPSA ;EXPONENT OF 2 OF FRACTION
;***** SOMETHING FISHY HERE. CONSIDER 12345.98@3
SUBI D,(C) ;DIGITS SINCE DECIMAL POINT DECREASE THE EXPONENT
HLRZ C,C
ADDI D,(C) ;BUT TRAILING ZEROES DONT COUNT
JUMPE D,DFSC2 ;EXPONENT OF 10 IS ZERO
JUMPG D,DFSC3
TLO FF,EXPNEG ;EXPONENT WAS NEG
MOVN D,D
SKIPA TEMP,[EXP.M1,,FR.M1] ;USE THIS TABLE SINCE EXP WAS NEG
DFSC3: MOVE TEMP,[EXP.P1,,FR.P1] ;EXP WAS POS
TRNE D,777700 ;CHECK EXPONENT RANGE
JRST DFSERR
TRNE D,40 ;E+-32 INVOLVED?
TLNE FF,EXPNEG ;YES. TOO BAD IF E-48
JRST MULOOP ;OK
TRNE D,20 ;E-48 ?
JRST DFSERR
MULOOP: TRZE D,1 ;SHOULD WE MULTIPLY?
PUSHJ P,DMUL.. ;YES
JUMPE D,DFSC2
ASH D,-1 ;NEXT BIT INTO POSITION
AOBJN TEMP,.+1 ;ADD 1 TO LH
AOJA TEMP,MULOOP ;AND 2 TO RH
DFSC2:
KI10< DMOVE A,X >;KI10
NOKI10< MOVE A,X
MOVE A+1,X+1 >;NOKI10
ASHC A,-8 ;MAKE ROOM FOR EXPONENT
FSC A,200(LPSA) ;INSERT IT
JFOV DFSERR
DFSC4:
JUMPGE Z,.+3 ;IF RAN OUT OF CHARS
TLNE FF,NUMSAW ; AND SAW NUMBER
MOVEI Z,0 ; THEN FLAG IT THIS WAY
KI10< TLNE FF,NUMNEG
DMOVN A,A
POPJ P,
>;KI10
NOKI10< TLNN FF,NUMNEG
POPJ P,
SETCA A, ;ONES COMPLEMENT OF HIGH WORD
MOVN A+1,A+1 ;TWOS COMPLEMENT OF LOW WORD
TLZ A+1,400000 ;FORCE SIGN BIT OFF
JUMPN A+1,CPOPJ ;IF LOW SIGNIFICANCE, DONE
AOJA A,CPOPJ ;OTHERWISE TWOS COMPLEMENT OF HIGH WORD
>;NOKI10
DFSERR: ERR <NUMIN: Exponent range exceeded>,1
SETOB A,A+1
TLNN FF,EXPNEG
TLZA A,400000 ;EXPONENT WAS POS, GIVE AN INFINITY
SETZB A,A+1 ;EXPONENT WAS NEG, GIVE ZERO
JRST DFSC4 ;OF RIGHT SIGN
;DMUL..
;MULTIPLY TWO DOUBLE-LENGTH PURE FRACTIONS. ONE IS (TEMP), OTHER IS X,Y PAIR
;RETURN DOUBLE-LENGTH RESULT IN X,Y
;SCALE FACTOR KEPT IN LPSA
DMUL..:
NOKL10< PUSH P,X ;SAVE HIGH
SETZM X ;1ST WORD, FINAL PRODUCT
MOVE A,(TEMP) ;HIGH
MULM A,Y ;* LOW
;IGNORING 3RD WORDS: 8 EXPONENT BITS TO BURN
MOVE A,1(TEMP) ;LOW
MUL A,(P) ;* HIGH
TLO A,400000 ;PREVENT OVERFLOWS
ADD A,Y ;ADD 2ND WORDS
TLZN A,400000 ;WOULD THERE HAVE BEEN AN OVERFLOW?
AOS X ;YES, DO CARRY (SETS X TO 1)
MOVEM A,Y ;STORE LOW RESULT
POP P,A ;HIGH
MUL A,(TEMP) ;* HIGH
TLO A+1,400000 ;PREVENT OVERFLOW
ADD A+1,Y ;COLLECT 2ND WORD
TLZN A+1,400000 ;WOULD THERE HAVE BEEN AN OVERFLOW?
ADDI A,1 ;YES
ADD A,X ;COLLECT 1ST WORD (THIS CAN'T OVERFLOW)
>;NOKL10
KL10<
DMOVE A,X
DMOVEM A+2,X
DMUL A,(TEMP)
DMOVE A+2,X
>;KL10
TLNE A,(1B1) ;NORMALIZED FRACTION?
JRST .+3 ;YES
ASHC A,1 ;NO, SHIFT OVER
SUBI LPSA,1 ;AND ADJUST EXPONENT
MOVS TEMP,TEMP ;COLLECT EXPONENT CHANGES
ADD LPSA,(TEMP)
MOVS TEMP,TEMP
MOVEM A,X ;STORE RESULT SO FAR
MOVEM A+1,Y
POPJ P,
FR.P1: 240000,,0 ;10↑1 PURE FRACTION PART
0
310000,,0 ;10↑2
0
234200,,0 ;10↑4
0
276570,,200000 ;10↑8
0
216067,,446770 ;10↑16
040000,,0
235613,,266501 ;10↑32
133413,,263574
EXP.P1: 4 ;POWER OF 2 EXPONENT PART
7
16
33
66
153
FR.M1: 314631,,463146 ;10↑-1
146314,,631463
243656,,050753 ;10↑-2
205075,,314217
321556,,135307 ;10↑-4
020626,,245364
253630,,734214 ;10↑-8
043034,,737425
346453,,122766 ;10↑-16
042336,,053314
317542,,172552 ;10↑-32
051631,,227215
EXP.M1: -3
-6
-15
-32
-65
-152
NUMBAD: ERR<NUMIN: Illegal JFN, byte-size or mode>
POPJ P,
BEGIN NUMTBL
↑NUMTBL:JRST DOSETCI ;0 -- XNULL
MOVE CHNL,1 ;1 -- XICHAR
JRST .COSCI ;2 -- XOCHAR
JRST .WISCI ;3 -- XIWORD
JRST .WOSCI ;4 -- XOWORD
MOVE CHNL,1 ;5 -- XCICHAR
REPEAT 2,<JRST NUMBAD> ;6,7
MOVE CHNL,1 ;10 -- XBYTE7
MOVE CHNL,1 ;11 -- XDICHAR
REPEAT 2,<JRST NUMBAD> ;12,13
DOSETCI:
PUSHJ P,SETCI
JRST NUMSIM
.COSCI: PUSHJ P,COSCI
JRST NUMSIM
.WISCI: PUSHJ P,WISCI
JRST NUMSIM
.WOSCI: PUSHJ P,WOSCI
JRST NUMSIM
BEND NUMTBL
NUMINP: PUSHJ P,DOINP
JRST NCH ;BUFFERED INPUT
JRST NCH1.1 ;7-BIT
JRST NCH7 ;EOF OR ERROR
RZ: SETZ A,
JRST DONE
ENDCOM(NUM)
COMPIL(TBB,<.CH.,.TEN.,.MT.>,,<TABLES FOR L PAUL'S ROUTINES>)
DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
⊗
↑↑.CH.: 4
7
16
33
66
153
777777777775
777777777772
777777777763
777777777746
777777777713
777777777626
↑↑.MT.: 240000000000
310000000000
234200000000
276570200000
216067446770
235613266501
314631463147
243656050754
321556135310
253630734215
346453122767
317542172553
↑↑.TEN.: 1
=10
=100
=1000
=10000
=100000
=1000000
=10000000
=100000000
=1000000000
=10000000000
ENDCOM(TBB)
IFN ALWAYS,<
BEND
>;IFN ALWAYS
DSCR SIMPLE PROCEDURE CHAROUT(INTEGER JFN, CHAR)
⊗
HERE(CHAROUT)
BEGIN CHAROUT
PUSHJ P,SAVE
MOVE LPSA,X33
LITCHN 1,-2(P),CHOLIT
DOSIMIO:SIMIO 3,TABL,CERR ;SOSGE IOCNT(CDB)
PUSHJ P,ADCO1
MOVE 2,-1(P)
IDPB 2,IOBP(CDB)
JRST RESTR
TABL: JRST DOSETCO ;0 -- XNULL
JRST .CISCO ;1 -- XICHAR
SOSGE IOCNT(CDB) ;2 -- XOCHAR
JRST .WISCO ;3 -- XIWORD
JRST .WOSCO ;4 -- XOWORD
JRST CERR ;5 -- XCICHAR
SOSGE IOCNT(CDB) ;6 -- XCOCHAR
JRST CERR ;7 -- XCWORD
JRST DOBOUT ;10 -- XBYTE7
JRST CERR ;11 -- XDICHAR
SOSGE IOCNT(CDB) ;12 -- XDOCHAR
JRST CERR ;13 -- XDARR
DOSETCO:
PUSHJ P,SETCO
JRST DOSIMIO
.CISCO: PUSHJ P,CISCO
JRST DOSIMIO
.WISCO: PUSHJ P,WISCO
JRST DOSIMIO
.WOSCO: PUSHJ P,WOSCO
JRST DOSIMIO
CERR: ERR <CHAROUT: Illegal JFN, byte-size, or mode.>,1
JRST RESTR
CHOLIT:
DOBOUT: MOVE 2,-1(P)
JSYS BOUT
JRST RESTR
BEND CHAROUT
DSCR SIMPLE PROCEDURE OUT(INTEGER JFN; STRING S)
⊗
HERE(OUT)
BEGIN OUT
PUSHJ P,SAVE
MOVE LPSA,X22
LITCHN 1,-1(P),CHKTTY
DOSIMIO:SIMIO 2,TABL,CERR ;HRRZ 3,-1(SP)
JUMPE 3,SOURET ;DONT SEND EMPTY STRING
LOOP: SOSGE IOCNT(CDB) ;DECREMENT BUFFER COUNT
PUSHJ P,ADCO1 ;GET NEW BUFFER
ILDB 2,(SP) ;NEXT CHAR ON STRING
IDPB 2,IOBP(CDB) ;AND COPY THE CHARACTER
SOJG 3,LOOP ;STRING CHAR COUNT
SOURET: SUB SP,X22 ;ADJUST STRING STACK
JRST RESTR
DOSOUT:
SKIPE CTLOSW ;IF CONTROL-O AND
SKIPN TTYINF(CDB) ;THE CONTROLLING TERMINAL
JRST .+2
JRST SOURET ;THEN DONT DO OUTPUT
REPEAT 0,<;BUGS IN SOUT JSYS -- ARE THEY STILL THERE??
DOSOU1: HRRZ 3,-1(SP)
JUMPE 3,SOURET
SOUT1: ILDB 2,(SP) ;NEXT CHAR
JSYS BOUT
SOJG 3,SOUT1 ;STRING CHAR COUNT
JRST SOURET
>;REPEAT 0
DOSOU1:
HRRZ 3,-1(SP) ;COUNT
JUMPE 3,SOURET ;DONT SEND NULL STRING
MOVE 2,(SP) ;STRING BP
MOVN 3,3 ;NEGATIVE COUNT
JSYS SOUT ;STRING OUTPUT
JRST SOURET ;AND RETURN
CERR: ERR <OUT: Illegal JFN, byte-size, or mode>,1
JRST SOURET
TABL: JRST DOSETCO ;0 -- XNULL
JRST .CISCO ;1 -- XICHAR
HRRZ 3,-1(SP) ;2 -- XOCHAR
JRST .WISCO ;3 -- XIWORD
JRST .WOSCO ;4 -- XOWORD
JRST CERR ;5 -- XCICHAR
HRRZ 3,-1(SP) ;6 -- XCOCHAR
JRST CERR ;7 -- XCWORD
JRST DOSOUT ;10 -- XBYTE7
JRST CERR ;11 -- XDICHAR
HRRZ 3,-1(SP) ;12 -- XDOCHAR
JRST CERR ;13 -- XDARR
DOSETCO:
PUSHJ P,SETCO
JRST DOSIMIO
.CISCO: PUSHJ P,CISCO
JRST DOSIMIO
.WISCO: PUSHJ P,WISCO
JRST DOSIMIO
.WOSCO: PUSHJ P,WOSCO
JRST DOSIMIO
CHKTTY:
SKIPN CTLOSW ;CONTROL-O SWITCH ON?
JRST DOSOU1 ;NO
CAIE 1,100 ;CONTROLLING TERMINAL?
CAIN 1,101
JRST SOURET ;YES, RETURN
JRST DOSOU1 ;NO, JUST DO IT
BEND OUT
DSCR PROCEDURE LINOUT(INTEGER JFN,VALUE)
⊗
HERE(LINOUT)
BEGIN LINOUT
PUSHJ P,SAVE
VALCHN A,-2(P),LINBAD
DOSIMIO:SIMIO B,TABL,LINBAD ;SKIPG B,IOCNT(CDB)
PUSHJ P,ADCO ;NO, SEND (OR PERHAPS JUST INITIALIZE)
MOVE TEMP,IOBP(CDB) ;GET BP
LINOPL: TLNN TEMP,760000 ;LINED BP?
JRST OKLIGN
IBP TEMP
SOJA B,LINOPL
OKLIGN: MOVEM TEMP,IOBP(CDB)
MOVEM B,IOCNT(CDB)
CAIGE B,=10 ;ENOUGH FOR 10 CHARS?
PUSHJ P,ADCO ;NO
SKIPGE B,-1(P) ;GET LINE-NO
JRST [MOVNS B
MOVNI A,5
JRST NOCONV]
MOVNI A,6
MOVE C,[<ASCII /00000/>/2]
EXCH B,C
PUSH P,LNBAK
LNCONV: IDIVI C,=10
IORI D,"0"
DPB D,[POINT 7,(P),6]
SKIPE C
PUSHJ P,LNCONV ;THE RECURSIVE PRINTER
HLL C,(P)
LSHC B,7
LNBAK: POPJ P,.+1
LSH B,1
TRO B,1
NOCONV: AOS C,IOBP(CDB) ;MOVE A WORD OUT
MOVEM B,(C)
ADDM A,IOCNT(CDB)
MOVEI B,11
CAME A,[-5]
IDPB B,IOBP(CDB) ;OUTPUT A TAB
NOTAB: MOVE LPSA,X33
JRST RESTR
LINBAD: ERR <LINOUT: Illegal JFN, byte-size, or mode>,1
JRST NOTAB
TABL: JRST DOSETCO ;0 -- XNULL
JRST .CISCO ;1 -- XICHAR
SKIPG B,IOCNT(CDB) ;2 -- XOCHAR
JRST .WISCO ;3 -- XIWORD
JRST .WOSCO ;4 -- XOWORD
JRST LINBAD ;5 -- XCIWORD
SKIPG B,IOCNT(CDB) ;6 -- XCOWORD
JRST LINBAD ;7 -- XCWORD
JRST LINBAD ;10 -- XBYTE7
JRST LINBAD ;11 -- XDICHAR
SKIPG B,IOCNT(CDB) ;12 -- XDOCHAR
JRST LINBAD ;13 -- XDARR
DOSETCO:
PUSHJ P,SETCO
JRST DOSIMIO
.CISCO: PUSHJ P,CISCO
JRST DOSIMIO
.WISCO: PUSHJ P,WISCO
JRST DOSIMIO
.WOSCO: PUSHJ P,WOSCO
JRST DOSIMIO
BEND LINOUT
HERE(RCHPTR)
BEGIN RCHPTR
PUSHJ P,SAVE
MOVE LPSA,X22
VALCHN 1,-1(P),CERR
SETZM .SKIP.
DOSIMIO:SIMIO 2,TABL,CERR
STOAC2: MOVEM 2,RACS+A(USER)
JRST RESTR
TABL: JRST RNULL ;0 -- XNULL
REPEAT 4,<PUSHJ P,GETCPT> ;1-4
REPEAT 3,<JRST CERR> ;5-7
JRST DORFPTR ;10 -- XBYTE7
REPEAT 3,<JRST CERR>
DORFPTR:
JSYS RFPTR
JRST .+2
JRST STOAC2
;HERE WITH AN ERROR FROM RFPTR
MOVEM 1,.SKIP.
JRST RNULL
CERR: ERR <RCHPTR: Illegal jfn, mode, or byte size>,1
SETOM .SKIP.
SETZM RACS+A(USER)
JRST RESTR
RNULL:
PUSHJ P,SETCIO
JRST DOSIMIO
BEND RCHPTR
HERE(SCHPTR)
BEGIN SCHPTR
PUSHJ P,SAVE
MOVE LPSA,X33
VALCHN 1,-2(P),CERR
SETZM .SKIP.
DOSIMIO:MOVE 2,-1(P) ;POINTER
SIMIO 3,TABL,CERR
JRST RESTR
TABL: JRST RNULL ;0 -- XNULL . Remember arg in 2
PUSHJ P,SETCPT ;1 -- XICHAR
PUSHJ P,SETCPT ;2 -- XOCHAR
PUSHJ P,SETCPT ;3 -- XIWORD
PUSHJ P,SETCPT ;4 -- XOWORD
REPEAT 3,<JRST CERR> ;5-7
JRST DOSFPTR ;10 -- XBYTE7
REPEAT 3,<JRST CERR> ;11-13
RNULL:
PUSHJ P,SETCIO
JRST DOSIMIO ;BUT GET ARGUMENT AGAIN
DOSFPTR:
JSYS SFPTR
JRST .+2 ;ERROR IN 1
JRST RESTR
MOVEM 1,.SKIP.
ERR <SCHPTR: Cannot do SFPTR>,1
JRST RESTR
CERR: ERR <Dryrout at SCHPTR>,1
SETOM .SKIP.
JRST RESTR
BEND SCHPTR
DSCR Auxiliary routines for character i/o.
⊗
SETCND:
;sets the FDB so tht the byte size is 7 and the number of bytes is as in 2
;1, CHNL, CDB loaded
;call is PUSHJ
PUSH P,2
PUSH P,3
MOVEM 2,FDBEOF(CDB)
HRLI 1,12 ;OFFSET
MOVEM 2,3 ;NEW COUNT
SETO 2, ;MASK FOR CHANGED BITS
JSYS CHFDB ;NEW NUMBER OF BYTES TO END
MOVEI 2,=7
MOVEM 2,FDBSZ(CDB)
HRLI 1,11
MOVSI 2,007700 ;MASK
MOVSI 3,000700 ;AND CHANGED BITS
JSYS CHFDB ;NEW BYTE SIZE
HRLI 1,0 ;LEAVE JFN IN 1
POP P,3
POP P,2
POPJ P,
GETCND:
;returns in 2 the character count that addresses EOF according to the FDB
;1, CDB loaded
BEGIN GETCND
PUSH P,3
SKIPN 3,FDBSZ(CDB)
JRST RET0
CAIN 3,=36 ;36 BITS?
JRST RET2 ;YES
CAIN 3,=7 ;7 BIT?
JRST RET1 ;YES
CAILE 3,=36 ;BETTER BE LEQ 36
ERR <GETCND: Byte size bigger than 36 bits>,1
PUSH P,4
MOVEI 2,=36
IDIVI 2,(3) ;GET THE NUMBER OF BYTES IN EACH 36-BIT WORD
MOVE 3,FDBEOF(CDB) ;GET THE NUMBER OF BYTES IN THE FILE
IDIVI 3,(2) ;THIS MANY WORDS -- EXTRA BYTES TO 3
IMULI 3,5 ;THIS MANY CHARACTERS IN THE WORDS
PUSH P,3 ;SAVE ON STACK
MOVEI 2,(4) ;EXTRA BYTES
IMUL 2,FDBSZ(CDB) ;EXTRA BITS
IDIVI 2,5 ;CHARACTERS
JUMPE 3,.+2 ;ANYTHING LEFT OVER?
AOJ 2, ;YES
POP P,3 ;GET BACK NUMBER OF CHARACTERS
ADD 2,3 ;PLUS THE ADDITIONAL ONES HERE -- ANSWER IN 2
POP P,4 ;RESTORE
POPBACK:
POP P,3
POPJ P, ;RETURN ANSWER IN 2
RET0: SETZ 2,
JRST POPBACK
RET1: MOVE 2,FDBEOF(CDB) ;7 BIT ALREADY
JRST POPBACK
RET2: MOVE 2,FDBEOF(CDB) ;36 BIT BYTES
IMULI 2,5 ;5 CHARACTERS PER BYTE
JRST POPBACK ;RETURN IT
BEND GETCND
BEGIN GETCPT
;ROUTINES FOR CHAR EOB
↑↑GETCPT:
;1,CDB LOADED
;RETURNS IN 2 THE END OF BUFFER CHARACTER
SKIPN 2,IOBP(CDB)
POPJ P, ;RETURN 0
PUSH P,3
TLZ 2,007700
TLO 2,000700 ;MAKE A 7-BIT POINTER
IBP 2 ;INCREMENT
HRRZM 2,3 ;ADDRESS
HRRI 2,BYTES
LDB 2,2
SUB 3,IOADDR(CDB) ;SUBTRACT
IMULI 3,5 ;CHARACTERS
ADDI 3,(2) ;PLUS THESE IN EXTRA WORD
MOVE 2,IOPAGE(CDB)
IMULI 2,1000*5 ;PREVIOUS PAGES IN THE FILE
ADDI 2,(3) ;PLUS THESE
POP P,3
POPJ P, ;RETURN IN 2
↑↑GTCPT1:
;1, CHNL, CDB loaded
;call PUSHJ
;returns the following
; 2 how many characters until the end of the buffer
; 3 bp to first free character
; 4 count for character output
; 5 count for character input
SKIPN 3,IOBP(CDB)
JRST RET
TLZ 3,007700
TLO 3,000700 ;MAKE A 7-BIT POINTER
MOVEM 3,2 ;COPY IN 2
IBP 2
HRRZM 2,4 ;ADDRESS
HRRI 2,BYTES
LDB 2,2 ;NUMBER OF ADDTL CHARS
SUB 4,IOADDR(CDB) ;ADDRESS OF BUFFER
IMULI 4,5
ADDI 4,(2)
MOVE 2,IOPAGE(CDB)
IMULI 2,1000*5
ADDI 2,(4)
MOVNI 4,(4)
ADDI 4,1000*5
MOVEM 2,5 ;SAVE 2
PUSHJ P,GETCND ;GET CHAR EOF
EXCH 5,2
SUB 5,2
CAML 5,4
MOVEM 4,5
POPJ P,
BYTES: BYTE (7) 0,1,2,3,4
RET: SETZB 2,3 ;NOT INITIALIZED
SETZB 4,5
POPJ P,
BEND GETCPT
CHCEOF:
;CHECKS TO SEE IF CHARACTER EOF POINTER NEEDS RESETTING
;1, CDB LOADED
SKIPN IOBP(CDB) ;DONT CHECK IF NOTHING THERE
POPJ P,
PUSH P,2
PUSH P,3
PUSHJ P,GETCND ;GET CHARACTER EOF IN 2
MOVEM 2,3 ;SAVE IN 6
PUSHJ P,GETCPT ;GET CHARACTER EOB IN 2
CAML 2,3 ;NEED RESETTING?
PUSHJ P,SETCND ;YES
POP P,3
POP P,2
POPJ P,
SETCPT:
;1,CDB LOADED
;2 HAS THE BYTE IN THE FILE TO SET TO
BEGIN SETCPT
MOVE 3,IOSTT(CDB)
CAIN 3,XOWORD ;PREVIOUSLY DOING WORD OUTPUT?
PUSHJ P,CHWEOF ;YES CHECK EOF
CAIN 3,XOCHAR ;PREVIOUSLY DOING CHAR OUTPUT
PUSHJ P,CHCEOF ;CHECK EOF
CAMN 2,[-1] ;WANT EOF?
PUSHJ P,GETCND ;YES, GET IN 2
IDIVI 2,1000*5 ;PAGE BEING REQUESTED
CAME 2,IOPAGE(CDB) ;SAME AS CURRENT
PUSHJ P,SETPAGE ;NO GET NEW PAGE
MOVE 2,IOADDR(CDB)
MOVEM 3,5 ;NUMBER OF CHARS IN THIS BUFFER
IDIVI 3,5 ;WORDS TO 3, BYTES TO 4
ADDI 2,(3) ;3 STILL HAS THE CHAR IN THIS PAGE
HLL 2,BPS(4)
MOVEM 2,IOBP(CDB)
MOVE 3,IOSTT(CDB)
CAIE 3,XICHAR
CAIN 3,XIWORD
JRST ASSUMIN
MOVEI 3,XOCHAR
MOVEM 3,IOSTT(CDB)
FULBUF: MOVEI 3,1000*5
SUBI3: SUBI 3,(5)
STOAC3: MOVEM 3,IOCNT(CDB)
POPJ P,
ASSUMIN:
MOVEI 3,XICHAR
MOVEM 3,IOSTT(CDB)
PUSHJ P,GETCND ;GET THE CHARACTER END OF FILE
IDIVI 2,1000*5 ;PAGES IN 2, CHARS IN 3
CAMGE 2,IOPAGE(CDB) ;IS REQUESTED PAGE BEYOND EOF?
JRST EMPBUF ;YES, NO INPUT THERE
CAME 2,IOPAGE(CDB) ;ON THIS PAGE?
JRST FULBUF ;NO
JRST SUBI3 ;SUBTRACT ALREADY COMMITTED
EMPBUF: SETZ 3,
JRST STOAC3
BPS: POINT 7,0,-1
POINT 7,0,6
POINT 7,0,13
POINT 7,0,20
POINT 7,0,27
BEND SETCPT
SETCIO:
;1,CDB LOADED
;DECIDE WHETHER TO SETCI OR SETCO
MOVEI 3,SETCI ;ASSUME CHARACTER INPUT
MOVE 2,OFL(CDB)
TESTN 2,RDBIT ;DOING INPUT?
MOVEI 3,SETCO ;NOPE ASSUME OUTPUT
JRST (3) ;AND POPJ RETURN
DSCR
ADCI
Accepts: 1 jfn
CDB channel data block
Call: PUSHJ
Returns: +1 for eof
+2 for good input
Resets values in the CDB
⊗
BEGIN ADCI
↑↑ADCI: PUSH P,1
PUSH P,2
PUSH P,3
SIMIO 2,TABL,ADCERR ;MOVE 3,IOPAGE(CDB)
AOJ 3, ;NEXT PAGE
IMULI 3,1000*5 ;NEXT CHARACTER
PUSHJ P,GETCND ;CHARACTER EOF IN 2
CAML 3,2 ;IS IT BEYOND
JRST ADEOF ;YES -- CONFESS THAT IT IS
SUB 2,3 ;COUNT CHARACTERS IN NEW BUFFER
CAILE 2,1000*5 ;LESS THAN A FULL BUFFER
MOVEI 2,1000*5 ;NO
MOVEM 2,IOCNT(CDB)
AOS 2,IOPAGE(CDB) ;INCREMENT PAGE COUNTER, GET IN 2
PUSHJ P,SETPAGE ;GET NEXT PAGE
MOVE 2,IOADDR(CDB)
HRLI 2,440700 ;MAKE A BYTE-POINTER
MOVEM 2,IOBP(CDB)
ADRET: AOS -3(P) ;INCREMENT PC WORD
ADEOF: POP P,3 ;EOF -- DONT INCREMENT
POP P,2
POP P,1
POPJ P, ;RETURN
TABL: JRST ADCERR ;0 -- XNULL
MOVE 3,IOPAGE(CDB) ;1 -- XICHAR
REPEAT 3,<JRST ADCERR> ;2-4
JRST DOSIN ;5 -- XCICHAR
REPEAT 3,<JRST ADCERR> ;6-10
JRST DODUMPI ;11 -- XDICHAR
REPEAT 2,<JRST ADCERR> ;12,13
ADCERR: ERR <Dryrot at ADCI>,1
JRST ADEOF
DOSIN: MOVE 2,IOADDR(CDB)
HRL 3,2
HRRI 3,1(2)
SETZM (2)
BLT 3,777(2)
HRLI 2,444400
MOVNI 3,1000
JSYS SIN
CAMG 3,[-1000]
JRST [CAMN 3,[-1000] ;EOF?
JRST ADEOF
JRST .+1]
ADDI 3,1000 ;NUMBER OF WORDS READ
IMULI 3,5 ;NUMBER OF CHARACTERS
STOCNT: MOVEM 3,IOCNT(CDB)
MOVE 2,IOADDR(CDB)
HRLI 2,440700
MOVEM 2,IOBP(CDB)
JRST ADRET ;AND RETURN
DODUMPI:
PUSH P,1 ;SAVE JFN OVER POSSIBLE DUMPI ERROR
PUSH P,4
MOVE 3,IOADDR(CDB)
HRL 2,3
HRRI 2,1(3)
SETZM (3)
BLT 2,777(3)
SOJ 3,
HRLI 3,-1000 ;MAKE AN IOWD
MOVEI 2,3 ;COMMAND LIST STARTS AT 3
SETZ 4, ;AND ENDS AT 4
JSYS DUMPI
JRST DMIERR
MOVEI 3,1000*5
POP P,4
POP P,1
JRST STOCNT
DMIERR: CAIE 1,600220 ;EOF?
ERR <ADCI: Dump mode input error>,1
POP P,4 ;RESTORE
POP P,1 ;PRECIOUS JFN
MOVE 2,DVTYP(CDB) ;GET DEVICE TYPE
CAIE 2,3 ;MAGTAPE?
JRST ADEOF ;NO, JUST INDICATE EOF
SETZ 2, ;MTOPR RESET
JSYS MTOPR
JRST ADEOF ;AND SAY WE ARE AT THE END OF THE FILE
BEND ADCI
DOINP:
;CHNL has the JFN
;CDB has the channel data block
;returns +1 for good buffered input
; +2 for 7-bit input with char in D
; +3 for eof or error
BEGIN DOINP
PUSH P,1 ;SAVE 1
PUSH P,2
MOVE 1,CHNL ;JFN
MOVE D,IOSTT(CDB) ;D IS FREE
CAIE D,XBYTE7 ;7-BIT?
JRST DOBUFF
SKIPE TTYINF(CDB) ;CONTROLLING TERMINAL?
JRST CHKTTY ;YES
DOBIN: JSYS BIN
JUMPE 2,CHKEOF ;IF 0 MAY BE EOF
MOVEM 2,D ;STORE
JRST DOB7
;;; MOVE 2,DVTYP(CDB) ;IS THE DEVICE A TTY?
;;; CAIE 2,12 ;
;;; JRST DOB7
;;; CAIE 2,12 ;
;;; JRST DOB7 ;NO
;;; CAIN D,32 ;A CONTROL-Z?
;;; JRST DOIEOF ;YES INDICATE EOF
;;; CAIN D,37 ;PHONEY BBN EOL?
;;; MOVEI D,12 ;A LINE-FEED
;;; JRST DOB7 ;AND RETURN
CHKEOF: JSYS GTSTS ;BETTER CHECK
TESTE 2,1B8
JRST DOIEOF ;YEP
SETZ D,
JRST DOB7
DOIEOF: SETOM .SKIP.
SKIPE ENDFL(CDB) ;SPECIFIED?
SETOM @ENDFL(CDB) ;YES
AOS -2(P)
DOB7: AOS -2(P)
DORET: POP P,2
POP P,1
POPJ P,
DOBUFF:
PUSHJ P,ADCI
JRST DOIEOF ;INDICATE EOF
JRST DORET
CHKTTY:
MOVE 2,TTYINF(CDB) ;CHECK STATUS OF TTY
TESTE 2,QTTEOF ;EOF QUED?
JRST DOIEOF ;YES
SETZM CTLOSW ;INDICATE REQUEST
;FOR INPUT
HRRZ 2,2
CAIN 2,TNXINP ;TENEX DEFAULT
JRST DOBIN
CAIN 2,TENXED ;TENEX STYLE EDITING?
JRST TNXBUF ;YES
CAIN 2,DECLED ;DEC STYLE BUFFERING?
JRST DECBUF
ERR <DOINP: Illegal buffering request for terminal>,1
IMSSS<
TNXBUF:
BEGIN TNXBUF
ORIGCNT←← =1000
PUSH P,1
PUSH P,2
PUSH P,3
HRRO 1,IOADDR(CDB) ;BP TO BUFFER FOR CHAN
SETZ 3,
MOVEI 2,ORIGCNT ;DEFAULT LENGTH
JSYS PSTIN
MOVEI 3,ORIGCNT ;MAXIMUM
SUBI 3,(2) ;GET NUMBER RECEIVED IN 3
LDB 2,1 ;GET THE LAST CHAR
CAIE 2,15 ;CARRIAGE RETURN (PROB!!)
JRST NOTCR
MOVEI 2,12 ;INSERT A 12 AFTER IT
IDPB 2,1
AOJ 3, ;INCREMENT COUNT
JRST GOTBRK ;BREAK TENDED
NOTCR:
CAIE 2,32 ;EOF?
JRST GOTBRK
MOVE 2,[QTTEOF]
ORM 2,TTYINF(CDB) ;QUE THE END OF FILE
SOJ 3, ;SUBTRACT ONE FROM COUNT -- CTRL-Z
GOTBRK: MOVEM 3,IOCNT(CDB) ;SAVE COUNT
MOVE 1,IOADDR(CDB)
HRLI 1,440700 ;MAKE A BP
MOVEM 1,IOBP(CDB) ;SAVE IT FOR USER
POP P,3 ;RESTORE
POP P,2
POP P,1
JRST DORET ;AND RETURN
BEND TNXBUF
>;IMSSS
NOIMSSS<;NON-IMSSS VERSION OF INTTY FOR THOSE WHO SUFFER
;UNDER BBN'S LACK OF A SYSTEM LINE EDITOR
TNXBUF:
BEGIN TNXBUF
ORIGCNT←← =200
;AC USES A,B,C JSYS TEMPORARIES
; D BYTEPOINTER
; E COUNT, INITIALLY 0
; Q1 (=6) ORIGINAL BP
PUSH P,A ;SAVE
PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,E
PUSH P,Q1
MOVE Q1,IOADDR(CDB)
HRLI Q1,440700 ;MAKE A BP
RESTRT: MOVE D,Q1 ;GET THE ORIGINAL BP
SETZ E, ;ZERO THE COUNT
INLUP: CAIL E,ORIGCNT
JRST CNTEXH ;COUNT EXHAUSTED
JSYS PBIN ;GET A CHAR
CAIN A,37 ;EOL?
JRST DOEOL ;YES
CAIN A,12 ;LINE FEED (ON TOPS 20)
JRST DONE ;YES
CAIN A,33 ;ESCAPE?
JRST DONE
CAIN A,7 ;CTRL-G
JRST DONE
CAIN A,32 ;CTRL-Z
JRST TTYEOF ;INDICATE EOF
CAIN A,"R"-100 ;CTRL-R FOR REPEAT
JRST DOCTR
CAIN A,"X"-100 ;CTRL-Z FOR DELETE LINE
JRST DOCTX ;YES
CAIE A,177 ;EITHER RUBOUT
CAIN A,"A"-100 ;OR CTRL-A
JRST DOCTA ;FOR DELETE CHARACTER
IDPB A,D
AOJA E,INLUP ;CONTINUE
DOCTR: HRROI A,[ASCIZ/
/]
JSYS PSOUT
JUMPE E,INLUP
MOVEI A,101
MOVE B,Q1 ;ORIG BP
MOVN C,E ;COUNT THUS FAR
JSYS SOUT
JRST INLUP ;AND CONTINUE
DOCTX: HRROI A,[ASCIZ/
/]
JSYS PSOUT
JRST RESTRT ;AND START ALL OVER
DOCTA: JUMPLE E,DOCTX ;IF NO CHARS THEN DO A CONTROL-X
MOVEI A,"\"
JSYS PBOUT
LDB A,D ;LAST CHAR
JSYS PBOUT
SOJ D,
IBP D
IBP D
IBP D
IBP D
SOJA E,INLUP ;SUBTRACT 1 AND CONTINUE
DOEOL:
MOVEI A,15
IDPB A,D
AOJ E,
MOVEI A,12
DONE: IDPB A,D
AOJ E,
CNTEXH:
MOVEM E,IOCNT(CDB) ;COUNT
MOVEM Q1,IOBP(CDB) ;BP
POP P,Q1 ;RESTORE
POP P,E
POP P,D
POP P,C
POP P,B
POP P,A
JRST DORET ;RETURN
TTYEOF: MOVE A,[QTTEOF]
ORM A,TTYINF(CDB) ;QUE END-OF-FILE
JRST CNTEXH ;AND RETURN
BEND TNXBUF
>;NOIMSSS
DECBUF:
BEGIN DECBUF
ORIGCNT ←← =1000 ;LOTS OF ROOM
PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,E
PUSH P,Q1
MOVE Q1,IOADDR(CDB)
HRLI Q1,440700 ;MAKE A BP
RESTRT: MOVE D,Q1
SETZ E, ;COUNT
INLUP: CAIL E,ORIGCNT ;BEYOND?
JRST CNTEXH ;YES
JSYS PBIN
CAIN A,DELLINE ;DELETE ENTIRE LINE?
JRST CTRLU ;YES
CAIN A,RUBCHAR ;RUBOUT?
JRST RUBOUT ;YES
CAIN A,37 ;PHONEY BBN EOL?
JRST SAWEOL
CAIN A,33
JRST SAWESC
CAIN A,32 ;CONTROL-Z?
JRST TTYEOF ;YES, EOF
CAIE A,7 ;CONTROL-G
CAIN A,12 ;OR LF
JRST DONE
IDPB A,D
AOJA E,INLUP ;CONTINUE
CTRLU: HRROI A,[BYTE (7) 7,15,12,0,0]
JSYS PSOUT
JRST RESTRT ;START OVER
RUBOUT: JUMPE E,CTRLU ;NOTHING, DO CTRLU
IMSSS <
MOVEI 1,101
JSYS DELCH
JFCL
JRST DLTED
JRST DLTED
>;IMSSS
MOVEI A,"\"
JSYS PBOUT
LDB A,D ;LAST CHAR
JSYS PBOUT
DLTED:
SOJ D, ;DECREMENT BP
IBP D
IBP D
IBP D
IBP D
SOJA E,INLUP ;DECREMENT COUNT AND CONTINUE
DONE:
IDPB A,D
AOJ E,
CNTEXH:
MOVEM E,IOCNT(CDB)
MOVEM Q1,IOBP(CDB)
POP P,Q1
POP P,E
POP P,D
POP P,C
POP P,B
POP P,A
JRST DORET
SAWEOL: MOVEI A,15 ;SIMULATE CR
IDPB A,D
AOJ E,
MOVEI A,12 ;SIMULATE LF
JRST DONE
SAWESC: MOVEI A,ALTMODE ;DEC ALTMODE
JRST DONE
TTYEOF: MOVE A,[QTTEOF]
ORM A,TTYINF(CDB) ;QUE AN EOF
JRST CNTEXH ;AND RETURN
BEND DECBUF
BEND DOINP
DSCR ADCO,ADCO1
CAL PUSHJ
SID SAVES ALL ACS
ARGS
1 JFN
CDB address of channel data block
⊗
BEGIN ADCO
;HERE IF THE COUNT ALREADY PROMISES A CHARACTER
↑↑ADCO1:
AOS IOCNT(CDB) ;MAKE THE COUNT HONEST, TEMPORARILY
PUSHJ P,ADCO ;CALL ADCO
SOS IOCNT(CDB) ;REFLECT THE FACT THAT A CHARACTER IS PROMISED
POPJ P, ;AND RETURN (TO CHARACTER OUTPUT CODE)
↑↑ADCO:
PUSH P,2 ;SAVE ACS
PUSH P,3
PUSH P,4
MOVE 2,IOSTT(CDB) ;GET STATUS
CAIE 2,XOCHAR ;PMAPPING THE DSK?
JRST NOPMAP ;GUESS NOT
AOS 2,IOPAGE(CDB) ;NEXT PAGE
PUSHJ P,SETPAGE
MOVEI 2,1000*5
MOVEM 2,IOCNT(CDB) ;CAN WRITE THIS MANY
MOVE 2,IOADDR(CDB)
HRLI 2,440700
MOVEM 2,IOBP(CDB) ;OK
ADRET: POP P,4
POP P,3
POP P,2
POPJ P,
NOPMAP:
CAIN 2,XCOCHAR ;36-BIT ETC.?
JRST STRSOU ;USE SOUT
CAIE 2,XDOCHAR ;BETTER BE DUMP-MODE
ERR <Dryrot at ADCO>,1
SKIPN IOBP(CDB) ;SET UP YET?
JRST DMPINIT
MOVE 3,IOADDR(CDB)
MOVEI 4,DMOCNT*5
CAMG 4,IOCNT(CDB) ;ANY CHARS TO SEND
JRST ADRET
MOVEI 2,3
SUBI 3,1
MOVNI 4,DMOCNT ;WORD COUNT FOR DUMP MODE OUTPUT
HRL 3,4 ;MAKE AN IOWD
SETZ 4, ;MAKE A COMMAND LIST
JSYS DUMPO
ERR <DUMPOUT: CANNOT WRITE DATA IN DUMP MODE>,1
SETOM DMPED(CDB) ;AND INDICATE DONE
DMPINIT:
MOVE 3,IOADDR(CDB)
HRL 2,3
HRRI 2,1(3)
SETZM (3)
BLT 2,DMOCNT-1(3) ;ZERO OUT
MOVEI 2,DMOCNT*5
MOVEM 2,IOCNT(CDB) ;SAVE COUNT
HLL 3,[POINT 7,0,-1];FIX A BYTE-POINTER
MOVEM 3,IOBP(CDB) ;AND SAVE BYTE-POINTER
JRST ADRET
STRSOU:
SKIPN IOBP(CDB)
JRST SOUINIT
MOVEI 3,1000*5
SUB 3,IOCNT(CDB) ;NUMBER OF CHARACTERS ACTUALLY IN BUFFER
IDIVI 3,5 ;NUMBER OF WORDS
SKIPE 4 ;ANY REMAINDER?
AOJ 3, ;YES, ANOTHER WORD FOR EXTRA CHARACTERS
JUMPE 3,ADRET ;RETURN IF NO CHARACTERS TO SEND
MOVN 3,3 ;NEGATIVE WORD COUNT FOR SOUT
MOVE 2,IOADDR(CDB)
HRLI 2,444400 ;MAKE A BP
JSYS SOUT
SOUINIT:
MOVE 2,IOADDR(CDB)
HRL 3,2
HRRI 3,1(2)
SETZM (2)
BLT 3,777(2) ;CLEAR OUT PAGE
HRLI 2,440700
MOVEM 2,IOBP(CDB)
MOVEI 3,1000*5
MOVEM 3,IOCNT(CDB)
JRST ADRET
BEND ADCO
DSCR SETIO
Master routine to set up the file io possibilities.
Arguments:
1,CHNL,CDB set up
There are four entries to the function, depending on the kind of IO that
appears to be desired. They are:
SETCI character input
SETCO character output
SETWI word input
SETWO word output
This routine does the following things:
(1) sets up IOSTT
It does so by first deciding each of these
(1) input or output immediately desired
(2) chars or words immediately desired
(3) 7 or 36 bit bytes open
(4) mode 0 or 17
(5) dsk or non-dsk
An additional consideration is that the file, if on the disk,
may need to be CLOSFed and reOPENFed to allow reading (and writing
if appending).
This facilitates (indeed, makes possible) PMAPping the file and
doing I/O directly into pages of the file. Should this reOPENF
fail (as when protection does not allow it), it will be necessary
to restrict the possibility of doing data mixed and random I/O
to the file. Such is the design of TENEX. (Example: MESSAGE.TXT
is ordinarily such that you can append to it but not read and
write, when it is someone else's file.)
⊗
BEGIN SETIO
↑SETWI: SKIPA 6,[=8] ;wants word input
↑SETWO: MOVEI 6,=24 ;wants word output
JRST SETIO ;
↑SETCI: TDZA 6,[-1] ;wants character input
↑SETCO: MOVEI 6,=16 ;wants character output
SETIO: LDB 2,[POINT 6,OFL(CDB),5] ;7-36 BIT BYTES?
CAIN 2,=36
ADDI 6,4 ;36
LDB 2,[POINT 4,OFL(CDB),9]
JUMPE 2,.+2 ;MODE 0 OR 17?
ADDI 6,2 ;17
SKIPE DVTYP(CDB) ;DSK OR NON-DSK?
AOJ 6, ;NON-DSK
IDIVI 6,7 ;SET UP FOR LDB
LDB 6,BPS(7)
JUMPN 6,.+2
ERR <DRYROT at SETIO: Nonsense combination of bytes and modes for io request.>,1
MOVEM 6,IOSTT(CDB) ;THAT IS THE ANSWER
CAIL 6,XICHAR ;PMAPPED DISK FILE?
CAILE 6,XOWORD
JRST NOPMAP
MOVE 2,OFL(CDB)
TESTN 2,WRBIT ;WRITING
TESTE 2,APPBIT ;OR APPENDING?
JRST .+2 ;THEN BETTER BE READING
JRST CHKED1
TESTO 2,RDBIT ;MUST BE READING
TESTN 2,APPBIT ;REMEMBER IF APPENDING
JRST NOAPP ;NOT APPENDING
TESTZ 2,APPBIT ;TURN OFF APPENDING
TESTO 2,WRBIT ;INDICATE WRITING
SKIPA 3,[-1] ;APPENDING
NOAPP: SETZ 3, ;NOT APPENDING
CAMN 2,OFL(CDB) ;DIFFERENT?
JRST CHKED ;NO
TESTO 1,1B0 ;DONT RELEASE
JSYS CLOSF
ERR <SETIO: Cannot do CLOSF>
TESTZ 1,1B0 ;RESET DONT RELEASE BIT
PUSH P,1 ;SAVE JFN
JSYS OPENF
JRST NOROPN ;CANNOT RE-OPEN FILE
POP P,1 ;RESTORE JFN
MOVEM 2,OFL(CDB) ;AND REMEMBER NEW FLAGS
CHKED: SKIPA 2,3 ;PICK UP SAVED POINTER
CHKED1: SETZ 2,
PUSH P,2 ;SAVE POINTER
SETOM IOPAGE(CDB) ;DENY THAT THERE IS A PAGE THERE
MOVE 2,[XWD 2,11] ;READ FDB
MOVEI 3,2
JSYS GTFDB
MOVEM 3,FDBEOF(CDB) ;SAVE EOF
LDB 2,[POINT 6,2,11]
MOVEM 2,FDBSZ(CDB)
POP P,2 ;GET POINTER BACK
CAIE 6,XIWORD ;SEE IF WORDS
CAIN 6,XOWORD
JRST SETWPT ;WORDS POPJ BACK
JRST SETCPT ;CHARACTERS POPJ BACK
NOROPN: POP P,1 ;CLOBBERED JFN
MOVE 2,OFL(CDB) ;FLAGS AS THEY WERE -- CANT DO NO BETTER
JSYS OPENF
ERR <SETIO: Cannot do OPENF>
MOVE 2,IOSTT(CDB) ;STATUS -- MUST BE CHANGED
CAIN 2,XICHAR
MOVEI 3,XCICHAR
CAIN 2,XOCHAR
MOVEI 3,XCOCHAR
CAIE 2,XIWORD
CAIN 2,XOWORD
MOVEI 3,XCIWORD
MOVEM 3,IOSTT(CDB) ;SAVE STATUS -- BEST WE CAN DO
;FALL THRU AND RETURN
NOPMAP: SETZM IOCNT(CDB)
SETZM IOBP(CDB)
POPJ P,
BPS: POINT 5,TABL(6),4 ;BYTE POINTERS
POINT 5,TABL(6),9
POINT 5,TABL(6),14
POINT 5,TABL(6),19
POINT 5,TABL(6),24
POINT 5,TABL(6),29
POINT 5,TABL(6),34
TABL: BYTE (5) XBYTE7,XBYTE7,0,0,XICHAR,XCICHAR,XDICHAR
BYTE (5) XDICHAR,0,0,0,0,XIWORD,XCIWORD
BYTE (5) XDARR,XDARR,XBYTE7,XBYTE7,0,0,XOCHAR
BYTE (5) XCOCHAR,XDOCHAR,XDOCHAR,0,0,0,0
BYTE (5) XOWORD,XCIWORD,XDARR,XDARR
BEND SETIO
DSCR
FINIO
Finishes the io.
Mainly does the following:
(1) outputs any remaining buffers
(2) checks eof pointer in FDB of dsk files
(3) writes EOF marks to magtape
CAL PUSHJ from runtimes (CFILE and CLOSF)
ARGS 1,CDB
SID nothing saved
⊗
HERE(FINIO)
BEGIN FINIO
PUSH P,1
PUSH P,2
PUSH P,3
PUSH P,4
PUSH P,5
PUSH P,6
SIMIO 2,TABL,POPBACK
UNMAP: SETZM DMPED(CDB) ;RESET VALUES TO ORIGINALS
SETZM IOCNT(CDB)
SETZM IOBP(CDB)
SETZM IOSTT(CDB)
SETOM IOPAGE(CDB) ;N.B.
SETO 1, ;DESTROY PAGE -- NOTE: CLOBBERS JFN
MOVE 2,FKPAGE(CDB) ;UNTIL POP BELOW
SETZ 3,
JSYS PMAP
POPBACK:POP P,6
POP P,5
POP P,4
POP P,3
POP P,2
POP P,1
POPJ P,
TABL: JRST POPBACK ;0 -- XNULL
JFCL ;1 -- XICHAR
PUSHJ P,CHCEOF ;2 -- XOCHAR -- POPJ RETURN
JFCL ;3 -- XIWORD
PUSHJ P,CHWEOF ;4 -- XOWORD
JFCL ;5 -- XCICHAR
PUSHJ P,ADCO ;6 -- XCOCHAR
JFCL ;7 -- XCWORD
JRST DOB7 ;10 -- XBYTE7
JFCL ;11 -- XDICHAR
JRST XDO1 ;12 -- XDOCHAR
JRST XDO2 ;13 -- XDARR
DOB7: SKIPN 2,TTYINF(CDB) ;A TELETYPE?
JRST UNMAP ;NOPE
TESTZ 2,QTTEOF ;TURN OFF QUED EOF
MOVEM 2,TTYINF(CDB)
JRST UNMAP ;AND UNBUFFER
XDO1: PUSHJ P,ADCO ;WRITE OUT WHATEVER IS THERE
XDO2: SKIPN DMPED(CDB) ;DUMP MODE OUTPUT SEEN?
JRST UNMAP ;NOPE
MOVE 2,DVTYP(CDB) ;DEVICE TYPE
CAIE 2,2 ;MAGTAPE?
JRST UNMAP ;NOPE
MOVEI 2,3 ;EOF
JSYS MTOPR ;WRITE TWO
JSYS MTOPR
MOVEI 2,17 ;BACKSPACE OVER 1 EOF
JSYS MTOPR
JRST UNMAP
BEND FINIO
ENDCOM(IOROU)
COMPIL(BINROU,<SFPTR,RFPTR,MTOPR,BKJFN,RFBSZ>
,<SAVE,RESTR,X22,X33,X44,.SKIP.,JFNTBL,CDBTBL>
,<BINROU -- Binary routines generally to not be used>)
DSCR SIMPLE PROCEDURE SFPTR(INTEGER JFN,POINTER)
Sets the file open on JFN to byte POINTER (-1 for EOF).
Errors returned in .SKIP.
WARNING: presently not compatible with special character
mode.
⊗
HERE(SFPTR)
PUSHJ P,SAVE
MOVE LPSA,X33
VALCHN 1,-2(P),SFBAD
SETZM .SKIP.
MOVE 2,-1(P)
JSYS SFPTR
MOVEM 1,.SKIP.
SFRET: JRST RESTR
SFBAD: ERR <Illegal JFN>,1
SETOM .SKIP.
JRST SFRET
DSCR INTEGER SIMPLE PROCEDURE RFPTR(INTEGER JFN)
Reads the pointer of JFN. Error codes to .SKIP.
WARNING: presently does not work for files in special character
mode.
⊗
HERE(RFPTR)
PUSHJ P,SAVE
MOVE LPSA,X22
VALCHN 1,-1(P),RFBAD
SETZM .SKIP.
JSYS RFPTR
MOVEM 1,.SKIP.
MOVEM 2,RACS+A(USER) ;ANSWER IN 2
RFRET: JRST RESTR
RFBAD: ERR <Illegal JFN>,1
SETOM .SKIP.
JRST RFRET
DSCR SIMPLE PROCEDURE MTOPR(INTEGER JFN,FUNCTION,VALUE)
Does the MTOPR jsys.
⊗
HERE(MTOPR)
BEGIN MTOPR
PUSHJ P,SAVE
MOVE LPSA,X44
VALCHN 1,-3(P),MTBAD
MOVE 2,-2(P)
MOVE 3,-1(P)
JSYS MTOPR
MTRET: JRST RESTR
MTBAD: ERR <Illegal JFN>,1
JRST MTRET
BEND MTOPR
DSCR SIMPLE PROCEDURE BKJFN(INTEGER JFN)
Does the BKJFN jsys on JFN, error code to .SKIP.
⊗
HERE(BKJFN)
PUSHJ P,SAVE
MOVE LPSA,X22
VALCHN 1,-1(P),BKBAD
SETZM .SKIP.
BKJF1: JSYS BKJFN
MOVEM 1,.SKIP. ;ERROR RETURN
BKRET: JRST RESTR
BKBAD: MOVE 1,-1(P) ;USE LITERALLY
JRST BKJF1
DSCR INTEGER SIMPLE PROCEDURE RFBSZ(INTEGER JFN);
Reads the byte-size of the file open on JFN.
⊗
HERE(RFBSZ)
PUSHJ P,SAVE
MOVE LPSA,X22
VALCHN 1,-1(P),RFBBAD
JSYS RFBSZ
JFCL ;TOPS 20 ERROR RETURN
MOVEM 2,RACS+A(USER) ;ANSWER IN 2
RFBRET: JRST RESTR
RFBBAD: ERR <Illegal JFN>,1
JRST RFBRET
ENDCOM(BINROU)
COMPIL(DSKOPS,<DSKIN,DSKOUT>
,<JFNTBL,CDBTBL,.SKIP.>
,<DSKOPS -- DIRECT DSK ROUTINES>)
DSCR SIMPLE PROCEDURE
DSKIN(INTEGER MODULE,RECNO,COUNT; REFERENCE INTEGER LOC);
IMSSS only.
Does direct IO from the DSK (formerly device "PAK").
Modules 4-7 are legal for everyone. Other modules require enabled
status.
Count words are read into user's core at location LOC, from
MODULE, record RECNO. Error bits are in .SKIP.
Does the DSKOP jsys (as modified at IMSSS).
⊗
BEGIN DSKOPS
HERE(DSKIN)
NOIMSSS<
ERR <DSKIN: Only defined in IMSSS system>
>;NOIMSSS
PUSHJ P,SAVE
SETZ 4, ;INDICATE READ ONLY
DSK1: HRRZ 2,-2(P)
JUMPLE 2,DSBAD ;LEQ 0 -- ERROR
CAILE 2,1000 ;DONT READ MORE THAN 1000 WORDS
JRST DSBAD
IOR 2,4 ;PICK UP READ OR WRITE (SET IN 4)
HRLZ 1,-4(P) ;MODULE
HRR 1,-3(P) ;RECORD NO. IN RIGHT HALF
TLO 1,600000 ;SOFTWARD ADDRESS, IMSSS FORMAT (BITS 0 AND 1 RES.)
HRRZ 3,-1(P) ; GET THE USER LOCATION
JSYS DSKOP
DSDUN: MOVEM 1,.SKIP. ; SAVE ERROR BITS
DSRET: MOVE LPSA,[XWD 5,5] ; TO ADJUST STACK
JRST RESTR
DSBAD: ERR <DSKIN OR DSKOUT: WORD COUNT EITHER <= 0 OR > '1000>,1
SETOM .SKIP.
JRST DSRET
DSCR SIMPLE PROCEDURE
DSKOUT(INTEGER MODULE,RECNO,COUNT; REFERENCE INTEGER LOC)
DESR Similar to DSKIN, except that a write is done.
⊗
HERE(DSKOUT)
NOIMSSS<
ERR <DSKOUT: Only defined at IMSSS>
>;NOIMSSS
PUSHJ P,SAVE
MOVSI 4,(1B14) ;INDICATE WRITE (TO BE IOR'ED INTO AC 2)
JRST DSK1 ;AND TO THE ABOVE CODE
BEND DSKOPS
ENDCOM(DSKOP)
COMPIL(DEVS,<DEVTYPE,DVCHR,ERSTR>
,<X22,X44,.SKIP.,JFNTBL,CDBTBL>
,<DEVS -- DEVICE HANDLERS, ERROR ROUTINE>)
DSCR INTEGER SIMPLE PROCEDURE DEVTYPE(INTEGER JFN);
Returns (via the DEVCHR jsys) the device type of
the device open on JFN. The more general DEVCHR call is
also implemented (below).
⊗
HERE(DEVTYPE)
VALCHN 1,-1(P),DEVBAD
JSYS DVCHR
HLRZ 1,2
ANDI 1,777
DEVRET: SUB P,X22
JRST @2(P)
DEVBAD: ERR <Illegal JFN>,1
JRST DEVRET
DSCR INTEGER SIMPLE PROCEDURE DVCHR(INTEGER JFN; REFERENCE INTEGER AC1,AC3);
Does the DEVCHR jsys, returning the flags from AC2 as the
value of the call, and AC1 and AC3 get the contents of ac's 1 and 3.;
⊗
HERE(DVCHR)
VALCHN 1,-3(P),DVBAD
JSYS DVCHR
MOVEM 1,@-2(P)
MOVEM 3,@-1(P)
MOVE 1,2
DVRET: SUB P,X44
JRST @4(P)
DVBAD: ERR <Illegal JFN>,1
JRST DVRET
DSCR SIMPLE PROCEDURE ERSTR(INTEGER ERRNO,FORK)
Using the ERSTR jsys, types out on the console the TENEX error string
associated with ERRNO for FORK fork (0 for the current fork). Parameters (in
the sense of the ERSTR jsys) are expanded.
Types out the string ERSTR: UNDEFINED ERROR number if
something is with your error number or fork (and sets .SKIP. to -1).
⊗
HERE(ERSTR)
SETZM .SKIP.
MOVEI 1,101 ;PRIMARY OUTPUT
SKIPN 2,-1(P) ;ANY FORK MENTIONED?
MOVEI 2,400000 ;ASSUME CURRENT FORK
HRLZ 2,2 ;IN LEFT HALF
HRR 2,-2(P) ;THE ERROR NUMBER
SETZ 3, ;NO LIMIT TO SIZE OF STRING
JSYS ERSTR
JRST ERSERR
JRST ERSERR ;ERROR RETURNS
ERSRET: SUB P,X33
JRST @3(P)
ERSERR: HRROI 1,[ASCIZ/
ERSTR: UNDEFINED ERROR NUMBER
/]
JSYS PSOUT
SETOM .SKIP. ;INDICATE ERROR
JRST ERSRET
ENDCOM(DEVS)
COMPIL(UTILITY,<SETCHN,ZSETST,ZADJST,.RESET,RDSEG>
,<CORGET,GOGTAB,JFNTBL,CDBTBL,STRNGC,INSET,SAVE,RESTR,X33>
,<UTILITY -- UTILITY TENEX ROUTINES>)
DSCR
SETCHN accepts in A the JFN, and returns in A the channel number associated with a JFN.
It sets up the JFNTBL, the CDBTBL table, and returns the address of the
file command block in ac CDB. Other acs are not modified (except USER).
In order to accommodate the OPEN statement, a channel will be
considered allocated when it has a CDB, even if it does not yet have a jfn.
⊗
HERE(SETCHN)
MOVE USER,GOGTAB
PUSH P,B
PUSH P,C
PUSH P,D
MOVEI B,JFNSIZE ;FOR COMPARISON TO RH OF A
CAILE B,(A) ;IS THE JFN BEYOND THE NUMBER OF CHANNELS
SKIPE CDBTBL(A) ;OR IS IT ALLOCATED OR USED?
JRST FNDCHN ;PERHAPS NOT, FIND ONE SOMEHOW
HRRZ D,A ;USE JFN NO. AS CHANNEL
;MUST GET A CHANNEL DATA BLOCK
GTCDB: MOVEI C,IOTLEN
PUSHJ P,CORGET
ERR <SETCHN: NO CORE>
MOVE CDB,B
MOVEM CDB,CDBTBL(D) ;SAVE ADDR OF CDB
;HERE WITH B,CDB, D LOADED WITH: CDBADDR,CDBADDR,CHANNEL
CLCDB:
HRL B,B
ADDI B,1
SETZM (CDB)
BLT B,IOTLEN-1(CDB)
GOTCHN:
MOVEM A,JFNTBL(D)
HRRZ 1,A ;JFN
JSYS DVCHR ;CLOBBERS 1,2,3
MOVEM 1,DVDSG(CDB) ;SAVE DESIGNATOR
MOVEM 2,DVCH(CDB) ;AND CHARACTERISTICS
HLRZ 1,2
ANDI 1,777 ;GET DEVICE TYPE
MOVEM 1,DVTYP(CDB) ;AND SAVE IT
CAIE 1,12 ;IS IT A TTY?
JRST NOTTTY ;NOPE
;CHECK THAT IT IS DEVICE "TTY" (IN WHICH CASE IT IS THE CONTROLLING TERM)
HRRZ 2,JFNTBL(D) ;GET JFN
TRNE 2,400000 ;A TERMINAL SPECIFIER FROM SETCHAN?
JRST NOTTTY ;YES, NOT DEVICE "TTY"
PUSH P,3 ;SOME SPACE
PUSH P,4
PUSH P,5
PUSH P,6
HRROI 1,4
MOVSI 3,200000 ;DEVICE FIELD ONLY
SETZ 4,
JSYS JFNS
MOVEM 4,2 ;SAVE IN 2
POP P,6 ;RESTORE ACS
POP P,5
POP P,4
POP P,3
CAME 2,[ASCIZ/TTY/] ;DEVICE TTY?
JRST NOTTTY ;NOT THE CONTROLLING TERMINAL
MOVE 2,[ISCTRM+TENXED] ;DEFAULT -- TENEX STYLE
MOVEM 2,TTYINF(CDB)
NOTTTY: MOVEI 2,STARTPAGE(D) ;PAGE FOR BUFFER
HRLI 2,400000 ;THIS FORK
MOVEM 2,FKPAGE(CDB) ;XWD FORK,PAGE FOR PMAPPING
LSH 2,9 ;MAKE AN ADDRESS
MOVEM 2,IOADDR(CDB) ;AND SAVE IT AS WELL
SETOM IOPAGE(CDB) ;DENY THAT THERE IS A PAGE THERE
HRRZ A,D ;CHANNEL INTO A
POP P,D ;RESTORE
POP P,C
POP P,B
POPJ P,
;FIND AN OPEN CHANNEL AND RETURN THE NUMBER IN D
;A HAS THE JFN NO. IN IT, SO CHECK TO SEE IF THE SAME
;B MAY BE CLOBBERED
FNDCHN: HRRZ D,JFNTBL(A) ;CHECK OLD JFN
CAIE D,(A) ;SAME AS THE NEW?
JRST FNDCH2 ;NO
MOVE CDB,CDBTBL(D) ;GET OLD CDB
MOVE B,CDB ;COPY CDB ADDR FOR BLT
JRST CLCDB
FNDCH2: SETZ D,
FNDCH1: CAIL D,JFNSIZE
ERR <SETCHN: JFN TABLE IS FULL (SHOULD NEVER HAPPEN)>
SKIPE CDBTBL(D) ;IS IT EMPTY?
AOJA D,FNDCH1 ;NO LOOK SOME MORE
JRST GTCDB ;YES, USE IT
DSCR SIMPLE INTEGER PROCEDURE ZSETST(INTEGER I);
Internal book-keeping routine not intended for
use from SAIL. Causes liberation from SAIL.
THE ARGUMENT IS THE MAXIMUM SIZE OF THE EXPECTED STRING.
THE RETURN IS THE BYTEPOINTER POINTING INTO THE TOP OF STRING SPACE
⊗
HERE(ZSETST)
MOVE USER,GOGTAB ; GET USER
SKIPE SGLIGN(USER)
PUSHJ P,INSET ;ASSUMING THAT IT IS TRANSPARENT FOR THE ACS
MOVE 1,-1(P) ;GET EXPECTED LENGTH
ADDM 1,REMCHR(USER) ; ADD ON
SKIPLE REMCHR(USER) ; NEED TO COLLECT?
PUSHJ P,GOCOLLECT ; YES
MOVE 1,TOPBYTE(USER) ; RETURN BP
SUB P,X22 ; ADJUST STACK
JRST @2(P) ; RETURN
GOCOLLECT:
MOVEM RF,RACS+RF(USER) ;SAVE RF
PUSHJ P,STRNGC ;
POPJ P, ; RETURN TO ABOVE
DSCR STRING SIMPLE PROCEDURE ZADJST(INTEGER CNTEST,BP)
Internal book-keeping routine.
ADJUSTS THE PARAMETERS ASSOCIATED WITH STRING SPACE.
BP IS OUR NEW TOPBYTE. CNTEST IS THE COUNT ESTIMATE WE
ORIGINALLY MADE.
FIRST, WE MUST MAKE REMCHR HONEST, THEN WE
CAN FIX TOPSTR AND THE USER'S LENGTH WORD.
⊗
HERE(ZADJST)
BEGIN ZADJST
MOVE USER,GOGTAB;
PUSH P,1
PUSH P,2
PUSH P,3
PUSH P,4
DEFINE CNTARG <-6(P)>
DEFINE BPARG <-5(P)>
MOVE 2,BPARG ;UPDATED BP
MOVE 1,TOPBYTE(USER) ; GET OLD TOPBYTE
CAMN 1,2 ; THE NULL STRING?
JRST NULRET; ;YES
;P. KANERVA'S BYTE ROUTINE
LDB 3,[POINT 6,1,5] ;BITS TO THE RIGHT OF BYTE 1
LDB 4,[POINT 6,2,5] ;BITS TO THE RIGHT OF BYTE 2
SUBI 3,(4) ;BIT DIFFERENCE
IDIVI 3,7 ;WITHIN-WORD BYTE DIFFERENCE
SUBI 2,(1) ;WORDS BETWEEN BYTES
HRRE 2,2 ;FULL WORD DIFFERENCE
IMULI 2,5 ;CONVERT IT TO BYTE DIFFERENCE
ADD 2,3 ;ADD COUNT DERIVED FROM WITHIN-WORD
;DIFFERENCE
CAMLE 2,CNTARG ;WITHIN RANGE?
ERR <ZADJST: TENEX WROTE TOO LONG A STRING, MAY BE FATAL>,1
GOTLNG: HRRO 1,2 ; XWD -1,COUNT
PUSH SP,1 ; XWD -1,COUNT
PUSH SP,TOPBYTE(USER) ; OLD TOPBYTE FOR BP FOR STRING
JUMPE 2,NOLNG
MOVE 1,BPARG
MOVEM 1,TOPBYTE(USER)
NOLNG:
SUB 2,CNTARG ; SUBTRACT THE COUNT ESTIMATE
ADDM 2,REMCHR(USER) ; MAKE REMCHR HONEST
POP P,4
POP P,3
POP P,2
POP P,1
SUB P,X33 ; ADJUST STACK
JRST @3(P) ;
NULRET: SETZ 2,;
JRST GOTLNG ; BE SURE TO FIX UP ALL THE GOODIES
BEND ZADJST
DSCR
.RESET
SID SAVES ALL ACS
CAL JSP P,.RESET from SAILOR
RESETS TENEX IO AND BOOKKEEPING, AND SETS THE TTY MODE TO WAKEUP
ON EVERY CHARACTER. TTY WAKEUP IS NOT DONE IF THE JOB IS DETACHED.
THIS SHOULD ONLY BE CALLED FROM SAILOR.
⊗
HERE(.RESET)
BEGIN RESET
;ZERO OUT BOOKKEEPING
SETZM JFNTBL
MOVE 1,[XWD JFNTBL,JFNTBL+1]
BLT 1,JFNTBL+JFNSIZE-1
SETZM CDBTBL
MOVE 1,[XWD CDBTBL,CDBTBL+1]
BLT 1,CDBTBL+JFNSIZE-1
;RELEASE PAGES ASSOCIATED WITH FILES (FROM STARTPAGE TO STARTPAGE+JFNSIZE-1)
SETO 1, ;RELEASE PAGE
SETZ 3, ;FLAGS WORD
MOVE 2,[XWD 400000,STARTPAGE]
.RESE1: CAMN 2,[XWD 400000,STARTPAGE+JFNSIZE] ;THIS WOULD BE TOO MANY PAGES
JRST .RESE2
JSYS PMAP
AOJA 2,.RESE1 ;NEXT?
.RESE2:
JSYS RESET ;CLEAR ALL IO
;SET UP PSI SYSTEM
HRRZI 1,400000 ;USE EXISTING TABLE IF THERE
;; JSYS RIR
;; JUMPN 2,.+3 ;ALREADY THERE
MOVE 2,[XWD LEVTAB,CHNTAB]
JSYS SIR
JSYS EIR ;TURN ON INTERRUPTS
;CHECK AND SEE IF WE ARE DETACHED
JSYS GJINF
CAMN 4,[-1] ;-1 FOR DETACHED JOBS
JRST DTCHED ;YES IT IS DETACHED
;SET PRIMARY INPUT TO WAKE UP ON EVERY CHARACTER
;THE USER MAY RESET THIS.
MOVEI 1,100 ;PRIMARY INPUT
JSYS RFMOD
TRO 2,170000 ;WAKEUP ON ALL CHARS
JSYS SFMOD
DTCHED: SETZM CTLOSW ;CLEAR OUTPUT-SUPPRESSION SWITCH
JRST (P) ;AND RETURN
BEND RESET
;ROUTINE TO CHECK IF A JFN HAS BEEN CLOSED BY ONE OF
;THE DEC-STYLE CLOSE ROUTINES (IN WHICH CASE IT
;MUST BE AVAILABLE FOR RE-OPENING)
;ARGS:
; 1 JFN
; CDB THE CHANNEL DATA BLOCK
↑OPNCHK:
SKIPL IOSTT(CDB) ;CLOSED BY DEC?
POPJ P, ;NO
PUSH P,2 ;SAVE 2
MOVE 2,OFL(CDB) ;PREVIOUSLY USED FLAGS
JSYS OPENF ;OPEN
ERR <OPNCHK: Cannot OPENF file>,1
SETZM IOSTT(CDB)
POP P,2 ;RESTORE 2
POPJ P, ;RETURN
HERE(RDSEG)
PUSHJ P,SAVE ;
MOVE LPSA,X33 ;FOR RESTR BELOW
HRRZ A,SEGPAGE*1000 + 12 ;ADDRESS OF LAST WORD OF SEGMENT IS HERE
LSH A,-=9 ;MAKE IT A PAGE NUMBER
HRLI A,SEGPAGE ;FIRST PAGE OF SEGMENT
MOVEM A,@-2(P) ;STORE
HRLI A,STARTPAGE ;FIRST WORD OF BUFFER REGION
HRRI A,STARTPAGE+JFNSIZE-1 ;LAST PAGE OF BUFFER REGION
MOVEM A,@-1(P) ;STORE
JRST RESTR ;AND RETURN
ENDCOM(UTILITY)
COMPIL(TTM,<RFMOD,SFMOD,STPAR,STI,RFCOC,SFCOC,GTTYP,STTYP,SETEDIT>
,<SAVE,RESTR,X22,X33,X44>
,<TTM -- TERMINAL MODE ROUTINES>)
DSCR INTEGER PROCEDURE RFMOD(INTEGER CHAN)
Reads a file's mode word.
PROCEDURE SFMOD(INTEGER CHAN,AC2)
Sets a file's mode word to argument AC2.
PROCEDURE STPAR(INTEGER CHAN,BITS)
Executes the STPAR jsys on CHAN with arguments BITS
PROCEDURE STI(INTEGER CHAN,CHAR)
Executes the STI jsys on CHAN with character CHAR.
PROCEDURE RFCOC(INTEGER CHAN; REFERENCE INTEGER AC2,AC3)
Does RFCOC jsys, returning values in AC2 and AC3.
PROCEDURE SFCOC(INTEGER CHAN,AC2,AC3)
Does SFCOC jsys, setting to AC2 and AC3.
INTEGER PROCEDURE GTTYP(INTEGER CHAN; REFERENCE INTEGER BUFS)
Does GTTYP jsys on CHAN/TTY and returns the
typ information as the value of the call. BUFS is the
result from AC 3.
PROCEDURE STTYP(INTEGER CHAN,NEWTYPE)
Sets the terminal type of CHAN to NEWTYPE
⊗
HERE(RFMOD)
PUSHJ P,SAVE
MOVE LPSA,X22
VALCH1 1,-1(P),RFMO1
RFMO2: JSYS RFMOD
MOVEM 2,RACS+A(USER)
JRST RESTR
RFMO1: MOVE 1,-1(P) ;USE LITERALLY
JRST RFMO2
HERE(SFMOD)
PUSHJ P,SAVE
MOVE LPSA,X33
VALCH1 1,-2(P),SFMO1
SFMO2: MOVE 2,-1(P)
JSYS SFMOD
JRST RESTR
SFMO1: MOVE 1,-2(P)
JRST SFMO2
HERE(STPAR)
PUSHJ P,SAVE
MOVE LPSA,X33
VALCH1 1,-2(P),STPAR1
STPAR2: MOVE 2,-1(P) ;PARAMETERS TO SET
JSYS STPAR ;EXECUTE JSYS
JRST RESTR
STPAR1: MOVE 1,-2(P) ;USE LITERALLY
JRST STPAR2
HERE(STI)
PUSHJ P,SAVE
MOVE LPSA,X33
VALCH1 1,-2(P),STI1
STI2: MOVE 2,-1(P)
JSYS STI
JRST RESTR
STI1: MOVE 1,-2(P) ;USE LITERALLY
JRST STI2
HERE(RFCOC)
PUSHJ P,SAVE
MOVE LPSA,X44
VALCH1 1,-3(P),RFCO1
RFCO2: JSYS RFCOC
MOVEM 2,@-2(P)
MOVEM 3,@-1(P)
JRST RESTR
RFCO1: MOVE 1,-3(P) ;USE LITERALLY
JRST RFCO2
HERE(SFCOC)
PUSHJ P,SAVE
MOVE LPSA,X44
VALCH1 1,-3(P),SFCO1
SFCO2: MOVE 2,-2(P)
MOVE 3,-1(P)
JSYS SFCOC
JRST RESTR
SFCO1: MOVE 1,-3(P) ;USE LITERALLY
JRST SFCO2
HERE(GTTYP)
PUSHJ P,SAVE
MOVE LPSA,X33
VALCH1 1,-2(P),GTTYP1
GTTYP2: JSYS GTTYP
MOVEM 2,RACS+A(USER) ;TERMINAL TYPE NUMBER FOR RETURN
MOVEM 3,@-1(P) ;XWD INBUFS, OUTBUFS
JRST RESTR
GTTYP1: MOVE 1,-2(P) ;USE LITERALLY
JRST GTTYP2
HERE(STTYP)
PUSHJ P,SAVE
MOVE LPSA,X33
VALCH1 1,-2(P),STTYP1
STTYP2: MOVE 2,-1(P) ;NEW TERMINAL TYPE
JSYS STTYP
JRST RESTR
STTYP1: MOVE 1,-2(P) ;USE LITERALLY
JRST STTYP2
HERE(SETEDIT)
PUSHJ P,SAVE
MOVE LPSA,X33
VALCHN 1,-2(P),SETTT1
SKIPL 2,TTYINF(CDB) ;IS IT THE CONTROLLING TERMINAL?
JRST SETTT2 ;NO RETURN(0);
HRRZ 2,2 ;OLD VALUE
MOVE 2,["B"
"D"
"T"](2)
HRRZM 2,RACS+A(USER) ;RETURN OLD VALUE
MOVE 2,-1(P) ;NEW VALUE
CAIL 2,"a"
CAILE 2,"z"
JRST .+2
SUBI 2," " ;UPPER CASE
CAIN 2,"B"
JRST [MOVEI 2,TNXINP
JRST SETTT3]
CAIN 2,"D"
JRST [MOVEI 2,DECLED
JRST SETTT3]
CAIN 2,"T"
JRST [MOVEI 2,TENXED
JRST SETTT3]
ERR <SETEDIT: Buffering mode must be "B", "D" or "T">,1
MOVEI 2,TENXED ;ASSUME THIS FOR USER
SETTT3: HRRM 2,TTYINF(CDB)
JRST RESTR ;AND RETURN
SETTT1: ERR <SETEDIT: Channel argument must be a SAIL channel>,1
JRST RESTR
SETTT2: SETZM RACS+A(USER)
JRST RESTR
ENDCOM(TTM)
COMPIL(PAGES,<PMAP>,<SAVE,RESTR,X44>
,<PAGES -- PAGE MANAGEMENT>)
DSCR SIMPLE PROCEDURE PMAP(INTEGER AC1,AC2,AC3);
DESR
Does the PMAP jsys, with these parameters:
ARGUMENTS:
AC1 contents of AC1
AC2 " of AC2
AC3 " of AC3
⊗
HERE(PMAP)
PUSHJ P,SAVE
MOVE LPSA,X44
MOVE 1,-3(P) ;FILEPAGE
MOVE 2,-2(P) ;XWD FORK,PAGE
MOVE 3,-1(P) ;ACCESS BITS
JSYS PMAP
JRST RESTR
ENDCOM(PAGES)
COMPIL(TT2,<PBTIN,INTTY>
,<X22,.SKIP.,ZSETST,ZADJST,CTLOSW>
,<TT2 -- IMSSS TTY ROUTINES>)
DSCR INTEGER SIMPLE PROCEDURE PBTIN(INTEGER SECONDS);
DESR
Executes the PBTIN jsys, with timing of SECONDS.
⊗
HERE(PBTIN)
NOIMSSS<
ERR <PBTIN: Only defined at IMSSS>
>;NOIMSSS
SETZM CTLOSW ;PROGRAM REQUESTS INPUT
MOVE 1,-1(P) ;TIME IN SECONDS
JSYS PBTIN
SUB P,X22
JRST @2(P)
DSCR STRING SIMPLE PROCEDURE INTTY;
Using the PSTIN jsys, accepts as many as 200 characters from
the user's Teletype, with the standard system breakcharacters. The
breakcharacter itself is removed from the string, and
no timing is available.
⊗
IMSSS<
HERE(INTTY)
PUSH P,1
PUSH P,2
PUSH P,3
SETZB 3,CTLOSW ;PROGRAM REQUESTS INPUT
MOVEI 2,=200 ;DEFAULT LENGTH
INTT2: PUSH P,2 ;LENGTH
PUSHJ P,ZSETST ;GET BP IN 1
JSYS PSTIN
CAIL 2,=200 ;DID WE GET 200 CHARS?
JRST [SETOM .SKIP.
JRST INTT1]
LDB 3,1 ;GET THE LAST CHAR
MOVEM 3,.SKIP. ;AND SAVE IT
SOJ 1, ;BACK UP BYTE-POINTER (OVER LAST CHAR)
IBP 1
IBP 1
IBP 1
IBP 1
INTT1: PUSH P,[=200]
PUSH P,1
PUSHJ P,ZADJST ;GET STRING ON STACK
POP P,3
POP P,2
POP P,1
POPJ P, ;RETURN
>;IMSSS
NOIMSSS<;NON-IMSSS VERSION OF INTTY FOR THOSE WHO SUFFER
;UNDER BBN'S LACK OF A SYSTEM LINE EDITOR
DSCR INTTY
Simulation of the above routine, doing something
that looks like "TENEX" line editing.
⊗;
HERE(INTTY)
BEGIN INTTY
ORIGCNT←←=200
;AC USES A,B,C JSYS TEMPORARIES
; D BYTEPOINTER
; E COUNT, INITIALLY 0
; Q1 (=6) ORIGINAL BP
PUSHJ P,SAVE
SETZM CTLOSW
MOVEI A,101
JSYS RFMOD
PUSH P,B ;SAVE THE TTY MODE
TRO B,170000 ;WAKEUP ON EVERYTHING
JSYS SFMOD
PUSH P,[ORIGCNT] ;
PUSHJ P,ZSETST ;GET A GOOD BP IN A
MOVE Q1,A
RESTRT: MOVE D,Q1 ;GET THE ORIGINAL BP
SETZ E, ;ZERO THE COUNT
INLUP: CAIL E,ORIGCNT
JRST CNTEXH ;COUNT EXHAUSTED
INLU1: JSYS PBIN ;GET A CHAR
CAIN A,15 ;CARRIAGE RETURN?
JRST INLU1 ;YES, IGNORE
CAIN A,37 ;EOL?
MOVEI A,12 ;MAKE LINEFEED
CAIN A,12
JRST DONE ;IS A BREAK CHARACTER
CAIN A,33 ;ESCAPE?
JRST DONE
CAIE A,32 ;CTRL-Z
CAIN A,7 ;CTRL-G
JRST DONE
CAIE A,"R"-100 ;CTRL-R FOR REPEAT
JRST NOCTR
HRROI A,[ASCIZ/
/]
JSYS PSOUT
JUMPE E,INLUP
MOVEI A,101
MOVE B,Q1 ;ORIG BP
MOVN C,E ;COUNT THUS FAR
JSYS SOUT
JRST INLUP ;AND CONTINUE
NOCTR: CAIE A,"X"-100 ;CONTROL-X FOR DELETE LINE
JRST NOCTX
DOCTX: HRROI A,[ASCIZ/
/]
JSYS PSOUT
JRST RESTRT ;AND START ALL OVER
NOCTX: CAIE A,177 ;RUBOUT OR
CAIN A,"A"-100 ;CONTROL-A
JRST .+2
JRST NOCTA
JUMPLE E,DOCTX ;IF NO CHARS THEN DO A CONTROL-X
MOVEI A,"\"
JSYS PBOUT
LDB A,D ;LAST CHAR
JSYS PBOUT
MOVE A,D
JSYS BKJFN
JFCL
MOVEM A,D ;BACK UP BP
SOJA E,INLUP ;SUBTRACT 1 AND CONTINUE
NOCTA: IDPB A,D
AOJA E,INLUP ;ONE MORE CHAR
CNTEXH: SETO A, ;INDICATE NO COUNT
DONE: MOVEM A,.SKIP. ;BREAK CHAR, -1 FOR EXHAUSTED
PUSH P,[ORIGCNT]
PUSH P,D ;NEW BP
PUSHJ P,ZADJST ;FIX UP STRING SPACE, PUT STRING ON STACK
MOVEI A,101
POP P,B ;MODE SETTING
JSYS SFMOD ;RESET
MOVE LPSA,X11
JRST RESTR ;AND RETURN
BEND INTTY
>;NOIMSSS
ENDCOM(TT2)
COMMENT ⊗ TTY FUNCTIONS ⊗
DSCR TTY FUNCTIONS
CAL SAIL
⊗
Comment ⊗
INTEGER PROCEDURE INCHRW;
RETURN A CHAR FROM PBIN
INTEGER PROCEDURE INCHRS;
RETURN -1 IF NO CHAR WAITING, ELSE FIRST CHAR (SIBE FOLLOWED BY PBIN)
STRING PROCEDURE INCHWL;
WAIT FOR A LINE, THEN RETURN IT (PBINs, LINE EDITING)
STRING PROCEDURE INCHSL(REFERENCE INTEGER FLAG);
FLAG←-1, STR←NULL IF NO LINE, ELSE FLAG←0,
STR←LINE (SIBE, FOLLOWED BY PBINs)
STRING PROCEDURE INSTR(INTEGER BRCHAR);
RETURN ALL CHARS TO AND NOT INCLUDING BRCHAR (PBINs)
STRING PROCEDURE INSTRL(INTEGER BRCHAR);
WAIT FOR ONE LINE, THEN DO INSTR (PBINs WITH EDITING)
STRING PROCEDURE INSTRS(REFERENCE INTEGER FLAG; INTEGER BRCHAR);
FLAG←-1, STR←NULL IF NO LINES, ELSE FLAG←0,
STR←INSTR(BRCHAR)
PROCEDURE OUTCHR(INTEGER CHAR);
OUTPUT CHAR (PBOUT)
PROCEDURE OUTSTR(STRING STR);
OUTPUT STR (SOUT)
PROCEDURE CLRBUF;
CLEARS INPUT BUFFER (CFIBF)
TTYIN, TTYINS, TTYINL (TABLE, @BRCHAR);
TTYIN WORKS WITH TTCALL 0'S; TTYINS DOES A SKIP
ON LINE FIRST, RETURNING NULL AND -1 IN BREAK IF NO LINES
TTYINL DOES A WAIT FOR LINE FIRST.
FULL BREAKSET CAPABILITIES EXCEPT FOR
"R" MODE (AND OF COURSE, LINE NUM. STUFF)
TITLE TTYUUO
⊗
COMPIL(TTY,<PBIN,PBOUT,PSOUT,INCHRW,INCHRS,INCHWL,INCHSL,INSTR,OUTCHR,OUTSTR,INSTRL,INSTRS,CLRBUF,TTYIN,TTYINS,TTYINL,TTYUP
>
,<SAVE,RESTR,X11,X22,X33,INSET,CAT,STRNGC,GOGTAB,BRKMSK,.SKIP.,CTLOSW>
,<TELETYPE FUNCTIONS>)
;;#GF# DCS 2-1-72 (1-3) INCHWL BREAKS ON ALL ACTIVATION, TELLS WHICH IN .SKIP.
; .SKIP. EXTERNAL ABOVE
;;#GF#
HERE(PBIN)
HERE (INCHRW)
SETZM CTLOSW ;INPUT REQUESTED
INCHR1: JSYS PBIN
POPJ P,
HERE (INCHRS)
SETZM CTLOSW ;INPUT REQUESTED
MOVEI 1,100
JSYS SIBE
JRST INCHR1
SETO 1, ;RETURN -1
POPJ P,
HERE(PBOUT)
HERE (OUTCHR)
SKIPE CTLOSW ;DOING OUTPUT?
JRST OUTCRE ;NO
EXCH 1,-1(P) ;GET PARAMETER, SAVING AC 1
JSYS PBOUT ;OUTPUT CHAR
EXCH 1,-1(P) ;GET BACK 1
OUTCRE: SUB P,X22
JRST @2(P) ;RETURN
HERE(PSOUT)
HERE (OUTSTR)
SKIPE CTLOSW ;DOING OUTPUT?
JRST [SUB SP,X22
POPJ P,
]
EXCH 2,(SP) ;BP WORD
EXCH 3,-1(SP) ;LENGTH WORD
PUSH P,1 ;ALSO NEED 1
HRRZ 3,3 ;COUNT
JUMPE 3,NULSTR ;DONT SEND EMPTY STR
MOVEI 1,101 ;TERMINAL OUTPUT
MOVN 3,3
JSYS SOUT
NULSTR: POP P,1
POP SP,2
POP SP,3 ;ADJUSTS STACK AUTOMATICALLY
POPJ P, ;RETURN
;REDSTR (0) MARKS CTLOSW THAT INPUT WAS REQUESTED
;(1) PREPARES TO MAKE A STRING OF 200 CHARS,
;(2) ZEROS C FOR COUNT
;(3) SETS UP D WITH THE ORIGINAL BYTE-POINTER
REDSTR: SETZM CTLOSW ;INPUT REQUESTED
SKIPE SGLIGN(USER)
PUSHJ P,INSET
MOVEI A,=200
ADDM A,REMCHR(USER)
SKIPLE REMCHR(USER)
PUSHJ P,STRNGC
SETZ C, ;COUNT HERE
MOVE D,TOPBYTE(USER) ;ORIGINAL BYTE-POINTER, IF NEEDED
PUSH SP,[0] ;NULL STRING IF NOTHING DONE
PUSH SP,TOPBYTE(USER)
POPJ P,
FINSTR: MOVEI A,=200
SUB A,C ;NUMBER USED
ADDM A,REMCHR(USER)
HRROM C,-1(SP) ;STRING COUNT WORD
MOVEM D,TOPBYTE(USER) ;NEW TOPBYTE
JRST RESTR
;CALL TO HERE WITH A PUSHJ TO GET A CHAR IN AC1
;AC 3 HAS THE COUNT, D THE BYTE-POINTER
EDICHR:
JSYS PBIN ;GET A CHARACTER
CAIN 1,DELLINE ;DELETE LINE CHAR
JRST CTRLU
CAIN 1,RUBCHAR ;RUBOUT?
JRST RUBOUT
CAIN 1,37 ;PHONEY TENEX EOL?
MOVEI 1,12
CAIN 1,33 ;PHONEY TENEX ALTMODE?
MOVEI 1,ALTMODE ;DEC ALTMODE
POPJ P, ;GOOD CHAR FOR USER
CTRLU:
;AC 1 IS FREE
HRROI 1,[BYTE (7) 7,15,12,0,0]
JSYS PSOUT
JUMPE C,EDICHR ;IF NO CHARS THEN DO NOTHING
SETZ C,
MOVE D,TOPBYTE(USER)
JRST EDICHR
RUBOUT: JUMPE C,CTRLU ;IF NO CHARS THEN DO CTRLU
;AC 1 IS AVAILABLE
IMSSS<
MOVEI 1,101 ;PRIMARY OUTPUT
JSYS DELCH
JFCL
JRST DLTED ;DISPLAY -- LINE EMPTY
JRST DLTED ;DISPLAY -- DELETE DONE
>;IMSSS
MOVEI 1,"\"
JSYS PBOUT
LDB 1,D ;GET LAST CHAR
JSYS PBOUT ;AND SEND IT
DLTED:
SOJ D, ;BACK UP BP TO LAST CHAR
IBP D
IBP D
IBP D
IBP D
SOJA C,EDICHR ;AND GET ANOTHER CHAR
HERE(INSTRL)
HERE (INSTR)
PUSHJ P,SAVE
PUSHJ P,REDSTR
MOVE B,-1(P) ;BREAK CHAR
MOVE LPSA,X22 ;# TO REMOVE
INS1: CAIL C,=200 ;COUNT EXHAUSTED?
JRST FINSTR ;YES
INS2: PUSHJ P,EDICHR ;GET A CHAR IN 1, USING EDITING
CAMN 1,B ;BREAK?
JRST FINSTR ; YES, ALL DONE
IDPB 1,D ;PUT IT AWAY AND
AOJA C,INS1
HERE (INCHWL) PUSHJ P,SAVE
PUSHJ P,REDSTR
MOVE LPSA,X11
INS3: CAIL C,=200 ;COUNT EXHAUSTED?
JRST DNSTR1 ;YES
PUSHJ P,EDICHR ;GET A CHAR
CAIE 1,ALTMODE
CAIN 1,12
JRST DNSTR
CAIN 1,15 ;CR?
JRST INS3 ;IGNORE
IDPB 1,D ;PUT IT AWAY AND
AOJA C,INS3 ;NEXT CHARACTER
DNSTR: MOVEM 1,.SKIP. ;SET BREAK CHAR
JRST FINSTR
DNSTR1: SETOM .SKIP. ;INDICATE COUNT EXHAUSTED
JRST FINSTR
HERE (INCHSL) PUSHJ P,SAVE
MOVE LPSA,X22 ;PARAM (FLAG) AND RETURN
PUSHJ P,REDSTR
SETOM @-1(P) ;ASSUME FAILED
MOVEI 1,100 ;PRIMARY INPUT
JSYS SIBE ;CHARACTERS WAITING?
SKIPA ;YES
JRST FINSTR ;NO, FIX UP AND RETURN
SETZM @-1(P)
JRST INS3 ;AND USE INCHWL'S LOOP
HERE(INSTRS)
PUSHJ P,SAVE
MOVE LPSA,X33
PUSHJ P,REDSTR
SETOM @-2(P) ;ASSUME FAILED
MOVEI 1,100 ;RIMARY INPUT
JSYS SIBE ;CHARACTERS WAITING
SKIPA ;YES
JRST FINSTR ;NO, FIX UP AND RETURN
SETZM @-2(P) ;INDICATE SUCCESS
MOVE B,-1(P) ;GET BREAK CHARACTER
JRST INS2
HERE (CLRBUF)
PUSH P,1
MOVEI 1,100 ;PRIMARY INPUT
JSYS CFIBF ;CLEAR BUFFER
POP P,1
POPJ P,
HERE (TTYINS) PUSHJ P,SAVE
PUSHJ P,REDSTR ;PREPARE TO MAKE A STRING
MOVE LPSA,X33
SETOM @-1(P) ;ASSUME NO CHARS
MOVEI 1,100 ;PRIMARY INPUT
JSYS SIBE ;CHARS WAITING?
SKIPA ;YES
JRST FINSTR ;NONE WAITING
JRST TYIN1 ;GO AHEAD
HERE(TTYINL)
HERE (TTYIN) PUSHJ P,SAVE
TYIN: PUSHJ P,REDSTR ;PREPARE STACK,A,STRNGC FOR A STRING
MOVE LPSA,X33 ;PREPARE TO RETURN
TYIN1: SETZM @-1(P) ;ASSUME NO BREAK CHAR
MOVE X,-2(P) ;TABLE #
MOVEI TEMP,-1 ;BLOCK MUST BE THERE AND TABLE MUST BE INIT'ED
PUSHJ P,BKTCHK ;CHECK TABLE #
JRST FINSTR ;ERROR
MOVE FF,BRKMSK(CHNL) ;BITS FOR THIS TABLE
ADD CHNL,CDB ;RELOCATE RANGE 1 TO 18
MOVEI Z,1 ;FOR TESTING LINE NUMBERS
SKIPN LINTBL(CHNL) ;DON'T LET TEST SUCCEED IF
MOVEI Z,0 ;WE'RE TO LET LINE NUMBERS THRU
MOVE Y,CDB
ADD Y,[XWD 1,BRKTBL] ;BRKTBL+RLC(CDB)
TTYN: CAIL C,=200 ;COUNT EXCEEDED?
JRST FINSTR ;YES
PUSHJ P,EDICHR ;GET A CHAR
TTYN1: TDNE FF,@Y ;BREAK OR OMIT?
JRST TTYSPC ; YES, FIND OUT WHICH
TTYC: IDPB 1,D ;PUT IT AWAY
AOJA C,TTYN ;COUNT AND CONTINUE
JRST FINSTR ;DONE
TTYSPC: HLLZ TEMP,@Y ;WHICH?
TDNN TEMP,FF
JRST TTYN ;OMIT
MOVEM 1,@-1(P)
SKIPN Y,DSPTBL(CHNL) ;WHAT TO DO WITH IT
JRST FINSTR ;DONE, NO SAVE
JUMPL Y,TTYAPP ;APPEND
PUSH P,1 ;SAVE
MOVEI 1,100 ;PRIMARY INPUT
JSYS BKJFN
ERR <CAN'T RETAIN BREAK CHAR FROM TTYIN>,1
POP P,1
JRST FINSTR ;AND RETURN
TTYAPP: IDPB 1,D ;COUNT THE BREAK CHAR
ADDI C,1 ;ONE MORE HAPPY CHAR
JRST FINSTR
DSCR INTEGER PROCEDURE TTYUP(INTEGER NEWVALUE)
Using the RFMOD and SFMOD jsyses, sets lower-to-upper
case conversion to NEWVALUE, returning the oldvalue. Tests
and modifies bit 31 of the RFMOD word for the primary input
file.
⊗;
HERE(TTYUP)
PUSHJ P,SAVE
MOVE LPSA,X22 ;SET FOR RETURN
MOVEI A,101 ;PRIMARY INPUT FILE
JSYS RFMOD ;GET THE CURRENT SETTINGS
SETZ C, ;ASSUME NOT CURRENTLY SET
TRNE B,1B31 ;IS IT SET?
SETO C, ;IT WAS
MOVEM C,RACS+A(USER)
MOVE C,[TRO B,1B31] ;ASSUME WE WANT TO SET UP
SKIPN -1(P) ;DID WE REALLY?
MOVE C,[TRZ B,1B31] ;NO, DONT
XCT C
JSYS STPAR
JRST RESTR ;AND RETURN
ENDCOM(TTY)
COMPIL(PTY)
ENDCOM(PTY)
COMPIL(FIL,<FILNAM>,<FLSCAN,X22>,<FILNAM SCANNING ROUTINE>)
COMMENT ⊗Filnam ⊗
DSCR FILNAM
CAL PUSHJ
PAR file name string on SP stack
of form FILENAME<.EXT><[PROJ,PROG]>
RES FNAME(USER) : SIXBIT /filename/
EXT(USER): SIXBIT /extension,,0/
0
PRPN(USER): SIXBIT /PRJ PRG/ (or zero)
SID uses D,X,Y (4-6), REMOVES STRING FROM STACK
⊗
↑↑FILNAM:
SUB SP,X22 ;ADJUST STACK
FOR II←1,3 <
SETZM FNAME+II(USER)>
MOVEI X,FNAME(USER) ;WHERE TO PUT IT
PUSHJ P,FLSCAN ;GET FILE NAME
JUMPE Y,FLDUN ;FILE NAME ONLY
CAIE Y,"." ;EXTENSION?
JRST FLEXT ;NO, CHECK PPN
MOVEI X,FNAME+1(USER)
PUSHJ P,FLSCAN
FLEXT: JUMPE Y,FLDUN ;NO PPN SPECIFIED
CAIE Y,"["
JRST FLERR ;INVALID CHARACTER
PUSHJ P,[
RJUST: SETZM PROJ(USER)
MOVEI X,PROJ(USER)
PUSHJ P,FLSCAN ;GET PROJ OR PROG IN SIXBIT
IFN SIXSW,<
MOVE X,PROJ(USER)
IMULI D,-6 ;SHIFT FACTOR
LSH X,(D) ;RIGHT-JUSTIFY THE PROJ OR PROG
>;IF SIXSW (SET IN HEAD, USUALLY CONDITIONED ON NOEXPO)
IFE SIXSW,<
MOVEI X,0
;;#GT# DCS 5-11-72 ALLOW LARGE OCTAL NUMBERS AT STD DEC SYSTEMS
MOVE D,PROJ(USER) ;WAS A HLLZ
;;
FBACK: MOVEI C,0
LSHC C,6 ;GET A SIXBIT CHAR
CAIL C,'0'
CAILE C,'7'
JRST FLERR ;INVALID OCTAL
LSH X,3
IORI X,-'0'(C)
JUMPN D,FBACK
>;NOT SIXSW (USUALLY CONDITIONED ON EXPO)
FPOP: POPJ P,]
HRLZM X,FNAME+3(USER)
CAIE Y,","
JRST FLERR ;INVALID CHAR
PUSHJ P,RJUST ;JUSTIFY(AND CONVERT IF EXPORT) PROG #
HRRM X,FNAME+3(USER)
CAIN Y,"]"
FLDUN: AOS (P) ;SUCCESSFUL
FLERR: POPJ P, ;DONE, NOT NECESSARILY RIGHT
ENDCOM(FIL)
COMPIL(FLS,<FLSCAN>,,<FLSCAN ROUTINE>)
COMMENT ⊗Flscan ⊗
DSCR FLSCAN
CAL PUSHJ
PAR X -- addr of destination SIXBIT
1(SP), 2(SP) -- input string
RES sixbit for next filename, etc in word addressed by X
break (punctuation) char in Y (0 if string exhausted)
D,X, input string adjusted
SID only those AC changes listed above (Y, for instance)
⊗
↑↑FLSCAN:
HRRZS 1(SP) ;WANT ONLY LENGTH PART
MOVEI D,6 ;MAX NUMBER PICKED UP
SETZM (X) ;ZERO DESTINATION
HRLI X,440600 ;BYTE POINTER NOW
FLN1: MOVEI Y,0 ;ASSUME NO STRING LEFT
SOSGE 1(SP) ;TEST 0-LENGTH STRING
POPJ P,
ILDB Y,2(SP) ;GET BYTE
CAIE Y,"." ;CHECK VALID BREAK CHAR
CAIN Y,"["
POPJ P,
CAIE Y,"]"
CAIN Y,","
POPJ P,
JUMPE D,FLN1 ;NEED NO MORE CHARS
TRZN Y,100 ;MOVE 100 BIT TO 40 BIT
TRZA Y,40 ; TO CONVERT TO SIXBIT
TRO Y,40 ; (NO CHECKING)
IDPB Y,X ;PUT IT AWAY
SOJA D,FLN1 ;CONTINUE
ENDCOM(FLS)
COMPIL(CAS,<CSERR,LPRYER>,<GOGTAB>
,<CSERR, LPRYER -- SUPPORT ROUTINES>)
HERE(CSERR) MOVE USER,GOGTAB
POP P,UUO1(USER) ;STANDARD PLACE
ERR <CASE INDEX OVERFLOW, VALUE IS >,13
JRST @UUO1(USER) ;RETURN OK
HERE (LPRYER) ERR <DATUM OF ARRAY NOT THERE>,1
POPJ P,
ENDCOM(CAS)
IFN ALWAYS, <BEND IOSER>
DSCR BEND IOSER ⊗
>;TENX