perm filename IOSER.TNX[MEW,AIL] blob
sn#091935 filedate 1974-03-17 generic text, type T, neo UTF8
00100 COMMENT ⊗ VALID 00091 PAGES VERSION 17-1(1)
00200 RECORD PAGE DESCRIPTION
00300 00001 00001
00400 00011 00002 TENX<THE ENTIRE FILE IS FOR TENEX ONLY
00500 00016 00003 COMPIL(PAT,<OPEN,LOOKUP,ENTER,USETI,USETO,MTAPE,TENXFI,RELEASE,CLOSE,CLOSIN,CLOSO,GETCHAN,CVJFN,RENAME>
00600 00024 00004 DSCR PROCEDURE LOOKUP(INTEGER CHNL STRING FILE REFERENCE INTEGER FLAG)
00700 00028 00005 HERE(ENTER)
00800 00031 00006 DSCR
00900 00034 00007 DSCR PROCEDURE USETI,USETO(INTEGER CHANNEL,BLOCK)
01000 00036 00008 DSCR PROCEDURE CLOSE(INTEGER CHANNEL)
01100 00037 00009 HERE(RELEASE)
01200 00038 00010 DSCR
01300 00039 00011 DSCR STRING PROCEDURE TENXFI(STRING DECFILE)
01400 00043 00012 DSCR
01500 00045 00013 COMPIL(JOBINF,<ODTIM,IDTIM,RUNTM,GTAD,GJINF>,<ZSETST,ZADJST,X22,X33,X44,.SKIP.,CATCHR>
01600 00046 00014
01700 00047 00015 DSCR INTEGER SIMPLE PROCEDURE RUNTM(INTEGER FORK REFERENCE INTEGER CONSOLE)
01800 00048 00016 DSCR INTEGER SIMPLE PROCEDURE GTAD
01900 00049 00017 DSCR INTEGER SIMPLE PROCEDURE GJINF(REFERENCE INTEGER LOGDIR,CONDIR,TTYNO)
02000 00050 00018 ENDCOM(JOBINF)
02100 00051 00019 COMPIL(DIRECT,<STDIR,DIRST>,<X22,X33,CATCHR,ZSETST,ZADJST.SKIP.>
02200 00053 00020 DSCR STRING SIMPLE PROCEDURE DIRST(INTEGER I)
02300 00054 00021 COMPIL(RUNPRG,<RUNPRG>,<X22,X33,CATCHR>,<RUNPRG -- RUN A PROGRAM>)
02400 00059 00022 COMPIL(OPF,<OPENFILE,SETINPUT,SETPL,INDEXFILE>,<.SKIP.>,<OPENFILE -- OPEN A FILE>)
02500 00067 00023 DSCR PROCEDURE SETINPUT(INTEGER CHAN REFERENCE INTEGER COUNT,BR,EOF)
02600 00068 00024 DSCR
02700 00070 00025 DSCR
02800 00072 00026 COMPIL(GTJFN,<GTJFN>,<.SKIP.,SETCHN,CATCHR,X22>,<GTJFN -- GET A JFN>)
02900 00074 00027 COMPIL(FILINF,<GNJFN,DELF,UNDELETE,SIZEF,JFNS,OPENF,CFILE,CLOSF,RLJFN,GTSTS,STSTS,RNAMF>
03000 00076 00028 DSCR PROCEDURE DELF(INTEGER CHAN)
03100 00077 00029 DSCR PROCEDURE UNDELETE(INTEGER CHAN)
03200 00078 00030 DSCR INTEGER PROCEDURE SIZEF(INTEGER JFN)
03300 00079 00031
03400 00080 00032 DSCR SIMPLE PROCEDURE OPENF(INTEGER JFN,FLAGS)
03500 00082 00033
03600 00086 00034 DSCR SIMPLE PROCEDURE CLOSF(INTEGER JFN)
03700 00088 00035 DSCR SIMPLE PROCEDURE RLJFN(INTEGER JFN)
03800 00089 00036 DSCR INTEGER SIMPLE PROCEDURE GTSTS(INTEGER JFN)
03900 00090 00037 DSCR BOOLEAN SIMPLE PROCEDURE STSTS(INTEGER JFN,STATUS)
04000 00091 00038 DSCR BOOLEAN SIMPLE PROCEDURE RNAMF(INTEGER EXISTINGJFN,NEWJFN)
04100 00092 00039 COMPIL(DEVINF,<CNDIR,ASND,RELD,GDSTS,SDSTS,STDEV,DEVST>
04200 00094 00040 DSCR BOOLEAN PROCEDURE ASND(INTEGER DEVICE)
04300 00095 00041 DSCR BOOLEAN PROCEDURE RELD(INTEGER DEVICE)
04400 00096 00042 DSCR INTEGER SIMPLE PROCEDURE GDSTS(INTEGER CHAN REFERENCE INTEGER WORDCNT)
04500 00097 00043 DSCR PROCEDURE SDSTS(INTEGER JFN,NEWSTATUS)
04600 00098 00044 DSCR INTEGER PROCEDURE STDEV(STRING S)
04700 00099 00045
04800 00100 00046
04900 00101 00047 COMPIL(FIO,<OUT,CHAROUT,LINOUT,GTFDB>
05000 00104 00048 DSCR PROCEDURE LINOUT(INTEGER JFN,VALUE)
05100 00106 00049 DSCR STRSND,STRSN0
05200 00111 00050 DSCR SIMPLE PROCEDURE GTFDB(INTEGER JFN REFERENCE INTEGER ARRAY BUF)
05300 00112 00051 COMPIL(BINROU,<WORDIN,WORDOUT,ARRYIN,ARRYOUT,MTOPR,SFPTR,RFPTR,BKJFN,RFBSZ>
05400 00114 00052 DSCR SIMPLE PROCEDURE WORDOUT(INTEGER JFN,BYTE)
05500 00115 00053 DSCR SIMPLE PROCEDURE ARRYIN(INTEGER JFN REFERENCE INTEGER LOC INTEGER COUNT)
05600 00118 00054 DSCR SIMPLE PROCEDURE ARRYOUT(INTEGER JFN REFERENCE INTEGER LOC INTEGER COUNT)
05700 00120 00055 DSCR SIMPLE PROCEDURE MTOPR(INTEGER JFN,FUNCTION,VALUE)
05800 00121 00056 DSCR SIMPLE PROCEDURE SFPTR(INTEGER JFN,POINTER)
05900 00122 00057 DSCR INTEGER SIMPLE PROCEDURE RFPTR(INTEGER JFN)
06000 00123 00058 DSCR SIMPLE PROCEDURE BKJFN(INTEGER JFN)
06100 00124 00059 DSCR INTEGER SIMPLE PROCEDURE RFBSZ(INTEGER JFN)
06200 00125 00060 IMSSS,<
06300 00127 00061 DSCR SIMPLE PROCEDURE
06400 00128 00062 COMPIL(DEVS,<DEVTYPE,DVCHR,ERSTR>
06500 00129 00063 DSCR INTEGER SIMPLE PROCEDURE DVCHR(INTEGER JFN REFERENCE INTEGER AC1,AC3)
06600 00130 00064 DSCR SIMPLE PROCEDURE ERSTR(INTEGER ERRNO,FORK)
06700 00132 00065 COMPIL(UTILITY,<SETCHN,ZSETST,ZADJST,.RESET>
06800 00137 00066 DSCR STRING SIMPLE PROCEDURE ZADJST(INTEGER CNTEST,BP)
06900 00140 00067 DSCR
07000 00144 00068 COMPIL(TTM,<RFMOD,SFMOD,RFCOC,SFCOC>
07100 00146 00069 COMPIL(PAGES,<PMAP>,<SAVE,RESTR,X44>
07200 00147 00070 IMSSS,<
07300 00148 00071 DSCR STRING SIMPLE PROCEDURE INTTY
07400 00150 00072 NOIMSSS<NON-IMSSS VERSION OF INTTY FOR THOSE WHO SUFFER
07500 00154 00073 TTY FUNCTIONS
07600 00157 00074 HERE(PBIN)
07700 00167 00075 Filnam
07800 00170 00076 Flscan
07900 00172 00077 COMPIL(INP,<INPUT,CHARIN,SINI>
08000 00175 00078 DSCR STRING SIMPLE PROCEDURE SINI(INTEGER JFN,MAXLENGTH,BRKCHAR)
08100 00179 00079 Input
08200 00185 00080 BACKUP, DOINP TO BACKUP JFN, DO INPUT.
08300 00196 00081 Realin, Realscan
08400 00198 00082 Intin, Intscan
08500 00200 00083 DSCR NUMIN
08600 00203 00084 NUMIN -- CONTD.
08700 00207 00085 SCAN (CALLED BY NUMIN AND STRIN)
08800 00211 00086 Character table for SCAN (Realscan,Intscan,Realin,Intin)
08900 00213 00087 DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
09000 00214 00088 COMPIL(STDBRK,<STDBRK>,<SAVE,RESTR,GOGTAB,X22>
09100 00215 00089
09200 00216 00090
09300 00217 00091
09400 00218 ENDMK
09500 ⊗;
00100 TENX<;THE ENTIRE FILE IS FOR TENEX ONLY
00200 COMMENT ⊗ TENEX-IOSER -- R. SMITH ⊗
00300 LSTON (IOSER)
00400
00500
00600 IFN ALWAYS, <BEGIN IOSER>
00700
00800 COMMENT ⊗ INDICES, BITS FOR TENEX VERSION OF IOSER ⊗
00900
01000
01100 ;WORDS IN CDB BLOCK FOR EACH CHANNEL
01200
01300
01400 ?GFL←←0 ;FLAGS FOR GTJFN
01500 ?OFL←←1 ;FLAGS FOR OPENF
01600 ?BRCHAR←←2 ;BRCHAR ADDRESS
01700 ?ICOUNT←←3 ;COUNT ADDRESS
01800 ?ENDFL←←4 ;EOF ADDRESS
01900 ?ICOWNT←←5 ;INPUT COUNT
02000 ?IBP←←6 ;INPUT BYTE-POINTER
02100 ?OCNT←←7 ;OUTPUT COUNT
02200 ?OBP←←10 ;OUTPUT BYTE-POINTER
02300 ?DVTYP←←11 ;DEVICE TYPE
02400 ?DVDSG←←12 ;DEVICE DESIGNATOR
02500 ?OPNDUN←←13 ;TRUE IF OPENED WITH THE OPEN STATEMENT
02600 ?DVCH←←14 ;DEVICE CHARACTERISTICS
02700 ?DMPED←←15 ;TRUE IF DUMP MODE OUTPUT SEEN
02800 ;IN PARTICULAR USED TO NOTE IF A MAGTAPE
02900 ;HAS BEEN WRITTEN BUT NOT YET CLOSED,
03000 ;SINCE EOF'S ARE WRITTEN AT THE CLOSE
03100 ;BY CLOSF,CFILE,CLOSE,ETC.
03200 ?LINNUM←←16 ;LINE NO (FOR INPUT FUNCTION)
03300 ?PAGNUM←←17 ;PAGE NO (FOR INPUT FUNCTION)
03400 ?SOSNUM←←20 ;SOS LINE NO (FOR INPUT FUNCTION)
03500 ?DECCLZ←←21 ;TRUE IF DEC-STYLE CLOSE JUST SEEN
03600
03700 ?IOTLEN←←22 ;CURRENT LENGTH OF CDB BLOCK
03800
03900 IFNDEF JFNSIZE, <?JFNSIZE←←20> ;NUMBER OF CHANNELS ALLOWED
04000 ?DMOCNT←←200 ;(DEFAULT) COUNT FOR DUMP MODE OUTPUT
04100 IFNDEF STARTPAGE,<?STARTPAGE←←610 ;STARTING PAGE FOR BUFFERS>
04200
04300 ;BITS FOR SCAN FLAGS FOR OPENFILE ROUTINE
04400 ;THE BITS OF THE FLAGS WORD ARE THE SAME AS THE BITS OF GTJFN AND OPENF
04500 ;HOPEFULLY (WHERE APPLICABLE)
04600
04700 ?STARBIT←←1B11 ;B11 OF GTJFN FOR INDEXED FILES
04800 ?TEMBIT←←1B5 ;B5 OF GTJFN FOR TEMPORARY FILE
04900 ?DELBIT←←1B8 ;GTJFN -- IGNORE DELETED BIT
05000 ?RDBIT←←1B19 ;B19 OF OPENF FOR READING
05100 ?WRBIT←←1B20 ;B20 OF OPENF FOR WRITING
05200 ?APPBIT←←1B22 ;B22 OF OPENF FOR APPEND
05300 ?CONFB1←←1B3 ;GTJFN BIT TO PRINT [CONFIRM] ETC
05400 ?CONFB2←←1B4 ;GTJFN BIT TO REQUIRE CONFIRMATION FROM USER
05500 ;ODDLY ENOUGH 3 AND 4 ARE ILLEGAL
05600 ?OUTBIT←←1B0 ;GTJFN -- FILE FOR OUTPUT USE
05700 ?OLDBIT←←1B2 ;GTJFN -- OLD FILE
05800 ?NEWBIT←←1B1 ;GTJFN -- NEW FILE
05900 ?ERTNBIT←←1B27 ;ERROR RETURN BIT -- INTERNAL
06000 ?BINBIT←←1B26 ;BINARY BIT -- INTERNAL
06100 ?THAWBIT←←1B25 ;THAWBIT GTJFN
06200 ?ERSNBIT←←1B28 ;ERROR SEEN -- INTERNAL
06300 ?CONFBIT←←1B29 ;CONFIRMATION -- INTERNAL
06400
06500 ;MACROS FOR BIT TESTING
06600
06700 DEFINE .ZZZ $ (X,Y,Z)<
06800 IFN Z&777777000000, <TL$X Y,Z⊗-=18> ;Z LSH -=18
06900 IFN Z&777777, <TR$X Y,Z>
07000 >
07100
07200 DEFINE TESTE (Y,Z) <.ZZZ NE,Y,Z> ;TDNE Y,[Z]
07300 DEFINE TESTN (Y,Z) <.ZZZ NN,Y,Z> ;TDNN Y,[Z]
07400 DEFINE TESTO (Y,Z) <.ZZZ O,Y,Z> ;TDO Y,[Z]
07500 DEFINE TESTZ (Y,W) <.ZZZ Z,Y,W> ;TDZ Y,[Z]
07600
07700
07800 ;MACRO TO GET THE JFN NUMBER IN X FROM Y. IF INVALID, JUMP TO LABEL Z
07900 ;LOADS CDB (I.E., 11) WITH THE CDB ADDRESS
08000 ;LOADS CHNL WITH THE CHANNEL NUMBER
08100 DEFINE VALCHN(X,Y,Z) <
08200
08300 SKIPL CHNL,Y
08400 CAIL CHNL,JFNSIZE
08500 JRST Z
08600 MOVE CDB,CDBTBL(CHNL)
08700 HRRZ X,JFNTBL(CHNL)
08800 SKIPN X
08900 JRST Z
09000 >
09100
09200 ;ONLY USES AC X
09300 DEFINE VALCH1(X,Y,Z) <
09400 SKIPL X,Y
09500 CAIL X,JFNSIZE
09600 JRST Z
09700 HRRZ X,JFNTBL(X)
09800 SKIPN X
09900 JRST Z
10000 >
10100
10200 ;TTY STUFF
10300 ;CHAR FOR LINE DELETION (DELLINE) AND CHARACTER DELETION (RUBCHAR)
10400 IFNDEF DELLINE,<?DELLINE←←"U"-100> ;CTRL-U
10500 IFNDEF RUBCHAR,<?RUBCHAR←←177> ;RUBOUT
10600 ?ALTMODE←←175 ;ONE OF MANY VERSIONS OF ALTMODE
10700
10800
00100 COMPIL(PAT,<OPEN,LOOKUP,ENTER,USETI,USETO,MTAPE,TENXFI,RELEASE,CLOSE,CLOSIN,CLOSO,GETCHAN,CVJFN,RENAME>
00200 ,<SAVE,RESTR,RELEASE,CORGET,INSET>
00300 ,<PAT -- TENEX ROUTINES EMULATING DEC CALLS>)
00400
00500 BEGIN PAT
00600
00700 DSCR PROCEDURE OPEN(INTEGER CHAN; STRING DEV; INTEGER MODE,IBUF,OBUF;
00800 REFERENCE INTEGER COUNT,BR,EOF)
00900 ⊗
01000 HERE(OPEN)
01100 BEGIN OPEN
01200 GTFLAGS←←4
01300 OPFLAGS←←5
01400 PUSH P,-7(P)
01500 PUSH P,[0] ;CLOSE INHIBIT
01600 PUSHJ P,RELEASE ;RELEASE IF ALREADY OPEN
01700
01800 ;SEE WHAT KIND OF DEVICE WE HAVE
01900
02000 PUSH SP,-1(SP)
02100 PUSH SP,-1(SP)
02200 PUSH P,[0]
02300 PUSHJ P,CATCHR ;PUT ON A NULL CHAR
02400 PUSHJ P,MAKUP ;MAKE UPPER CASE (DAMMIT)
02500 PUSH SP,-3(SP)
02600 PUSH SP,-3(SP)
02700 PUSH SP,[3]
02800 PUSH SP,[POINT 7,[ASCIZ/:
02900 /]]
03000 PUSHJ P,CAT ;PUT ON A STRING
03100 POP SP,-4(SP)
03200 POP SP,-4(SP) ;SAVE ABOVE
03300
03400 PUSHJ P,SAVE ;NOW SAVE ACS
03500 SETZ LPSA, ;NO PARAMETERS TO REMOVE
03600 MOVE CHNL,-7(P) ;USER CHANNEL NUMBER
03700 MOVE 1,(SP) ;STRING FOR DEVICE
03800 SUB SP,X22 ;ADJUST STACK
03900 JSYS STDEV
04000 JRST BADOPN ;NOT A PLAUSIBLE DEVICE
04100 PUSH P,2 ;SAVE DEVICE DESIGNATOR
04200 ;ITS A PLAUSIBLE DEVICE
04300 MOVEI C,IOTLEN
04400 PUSHJ P,CORGET
04500 ERR <OPEN: CANNOT GET CORE>
04600 MOVE CDB,B ;IO BLOCK ADDRESS
04700 MOVEM CDB,CDBTBL(CHNL) ;SAVE
04800 ;ZERO OUT CORE (SINCE CORGET DOESNT!!!)
04900 HRL B,B
05000 ADDI B,1
05100 SETZM (CDB)
05200 BLT B,IOTLEN-1(CDB)
05300
05400 POP P,1 ;GET DEVICE DESIGNATOR
05500 MOVEM 1,DVDSG(CDB) ;AND SAVE IT
05600 JSYS DVCHR
05700 MOVEM 2,DVCH(CDB) ;SAVE DEVICE CHARACTERISTICS
05800 HLRZ 1,2
05900 ANDI 1,777 ;DEVICE TYPE
06000 MOVEM 1,DVTYP(CDB) ;SAVE IT
06100 TLNN 2,100000 ;IS DEVICE A DIRECTORY DEVICE
06200 JRST GTNOW ;NOPE, DO GTJFN AND OPENF NO
06300 HASDIR:
06400 ;GET THE MODE IN 4
06500 MOVE 4,-6(P) ;MODE
06600 ANDI 4,17 ;FORGET OTHER JUNK
06700 ;IF DEVICE IS A DECTAPE IN DUMP MODE THEN DO IT NOW ALSO
06800 CAIE 1,3 ;IS IT A DECTAPE?
06900 JRST HASDI1 ;NO
07000 CAIN 4,17 ;IN DUMP MODE?
07100 JRST DOMNT ;YES MOUNT AND THEN OPEN
07200 ;SO DONT DO GTJFN NOW, BUT WAIT
07300 HASDI1: SETZM JFNTBL(CHNL) ;BE SURE
07400 MOVEM 4,GFL(CDB) ;SAVE THE MODE AS THE GTJFN FLAGS
07500 HRL 4,-5(P) ;INPUT BUFFERS
07600 HRR 4,-4(P) ;OUTPUT BUFFERS
07700 MOVEM 4,OFL(CDB) ;SAVE AS THE OPENF FLAGS
07800 JRST GUDRET ;AND RETURN
07900
08000 ;MOUNT AND OPEN DECTAPE IN DUMP MODE
08100 DOMNT: MOVE A,DVDSG(CDB) ;GET DEVICE DESIGNATOR
08200 TLO A,(1B3) ;DONT READ DIRECTORY FOR DUMP MODE
08300 JSYS MOUNT
08400 JRST BADOPN ;CANNOT MOUNT
08500 MOVSI GTFLAGS,100001
08600 MOVE 1,GTFLAGS
08700 MOVE 2,(SP)
08800 JSYS GTJFN
08900 JRST BADOPN
09000 MOVEM 1,JFNTBL(CHNL)
09100 MOVEM GTFLAGS,GFL(CDB)
09200 MOVE OPFLAGS,[447400000000!RDBIT!WRBIT]
09300 MOVE 2,OPFLAGS
09400 JSYS OPENF
09500 JRST CNTOPN
09600 JRST OPOK
09700
09800 GTNOW:
09900 MOVSI GTFLAGS,100001
10000 MOVE 1,GTFLAGS
10100 MOVE 2,(SP) ;DEVICE STRING
10200 JSYS GTJFN
10300 JRST BADOPN ;NOPE CANNOT GET
10400 MOVEM 1,JFNTBL(CHNL) ;SAVE JFN
10500 MOVEM GTFLAGS,GFL(CDB) ;AND SAVE THEM
10600 ;COMPUTE OPENF FLAGS
10700 SETZ OPFLAGS,
10800 MOVE 2,DVCH(CDB) ;DEVICE CHARACTERISTICS
10900 TESTE 2,<1B1> ;CAN DO INPUT?
11000 TESTO OPFLAGS,RDBIT
11100 TESTE 2,<1B0> ;CAN DO OUTPUT?
11200 TESTO OPFLAGS,WRBIT
11300 MOVE 1,DVTYP(CDB) ;CHECK DEVICE TYPE
11400 CAIN 1,12 ;IS IT A TTY?
11500 JRST OP7BT ;USE 7 BIT BYTES
11600 ;NOW TRY VARIOUS THINGS, LOOKING FOR SOMETHING THAT WORKS
11700
11800 HRRZ 1,JFNTBL(CHNL)
11900 HRLI OPFLAGS,440000
12000 MOVE 2,OPFLAGS ;36-BIT, MODE 0
12100 JSYS OPENF
12200 SKIPA
12300 JRST OPOK
12400 HRRZ 1,JFNTBL(CHNL)
12500 HRLI OPFLAGS,447400 ;36-BIT, MODE 17
12600 MOVE 2,OPFLAGS
12700 JSYS OPENF
12800 SKIPA
12900 JRST OPOK
13000 OP7BT: HRRZ 1,JFNTBL(CHNL)
13100 HRLI OPFLAGS,70000 ;7-BIT, MODE 0
13200 MOVE 2,OPFLAGS
13300 JSYS OPENF
13400 JRST NOOPN
13500 OPOK: MOVEM OPFLAGS,OFL(CDB) ;SAVE OP FLAGS
13600 GUDRET:
13700 ;SAVE FLAGS
13800 SETOM OPNDUN(CDB) ;INDICATE OPENED WITH OPEN
13900 POP P,TEMP ;RETURN ADDRESS
14000 POP P,ENDFL(CDB) ;SAVE GOOD THINGS
14100 POP P,BRCHAR(CDB)
14200 POP P,ICOUNT(CDB)
14300 SETZM @ENDFL(CDB) ;INDICATE GOOD OPENING
14400 SUB SP,X22 ;CLEAN UP STACKS
14500 SUB P,X44
14600 JRST RESTR ;AND RETURN
14700
14800
14900 NOOPN:
15000 CNTOPN: SKIPN 1,JFNTBL(CHNL) ;RELEASE JFN
15100 JSYS RLJFN
15200 JFCL
15300 BADOPN:
15400 SKIPE B,CDBTBL(CHNL) ;CORE ALLOCATED?
15500 PUSHJ P,CORREL ;RELEASE CORE
15600 SETZM JFNTBL(CHNL)
15700 SETZM CDBTBL(CHNL)
15800 SKIPN @-1(P) ;USER WANTS ERROR?
15900 ERR <OPEN: IO ERROR OR ILLEGAL SPECIFICATIONS>,1
16000 SETOM @-1(P)
16100 POP P,TEMP
16200 SUB P,[XWD 7,7]
16300 SUB SP,X22
16400 JRST RESTR
16500
16600
16700
16800
16900 BEND OPEN
17000
17100 ;MAKE UPPER CASE LETTERS
17200 MAKUP: PUSHJ P,SAVE
17300 SKIPE SGLIGN(USER)
17400 PUSHJ P,INSET
17500 HRRZ A,-1(SP) ;LENGTH OF STRING
17600 ADDM A,REMCHR(USER)
17700 SKIPLE REMCHR(USER) ;OK?
17800 PUSHJ P,STRNGC ;NO, COLLECT
17900 MOVE B,A
18000 HRRO A,A
18100 PUSH SP,A
18200 PUSH SP,TOPBYTE(USER)
18300 UPPER1: JUMPLE B,UPPER2 ;DONE YET?
18400 ILDB C,-2(SP) ;NEXT CHAR
18500 CAIL C,141
18600 CAILE C,172
18700 SKIPA
18800 SUBI C,40 ;CONVERT TO UPPER CASE
18900 IDPB C,TOPBYTE(USER)
19000 SOJA B,UPPER1
19100 UPPER2: POP SP,-2(SP)
19200 POP SP,-2(SP)
19300 SETZ LPSA,
19400 POP P,TEMP ;RETURN ADDR
19500 JRST RESTR ;RETURN
19600
00100 DSCR PROCEDURE LOOKUP(INTEGER CHNL; STRING FILE; REFERENCE INTEGER FLAG)
00200
00300 ⊗
00400
00500 HERE(LOOKUP)
00600 BEGIN LOOKUP
00700 PUSHJ P,TENXFI ;MAKE THE FILE SPEC TENEX
00800
00900 PUSH P,1
01000 PUSH P,2
01100 PUSH P,3
01200 PUSH P,CHNL
01300 PUSH P,CDB
01400 DEFINE CHNARG <-7(P)>
01500 DEFINE FLGARG <-6(P)>
01600
01700
01800 SKIPL CHNL,CHNARG
01900 CAIL CHNL,JFNSIZE
02000 JRST BADLU1
02100 MOVE CDB,CDBTBL(CHNL)
02200 SKIPN OPNDUN(CDB) ;ERROR IF NOT OPENED
02300 JRST BADLU1
02400 MOVE 2,DVCH(CDB) ;GET DEVICE CHARACTERISTICS
02500 TLNN 2,100000 ;DOES DEVICE HAVE A DIRECTORY?
02600 JRST LUKRET ;NO, NO LOOKUP
02700 SKIPE JFNTBL(CHNL) ;JFN ALREADY ASSIGNED?
02800 PUSHJ P,RELNOW ;YES, RELEASE IT
02900
03000 PUSHJ P,DEVCAT
03100
03200 MOVSI 1,100001 ;OLD FILE
03300 MOVE 2,(SP)
03400 JSYS GTJFN
03500 JRST BADLUK
03600 MOVEM 1,JFNTBL(CHNL)
03700 MOVSI 3,100001
03800 MOVEM 3,GFL(CDB)
03900 MOVE 2,[XWD 440000,200000] ;36-BIT
04000 JSYS OPENF
04100 SKIPA
04200 JRST GUDLUK
04300 MOVE 1,JFNTBL(CHNL)
04400 MOVE 2,[XWD 447400,200000] ;36-BIT, DUMP
04500 JSYS OPENF
04600 SKIPA
04700 JRST GUDLUK
04800 MOVE 1,JFNTBL(CHNL)
04900 MOVE 2,[XWD 70000,200000] ;7-BIT
05000 JSYS OPENF
05100 JRST BADLUK
05200 GUDLUK: MOVEM 2,OFL(CDB)
05300 SETZM @FLGARG
05400 LUKRET: POP P,CDB
05500 POP P,CHNL
05600 POP P,3
05700 POP P,2
05800 POP P,1
05900 SUB SP,X22
06000 SUB P,X33
06100 JRST @3(P)
06200
06300 BADLUK: MOVEM 1,@FLGARG
06400 JRST LUKRET
06500
06600 BADLU1: SETOM @FLGARG
06700 JRST LUKRET
06800
06900
07000 BEND LOOKUP
07100
07200 DEVCAT:
07300 ;HERE WITH CDB LOADED, FILENAME ON THE SP STACK
07400 ;RETURN WITH "DEV:FILE" & 0 ON THE SP STACK
07500 ;MUST NOT HAVE CALLED SAVE WHEN THIS IS CALLED
07600 PUSH P,1
07700 PUSH P,2
07800 PUSH P,[=100]
07900 PUSHJ P,ZSETST ;BP IN 1
08000 MOVE 2,DVDSG(CDB) ;DEVICE DESIGNATOR
08100 JSYS DEVST
08200 ERR <LOOKUP, ENTER, OR RENAME: CANNOT DO DEVST>
08300 PUSH P,[=100]
08400 PUSH P,1 ;UPDATED BP
08500 PUSHJ P,ZADJST
08600 PUSH P,[":"]
08700 PUSHJ P,CATCHR
08800 PUSHJ P,CAT.RV
08900 PUSH P,[0]
09000 PUSHJ P,CATCHR
09100 POP P,2
09200 POP P,1
09300 POPJ P,
09400
09500 ;RELEASE JFN ALREADY THERE
09600 RELNOW:
09700 PUSH P,CHNL ;CHANNEL
09800 PUSHJ P,CLOSF ;CLOSE DANCE
09900 PUSH P,1
10000 MOVE 1,JFNTBL(CHNL) ;GET JFN
10100 JSYS RLJFN ;RELEASE
10200 ERR <CANNOT RELEASE JFN>,1
10300 SETZM JFNTBL(CHNL) ;AND ZERO OUT
10400 SETZM DECCLZ(CDB) ;NO CLOSE DONE
10500 POP P,1
10600 POPJ P,
10700
10800
00100 HERE(ENTER)
00200 BEGIN ENTER
00300
00400 PUSHJ P,TENXFI
00500
00600 PUSH P,1
00700 PUSH P,2
00800 PUSH P,3
00900 PUSH P,CHNL
01000 PUSH P,CDB
01100 DEFINE CHNARG <-7(P)>
01200 DEFINE FLGARG <-6(P)>
01300
01400 SKIPL CHNL,CHNARG
01500 CAIL CHNL,JFNSIZE
01600 JRST BADEN1
01700 MOVE CDB,CDBTBL(CHNL)
01800 SKIPN OPNDUN(CDB)
01900 JRST BADEN1 ;WAS AN OPEN PERFORMED HERE?
02000 SKIPN 1,JFNTBL(CHNL)
02100 JRST NOTOPN
02200 MOVE 2,DVCH(CDB) ;GET DEVICE CHARACTERISTICS
02300 TLNN 2,100000 ;DOES DEVICE HAVE DIRECTORY?
02400 JRST ENTRET ;NO
02500
02600 SKIPE DECCLZ(CDB) ;A DEC-STYLE CLOSE DONE?
02700 JRST [PUSHJ P,RELNOW ;RELEASE JFN
02800 JRST NOTOPN ;AND PROCEED
02900 ]
03000 PUSH P,1 ;SAVE JFN
03100 JSYS CLOSF
03200 JFCL ;IGNORE
03300 POP P,1
03400 MOVE 2,OFL(CDB)
03500 TESTO 2,WRBIT ;TURN ON WRITE BIT
03600 MOVEM 2,OFL(CDB) ;AND SAVE NEW FLAGS
03700 JSYS OPENF
03800 JRST BADENT ;ERROR IN 1
03900 JRST ENTRET ;RETURN
04000
04100 NOTOPN:
04200 PUSHJ P,DEVCAT
04300
04400 MOVSI 1,600001 ;NEW FILE
04500 MOVE 2,(SP)
04600 JSYS GTJFN
04700 JRST BADENT ;CANNOT GTJFN
04800 MOVEM 1,JFNTBL(CHNL)
04900 MOVSI 2,600001 ;THE
05000 MOVEM 2,GFL(CDB) ;SAVE THE GTJFN FLAGS
05100 B36: HRRZ 1,JFNTBL(CHNL)
05200 MOVE 2,[XWD 440000,100000] ;36-BIT
05300 JSYS OPENF
05400 SKIPA
05500 JRST ENT1
05600 HRRZ 1,JFNTBL(CHNL)
05700 MOVE 2,[XWD 447400,100000] ;36-BIT, DUMP
05800 JSYS OPENF
05900 SKIPA
06000 JRST ENT1
06100 HRRZ 1,JFNTBL(CHNL)
06200 MOVE 2,[XWD 70000,100000]
06300 JSYS OPENF
06400 JRST BADENT
06500 ENT1: MOVEM 2,OFL(CDB)
06600 ENTRET: SETZM @FLGARG
06700 ENTPOP: POP P,CDB
06800 POP P,CHNL
06900 POP P,3
07000 POP P,2
07100 POP P,1
07200 SUB SP,X22
07300 SUB P,X33
07400 JRST @3(P)
07500
07600
07700 BADENT: MOVEM 1,@FLGARG
07800 JRST ENTPOP
07900
08000 BADEN1: SETOM @FLGARG
08100 JRST ENTPOP
08200
08300 BEND ENTER
08400
00100 DSCR
00200 RENAME(CHNL,"STR",PROT,@FLAG)
00300 Since protection is not implemented in TENEX,
00400 the feature will be ignored.
00500 ⊗
00600
00700 HERE(RENAME)
00800 BEGIN RENAME
00900 PUSH P,1
01000 PUSH P,2
01100 PUSH P,3
01200 PUSH P,CHNL
01300 PUSH P,CDB
01400 DEFINE CHNARG <-10(p)>
01500 DEFINE FLGARG <-6(P)>
01600
01700 VALCHN 1,CHNARG,RENBAD
01800 PUSHJ P,OPNCHK ;MAKE SURE OPEN (SOMEWHAT REDUNDANT)
01900 MOVE 2,DVCH(CDB) ;DEVICE CHARS
02000 TLNN 2,100000 ;DIRECTORY DEVICE?
02100 JRST RENRET ;NO, NOP
02200
02300 PUSHJ P,TENXFI ;MAKE A TENEX FILE NAME
02400
02500 ;PERHAPS ONLY A DELETE?
02600 HRRZ 2,-1(SP) ;NULL FILE SPEC?
02700 JUMPE 2,RENDEL ;YES, DELETE
02800
02900 ;ACTUALLY RENAME (ON THE SAME DEVICE)
03000 PUSH P,CHNARG
03100 PUSHJ P,CLOSF ;FIRST CLOSE THE FILE
03200
03300 PUSHJ P,DEVCAT
03400
03500 MOVE 3,1 ;SAVE FIRST JFN
03600 MOVE 1,GFL(CDB) ;USE SAME FLAGS
03700 TESTZ 1,OLDBIT ;EXCEPT NOT OLD
03800 TESTO 1,NEWBIT ;BUT DO WANT NEW
03900 TESTO 1,OUTBIT ;AND VERSION DEFAULTING
04000 MOVEM 1,GFL(CDB) ;SAVE FLAGS
04100 MOVE 2,(SP)
04200 JSYS GTJFN
04300 JRST RENERR ;ERROR BITS IN 1
04400
04500 MOVE 2,1 ;NEW JFN
04600 MOVE 1,3 ;OLD JFN
04700 JSYS RNAMF
04800 JRST RENERR ;ERROR BITS IN 1
04900 MOVE 1,2 ;NEW JFN
05000 MOVE 2,OFL(CDB) ;OPENF FLAGS
05100 JSYS OPENF
05200 JRST RENERR ;ERROR BITS IN 1
05300 MOVEM 1,JFNTBL(CHNL) ;SAVE THE NEW JFN
05400
05500 RENRET: SETZM @FLGARG ;INDICATE A GOOD RETURN
05600 RENRE1: POP P,CDB
05700 POP P,CHNL
05800 POP P,3
05900 POP P,2
06000 POP P,1
06100 SUB SP,X22
06200 SUB P,X44
06300 JRST @4(P)
06400
06500 RENERR: MOVEM 1,@FLGARG
06600 JRST RENRE1
06700
06800 RENBAD: SETOM @FLGARG
06900 JRST RENRE1
07000
07100 RENDEL: JSYS DELF ;JFN IN 1
07200 JRST RENERR
07300 JRST RENRET
07400 BEND RENAME
07500
00100 DSCR PROCEDURE USETI,USETO(INTEGER CHANNEL,BLOCK)
00200 ⊗
00300
00400 HERE(USETI)
00500 HERE(USETO)
00600 PUSHJ P,SAVE
00700 MOVE LPSA,X33
00800 VALCHN 1,-2(P),USETER
00900 PUSHJ P,OPNCHK ;MAKE SURE OPEN
01000 MOVE 2,DVTYP(CDB)
01100 CAIN 2,3 ;IS IT A DECTAPE?
01200 JRST USEDTA ;YES
01300 DOSFPT: MOVE 2,-1(P)
01400 SUBI 2,1
01500 IMULI 2,200 ;BLOCK NUMBER
01600 JSYS SFPTR
01700 ERR <USETI OR USETO: CANNOT DO SFPTR>,1
01800 JRST RESTR
01900
02000 USEDTA:
02100 ;SFPTR DOES NOT SEEM TO WORK TO THE DECTAPE IN TENEX
02200 ;;; LDB 2,[POINT 4,OFL(CDB),9] ;MODE
02300 ;;; CAIE 2,17 ;DUMP?
02400 ;;; JRST DOSFPT ;NO
02500
02600 MOVEI 2,30 ;OPERATION 30 FOR DECTAPES
02700 HRRZ 3,-1(P) ;TAPE BLOCK
02800 JSYS MTOPR ;SET DIRECTLY
02900 JRST RESTR ;AND RETURN
03000 USETER: ERR<Illegal JFN>,1
03100 JRST RESTR ;AND RETURN
03200
00100 DSCR PROCEDURE CLOSE(INTEGER CHANNEL)
00200 PROCEDURE CLOSO(INTEGER CHANNEL)
00300 PROCEDURE CLOSIN(INTEGER CHANNEL)
00400 ⊗
00500 BEGIN CLOSES
00600
00700 HERE(CLOSIN)
00800 HERE(CLOSO)
00900 HERE(CLOSE)
01000 DOOPN: PUSH P,-1(P)
01100 PUSHJ P,CLOSF ;FORCE BUFFERS OUT, WRITE MAGT EOFS, CLOSF
01200 PUSHJ P,SAVE
01300 VALCHN 1,-1(P),CLORET
01400 SETOM DECCLZ(CDB) ;INDICATE DEC CLOSE PERFORMED
01500 CLORET: MOVE LPSA,X22
01600 JRST RESTR
01700
01800 BEND CLOSES
01900
00100 HERE(RELEASE)
00200 DSCR
00300 Ignores the close inhibit bits that are available in
00400 the STANFORD SAIL, until we decide what to do with them.
00500 ⊗
00600
00700 PUSH P,1
00800 PUSH P,-3(P) ;CHANNEL
00900 PUSHJ P,CFILE
01000 POP P,1 ;RESTORE 1
01100 SUB P,X33
01200 JRST @3(P) ;RETURN
01300
01400
01500
01600
00100 DSCR
00200 PROCEDURE MTAPE(INTEGER CHAN,OPERATION)
00300 (the operation is a character e.g., "U" to unload)
00400 as in the SAIL manual.
00500 ⊗
00600
00700 HERE(MTAPE)
00800 BEGIN MTAPE
00900 PUSHJ P,SAVE
01000 MOVE LPSA,X33
01100 LDB C,[POINT 5,-1(P),35]
01200 MOVE A,OPTAB
01300 MOVE B,OPTAB+1
01400 TRZE C,30 ;COMPRESS TABLE
01500 ADDI C,5
01600 LSH C,2
01700 ROTC A,(C)
01800 ANDI B,17
01900 VALCHN 1,-2(P),MTAERR
02000 PUSHJ P,OPNCHK ;MAKE SURE OPEN
02100 JSYS MTOPR
02200 JRST RESTR
02300 MTAERR: ERR <Illegal JFN>,1
02400 JRST RESTR
02500
02600 OPTAB: BYTE (4) 16,17,0,0,3,6,7,13,10 ;A,B,E,F,R,S,T
02700 BYTE (4) 11,0,1 ;U,W
02800
02900 BEND MTAPE
03000
03100
03200
03300
00100 DSCR STRING PROCEDURE TENXFI(STRING DECFILE)
00200
00300 Converts the string to a TENEX file specification.
00400 A la Alex Cannara.
00500 ⊗
00600
00700 HERE(TENXFI)
00800 BEGIN TENXFI
00900
01000 CTRLV←←"V"-100
01100 FIND←←2
01200
01300 PUSH P,1
01400 PUSH P,2
01500 PUSH P,3
01600 SETZM FIND
01700 PUSH SP,[0] ;DEVICE TEMPORARY
01800 PUSH SP,[0]
01900 PUSH SP,[0] ;DIR TEMPORARY
02000 PUSH SP,[0]
02100 PUSH SP,[0] ;NAM TEMPORARY
02200 PUSH SP,[0]
02300
02400 DEFINE ORIG <-7(SP)>
02500 DEFINE ORIG1 <-6(SP)>
02600 DEFINE DEV <-5(SP)>
02700 DEFINE DEV1 <-4(SP)>
02800 DEFINE DIR <-3(SP)>
02900 DEFINE DIR1 <-2(SP)>
03000 DEFINE NAM <-1(SP)>
03100 DEFINE NAM1 <0(SP)>
03200
03300 ;SIMPLE SINCE NAME IS AT THE TOP OF SP
03400 DEFINE CATNAM (X) <
03500 PUSH P,X
03600 PUSHJ P,CATCHR
03700 >
03800 DEFINE CATDIR (X) <
03900 PUSH P,X
04000 PUSH SP,DIR
04100 PUSH SP,DIR
04200 PUSHJ P,CATCHR
04300 POP SP,-4(SP)
04400 POP SP,-4(SP)
04500 >
04600
04700 DEFINE GCH <
04800 HRRZ 1,ORIG
04900 JUMPE 1,TENDUN
05000 ILDB 3,ORIG1
05100 SOS ORIG
05200 >
05300
05400
05500 TENX1: GCH
05600 CAIE 3,CTRLV
05700 JRST NOQUOTE
05800 SKIPE FIND
05900 JRST QUODIR
06000 PUSHJ P,CATNA3
06100 GCH
06200 PUSHJ P,CATNA3 ;AND THE CHAR FOLLOWING THE CTRLV
06300 JRST TENX1
06400 QUODIR: PUSHJ P,CATDI3
06500 GCH
06600 PUSHJ P,CATDI3
06700 JRST TENX1 ;AND CONTINUE
06800
06900 NOQUOTE:
07000 CAIN 3,":" ;COLON -- DEVICE
07100 JRST ISDEV ;ITS BEEN A DEVICE ALL ALONG!!
07200 CAIN 3,","
07300 JRST TENX1 ;IGNORE COMMA
07400 CAIE 3,40 ;SPACE
07500 CAIN 3,11 ;OR TAB
07600 JRST TENX1
07700
07800 CAIE 3,"<" ;THESE START THE DIRECTORY NAME
07900 CAIN 3,"["
08000 JRST STDIR
08100 CAIE 3,">" ;THESE FINISH THE DIR. NAME
08200 CAIN 3,"]"
08300 JRST ENDDIR
08400 SKIPE FIND ;DOING DIRECTORY?
08500 JRST .+3 ;YES
08600 PUSHJ P,CATNA3
08700 JRST TENX1
08800 PUSHJ P,CATDI3
08900 JRST TENX1
09000
09100 STDIR: SETOM FIND
09200 SKIPE DIR ;ANYTHING THERE?
09300 JRST TENX1 ;YES, IGNORE
09400 CATDIR <[74]>
09500 JRST TENX1
09600
09700 ENDDIR: SETZM FIND
09800 JRST TENX1
09900
10000 ISDEV: PUSHJ P,CATNA3 ;PUT THE COLON ON THE NAME
10100 MOVE 3,NAM ;THE "NAME" HAS REALLY BEEN A DEV
10200 MOVEM 3,DEV
10300 MOVE 3,NAM1
10400 MOVEM 3,DEV1
10500
10600 SETZM NAM ;SO CLEAR THE NAME -- START OVER
10700 SETZM NAM1
10800 JRST TENX1
10900
11000 TENDUN:
11100 ;CHECK TO SEE WHAT LAST CHAR OF DIR IS
11200 SKIPN DIR
11300 JRST GOTDIR ;NO DIRECTORY THERE
11400 CATDIR <[76]> ;PUT ON A ">"
11500 ;NOW STACK HAS ORIG,DEV,DIR,NAM
11600 GOTDIR:
11700 PUSHJ P,CAT
11800 ;NOW STACK HAS ORIG,DEV,<DIR>NAM
11900 PUSHJ P,CAT
12000 ;NOW STACK HAS ORIG,DEV:<DIR>NAM
12100 GOTDI1: POP SP,-2(SP)
12200 POP SP,-2(SP)
12300
12400 TXFRET:
12500 POP P,3
12600 POP P,2
12700 POP P,1
12800 POPJ P,
12900
13000
13100 ;CALL CAT MACROS WITH AC 3 AS THE ARG
13200 CATNA3: CATNAM 3
13300 POPJ P,
13400
13500 CATDI3: CATDIR 3
13600 POPJ P,
13700
13800
13900 BEND TENXFI
14000
00100 DSCR
00200 INTEGER PROCEDURE GETCHAN(INTEGER I)
00300 RETURNS AN UNUSED CHANNEL NUMBER, AND MARKS IT
00400 FOR USE, SO THAT NO ONE WILL TRY TO USE IT.
00500 ⊗
00600
00700 HERE(GETCHAN)
00800 MOVE A,[XWD -JFNSIZE+1,1] ;START AT CHANNEL 1
00900 GETCH1: SKIPN CDBTBL(A) ;ALLOCATED YET?
01000 JRST GETCH2 ;NO, TAKE IT
01100 AOBJN A,GETCH1 ;YES
01200 SETOM A ;INDICATE ERROR
01300 POPJ P,
01400
01500 GETCH2: HRRZ A,A
01600 PUSH P,B ;NOW ALLOCATE A TABLE
01700 PUSH P,C
01800 MOVEI C,IOTLEN
01900 PUSHJ P,CORGET
02000 ERR <GETCHAN: CANNOT GET CORE>
02100 MOVEM B,CDBTBL(A)
02200
02300 HRL C,B ;ZERO OUT BLOCK
02400 HRRI C,1(B)
02500 SETZM (B)
02600 BLT C,IOTLEN-1(B)
02700
02800 SETZM JFNTBL(A) ;BUT NO JFN (YET)
02900 POP P,C
03000 POP P,B
03100 POPJ P,
03200
03300 DSCR
03400 INTEGER PROCEDURE CVJFN(INTEGER CHAN)
03500
03600 Returns the JFN (XWD flags,jfn) associated
03700 with a logical channel, -1 if no jfn assigned.
03800 Hereby, the user of these routines can access
03900 the system directly if the need arises.
04000 ⊗
04100 HERE(CVJFN)
04200 SKIPL 1,-1(P)
04300 CAIL 1,JFNSIZE
04400 JRST CVJFER
04500 SKIPN 1,JFNTBL(1)
04600 JRST CVJFER
04700 CVJFR: SUB P,X22
04800 JRST @2(P)
04900 CVJFER: SETO 1,
05000 JRST CVJFR
05100
05200
05300 BEND PAT
05400
05500 ENDCOM(PAT)
05600
00100 COMPIL(JOBINF,<ODTIM,IDTIM,RUNTM,GTAD,GJINF>,<ZSETST,ZADJST,X22,X33,X44,.SKIP.,CATCHR>
00200 ,<JOBINF -- JOB UTILITY ROUTINES>)
00300 DSCR STRING SIMPLE PROCEDURE ODTIM(INTEGER DT,FORMAT)
00400 Returns the string representation of DT
00500 (which is in internal TENEX representation). If DT
00600 is -1 the current date and time are used. If format
00700 is -1, the standard format is used.
00800 ⊗
00900 HERE(ODTIM)
01000 PUSH P,[=100] ; 100 CHARS
01100 PUSHJ P,ZSETST ;GET BP IN 1
01200 MOVE 2,-2(P) ;TIME
01300 MOVE 3,-1(P) ;FORMAT
01400 JSYS ODTIM
01500 PUSH P,[=100]
01600 PUSH P,1 ;UPDATED BP
01700 PUSHJ P,ZADJST ;GET STRING
01800 SUB P,X33 ;ADJUST STACK
01900 JRST @3(P) ;RETURN
00100
00200 DSCR INTEGER SIMPLE PROCEDURE IDTIM(STRING S)
00300 Returns the internal TENEX representation of S, which
00400 is assumed to be the date and time in some reasonable format.
00500 If the format cannot be scanned, the error is returned in .SKIP.
00600
00700 ⊗
00800
00900 HERE(IDTIM)
01000 PUSH P,[0]
01100 PUSHJ P,CATCHR
01200 MOVE 1,(SP) ;BYTE-POINTER
01300 SETZB 2,.SKIP. ;NO SPECIAL FORMAT, ASSUME NO ERROR
01400 JSYS IDTIM
01500 MOVEM 1,.SKIP. ;ERROR TO USER
01600 MOVE 1,2 ;ANSWER
01700 SUB SP,X22 ;ADJUST SP STACK
01800 POPJ P, ;RETURN
00100 DSCR INTEGER SIMPLE PROCEDURE RUNTM(INTEGER FORK; REFERENCE INTEGER CONSOLE);
00200 Returns the runtime of a fork. If FORK=-5, then then
00300 whole job. Time is returned as milliseconds for you. Console time,
00400 similarly converted, is returned in CONSOLE.
00500 ⊗
00600 HERE(RUNTM)
00700 MOVE 1,-2(P)
00800 JSYS RUNTM
00900 MOVEM 3,@-1(P)
01000 SUB P,X33
01100 JRST @3(P)
00100 DSCR INTEGER SIMPLE PROCEDURE GTAD;
00200 Returns the current date and time. See Jsys manual,
00300 3-3.
00400 ⊗
00500 HERE(GTAD)
00600 JSYS GTAD
00700 POPJ P,
00100 DSCR INTEGER SIMPLE PROCEDURE GJINF(REFERENCE INTEGER LOGDIR,CONDIR,TTYNO);
00200 Returns the TENEX jobnumber. LOGDIR is the directory
00300 no. logged in, CONDIR is the connected directory number. TTYNO is the
00400 TENEX teletype number, which is -1 if the job is detached.
00500 See the DIRST routine for converting directory numbers to
00600 directory strings.
00700 ⊗
00800
00900 HERE(GJINF)
01000 JSYS GJINF
01100 MOVEM 1,@-3(P)
01200 MOVEM 2,@-2(P)
01300 MOVEM 4,@-1(P)
01400 MOVE 1,3;
01500 SUB P,X44
01600 JRST @4(P)
00100 ENDCOM(JOBINF)
00200
00100 COMPIL(DIRECT,<STDIR,DIRST>,<X22,X33,CATCHR,ZSETST,ZADJST.SKIP.>
00200 ,<DIRECT -- TENEX DIRECTORY SPECS>)
00300 DSCR INTEGER SIMPLE PROCEDURE STDIR(STRING S; BOOLEAN DORECOGNITION)
00400 DESR
00500 Returns the directory number associated with a string.
00600 Any problems are returned in .SKIP. with the code:
00700 1 string does not match
00800 2 string is ambiguous.
00900 ⊗
01000 HERE(STDIR)
01100 PUSH P,[0]
01200 PUSHJ P,CATCHR ;TACK ON 0
01300 SETZ 3, ;
01400 MOVEI 1,1 ; ASSUME NO RECOGNITION
01500 SKIPE -1(P) ; DO WE WANT IT?
01600 SETO 1, ; YES AFTER ALL
01700 MOVE 2,(SP) ;BYTE-POINTER
01800 JSYS STDIR
01900 MOVEI 3,1 ; NO MATCH;
02000 MOVEI 3,2 ; AMBIGUOUS
02100 MOVEM 3,.SKIP. ; SAVE IT FOR USER
02200 HRRZ 1,1 ; SAVE DIR NO. (ONLY)
02300 SUB SP,X22 ;ADJUST STRING STACK
02400 SUB P,X22
02500 JRST @2(P) ;RETURN
02600
00100 DSCR STRING SIMPLE PROCEDURE DIRST(INTEGER I)
00200 Returns the string name for directory I. Any problems
00300 cause .SKIP. to be set TRUE.
00400 ⊗
00500
00600 HERE(DIRST)
00700 PUSH P,[=100]
00800 PUSHJ P,ZSETST
00900 SETZM .SKIP.
01000 MOVE 2,-1(P) ;DIRECTORY NO.
01100 JSYS DIRST
01200 SETOM .SKIP.
01300 PUSH P,[=100]
01400 PUSH P,1 ;UPDATED BP
01500 PUSHJ P,ZADJST ;GET STRING ON STACK
01600 SUB P,X22
01700 JRST @2(P)
01800
01900 ENDCOM(DIRECT)
00100 COMPIL(RUNPRG,<RUNPRG>,<X22,X33,CATCHR>,<RUNPRG -- RUN A PROGRAM>)
00200 DSCR INTEGER SIMPLE PROCEDURE RUNPRG(STRING PROGRAM; INTEGER INCREM; BOOLEAN NEWFORK)
00300 This does two entirely different things depending on whether
00400 NEWFORK is true or not.
00500 If NEWFORK then a new fork is created, capabilities transmitted,
00600 and PROGRAM is run there. INCREM is added to the entry vector. Any problems
00700 cause the routine to return FALSE, otherwise it returns TRUE.
00800 If not NEWFORK then the current job is destroyed and replaced
00900 with PROGRAM, with INCREM added to the entry vector location. This is
01000 like the DEC RUN uuo, and hence if the increment is 1, the program is
01100 started at the CCL address. If the routine returns at all, there was a problem
01200 with the file.
01300 Remember to say .SAV as the PROGRAM extension.
01400 ⊗
01500
01600
01700 HERE(RUNPRG)
01800 BEGIN
01900 JFN←←0
02000 FORK←←14
02100 PUSH P,[0]
02200 PUSHJ P,CATCHR
02300 MOVSI 1,100001 ; OLD FILE, PTR IN 2
02400 MOVE 2,(SP) ; STRING POINTER
02500 JSYS GTJFN ; TRY FOR JFN
02600 JRST RUNERR ; ERROR
02700 MOVEM 1,JFN ; SAVE JFN
02800
02900 SKIPN -1(P) ; USER WANTS FORK?
03000 JRST SWP ; NO, REPLACE CURRENT PRG
03100
03200 MOVSI 1,100000 ; XMIT CAPABILITIES
03300 JSYS CFORK
03400 JRST RUNERR ; CANNOT CREATE FORK
03500 MOVEM 1,FORK ; SAVE HANDLE
03600 SETOB 2,3 ; INDICATE ALL PRIVILEDGES
03700 JSYS EPCAP
03800 HRLZ 1,1 ; FORK HANDLE
03900 HRR 1,JFN ; THE JFN
04000 JSYS GET ; JSYS GET THE FILE
04100 MOVEI 1,400000 ; CURRENT FORK
04200 JSYS GPJFN ;PRIMARY JFNS IN 2
04300 MOVE 1,FORK ; SET PRIMARY IO
04400 JSYS SPJFN ;FOR NEW FORK
04500 MOVE 1,FORK ; FORK
04600 MOVE 2,-2(P) ; USER VALUE FOR ENTRY VECTOR
04700 JSYS SFRKV ;START THE FORK
04800 MOVE 1,FORK ;
04900 JSYS WFORK
05000 SKIPE 1,FORK ; SET TO KILL
05100 JSYS KFORK ;KILL THE FORK
05200 HRRZ 1,JFN ;
05300 JSYS RLJFN ; RELEASE
05400 JFCL ; IGNORE
05500 JRST RUNRET ; AND RETURN SAFELY
05600
05700 SWP:
05800 IMSSS,< ;DESTROY EMULATOR INFO AT IMSSS
05900 SETO 1,
06000 MOVE 2,[XWD 400000,711] ;PAGE 711
06100 JSYS PMAP ;DESTROY
06200 >;IMSSS
06300 PUSH P,JFN ;SAVE THE JFN
06400 HRLI A1 ; BLT INTO ACS
06500 HRRI 1 ;
06600 BLT 15 ; THE INSTRUCTIONS -- NOTE THAT RF IS NOW CLOBBERED
06700 POP P,0 ; RESTORE JFN TO AC0
06800 HRLI 0,400000 ; XWD FORK, JFN
06900 MOVE 16,-2(P) ; THE INCREMENT -- NOTE THAT SP IS NOW CLOBBERED
07000 MOVE 17,[254000400010] ; FOR COMPARISON -- NOTE THAT THE P STACK IS GONE
07100 JRST 4 ; AND GO
07200 A1: -1 ; FOR PMAP
07300 A2: 400000000677 ; THIS FORK, START AT 677 (LEAVING EMULATOR)
07400 A3: 0 ;
07500 A4: JSYS PMAP
07600 A5: SOJL 2,4 ; LOOP THROUGH PAGES
07700 A6: MOVE 1,0 ; XWD 400000,JFN
07800 A7: JSYS GET ;
07900 A10: MOVEI 1,400000 ; THIS FORK
08000 A11: JSYS GEVEC ; JSYS GET ENTRY VECTOR
08100 A12: CAMN 2,17 ; DEC STYLE??
08200 A13: HRRZ 2,120 ; YES
08300 A14: ADD 2,16 ; ADD THE INCREMREMENT
08400 A15: JRST (2) ; AND START THE JOB
08500
08600 RUNERR: TDZA 1,[-1] ;ZERO 1 AND SKIP
08700 RUNRET: SETO 1, ;INDICATE SUCCESS
08800 SUB SP,X22
08900 SUB P,X33
09000 JRST @3(P)
09100
09200
09300 BEND;RUNPRG
09400 ENDCOM(RUNPRG)
00100 COMPIL(OPF,<OPENFILE,SETINPUT,SETPL,INDEXFILE>,<.SKIP.>,<OPENFILE -- OPEN A FILE>)
00200 DSCR INTEGER SIMPLE PROCEDURE OPENFILE(STRING NAME,OPTIONS)
00300
00400 Name is the name of the file to be opened. If it is null, then
00500 OPENFILE goes to the user's console for the filname (with recognition).
00600 The value of the call is the jfn returned to the user.
00700 OPTIONS is a string of options available to the user. Legal
00800 characters are:
00900
01000 One of these:
01100 R read
01200 W write
01300 A append
01400 Version numbering
01500 O old file
01600 N new file
01700 T temporary file
01800 * index with INDEXFILE routine
01900
02000 Independent:
02100 C require confirmation
02200 D ignore deleted bit
02300 H "thawed" access
02400 Error handling
02500 E return errors to user in the external
02600 integer !skip!. TENEX error codes are used.
02700 (JFN will be released in this case.)
02800 OPENFILE does a GTJFN followed by a OPENF. If GTJFN fails, a new
02900 attempt is made, from the user's console.
03000 ⊗
03100
03200 BEGIN OPENFILE
03300 JFN←3 ;WHERE TO PUT THINGS
03400 FLAGS←4
03500 GTFLAGS←5
03600 OPFLAGS←6
03700
03800 DEFINE EQ $ (X,Y) <
03900 CAIE A,"$X$"
04000 JRST .+3
04100 TESTO FLAGS,Y
04200 JRST OPCONT
04300 >
04400
04500 DEFINE JTRUE $ (X) <
04600 TESTN FLAGS,X
04700 >
04800 DEFINE JFALSE (X) <
04900 TESTE FLAGS,X
05000 >
05100
05200 DEFINE SGT (X) <
05300 TESTO GTFLAGS,X
05400 >
05500 DEFINE SOF (X) <
05600 TESTO OPFLAGS,X
05700 >
05800 DEFINE TGT (X) <
05900 TESTE FLAGS,X
06000 TESTO GTFLAGS,X
06100 >
06200 DEFINE TOP (X) <
06300 TESTE FLAGS,X
06400 TESTO OPFLAGS,X
06500 >
06600
06700 HERE(OPENFILE)
06800 SETZB FLAGS,.SKIP.
06900 SETZB GTFLAGS,OPFLAGS
07000 HRRZ B,-1(SP) ;COUNT OF OPTIONS WORD
07100
07200 WHIOPT: JUMPE B,OPTDUN
07300 ILDB A,(SP) ;GET AN OPTION
07400 CAIGE A,141
07500 JRST .+3
07600 CAIG A,172
07700 SUBI A,40 ;CONVERT TO UPPER CASE
07800 ;ANY NON-ALPHABETIC CHARS GO HERE
07900
08000 EQ *,STARBIT
08100 ;NOW ALLOW ONLY ALPHABETIC CHARS
08200 CAIL A,101 ;MUST BE
08300 CAILE A,132
08400 JRST OPTERR
08500 SKIPN BITTBL-"A"(A) ;SOMETHING THERE?
08600 JRST OPTERR ;NOPE, ERROR
08700 TDO FLAGS,BITTBL-"A"(A) ;RIGHT SPOT IN TABLE
08800 SOJGE B,WHIOPT
08900 JRST OPTDUN
09000 ;HERE ON ERROR
09100 OPTERR: ERR <OPENFILE: ILLEGAL OPTION >,1
09200 TESTO FLAGS,ERSNBIT
09300
09400 OPCONT:
09500 SOJGE B,WHIOPT
09600
09700 ;NOW SET UP GTFLAGS ACCORDING TO THE SCANNED INFORMATION
09800 OPTDUN:
09900 TGT OLDBIT ;INSIST ON OLD?
10000 TGT NEWBIT ;INSIST ON NEW?
10100 JTRUE OLDBIT
10200 JFALSE NEWBIT ;IF NEITHER
10300 JRST OPTDU1 ;WELL, ONE
10400 JTRUE WRBIT ;IF WRITING
10500 JRST OPTDU1
10600 JFALSE RDBIT ;AND READING
10700 JTRUE APPBIT ;BUT NOT APPENDING
10800 SGT OUTBIT ;THEN SET OUTPUT BIT
10900 OPTDU1:
11000 ;NOW TEST FOR INDEPENDANT THINGS
11100 TOP RDBIT
11200 TOP WRBIT
11300 TOP APPBIT
11400 TGT TEMBIT
11500 TGT STARBIT
11600 TOP THAWBIT
11700 JFALSE CONFBIT
11800 JRST [SGT CONFB1
11900 SGT CONFB2
12000 JRST .+1]
12100 TLO GTFLAGS,1 ;SHORT CALL OF GTJFN
12200 GTAGAIN:
12300 HRRZ A,-3(SP) ;LENGTH OF NAME
12400 JUMPE A,[TRYAGN:
12500 TLO GTFLAGS,2
12600 MOVE 2,[XWD 100,101]
12700 JRST GT]
12800 AND GTFLAGS,[717777777777]
12900
13000 PUSH SP,-3(SP)
13100 PUSH SP,-3(SP)
13200 PUSH P,[0]
13300 PUSHJ P,CATCHR ;CONCATENATE A NULL CHAR
13400 MOVE 2,(SP) ;BYTE-POINTER
13500 SUB SP,X22 ;ADJUST STACK
13600 GT: MOVE 1,GTFLAGS
13700 JSYS GTJFN
13800 JRST GTERR
13900 MOVEM 1,JFN ;REMEMBER JFN
14000 PUSHJ P,SETCHN ;SET A CHANNEL, ALLOCATE, GET CDB, SET DVTYP, RETURN CHANNEL
14100 MOVEM 1,CHNL ;REMEMBER CHANNEL
14200 MOVEM GTFLAGS,GFL(CDB)
14300
14400
14500 COMMENT ⊗ Do the open.
14600 ⊗
14700 MOVE 1,DVTYP(CDB) ;CHECK THE DEVICE TYPE
14800 CAIN 1,12 ;IS IT A TTY?
14900 JRST B7 ;YES, USE 7 BIT
15000 B36: HRRZ 1,JFN ;JFN
15100 HRRZ 2,OPFLAGS
15200 HRLI 2,440000 ;36-BIT, MODE 0
15300 JSYS OPENF
15400 JRST B36DMP ;TRY 36-BIT, DUMP MODE
15500 JRST OPNOK
15600 B36DMP: HRRZ 1,JFN
15700 HRRZ 2,OPFLAGS
15800 HRLI 2,447400 ;36 BITS, DUMP MODE
15900 JSYS OPENF
16000 JRST B7
16100 JRST OPNOK
16200 B7: HRRZ 1,JFN
16300 HRRZ 2,OPFLAGS
16400 HRLI 2,70000 ;7 BIT
16500 JSYS OPENF
16600 JRST OPERR ;NOPE
16700 OPNOK: MOVEM 2,OFL(CDB) ;SAVE
16800 MOVE 1,CHNL ;RETURN CHANNEL NO
16900 OPFRET: SUB SP,X44 ;ADJUST
17000 POPJ P, ;AND RETURN
17100
17200
17300
17400
17500 GTERR:
17600 ;HERE WITH ERROR ON GTJFN
17700 JTRUE ERTNBIT ;USER WANT'S ERRORS?
17800 JRST GTER1 ;NO
17900 ERRRET: MOVEM 1,.SKIP. ;STORE FOR USER
18000 SETO 1, ;SOMETHING SUSPICIOUS
18100 JRST OPFRET ;AND RETURN
18200
18300 GTER1: HRROI 1,[ASCIZ/
18400 CANNOT GTJFN FILE /]
18500 JSYS PSOUT
18600 PUSH SP,-3(SP)
18700 PUSH SP,-3(SP)
18800 PUSHJ P,OUTSTR
18900 HRROI 1,[ASCIZ/, TRY AGAIN */]
19000 JSYS PSOUT
19100 JRST TRYAGN
19200
19300
19400
19500 OPERR: JTRUE ERTNBIT
19600 JRST OPER1
19700 PUSH P,1 ;SAVE ERROR BITS
19800 PUSH P,CHNL
19900 PUSHJ P,CFILE
20000 POP P,1 ;RESTORE ERROR BITS
20100 JRST ERRRET
20200
20300 OPER1: HRROI 1,[ASCIZ/
20400 CANNOT OPENF FILE /]
20500 JSYS PSOUT
20600 PUSH SP,-3(SP)
20700 PUSH SP,-3(SP)
20800 PUSHJ P,OUTSTR
20900 HRROI 1,[ASCIZ/, TRY AGAIN */]
21000 JSYS PSOUT
21100 PUSH P,CHNL ;CLOSE AND RELEASE FILE AND CDB BLOCK
21200 PUSHJ P,CFILE
21300 JRST TRYAGN
21400
21500 BITTBL: APPBIT ;A
21600 BINBIT ;B
21700 CONFBIT ;C
21800 DELBIT ;D
21900 ERTNBIT ;E
22000 0 ;F
22100 0 ;G
22200 THAWBIT ;H
22300 0 ;I
22400 0 ;J
22500 0 ;K
22600 0 ;L
22700 0 ;M
22800 NEWBIT ;N
22900 OLDBIT ;O
23000 0 ;P
23100 0 ;Q
23200 RDBIT ;R
23300 0 ;S
23400 TEMBIT ;T
23500 0 ;U
23600 0 ;V
23700 WRBIT ;W
23800 0 ;X
23900 0 ;Y
24000 0 ;Z
24100
24200
24300 BEND OPENFILE
24400
00100 DSCR PROCEDURE SETINPUT(INTEGER CHAN; REFERENCE INTEGER COUNT,BR,EOF)
00200 Sets up the variables associated with input (as in the DEC
00300 open statement.)
00400 ⊗
00500
00600 HERE(SETINPUT)
00700 PUSHJ P,SAVE
00800 VALCHN 1,-4(P),SETERR
00900 POP P,TEMP
01000 POP P,ENDFL(CDB)
01100 SKIPE ENDFL(CDB)
01200 SETZM @ENDFL(CDB) ;ASSUME NOT EOF
01300 POP P,BRCHAR(CDB)
01400 SKIPE BRCHAR(CDB)
01500 SETZM @BRCHAR(CDB) ;ASSUME NO BRCHAR
01600 POP P,ICOUNT(CDB)
01700 SETZ LPSA, ;NO PARAMETERS
01800 SUB P,X11
01900 JRST RESTR
02000 SETERR: ERR <Illegal JFN>,1
02100 MOVE LPSA,[XWD 5,5]
02200 JRST RESTR
02300
00100 DSCR
00200 SETPL(CHAN,@LINNUM,@PAGNUM,@SOSNUM)
00300
00400 Names the variables to be used by the INPUT
00500 function for counting the line-feeds (12), formfeeds (14)
00600 seen by INPUT, as well as keeping the current SOS line
00700 number, if any. Useful when scanning a file, and
00800 you want to know what page,line you are on.
00900 Initializes all three variables to 0.
01000
01100 ⊗
01200 HERE(SETPL)
01300 PUSHJ P,SAVE
01400 VALCHN 1,-4(P),SETPER
01500 POP P,TEMP ;RET ADR
01600 POP P,SOSNUM(CDB)
01700 SETZM @SOSNUM(CDB)
01800 POP P,PAGNUM(CDB)
01900 SETZM @PAGNUM(CDB)
02000 POP P,LINNUM(CDB)
02100 SETZM @LINNUM(CDB)
02200 SUB P,X11 ;REMOVE CHANNEL NO.
02300 SETRET: SETZ LPSA,
02400 JRST RESTR
02500 SETPER: ERR <Illegal JFN>,1
02600 MOVE LPSA,[XWD 5,5]
02700 JRST RESTR
02800
02900
03000
03100
00100 DSCR
00200 BOOLEAN PROCEDURE INDEXFILE(INTEGER JFN)
00300
00400 RETURNS TRUE AS LONG AS WE CAN GNJFN ANOTHER FILE
00500 ⊗
00600
00700 HERE(INDEXFILE)
00800 PUSH P,-1(P)
00900 PUSHJ P,CLOSF
01000 PUSH P,-1(P)
01100 PUSHJ P,GNJFN
01200 JUMPE 1,INDRET ;RETURN FALSE IF NO OTHER FILES
01300 PUSH P,2
01400 PUSH P,CDB
01500 PUSH P,CHNL
01600 ;CHANNEL ALREADY VALID
01700 MOVE CHNL,-4(P) ;CHANNEL NUMBER
01800 MOVE CDB,CDBTBL(CHNL) ;CDB LOC
01900 HRRZ 1,JFNTBL(CHNL) ;JFN
02000 MOVE 2,OFL(CDB) ;GET OPENFLAGS
02100 JSYS OPENF ;TRY OPENING
02200 JRST NOIND
02300 SKIPE ENDFL(CDB) ;ZERO SETINPUT (or OPEN) VARIABLES IF HERE
02400 SETZM @ENDFL(CDB)
02500 SKIPE BRCHAR(CDB)
02600 SETZM @BRCHAR(CDB)
02700 SKIPE LINNUM(CDB) ;ZERO SETPL VARS
02800 SETZM @LINNUM(CDB)
02900 SKIPE PAGNUM(CDB)
03000 SETZM @PAGNUM(CDB)
03100 SKIPE SOSNUM(CDB)
03200 SETZM @SOSNUM(CDB)
03300 SETO 1,
03400 INDPOP: POP P,CHNL
03500 POP P,CDB
03600 POP P,2
03700 INDRET: SUB P,X22
03800 JRST @2(P)
03900
04000 NOIND: ERR <INDEXFILE: CANNOT OPENF>,1
04100 SETZ 1,
04200 JRST INDPOP
04300
04400
04500
04600
04700 ENDCOM(OPF)
00100 COMPIL(GTJFN,<GTJFN>,<.SKIP.,SETCHN,CATCHR,X22>,<GTJFN -- GET A JFN>)
00200 DSCR INTEGER SIMPLE PROCEDURE GTJFN(STRING S; INTEGER FLAGS)
00300 Does a GTJFN. If S is non-null, it is the filename, otherwise
00400 the routine goes to the user's console for a file. FLAGS are used for
00500 accumulator 1, and any error code is returned in .SKIP. The value
00600 of the call is the JFN, if obtained.
00700 Defaults for FLAGS: 0 means ordinary input, 1 means ordinary
00800 output. Ordinarily the user will use the OPENFI routine.
00900 ⊗
01000
01100 HERE(GTJFN)
01200 SKIPN 1,-1(P)
01300 MOVSI 1,100001
01400 CAIN 1,1
01500 MOVSI 1,600001
01600 TLO 1,1 ;MARK FOR SHORT CALL
01700 HRRZ 2,-1(SP)
01800 JUMPE 2,[MOVE 2,[100000101]
01900 TLO 1,2 ;INDICATE XWD JFN,JFN IN 2
02000 JRST GOTDEST]
02100 TLZ 1,2 ;INDICATE BYTE-POINTER IN 2
02200 PUSH P,[0]
02300 PUSHJ P,CATCHR ;PUT ON A NULL
02400 MOVE 2,(SP)
02500 GOTDEST: SETZM .SKIP. ;ASSUME NO ERROR
02600 PUSH P,1 ;SAVE FLAGS
02700 JSYS GTJFN
02800 JRST GTBAD ; SOMETHING IS WRONG
02900 PUSHJ P,SETCHN ;SETUP A CHANNEL, AND ALLOCATE, GET STATUS, SET CDB
03000 POP P,GFL(CDB) ;SAVE FLAGS
03100 GTRET: SUB SP,X22
03200 SUB P,X22
03300 JRST @2(P)
03400
03500 GTBAD:
03600
03700 MOVEM 1,.SKIP. ; REMEMBER
03800 POP P,1 ;ADJUST STACK
03900 SETO 1, ; SOMETHING SUSPICIOUS TO RETURN TO USER
04000 JRST GTRET
04100
04200 ENDCOM(GTJFN)
00100 COMPIL(FILINF,<GNJFN,DELF,UNDELETE,SIZEF,JFNS,OPENF,CFILE,CLOSF,RLJFN,GTSTS,STSTS,RNAMF>
00200 ,<JFNTBL,CDBTBL,STRSND,X11,X22,X33,CORREL,.SKIP.,ZSETST,ZADJST>
00300 ,<FILINF -- UTILITY FILE ROUTINES>)
00400
00500
00600 DSCR INTEGER SIMPLE PROCEDURE GNJFN(INTEGER JFN)
00700 Does the GNJFN jsys.
00800 ⊗
00900 HERE(GNJFN)
01000 PUSHJ P,SAVE
01100 MOVE LPSA,X22
01200 VALCHN 1,<-1(P)>,GNERR
01300 MOVE 1,JFNTBL(CHNL) ;GET THE WHOLE JFN
01400 SETO 2,; ;ASSUME GOOD
01500 JSYS GNJFN
01600 SETZ 2, ;NOPE, BAD
01700 MOVEM 2,RACS+A(USER)
01800 JUMPE 2,GNRLZ ;RELEASE IF NO OTHER FILE
01900 GNRET: JRST RESTR
02000
02100 GNERR: ERR <Illegal JFN>,1
02200 SETZM RACS+A(USER)
02300 JRST RESTR
02400
02500 GNRLZ: PUSH P,-1(P)
02600 PUSHJ P,CFILE
02700 JRST RESTR
02800
00100 DSCR PROCEDURE DELF(INTEGER CHAN)
00200 Deletes file open on CHAN. Errors to .SKIP.
00300 ⊗
00400 HERE(DELF)
00500 PUSH P,1
00600 VALCH1 1,-2(P),DELF1
00700 JSYS DELF
00800 JRST DELF2
00900 SETZM .SKIP. ;NO ERROR
01000 DELFRE: POP P,1
01100 SUB P,X22
01200 JRST @2(P)
01300 DELF1: SETO 1,
01400 DELF2: MOVEM 1,.SKIP.
01500 JRST DELFRE
01600
00100 DSCR PROCEDURE UNDELETE(INTEGER CHAN)
00200 Undeletes file open on CHAN. Errors to .SKIP.
00300 ⊗
00400 HERE(UNDELETE)
00500 PUSHJ P,SAVE
00600 VALCH1 1,-1(P),UNDEL1
00700 HRLI 1,1 ;XWD 1,JFN
00800 MOVSI 2,(1B3) ;DELETED BIT
00900 SETZ 3, ;TURN IT OFF
01000 JSYS CHFDB ;CHANGE THE FDB
01100 JRST RESTR
01200 UNDEL1: SETOM .SKIP.
01300 JRST RESTR
01400
01500
01600
01700
00100 DSCR INTEGER PROCEDURE SIZEF(INTEGER JFN)
00200 Gets the size in pages of the file open on JFN, with error code to
00300 .SKIP.
00400 ⊗
00500 HERE(SIZEF)
00600 PUSHJ P,SAVE
00700 MOVE LPSA,X22
00800 VALCHN 1,<-1(P)>,SIZERR
00900 SETZM .SKIP.
01000 JSYS SIZEF
01100 JRST [MOVEM 1,.SKIP.
01200 SETZM RACS+A(USER)
01300 JRST SIZRET]
01400 MOVEM 3,RACS+A(USER) ;ANSWER IN AC 3
01500 SIZRET: JRST RESTR
01600
01700 SIZERR: ERR <Illegal JFN>
01800 SETOM .SKIP.
01900 JRST SIZRET
02000
02100
00100
00200 DSCR STRING SIMPLE PROCEDURE JFNS(INTEGER JFN,FLAGS)
00300 Returns the name of the file associated with JFN.
00400 FLAGS are for ac 3 as described in the jsys manual, with
00500 0 the reasonable default.
00600 ⊗
00700
00800 HERE(JFNS)
00900 VALCHN 2,<-2(P)>,JFNSER ;GET JFN IN AC2
01000 PUSH P,[=100]
01100 PUSHJ P,ZSETST ;GET BP IN AC 1
01200 MOVE 3,-1(P)
01300 JSYS JFNS
01400 PUSH P,[=100]
01500 PUSH P,1
01600 PUSHJ P,ZADJST
01700 JFNSRE: SUB P,X33
01800 JRST @3(P)
01900 JFNSER: ERR <Illegal JFN>,1
02000 PUSH SP,[0] ;RETURN NULL STRING
02100 PUSH SP,[0]
02200 JRST JFNSRE
02300
00100 DSCR SIMPLE PROCEDURE OPENF(INTEGER JFN,FLAGS)
00200 Does an OPENF.
00300
00400 PARAMETERS:
00500 JFN the JFN
00600 FLAGS for accumulator 2.
00700 .SKIP. the error code (if pertinent)
00800
00900 Some defaults:
01000 FLAGS ACTION
01100 -----------------------
01200 0 INPUT CHARACTERS
01300 1 OUTPUT CHARACTERS
01400 2 INPUT 36-BIT WORDS
01500 3 OUTPUT 36-BIT WORDS
01600 4 DUMP MODE INPUT (USE DUMPI FUNCTION)
01700 5 DUMP MODE OUTPUT (USE DUMPO FUNCTION)
01800 VALUES 6-10 ARE RESERVED FOR EXPANSION
01900
02000 Other values of FLAGS are interpreted literally.
02100 Ordinarily the user will use the OPENFI routine.
02200 ⊗
02300
02400 HERE(OPENF)
02500 PUSHJ P,SAVE
02600 MOVE LPSA,X33
02700 VALCHN 1,-2(P),OPNERR
02800 SKIPL 2,-1(P) ;GET THE FLAGS
02900 CAILE 2,5 ;CHECK IN RANGE 0-5
03000 JRST GOTFLAGS
03100 MOVE 2,OPNTBL(2) ;GET CORRECT WORD
03200 GOTFLAGS:
03300 SETZM .SKIP.
03400 PUSH P,2 ;SAVE FLAGS
03500 JSYS OPENF
03600 JRST NOOPN
03700 POP P,OFL(CDB) ;AND SAVE FLAGS
03800 OPNRET: JRST RESTR
03900
04000 OPNERR: ERR <Illegal JFN>,1
04100 SETOM .SKIP.
04200 JRST OPNRET
04300
04400 NOOPN: MOVEM 1,.SKIP.
04500 SUB P,X11 ;ADJUST STACK
04600 JRST OPNRET
04700
04800 OPNTBL: 070000200000 ;7-BIT READ
04900 070000100000 ;7-BIT WRITE
05000 440000200000 ;36-BIT READ
05100 440000100000 ;36-BIT WRITE
05200 447400200000 ;36-BIT DUMP READ
05300 447400100000 ;36-BIT DUMP WRITE
05400
00100
00200 DSCR SIMPLE INTEGER PROCEDURE CFILE(INTEGER JFN)
00300 Closes the file (CLOSF) and releases (RLFJN)
00400 the jfn. This is the ordinary way the user will use
00500 to dispense with a file.
00600 Returns TRUE if JFN legal and released, FALSE o.w.
00700 Always returns.
00800 ⊗
00900
01000 HERE(CFILE)
01100 PUSH P,2
01200 PUSH P,3
01300 PUSH P,CHNL
01400 PUSH P,CDB
01500 SKIPL CHNL,-5(P)
01600 CAIL CHNL,JFNSIZE
01700 JRST CFBAD
01800 MOVE CDB,CDBTBL(CHNL) ;GET CDB
01900 SKIPN 1,JFNTBL(CHNL) ;JFN ASSIGNED?
02000 JRST CFBA1 ;NO, JUST RELEASE CORE
02100 HRRZ 1,1 ;JFN ONLY
02200 LDB 2,[POINT 6,OFL(CDB),5] ;GET BYTE SIZE
02300 CAIE 2,=36 ;36-BIT?
02400 JRST RLCOR ;NO
02500 ;FILE IN 36-BIT BYTES
02600 SKIPE OBP(CDB) ; A BYTE-POINTER?
02700 PUSHJ P,STRSND ;SEND OUT THE BUFFER
02800 PUSHJ P,CUNMAP ;UNMAP THE PAGE
02900 SKIPN DMPED(CDB) ;DUMP-MODE OUTPUT SEEN?
03000 JRST RLCOR ;NO
03100 PUSHJ P,MTCHK ;CHECK FOR MAGTAPE OUTPUT
03200 SETZM DMPED(CDB) ;AND INDICATE ALL DONE
03300
03400 RLCOR: SKIPE B,CDBTBL(CHNL) ; ANY CORE TO RELEASE?
03500 PUSHJ P,CORREL ; RELEASE THE BLOCK
03600 TLZ 1,400000 ; BE SURE TO RELEASE
03700 JSYS CLOSF ; CLOSE (AND RELEASE)
03800 JFCL ; ERROR RETURN
03900 HRRZ 1,JFNTBL(CHNL) ; GET JFN AGAIN
04000 JSYS RLJFN ; RELEASE (FOR GOOD MEASURE IF FILE NOT OPEN)
04100 JFCL ; ERROR RETURN
04200 SETO 1, ; RETURN TRUE FOR GOOD RELEASE
04300 SETZM CDBTBL(CHNL)
04400 SETZM JFNTBL(CHNL)
04500 CFRET: POP P,CDB
04600 POP P,CHNL
04700 POP P,3
04800 POP P,2
04900 SUB P,X22 ; ADJUST
05000 JRST @2(P) ; RETURN
05100
05200 CFBAD: SETZ 1, ; RETURN FALSE
05300 JRST CFRET ;
05400
05500 CFBA1: SKIPE B,CDB
05600 PUSHJ P,CORREL ;RELEASE CORE BLOCK
05700 SETZM CDBTBL(CHNL) ;REMOVE ALL TRACE
05800 SETZM JFNTBL(CHNL)
05900 SETZ 1, ; RETURN FALSE
06000 JRST CFRET
06100
06200 ;HERE WITH 1,CHNL,CDB LOADED
06300 ;IF DEVICE IS MAGTAPE, THEN WRITE TWO EOF'S AND BACKSPACE
06400 MTCHK:
06500 PUSH P,2 ;SAVE 2
06600 MOVE 2,DVTYP(CDB) ;GET DEVICE TYPE
06700 CAIE 2,2 ;IS IT A MAGTAPE?
06800 JRST MTRET ;NO
06900 MOVEI 2,3 ;WRITE EOF
07000 JSYS MTOPR
07100 JSYS MTOPR
07200 MOVEI 2,17 ;NOW BACKSPACE
07300 JSYS MTOPR
07400 MTRET: POP P,2 ;RESTORE
07500 POPJ P,
07600
07700 ;HERE WITH 1,CHNL,CDB LOADED
07800 ;UNMAP PAGE ASSOCIATED WITH JFN
07900 ;CLOBBERS 2,3
08000 CUNMAP:
08100 PUSH P,1 ;SAVE JFN
08200 MOVEI 2,STARTPAGE(1)
08300 HRLI 2,400000 ;XWD THIS FORK, PAGE NO.
08400 SETO 1,
08500 SETZ 3,
08600 JSYS PMAP
08700 POP P,1 ;GET JFN BACK
08800 POPJ P,
08900
09000
09100
00100 DSCR SIMPLE PROCEDURE CLOSF(INTEGER JFN)
00200 Does a CLOSF on the JFN. Ordinarily the user
00300 will want to use the CFILE routine, which handles errors
00400 internally. The CLOSF is accomplished in such a way that
00500 the JFN is actually not released.
00600 If the device is a magtape open for output, then
00700 2 eof's are written, followed by a backspace. This writes
00800 a standard end-of-file on the tape.
00900 ⊗
01000 HERE(CLOSF)
01100 PUSHJ P,SAVE
01200 MOVE LPSA,X22
01300 VALCHN 1,<-1(P)>,CLOERR
01400 LDB 2,[POINT 6,OFL(CDB),5] ;BYTE-SIZE
01500 CAIE 2,=36 ;36-BIT BYTES?
01600 JRST DOCLO
01700 ;RELEASE BUFFER IN CORE (IF THERE IS ONE)
01800 SKIPE OBP(CDB) ;A BYTE POINTER?
01900 PUSHJ P,STRSND ;CLEAN UP BUFFER IN CORE
02000 PUSHJ P,CUNMAP ;UNMAP THE PAGE
02100 SKIPE DMPED(CDB) ;DUMP-MODE IO SEEN?
02200 PUSHJ P,MTCHK ;CHECK IF MAGT-TAPE (AND MARK EOF,EOF)
02300 SETZM DMPED(CDB) ;AND INDICATE ALL DONE
02400 SETZM ICOWNT(CDB)
02500 SETZM IBP(CDB)
02600 SETZM OCNT(CDB)
02700 SETZM OBP(CDB)
02800 SETZM DECCLZ(CDB)
02900
03000 DOCLO: SETZM .SKIP. ;ASSUME NO ERROR
03100 TLO 1,400000 ; DO NOT RELEASE THE JFN
03200 JSYS CLOSF
03300 MOVEM 1,.SKIP. ;ERROR
03400 CLORET: JRST RESTR
03500
03600 CLOERR:
03700 SETOM .SKIP.
03800 JRST CLORET
03900
04000
04100
04200
04300
00100 DSCR SIMPLE PROCEDURE RLJFN(INTEGER JFN)
00200 Does the RLJFN jsys. Ordinarily the user will want
00300 to use the CFILE routine, which handles errors internally.
00400 ⊗
00500
00600 HERE(RLJFN)
00700 PUSHJ P,SAVE
00800 MOVE LPSA,X22
00900 SKIPL C,-1(P)
01000 CAIL C,JFNSIZE
01100 JRST RLJBAD
01200 SKIPN 1,JFNTBL(C)
01300 JRST RLJBAD
01400 SETZM JFNTBL(C)
01500 SKIPE B,CDBTBL(C)
01600 PUSHJ P,CORREL
01700 SETZM CDBTBL(C)
01800 SETZM .SKIP. ;ASSUME NO ERROR
01900 JSYS RLJFN
02000 MOVEM 1,.SKIP. ;ERROR RETURN
02100 RLJRET: JRST RESTR
02200
02300 RLJBAD: ERR <Illegal JFN>,1
02400 SETOM .SKIP.
02500 JRST RLJRET
02600
02700
00100 DSCR INTEGER SIMPLE PROCEDURE GTSTS(INTEGER JFN);
00200 Gets the file status.
00300 WARNING: The results of this call are not necessarily appropriate
00400 if the file is open in special character input mode. If you want to check
00500 for end-of-file, examine the EOF variable instead.
00600 ⊗
00700
00800 HERE(GTSTS)
00900 PUSHJ P,SAVE
01000 MOVE LPSA,X22
01100 VALCHN 1,<-1(P)>,GTSERR
01200 JSYS GTSTS
01300 MOVEM 2,RACS+A(USER)
01400 GTSRET: JRST RESTR
01500
01600 GTSERR: ERR <Illegal JFN>,1
01700 JRST GTSRET
00100 DSCR BOOLEAN SIMPLE PROCEDURE STSTS(INTEGER JFN,STATUS);
00200 Sets the status of JFN to STATUS using the STSTS jsys.
00300 ⊗
00400
00500 HERE(STSTS)
00600 VALCH1 1,<-2(P)>,STSERR
00700 MOVE 2,-1(P)
00800 SETO 3, ;ASSUME SKIP
00900 SETZM .SKIP.
01000 JSYS STSTS
01100 JRST [STERRT: SETZ 3, ;PROBLEM
01200 MOVEM 1,.SKIP.
01300 JRST .+1]
01400 MOVE 1,3 ;RETURN
01500 SUB P,X33
01600 JRST @3(P)
01700
01800 STSERR: ERR <Illegal JFN>,1
01900 JRST STERRT ;RETURN
02000
00100 DSCR BOOLEAN SIMPLE PROCEDURE RNAMF(INTEGER EXISTINGJFN,NEWJFN);
00200 File open on EXISTINGJFN is renamed to file open
00300 on NEWJFN.
00400 ⊗
00500 HERE(RNAMF)
00600 VALCH1 1,<-2(P)>,RNFERR
00700 VALCH1 2,<-1(P)>,RNFERR
00800 SETO 3, ;ASSUME OK
00900 SETZM .SKIP.
01000 JSYS RNAMF
01100 JRST [RNERET: SETZ 3,
01200 MOVEM 1,.SKIP.
01300 JRST .+1]
01400 RNFRET: MOVE 1,3 ;RETURN VALUE
01500 SUB P,X33
01600 JRST @3(P)
01700
01800 RNFERR: ERR <Illegal JFN>,1
01900 JRST RNERET
02000
02100 ENDCOM(FILINF)
00100 COMPIL(DEVINF,<CNDIR,ASND,RELD,GDSTS,SDSTS,STDEV,DEVST>
00200 ,<JFNTBL,CDBTBL,STRSND,X11,X22,X33,CORREL,.SKIP.,ZSETST,ZADJST>
00300 ,<DEVINF -- DEVICE AND DIRECTORY ROUTINES>)
00400
00500 DSCR BOOLEAN SIMPLE PROCEDURE CNDIR(INTEGER DIR; STRING PASSWORD);
00600 Using the CNDIR jsys, connects to TENEX directory DIR (for
00700 AC1.) PASSWORD is the password, which will usually be null, as
00800 in the EXEC CONNECT command.
00900 ⊗
01000
01100 HERE(CNDIR)
01200 PUSH P,[0]
01300 PUSHJ P,CATCHR ;PUT A NULL ON THE END OF THE PASSWORD
01400 POP SP,2 ;GET BP IN 2
01500 SUB SP,X11 ;CLEAN UP SP STACK
01600 MOVE 1,-1(P) ;DIRECTORY NO
01700 SETO 3, ;ASSUME SUCCESS
01800 SETZM .SKIP.
01900 JSYS CNDIR
02000 JRST [SETZ 3,
02100 MOVEM 1,.SKIP.
02200 JRST .+1]
02300 MOVE 1,3
02400 SUB P,X22
02500 JRST @2(P)
02600
00100 DSCR BOOLEAN PROCEDURE ASND(INTEGER DEVICE)
00200 Assigns the device specified by DEVICE using the ASND jsys.
00300 Returns TRUE if successful, else error code in .SKIP.
00400 ⊗
00500
00600 HERE(ASND)
00700 MOVE 1,-1(P) ;GET DEVICE DESIGNATOR
00800 JSYS ASND
00900 JRST [MOVEM 1,.SKIP.
01000 SETZ 1,
01100 JRST .+2]
01200 SETO 1,
01300 SUB P,X22
01400 JRST @2(P)
00100 DSCR BOOLEAN PROCEDURE RELD(INTEGER DEVICE)
00200 Releases DEVICE using the RELD jsys. If DEVICE is -1,
00300 then releases all devices assigned to this job.
00400 ⊗
00500
00600 HERE(RELD)
00700 MOVE 1,-1(P)
00800 JSYS RELD
00900 JRST [MOVEM 1,.SKIP.
01000 SETZ 1,
01100 JRST .+2]
01200 SETO 1,
01300 SUB P,X22
01400 JRST @2(P)
00100 DSCR INTEGER SIMPLE PROCEDURE GDSTS(INTEGER CHAN; REFERENCE INTEGER WORDCNT)
00200 Returns the device status of device open on CHAN using the GDSTS
00300 jsys. The LH of WORDCNT has the word count of the last transfer completed,
00400 negative if the last transfer completed unsuccessful.
00500 ⊗
00600
00700 HERE(GDSTS)
00800 VALCH1 1,<-2(P)>,GDSERR
00900 SETZM .SKIP.
01000 JSYS GDSTS
01100 MOVEM 3,@-1(P) ;REFERENCE ARG
01200 MOVE 1,2 ;RETURN VALUE
01300 GDSRET: SUB P,X33
01400 JRST @3(P)
01500 GDSERR: ERR <Illegal JFN>,1
01600 SETOM .SKIP.
01700 SETZ 1,
01800 JRST GDSRET
00100 DSCR PROCEDURE SDSTS(INTEGER JFN,NEWSTATUS)
00200 ⊗
00300 HERE(SDSTS)
00400 VALCH1 1,<-2(P)>,SDSERR
00500 SETZM .SKIP. ;INDICATE NO ERROR
00600 MOVE 2,-1(P)
00700 JSYS SDSTS
00800 SDSRET: SUB P,X33
00900 JRST @3(P)
01000 SDSERR: ERR <Illegal JFN>,1
01100 SETOM .SKIP.
01200 JRST SDSRET
00100 DSCR INTEGER PROCEDURE STDEV(STRING S)
00200 S is a string pointer to a string of the form DTA1.
00300 The device designator is returned.
00400 ⊗
00500
00600 HERE(STDEV)
00700 PUSH P,[0]
00800 PUSHJ P,CATCHR
00900 POP SP,1
01000 SUB SP,X11 ;CLEAN SP STACK
01100 SETZM .SKIP.
01200 JSYS STDEV
01300 JRST [MOVEM 2,.SKIP.
01400 SETZ 1,
01500 JRST .+2]
01600 MOVE 1,2
01700 POPJ P,
01800
00100
00200 DSCR STRING PROCEDURE DEVST(INTEGER DEVICE)
00300 ⊗
00400 HERE(DEVST)
00500 PUSH P,[=100]
00600 PUSHJ P,ZSETST ;GET A BP FOR 100 CHARS
00700 SETZM .SKIP.
00800 MOVE 2,-1(P)
00900 JSYS DEVST
01000 MOVEM 2,.SKIP. ;INDICATE ERROR
01100 PUSH P,[=100]
01200 PUSH P,1 ;UPDATED BP
01300 PUSHJ P,ZADJST
01400 SUB P,X22
01500 JRST @2(P)
01600
00100
00200 ENDCOM(DEVINF)
00100 COMPIL(FIO,<OUT,CHAROUT,LINOUT,GTFDB>
00200 ,<CDBTBL,JFNTBL,X22,X33,X44,.SKIP.,SAVE,RESTR>
00300 ,<FILIO -- IO ROUTINES>)
00400
00500 DSCR SIMPLE PROCEDURE CHAROUT(INTEGER JFN; INTEGER JFN)
00600 ⊗
00700 HERE(CHAROUT)
00800 BEGIN CHAROUT
00900
01000 PUSH P,1
01100 PUSH P,2
01200 PUSH P,CDB
01300 PUSH P,CHNL
01400 SKIPL CHNL,-6(P) ;CHANNEL
01500 CAIL CHNL,JFNSIZE
01600 JRST CHOLIT ;USE JFN LITERALLY
01700 MOVE CDB,CDBTBL(CHNL)
01800 HRRZ 1,JFNTBL(CHNL)
01900 SKIPN 1
02000 JRST CHAOBAD
02100 LDB 2,[POINT 6,OFL(CDB),5] ;GET BYTE SIZE
02200 CAIN 2,=36
02300 JRST B36
02400 PUSHJ P,OPNCHK
02500 MOVE 2,-5(P)
02600 JSYS BOUT
02700 JRST CHARET
02800
02900 B36: MOVE 2,-5(P)
03000 SOSGE OCNT(CDB)
03100 PUSHJ P,STRSN0 ;WITH 1,CDB,CHNL LOADED
03200 IDPB 2,OBP(CDB)
03300 CHARET: POP P,CHNL
03400 POP P,CDB
03500 POP P,2
03600 POP P,1
03700 SUB P,X33
03800 JRST @3(P)
03900
04000 CHAOBAD: ERR <CHAROUT: Illegal JFN OR BYTE-SIZE>,1
04100 JRST CHARET
04200
04300 CHOLIT: MOVE 1,-6(P)
04400 MOVE 2,-5(P)
04500 JSYS BOUT
04600 JRST CHARET
04700
04800 BEND CHAROUT
04900
05000
05100
05200 DSCR SIMPLE PROCEDURE OUT(INTEGER JFN; STRING S)
05300 Outputs a SAIL string to the JFN, which may be open
05400 in DUMP mode.
05500 ⊗
05600 HERE(OUT)
05700 BEGIN OUT
05800 PUSHJ P,SAVE
05900 MOVE LPSA,X22
06000 HRRZ 3,-1(SP) ; GET THE COUNT
06100 JUMPE 3,SOURET ; DONT SEND NULL STRING
06200 VALCHN 1,-1(P),SOUBAD
06300 LDB 2,[POINT 6,OFL(CDB),5] ;GET BYTE SIZE
06400 CAIN 2,7 ;7-BIT?
06500 JRST USESOU ;USE SOUT
06600 CAIE 2,=36 ;36-BIT?
06700 JRST SOUBAD
06800
06900 ;HERE TO DO BUFFERED OUTPUT
07000 DMPAGN: ILDB 2,(SP) ;GET A CHARACTER
07100 SOSGE OCNT(CDB) ;AND DECREMENT BUFFER COUNT
07200 PUSHJ P,STRSN0 ;SO SEND THE BUFFER ;WITH 1,CDB,CHNL LOADED
07300 IDPB 2,OBP(CDB) ;AND COPY THE CHARACTER
07400 SOJG 3,DMPAGN ;STRING CHAR COUNT
07500 SOURET: SUB SP,X22
07600 JRST RESTR
07700
07800
07900 USESOU: PUSHJ P,OPNCHK ;CHECK IF OPEN
08000 MOVE 2,(SP) ; GET THE BYTE-POINTER
08100 MOVN 3,3 ; NEGATE BYTE-COUNT
08200 JSYS SOUT
08300 JRST SOURET
08400
08500 SOUBAD: ERR <OUT Illegal JFN OR BYTE-SIZE>,1
08600 JRST SOURET
08700
08800 BEND OUT
08900
00100 DSCR PROCEDURE LINOUT(INTEGER JFN,VALUE)
00200 ⊗
00300
00400 HERE(LINOUT)
00500 BEGIN LINOUT
00600
00700 PUSHJ P,SAVE
00800 VALCHN A,-2(P),LINBAD
00900 LDB B,[POINT 6,OFL(CDB),5] ;GET BYTE-SIZE
01000 CAIE B,=36 ;MUST BE 36-BIT
01100 JRST LINBAD
01200 SKIPG B,OCNT(CDB) ;ANY CHARS WAITING?
01300 PUSHJ P,STRSND ;NO, SEND (OR PERHAPS JUST INITIALIZE)
01400 MOVE TEMP,OBP(CDB) ;GET BP
01500
01600 LINOPL: TLNN TEMP,760000 ;LINED BP?
01700 JRST OKLIGN
01800 IBP TEMP
01900 SOJA B,LINOPL
02000
02100 OKLIGN: MOVEM TEMP,OBP(CDB)
02200 MOVEM B,OCNT(CDB)
02300 CAIGE B,=10 ;ENOUGH FOR 10 CHARS?
02400 PUSHJ P,STRSND ;NO
02500 SKIPGE B,-1(P) ;GET LINE-NO
02600 JRST [MOVNS B
02700 MOVNI A,5
02800 JRST NOCONV]
02900 MOVNI A,6
03000 MOVE C,[<ASCII /00000/>/2]
03100 EXCH B,C
03200 PUSH P,LNBAK
03300 LNCONV: IDIVI C,=10
03400 IORI D,"0"
03500 DPB D,[POINT 7,(P),6]
03600 SKIPE C
03700 PUSHJ P,LNCONV ;THE RECURSIVE PRINTER
03800 HLL C,(P)
03900 LSHC B,7
04000 LNBAK: POPJ P,.+1
04100 LSH B,1
04200 TRO B,1
04300 NOCONV: AOS C,OBP(CDB) ;MOVE A WORD OUT
04400 MOVEM B,(C)
04500 ADDM A,OCNT(CDB)
04600 MOVEI B,11
04700 CAME A,[-5]
04800 IDPB B,OBP(CDB) ;OUTPUT A TAB
04900 NOTAB: MOVE LPSA,X33
05000 JRST RESTR
05100 LINBAD: ERR <LINOUT: Illegal JFN OR MODE>,
05200 JRST NOTAB
05300
05400 BEND LINOUT
05500
05600
05700
00100 DSCR STRSND,STRSN0
00200 CAL PUSHJ
00300 SID SAVES ALL ACS
00400 ARGS
00500 1 JFN
00600 CDB address of channel data block
00700
00800 1) does the dump mode output only if there are characters
00900 to be sent, accounting for only as much of the buffer as is full.
01000 2) resets the OCNT and OBP variables.
01100
01200 OCNT always has the number of free characters remaining
01300 in the buffer. This means that routines such as RELEASE can call
01400 STRSND, and STRSND will be able to account for how many characters
01500 need to be sent. In this way, some of the classical problems
01600 with counts are averted, since OCNT is honest.
01700 The exception, of course, is in the tight loops for
01800 character transmission. These are found in CHAROUT and OUT.
01900 These are coded with (something like):
02000
02100 SOSGE OCNT(CDB)
02200 PUSHJ P,STRSN0
02300 ILDB CHAR,OBP(CDB)
02400
02500 At the call to STRSN0, OCNT is dishonest, reflecting the
02600 fact that one character has already been promised. Thus,
02700 the same code cannot be used for STRSND and STRSN0.
02800 Hence, two entries to the code here.
02900
03000 ⊗
03100
03200 BEGIN STRSND
03300 ↑↑STRSN0:
03400 AOS OCNT(CDB) ;MAKE THE COUNT HONEST, TEMPORARILY
03500 PUSHJ P,STRSND ;CALL STRSND
03600 SOS OCNT(CDB) ;REFLECT THE FACT THAT A CHARACTER IS PROMISED
03700 POPJ P, ;AND RETURN (TO CHARACTER OUTPUT CODE)
03800
03900 ↑↑STRSND:
04000 PUSHJ P,OPNCHK ;MAKE SURE OPEN
04100 PUSH P,2 ;SAVE ACS
04200 PUSH P,3
04300 PUSH P,4
04400 LDB 2,[POINT 4,OFL(CDB),9] ;GET MODE
04500 JUMPE 2,STRSOU ;USE SOUT
04600 CAIE 2,17 ;BETTER BE DUMP MODE
04700 ERR <STRSND: MODE NOT 0 OR 17>
04800 HRRZI 3,STARTPAGE(1) ;GET THE PAGE NUMBER FOR THE BUFFER
04900 IMULI 3,1000 ;MAKE AN ADDRESS
05000
05100 SKIPN OBP(CDB) ;INITIALIZED?
05200 JRST DMPINIT ;NO, JUST INITIALIZE
05300 MOVEI 4,DMOCNT*5
05400 CAMG 4,OCNT(CDB) ;ANY CHARS TO SEND
05500 JRST STRRET ;NO
05600
05700 MOVEI 2,3
05800 SUBI 3,1
05900 MOVNI 4,DMOCNT ;WORD COUNT FOR DUMP MODE OUTPUT
06000 HRL 3,4 ;MAKE AN IOWD
06100 SETZ 4, ;MAKE A COMMAND LIST
06200 JSYS DUMPO
06300 ERR <DUMPOUT: CANNOT WRITE DATA IN DUMP MODE>,1
06400 SETOM DMPED(CDB) ;AND INDICATE DONE
06500 DMPINIT:
06600 MOVEI 3,STARTPAGE(1)
06700 IMULI 3,1000
06800 HRL 2,3
06900 HRRI 2,1(3)
07000 SETZM (3)
07100 BLT 2,DMOCNT-1(3) ;ZERO OUT
07200 MOVEI 2,DMOCNT*5
07300 MOVEM 2,OCNT(CDB) ;SAVE COUNT
07400 HLL 3,[POINT 7,0,-1];FIX A BYTE-POINTER
07500 MOVEM 3,OBP(CDB) ;AND SAVE BYTE-POINTER
07600 STRRET: POP P,4 ;RESTORE AND RETURN
07700 POP P,3
07800 POP P,2
07900 POPJ P,
08000
08100 STRSOU: SKIPN OBP(CDB) ;INITIALIZED?
08200 JRST SOUINIT ;NO
08300 MOVEI 3,1000*5
08400 SUB 3,OCNT(CDB) ;NUMBER OF CHARACTERS ACTUALLY IN BUFFER
08500 IDIVI 3,5 ;NUMBER OF WORDS
08600 SKIPE 4 ;ANY REMAINDER?
08700 AOJ 3, ;YES, ANOTHER WORD FOR EXTRA CHARACTERS
08800 JUMPE 3,STRRET ;RETURN IF NO CHARACTERS TO SEND
08900 MOVN 3,3 ;NEGATIVE WORD COUNT FOR SOUT
09000 HRRZI 2,STARTPAGE(1)
09100 IMULI 2,1000 ;CALCULATE ADDRESS
09200 HRLI 2,444400 ;MAKE A BP
09300 JSYS SOUT
09400 SOUINIT:
09500 HRRZI 2,STARTPAGE(1)
09600 IMULI 2,1000
09700 HRL 3,2
09800 HRRI 3,1(2)
09900 SETZM (2)
10000 BLT 3,777(2) ;CLEAR OUT PAGE
10100 HRLI 2,440700
10200 MOVEM 2,OBP(CDB)
10300 MOVEI 3,1000*5
10400 MOVEM 3,OCNT(CDB)
10500 JRST STRRET
10600
10700 BEND STRSND
10800
10900
00100 DSCR SIMPLE PROCEDURE GTFDB(INTEGER JFN; REFERENCE INTEGER ARRAY BUF)
00200
00300 Entire FDB of JFN is read into BUF. No bounds checking,
00400 so BUF should be at least '26 words.
00500 ⊗
00600 HERE(GTFDB)
00700 PUSHJ P,SAVE
00800 MOVE LPSA,X33
00900 VALCHN 1,<-2(P)>,GTFBAD
01000 MOVSI 2,25 ;ALL 25 WORDS
01100 HRRZ 3,-1(P) ;ADDRESS OF ARRAY
01200 JSYS GTFDB
01300 GTFRET: JRST RESTR
01400
01500 GTFBAD: ERR <Illegal JFN>,1
01600 JRST GTFRET
01700
01800
01900 ENDCOM(FIO)
00100 COMPIL(BINROU,<WORDIN,WORDOUT,ARRYIN,ARRYOUT,MTOPR,SFPTR,RFPTR,BKJFN,RFBSZ>
00200 ,<JFNTBL,X22,X33,.SKIP.,CDBTBL,SAVE,RESTR>
00300 ,<BINROU -- BINARY ROUTINES>)
00400 DSCR INTEGER SIMPLE PROCEDURE WORDIN(INTEGER JFN);
00500 Does the BIN jsys on JFN.
00600 ⊗
00700 HERE(WORDIN)
00800 PUSH P,2
00900 PUSH P,CHNL
01000 PUSH P,CDB
01100 VALCHN 1,<-4(P)>,BINBAD
01200 PUSHJ P,OPNCHK
01300 SKIPE ENDFL(CDB)
01400 SETZM @ENDFL(CDB) ;ASSUME NO EOF
01500 SETZM .SKIP. ;ALSO MARK FOR EOF
01600 JSYS BIN
01700 JUMPE 2,CKWEOF ;CHECK EOF
01800 MOVE 1,2;
01900 BINRET: POP P,CDB ;RESTORE
02000 POP P,CHNL
02100 POP P,2
02200 SUB P,X22
02300 JRST @2(P)
02400 BINBAD: ERR <Illegal JFN>,1
02500 SETZ 1, ;RETURN A NULL
02600 JRST BINRET
02700
02800 CKWEOF: JSYS GTSTS ;CHECK STATUS
02900 TESTE 2,<1B8> ;END-OF-FILE?
03000 JRST [SKIPE ENDFL(CDB) ;EOF LOCATION
03100 SETOM @ENDFL(CDB) ;YES
03200 SETOM .SKIP. ;ALSO MARK
03300 JRST .+1]
03400 SETZ 1, ;RETURN NULL TO USER
03500 JRST BINRET
03600
03700
00100 DSCR SIMPLE PROCEDURE WORDOUT(INTEGER JFN,BYTE);
00200 Does the BOUT jsys.;
00300 ⊗
00400 HERE(WORDOUT)
00500 PUSHJ P,SAVE
00600 VALCHN 1,<-2(P)>,BOUBAD
00700 PUSHJ P,OPNCHK
00800 MOVE 2,-1(P);
00900 JSYS BOUT
01000 BOURET: MOVE LPSA,X33
01100 JRST RESTR
01200 BOUBAD: ERR <Illegal JFN>,1
01300 JRST BOURET
01400
00100 DSCR SIMPLE PROCEDURE ARRYIN(INTEGER JFN; REFERENCE INTEGER LOC; INTEGER COUNT);
00200 Reads in COUNT words into LOC from JFN. The file should be open
00300 for 36-bit bytes for this to work.
00400 WARNING: no array bounds checking.
00500 ⊗
00600 HERE(ARRYIN)
00700 PUSHJ P,SAVE
00800 MOVE LPSA,X44
00900 MOVN 3,-1(P) ;NEGATIVE WORD COUNT
01000 JUMPE 3,ARIRET
01100 JUMPG 3,ARIBAD ;NEGATIVE WORD COUNT
01200 SKIPL CHNL,-3(P)
01300 CAIL CHNL,JFNSIZE
01400 JRST ARIBAD
01500 MOVE CDB,CDBTBL(CHNL) ;GET CDB
01600 SKIPN 1,JFNTBL(CHNL)
01700 JRST ARIBAD
01800 SKIPE ENDFL(CDB) ;EOF LOCATION?
01900 SETZM @ENDFL(CDB) ;ASSUME GOOD
02000 SETZM .SKIP.
02100 HRRZ 1,1 ;THIS IS THE JFN NOW
02200 PUSHJ P,OPNCHK ;MAKE CERTAIN WE ARE OPEN
02300 LDB 2,[POINT 4,OFL(CDB),9] ;GET THE MODE
02400 JUMPE 2,USESIN ;MODE ZERO?
02500 CAIE 2,17 ;BETTER BE DUMP
02600 JRST ARIBAD
02700
02800 USEDMP: MOVEI 2,3
02900 HRL 3,3 ;NEGATIVE WORD COUNT
03000 HRR 3,-2(P) ;ADDRESS OF BUFFER
03100 SUBI 3,1
03200 SETZB 4,.SKIP. ;ZERO NEXT LOCATION, ERROR WORD
03300 JSYS DUMPI
03400 JRST DMPERR
03500 JRST ARIRET ;RETURN
03600
03700 USESIN: MOVSI 2,444400 ;BYTE-POINTER
03800 HRR 2,-2(P) ;LOCATION
03900 SETZM .SKIP. ;ASSUME NO ERROR
04000 JSYS SIN
04100 SKIPE 3 ;EVERYTHING READ ?
04200 JRST SINEOF
04300 ARIRET: JRST RESTR
04400
04500 SINEOF: ADD 3,-1(P) ;CALCULATE NO. OF WORDS READ IN
04600 HRLI 3,-1 ;MAKE IT XWD -1,COUNT
04700 SKIPE ENDFL(CDB) ;EOF LOCATION
04800 MOVEM 3,@ENDFL(CDB) ;AND SAVE
04900 SETOM .SKIP.
05000 JRST ARIRET
05100
05200
05300 ARIBAD: ERR <ARRYIN: NEGATIVE WORD COUNT, Illegal JFN OR ILLEGAL MODE>,1
05400 ARIBA1: SETOM .SKIP.
05500 JRST ARIRET
05600
05700 DMPERR: CAIN 1,600220 ;END OF FILE?
05800 JRST DMPEOF
05900 ERR <ARRYIN: DUMP MODE ERROR>,1
06000 JRST ARIBA1
06100
06200 DMPEOF: SKIPE ENDFL(CDB) ;EOF LOCATION
06300 SETOM @ENDFL(CDB) ;INDICATE EOF
06400 SETOM .SKIP.
06500 MOVE 1,DVTYP(CDB) ;GET DEVICE TYPE
06600 CAIE 1,2 ;IS IT MAGNETIC TAPE?
06700 JRST ARIRET ;NO
06800 HRRZ 1,JFNTBL(CHNL) ;THE JFN
06900 SETZ 2,
07000 JSYS MTOPR ;CLEAR STATUS
07100 JRST ARIRET ;AND RETURN
07200
07300
00100 DSCR SIMPLE PROCEDURE ARRYOUT(INTEGER JFN; REFERENCE INTEGER LOC; INTEGER COUNT);
00200 DESR
00300 Writes COUNT words to JFN starting at LOC. The file should be open
00400 in 36-bit bytes.;
00500 ⊗
00600
00700 HERE(ARRYOUT)
00800 PUSHJ P,SAVE
00900 MOVE LPSA,X44
01000 MOVN 3,-1(P) ;COUNT
01100 JUMPE 3,ARORET
01200 JUMPG 3,AROBAD ;NEGATIVE COUNT?
01300 SKIPL 1,-3(P) ;CHANNEL
01400 CAIL 1,JFNSIZE
01500 JRST AROBAD
01600 MOVE CDB,CDBTBL(1)
01700 SKIPN 1,JFNTBL(1)
01800 JRST AROBAD
01900 HRRZ 1,1 ;JFN
02000 PUSHJ P,OPNCHK
02100 LDB 2,[POINT 4,OFL(CDB),9] ;GET THE MODE
02200 JUMPE 2,AROSOU ;MODE ZERO?
02300
02400 CAIE 2,17 ;BETTER BE DUMP
02500 JRST AROBAD ;NOT OPEN IN DUMP MODE
02600
02700 ARODMP: MOVEI 2,3
02800 HRL 3,3 ;NEGATIVE WORD COUNT
02900 HRR 3,-2(P)
03000 SUBI 3,1 ;MAKE AN IOWD
03100 SETZB 4,.SKIP.
03200 JSYS DUMPO
03300 JRST DMPOER
03400 SETOM DMPED(CDB) ;INDICATE DUMP MODE
03500 JRST ARORET ;RETURN
03600
03700 AROSOU: MOVSI 2,444400 ;BYTE-POINTER
03800 HRR 2,-2(P) ;LOCATION
03900 SETZM .SKIP.
04000 JSYS SOUT
04100 ARORET: JRST RESTR
04200
04300 AROBAD: ERR <ARRYOUT: NEGATIVE WORD COUNT, Illegal JFN OR ILLEGAL MODE>,1
04400 AROBA1: SETOM .SKIP.
04500 JRST ARORET
04600
04700 DMPOER: ERR <ARRYOUT: DUMP MODE ERROR>,1
04800 JRST AROBA1
04900
05000
00100 DSCR SIMPLE PROCEDURE MTOPR(INTEGER JFN,FUNCTION,VALUE)
00200 Does the MTOPR jsys.
00300 ⊗
00400 HERE(MTOPR)
00500 BEGIN MTOPR
00600 PUSHJ P,SAVE
00700 MOVE LPSA,X44
00800 VALCHN 1,-3(P),MTBAD
00900 MOVE 2,-2(P)
01000 MOVE 3,-1(P)
01100 JSYS MTOPR
01200 MTRET: JRST RESTR
01300
01400 MTBAD: ERR <Illegal JFN>,1
01500 JRST MTRET
01600
01700 BEND MTOPR
01800
00100 DSCR SIMPLE PROCEDURE SFPTR(INTEGER JFN,POINTER)
00200 Sets the file open on JFN to byte POINTER (-1 for EOF).
00300 Errors returned in .SKIP.
00400 WARNING: presently not compatible with special character
00500 mode.
00600 ⊗
00700 HERE(SFPTR)
00800 PUSHJ P,SAVE
00900 MOVE LPSA,X33
01000 VALCHN 1,-2(P),SFBAD
01100 SETZM .SKIP.
01200 MOVE 2,-1(P)
01300 JSYS SFPTR
01400 MOVEM 1,.SKIP.
01500 SFRET: JRST RESTR
01600
01700 SFBAD: ERR <Illegal JFN>,1
01800 SETOM .SKIP.
01900 JRST SFRET
02000
02100
02200
02300
00100 DSCR INTEGER SIMPLE PROCEDURE RFPTR(INTEGER JFN)
00200 Reads the pointer of JFN. Error codes to .SKIP.
00300 WARNING: presently does not work for files in special character
00400 mode.
00500 ⊗
00600 HERE(RFPTR)
00700 PUSHJ P,SAVE
00800 MOVE LPSA,X22
00900 VALCHN 1,-1(P),RFBAD
01000 SETZM .SKIP.
01100 JSYS RFPTR
01200 MOVEM 1,.SKIP.
01300 MOVEM 2,RACS+A(USER) ;ANSWER IN 2
01400 RFRET: JRST RESTR
01500
01600 RFBAD: ERR <Illegal JFN>,1
01700 SETOM .SKIP.
01800 JRST RFRET
01900
00100 DSCR SIMPLE PROCEDURE BKJFN(INTEGER JFN)
00200 Does the BKJFN jsys on JFN, error code to .SKIP.
00300 ⊗
00400 HERE(BKJFN)
00500 PUSHJ P,SAVE
00600 MOVE LPSA,X22
00700 VALCHN 1,-1(P),BKBAD
00800 SETZM .SKIP.
00900 JSYS BKJFN
01000 MOVEM 1,.SKIP.
01100 BKRET: JRST RESTR
01200
01300 BKBAD: ERR <Illegal JFN>,1
01400 SETOM .SKIP.
01500 JRST BKRET
00100 DSCR INTEGER SIMPLE PROCEDURE RFBSZ(INTEGER JFN);
00200 Reads the byte-size of the file open on JFN.
00300 ⊗
00400 HERE(RFBSZ)
00500 PUSHJ P,SAVE
00600 MOVE LPSA,X22
00700 VALCHN 1,-1(P),RFBBAD
00800 JSYS RFBSZ
00900 MOVEM 2,RACS+A(USER) ;ANSWER IN 2
01000 RFBRET: JRST RESTR
01100
01200 RFBBAD: ERR <Illegal JFN>,1
01300 JRST RFBRET
01400 ENDCOM(BINROU)
01500
00100 IMSSS,<
00200 COMPIL(DSKOPS,<DSKIN,DSKOUT>
00300 ,<JFNTBL,CDBTBL,.SKIP.>
00400 ,<DSKOPS -- DIRECT DSK ROUTINES>)
00500
00600 DSCR SIMPLE PROCEDURE
00700 DSKIN(INTEGER MODULE,RECNO,COUNT; REFERENCE INTEGER LOC);
00800
00900 IMSSS only.
01000 Does direct IO from the DSK (formerly device "PAK").
01100 Modules 4-7 are legal for everyone. Other modules require enabled
01200 status.
01300 Count words are read into user's core at location LOC, from
01400 MODULE, record RECNO. Error bits are in .SKIP.
01500 Does the DSKOP jsys (as modified at IMSSS).
01600 ⊗
01700
01800 BEGIN DSKOPS
01900 HERE(DSKIN)
02000 PUSHJ P,SAVE
02100 SETZ 4, ;INDICATE READ ONLY
02200
02300 DSK1: HRRZ 2,-2(P)
02400 JUMPLE 2,DSBAD ;LEQ 0 -- ERROR
02500 CAILE 2,1000 ;DONT READ MORE THAN 1000 WORDS
02600 JRST DSBAD
02700 IOR 2,4 ;PICK UP READ OR WRITE (SET IN 4)
02800 HRLZ 1,-4(P) ;MODULE
02900 HRR 1,-3(P) ;RECORD NO. IN RIGHT HALF
03000 TLO 1,600000 ;SOFTWARD ADDRESS, IMSSS FORMAT (BITS 0 AND 1 RES.)
03100 HRRZ 3,-1(P) ; GET THE USER LOCATION
03200 JSYS DSKOP
03300 DSDUN: MOVEM 1,.SKIP. ; SAVE ERROR BITS
03400 DSRET: MOVE LPSA,[XWD 5,5] ; TO ADJUST STACK
03500 JRST RESTR
03600 DSBAD: ERR <DSKIN OR DSKOUT: WORD COUNT EITHER <= 0 OR > '1000>,1
03700 SETOM .SKIP.
03800 JRST DSRET
03900
04000
04100
00100 DSCR SIMPLE PROCEDURE
00200 DSKOUT(INTEGER MODULE,RECNO,COUNT; REFERENCE INTEGER LOC)
00300 DESR Similar to DSKIN, except that a write is done.
00400 ⊗
00500
00600 HERE(DSKOUT)
00700 PUSHJ P,SAVE
00800 MOVSI 4,(1B14) ;INDICATE WRITE (TO BE IOR'ED INTO AC 2)
00900 JRST DSK1 ;AND TO THE ABOVE CODE
01000
01100 BEND DSKOPS
01200
01300 ENDCOM(DSKOP)
01400 >;IMSSS
01500
00100 COMPIL(DEVS,<DEVTYPE,DVCHR,ERSTR>
00200 ,<X22,X44,.SKIP.,JFNTBL,CDBTBL>
00300 ,<DEVS -- DEVICE HANDLERS, ERROR ROUTINE>)
00400 DSCR INTEGER SIMPLE PROCEDURE DEVTYPE(INTEGER JFN);
00500 Returns (via the DEVCHR jsys) the device type of
00600 the device open on JFN. The more general DEVCHR call is
00700 also implemented (below).
00800 ⊗
00900 HERE(DEVTYPE)
01000 VALCHN 1,-1(P),DEVBAD
01100 JSYS DVCHR
01200 HLRZ 1,2
01300 ANDI 1,777
01400 DEVRET: SUB P,X22
01500 JRST @2(P)
01600 DEVBAD: ERR <Illegal JFN>,1
01700 JRST DEVRET
00100 DSCR INTEGER SIMPLE PROCEDURE DVCHR(INTEGER JFN; REFERENCE INTEGER AC1,AC3);
00200 Does the DEVCHR jsys, returning the flags from AC2 as the
00300 value of the call, and AC1 and AC3 get the contents of ac's 1 and 3.;
00400 ⊗
00500 HERE(DVCHR)
00600 VALCHN 1,-3(P),DVBAD
00700 JSYS DVCHR
00800 MOVEM 1,@-2(P)
00900 MOVEM 3,@-1(P)
01000 MOVE 1,2
01100 DVRET: SUB P,X44
01200 JRST @4(P)
01300 DVBAD: ERR <Illegal JFN>,1
01400 JRST DVRET
01500
01600
00100 DSCR SIMPLE PROCEDURE ERSTR(INTEGER ERRNO,FORK)
00200 Using the ERSTR jsys, types out on the console the TENEX error string
00300 associated with ERRNO for FORK fork (0 for the current fork). Parameters (in
00400 the sense of the ERSTR jsys) are expanded.
00500 Types out the string ERSTR: UNDEFINED ERROR number if
00600 something is with your error number or fork (and sets .SKIP. to -1).
00700 ⊗
00800 HERE(ERSTR)
00900 SETZM .SKIP.
01000 MOVEI 1,101 ;PRIMARY OUTPUT
01100 SKIPN 2,-1(P) ;ANY FORK MENTIONED?
01200 MOVEI 2,400000 ;ASSUME CURRENT FORK
01300 HRLZ 2,2 ;IN LEFT HALF
01400 HRR 2,-2(P) ;THE ERROR NUMBER
01500 SETZ 3, ;NO LIMIT TO SIZE OF STRING
01600 JSYS ERSTR
01700 JRST ERSERR
01800 JRST ERSERR ;ERROR RETURNS
01900 ERSRET: SUB P,X33
02000 JRST @3(P)
02100 ERSERR: HRROI 1,[ASCIZ/
02200 ERSTR: UNDEFINED ERROR NUMBER
02300 /]
02400 JSYS PSOUT
02500 SETOM .SKIP. ;INDICATE ERROR
02600 JRST ERSRET
02700 ENDCOM(DEVS)
02800
00100 COMPIL(UTILITY,<SETCHN,ZSETST,ZADJST,.RESET>
00200 ,<CORGET,GOGTAB,JFNTBL,CDBTBL,STRNGC,INSET>
00300 ,<UTILITY -- UTILITY TENEX ROUTINES>)
00400 DSCR
00500 SETCHN accepts in A the JFN, and returns in A the channel number associated with a JFN.
00600 It sets up the JFNTBL, the CDBTBL table, and returns the address of the
00700 file command block in ac CDB. Other acs are not modified (except USER).
00800 In order to accommodate the open statement, a channel will be
00900 considered allocated when it has a CDB, even if it does not yet have a jfn.
01000 ⊗
01100
01200 HERE(SETCHN)
01300 MOVE USER,GOGTAB
01400 PUSH P,B
01500 PUSH P,C
01600 PUSH P,D
01700
01800 SKIPE CDBTBL(A) ;CAN WE USE THE SAME CHANNEL AS JFN?
01900 JRST FNDCHN ;PERHAPS NOT, FIND ONE SOME HOW
02000 HRRZ D,A ;USE JFN AS CHANNEL
02100 ;MUST GET A CHANNEL DATA BLOCK
02200 GTCDB: MOVEI C,IOTLEN
02300 PUSHJ P,CORGET
02400 ERR <SETCHN: NO CORE>
02500 MOVE CDB,B
02600 MOVEM CDB,CDBTBL(D) ;SAVE ADDR OF CDB
02700 ;HERE WITH B,CDB, D LOADED WITH: CDBADDR,CDBADDR,CHANNEL
02800 CLCDB:
02900 HRL B,B
03000 ADDI B,1
03100 SETZM (CDB)
03200 BLT B,IOTLEN-1(CDB)
03300
03400 GOTCHN:
03500 MOVEM A,JFNTBL(D)
03600 HRRZ 1,A ;JFN
03700 JSYS DVCHR ;CLOBBERS 1,2,3
03800 MOVEM 1,DVDSG(CDB) ;SAVE DESIGNATOR
03900 MOVEM 2,DVCH(CDB) ;AND CHARACTERISTICS
04000 HLRZ 1,2
04100 ANDI 1,777 ;GET DEVICE TYPE
04200 MOVEM 1,DVTYP(CDB) ;AND SAVE IT
04300 HRRZ A,D ;CHANNEL INTO A
04400 POP P,D ;RESTORE
04500 POP P,C
04600 POP P,B
04700 POPJ P,
04800
04900
05000 ;FIND AN OPEN CHANNEL AND RETURN THE NUMBER IN D
05100 ;A HAS THE JFN NO. IN IT, SO CHECK TO SEE IF THE SAME
05200 ;B MAY BE CLOBBERED
05300 FNDCHN: HRRZ D,JFNTBL(A) ;CHECK OLD JFN
05400 CAIE D,(A) ;SAME AS THE NEW?
05500 JRST FNDCH2 ;NO
05600 MOVE CDB,CDBTBL(D) ;GET OLD CDB
05700 MOVE B,CDB ;COPY CDB ADDR FOR BLT
05800 JRST CLCDB
05900
06000 FNDCH2: SETZ D,
06100 FNDCH1: CAIL D,JFNSIZE
06200 ERR <SETCHN: JFN TABLE IS FULL (SHOULD NEVER HAPPEN)>
06300 SKIPE CDBTBL(D) ;IS IT EMPTY?
06400 AOJA D,FNDCH1 ;NO LOOK SOME MORE
06500 JRST GTCDB ;YES, USE IT
06600
06700
06800 DSCR SIMPLE INTEGER PROCEDURE ZSETST(INTEGER I);
06900
07000 Internal book-keeping routine not intended for
07100 use from SAIL. Causes liberation from SAIL.
07200
07300 THE ARGUMENT IS THE MAXIMUM SIZE OF THE EXPECTED STRING.
07400 THE RETURN IS THE BYTEPOINTER POINTING INTO THE TOP OF STRING SPACE
07500 ⊗
07600
07700 HERE(ZSETST)
07800 MOVE USER,GOGTAB ; GET USER
07900 SKIPE SGLIGN(USER)
08000 PUSHJ P,INSET ;ASSUMING THAT IT IS TRANSPARENT FOR THE ACS
08100 MOVE 1,-1(P) ;GET EXPECTED LENGTH
08200 ADDM 1,REMCHR(USER) ; ADD ON
08300 SKIPLE REMCHR(USER) ; NEED TO COLLECT?
08400 PUSHJ P,GOCOLLECT ; YES
08500 MOVE 1,TOPBYTE(USER) ; RETURN BP
08600 SUB P,X22 ; ADJUST STACK
08700 JRST @2(P) ; RETURN
08800
08900 GOCOLLECT:
09000 MOVEM RF,RACS+RF(USER) ;SAVE RF
09100 PUSHJ P,STRNGC ;
09200 POPJ P, ; RETURN TO ABOVE
09300
00100 DSCR STRING SIMPLE PROCEDURE ZADJST(INTEGER CNTEST,BP)
00200 Internal book-keeping routine.
00300 ADJUSTS THE PARAMETERS ASSOCIATED WITH STRING SPACE.
00400 BP IS OUR NEW TOPBYTE. CNTEST IS THE COUNT ESTIMATE WE
00500 ORIGINALLY MADE.
00600 FIRST, WE MUST MAKE REMCHR HONEST, THEN WE
00700 CAN FIX TOPSTR AND THE USER'S LENGTH WORD.
00800 ⊗
00900 HERE(ZADJST)
01000 BEGIN ZADJST
01100
01200
01300 MOVE USER,GOGTAB;
01400 PUSH P,1
01500 PUSH P,2
01600 PUSH P,3
01700 PUSH P,4
01800
01900 DEFINE CNTARG <-6(P)>
02000 DEFINE BPARG <-5(P)>
02100
02200 MOVE 2,BPARG ;UPDATED BP
02300 MOVE 1,TOPBYTE(USER) ; GET OLD TOPBYTE
02400 CAMN 1,2 ; THE NULL STRING?
02500 JRST NULRET; ;YES
02600 ;P. KANERVA'S BYTE ROUTINE
02700 LDB 3,[POINT 6,1,5] ;BITS TO THE RIGHT OF BYTE 1
02800 LDB 4,[POINT 6,2,5] ;BITS TO THE RIGHT OF BYTE 2
02900 SUBI 3,(4) ;BIT DIFFERENCE
03000 IDIVI 3,7 ;WITHIN-WORD BYTE DIFFERENCE
03100
03200 SUBI 2,(1) ;WORDS BETWEEN BYTES
03300 HRRE 2,2 ;FULL WORD DIFFERENCE
03400 IMULI 2,5 ;CONVERT IT TO BYTE DIFFERENCE
03500 ADD 2,3 ;ADD COUNT DERIVED FROM WITHIN-WORD
03600 ;DIFFERENCE
03700
03800 CAMLE 2,CNTARG ;WITHIN RANGE?
03900 ERR <ZADJST: TENEX WROTE TOO LONG A STRING, MAY BE FATAL>,1
04000 GOTLNG: HRRO 1,2 ; XWD -1,COUNT
04100 PUSH SP,1 ; XWD -1,COUNT
04200 PUSH SP,TOPBYTE(USER) ; OLD TOPBYTE FOR BP FOR STRING
04300 SUB 2,CNTARG ; SUBTRACT THE COUNT ESTIMATE
04400 ADDM 2,REMCHR(USER) ; MAKE REMCHR HONEST
04500 MOVE 2,BPARG ; GET THE NEW TOPBYTE
04600 MOVEM 2,TOPBYTE(USER) ; AND SAVE IT
04700 POP P,4
04800 POP P,3
04900 POP P,2
05000 POP P,1
05100 SUB P,X33 ; ADJUST STACK
05200 JRST @3(P) ;
05300
05400 NULRET: SETZ 2,;
05500 JRST GOTLNG ; BE SURE TO FIX UP ALL THE GOODIES
05600
05700 BEND ZADJST
05800
00100 DSCR
00200 .RESET
00300 SID SAVES ALL ACS
00400 CAL PUSHJ, FROM SAIL AND THE COMPILER
00500
00600 RESETS TENEX IO AND BOOKKEEPING, AND SETS THE TTY MODE TO WAKEUP
00700 ON EVERY CHARACTER.
00800 THIS SHOULD ONLY BE CALLED INTERNALLY
00900 ⊗
01000 HERE(.RESET)
01100 BEGIN RESET
01200 ;ZERO OUT BOOKKEEPING
01300 PUSH P,1
01400 PUSH P,2
01500 PUSH P,3
01600 SETZM JFNTBL
01700 MOVE 1,[XWD JFNTBL,JFNTBL+1]
01800 BLT 1,JFNTBL+JFNSIZE-1
01900 SETZM CDBTBL
02000 MOVE 1,[XWD CDBTBL,CDBTBL+1]
02100 BLT 1,CDBTBL+JFNSIZE-1
02200
02300 ;RELEASE PAGES ASSOCIATED WITH FILES (FROM STARTPAGE TO STARTPAGE+JFNSIZE-1)
02400 SETO 1, ;RELEASE PAGE
02500 SETZ 3, ;FLAGS WORD
02600 MOVE 2,[XWD 400000,STARTPAGE]
02700 .RESE1: CAMN 2,[XWD 400000,STARTPAGE+JFNSIZE] ;THIS WOULD BE TOO MANY PAGES
02800 JRST .RESE2
02900 JSYS PMAP
03000 AOJA 2,.RESE1 ;NEXT?
03100
03200 .RESE2:
03300 JSYS RESET ;CLEAR ALL IO
03400
03500 ;SET UP PSI SYSTEM
03600 HRRZI 1,400000 ;USE EXISTING TABLE IF THERE
03700 JSYS RIR
03800 JUMPN 2,.+3 ;ALREADY THERE
03900 MOVE 2,[XWD LEVTAB,CHNTAB]
04000 JSYS SIR
04100 JSYS EIR ;TURN ON INTERRUPTS
04200
04300 ;SET PRIMARY INPUT TO WAKE UP ON EVERY CHARACTER
04400 ;THE USER MAY RESET THIS.
04500 MOVEI 1,100 ;PRIMARY INPUT
04600 JSYS RFMOD
04700 TRO 2,170000 ;WAKEUP ON ALL CHARS
04800 JSYS SFMOD
04900 SETZM CTLOSW ;CLEAR OUTPUT-SUPPRESSION SWITCH
05000
05100 POP P,3
05200 POP P,2
05300 POP P,1
05400 POPJ P,
05500 BEND RESET
05600
05700 ;ROUTINE TO CHECK IF A JFN HAS BEEN CLOSED BY ONE OF
05800 ;THE DEC-STYLE CLOSE ROUTINES (IN WHICH CASE IT
05900 ;MUST BE AVAILABLE FOR RE-OPENING)
06000 ;ARGS:
06100 ; 1 JFN
06200 ; CDB THE CHANNEL DATA BLOCK
06300 ; CHNL THE CHANNEL NUMBER
06400 ↑OPNCHK:
06500 SKIPN DECCLZ(CDB) ;CLOSED BY DEC?
06600 POPJ P, ;NO
06700 PUSH P,2 ;SAVE 2
06800 MOVE 2,OFL(CDB) ;PREVIOUSLY USED FLAGS
06900 JSYS OPENF ;OPEN
07000 ERR <OPNCHK: CANNOT OPENF FILE>
07100 SETZM DECCLZ(CDB)
07200 POP P,2 ;RESTORE 2
07300 POPJ P, ;RETURN
07400
07500 ;SIMILAR TO OPNCHK EXCEPT THAT
07600 ;ARGS:
07700 ; CHNL THE CHANNEL NUMBER
07800 ; CDB THE CHANNEL DATA BLOCK
07900 ↑OPNCH1:
08000 SKIPN DECCLZ(CDB) ;CLOSED BY DEC?
08100 POPJ P,
08200 PUSH P,1
08300 PUSH P,2
08400 HRRZ 1,JFNTBL(CHNL)
08500 MOVE 2,OFL(CDB)
08600 JSYS OPENF
08700 ERR <OPNCHK: CANNOT OPENF FILE>
08800 POP P,2
08900 POP P,1
09000 POPJ P, ;RETURN;
09100 ENDCOM(UTILITY)
00100 COMPIL(TTM,<RFMOD,SFMOD,RFCOC,SFCOC>
00200 ,<SAVE,RESTR,X22,X33,X44>
00300 ,<TTM -- TERMINAL MODE ROUTINES>)
00400
00500 DSCR INTEGER PROCEDURE RFMOD(INTEGER CHAN)
00600
00700 Reads a file's mode word.
00800
00900 PROCEDURE SFMOD(INTEGER CHAN,AC2)
01000
01100 Sets a file's mode word to argument AC2.
01200
01300 PROCEDURE RFCOC(INTEGER CHAN; REFERENCE INTEGER AC2,AC3)
01400
01500 Does RFCOC jsys, returning values in AC2 and AC3.
01600
01700 PROCEDURE SFCOC(INTEGER CHAN,AC2,AC3)
01800
01900 Does SFCOC jsys, setting to AC2 and AC3.
02000
02100
02200 ⊗
02300
02400 HERE(RFMOD)
02500 PUSHJ P,SAVE
02600 MOVE LPSA,X22
02700 VALCH1 1,-1(P),RFMO1
02800 RFMO2: JSYS RFMOD
02900 MOVEM 2,RACS+A(USER)
03000 JRST RESTR
03100 RFMO1: MOVE 1,-1(P) ;USE LITERALLY
03200 JRST RFMO2
03300
03400
03500
03600 HERE(SFMOD)
03700 PUSHJ P,SAVE
03800 MOVE LPSA,X33
03900 VALCH1 1,-2(P),SFMO1
04000 SFMO2: MOVE 2,-1(P)
04100 JSYS SFMOD
04200 JRST RESTR
04300 SFMO1: MOVE 1,-2(P)
04400 JRST SFMO2
04500
04600 HERE(RFCOC)
04700 PUSHJ P,SAVE
04800 MOVE LPSA,X44
04900 VALCH1 1,-3(P),RFCO1
05000 RFCO2: JSYS RFCOC
05100 MOVEM 2,@-2(P)
05200 MOVEM 3,@-1(P)
05300 JRST RESTR
05400 RFCO1: MOVE 1,-3(P) ;USE LITERALLY
05500 JRST RFCO2
05600
05700 HERE(SFCOC)
05800 PUSHJ P,SAVE
05900 MOVE LPSA,X44
06000 VALCH1 1,-3(P),SFCO1
06100 SFCO2: MOVE 2,-2(P)
06200 MOVE 3,-1(P)
06300 JSYS SFCOC
06400 JRST RESTR
06500 SFCO1: MOVE 1,-3(P) ;USE LITERALLY
06600 JRST SFCO2
06700
06800
06900 ENDCOM(TTM)
07000
00100 COMPIL(PAGES,<PMAP>,<SAVE,RESTR,X44>
00200 ,<PAGES -- PAGE MANAGEMENT>)
00300 DSCR SIMPLE PROCEDURE PMAP(INTEGER AC1,AC2,AC3);
00400 DESR
00500 Does the PMAP jsys, with these parameters:
00600
00700 ARGUMENTS:
00800 AC1 contents of AC1
00900 AC2 " of AC2
01000 AC3 " of AC3
01100
01200 ⊗
01300 HERE(PMAP)
01400 PUSHJ P,SAVE
01500 MOVE LPSA,X44
01600 MOVE 1,-3(P) ;FILEPAGE
01700 MOVE 2,-2(P) ;XWD FORK,PAGE
01800 MOVE 3,-1(P) ;ACCESS BITS
01900 JSYS PMAP
02000 JRST RESTR
02100 ENDCOM(PAGES)
00100 IMSSS,<
00200 COMPIL(TT2,<PBTIN,INTTY>
00300 ,<X22,.SKIP.,ZSETST,ZADJST,CTLOSW>
00400 ,<TT2 -- IMSSS TTY ROUTINES>)
00500
00600 DSCR INTEGER SIMPLE PROCEDURE PBTIN(INTEGER SECONDS);
00700 DESR
00800 Executes the PBTIN jsys, with timing of SECONDS.
00900 ⊗
01000 HERE(PBTIN)
01100 SETZM CTLOSW ;PROGRAM REQUESTS INPUT
01200 MOVE 1,-1(P) ;TIME IN SECONDS
01300 JSYS PBTIN
01400 SUB P,X22
01500 JRST @2(P)
01600
00100 DSCR STRING SIMPLE PROCEDURE INTTY;
00200 Using the PSTIN jsys, accepts as many as 200 characters from
00300 the user's Teletype, with the standard system breakcharacters. The
00400 breakcharacter itself is removed from the string, and
00500 no timing is available. For fancier calls, see PSTIN routine.
00600 ⊗
00700
00800 HERE(INTTY)
00900 PUSH P,1
01000 PUSH P,2
01100 PUSH P,3
01200 SETZB 3,CTLOSW ;PROGRAM REQUESTS INPUT
01300 MOVEI 2,=200 ;DEFAULT LENGTH
01400 INTT2: PUSH P,2 ;LENGTH
01500 PUSHJ P,ZSETST ;GET BP IN 1
01600 JSYS PSTIN
01700 CAIL 2,=200 ;DID WE GET 200 CHARS?
01800 JRST [SETOM .SKIP.
01900 JRST INTT1]
02000 LDB 3,1 ;GET THE LAST CHAR
02100 MOVEM 3,.SKIP. ;AND SAVE IT
02200 SOJ 1, ;BACK UP BYTE-POINTER (OVER LAST CHAR)
02300 IBP 1
02400 IBP 1
02500 IBP 1
02600 IBP 1
02700 INTT1: PUSH P,[=200]
02800 PUSH P,1
02900 PUSHJ P,ZADJST ;GET STRING ON STACK
03000 POP P,3
03100 POP P,2
03200 POP P,1
03300 POPJ P, ;RETURN
03400
03500
03600 ENDCOM(TT2)
03700 >;IMSSS
03800
00100 NOIMSSS<;NON-IMSSS VERSION OF INTTY FOR THOSE WHO SUFFER
00200 ;UNDER BBN'S LACK OF A SYSTEM LINE EDITOR
00300
00400 COMPIL(TT2,<INTTY>
00500 ,<X11,.SKIP.,ZSETST,ZADJST,CTLOSW,SAVE,RESTR>
00600 ,<TT2 -- INTTY FOR TENEX STYLE INPUT>)
00700 DSCR INTTY
00800
00900
01000 ⊗;
01100 HERE(INTTY)
01200 BEGIN INTTY
01300 ORIGCNT←←=200
01400 ;AC USES A,B,C JSYS TEMPORARIES
01500 ; D BYTEPOINTER
01600 ; E COUNT, INITIALLY 0
01700 ; Q1 (=6) ORIGINAL BP
01800
01900
02000 PUSHJ P,SAVE
02100 SETZM CTLOSW
02200 MOVEI A,101
02300 JSYS RFMOD
02400 PUSH P,B ;SAVE THE TTY MODE
02500 TRO B,170000 ;WAKEUP ON EVERYTHING
02600 JSYS SFMOD
02700
02800 PUSH P,[ORIGCNT] ;
02900 PUSHJ P,ZSETST ;GET A GOOD BP IN A
03000 MOVE Q1,A
03100
03200
03300
03400 RESTRT: MOVE D,Q1 ;GET THE ORIGINAL BP
03500 SETZ E, ;ZERO THE COUNT
03600 INLUP: CAIL E,ORIGCNT
03700 JRST CNTEXH ;COUNT EXHAUSTED
03800 JSYS PBIN ;GET A CHAR
03900 CAIE A,37 ;EOL?
04000 CAIN A,33 ;ESCAPE?
04100 JRST DONE
04200 CAIE A,32 ;CTRL-Z
04300 CAIN A,7 ;CTRL-G
04400 JRST DONE
04500 CAIE A,"R"-100 ;CTRL-R FOR REPEAT
04600 JRST NOCTR
04700 HRROI A,[ASCIZ/
04800 /]
04900 JSYS PSOUT
05000 JUMPE E,INLUP
05100 MOVEI A,101
05200 MOVE B,Q1 ;ORIG BP
05300 MOVN C,E ;COUNT THUS FAR
05400 JSYS SOUT
05500 JRST INLUP ;AND CONTINUE
05600 NOCTR: CAIE A,"X"-100 ;CONTROL-X FOR DELETE LINE
05700 JRST NOCTX
05800 DOCTX: HRROI A,[ASCIZ/
05900 /]
06000 JSYS PSOUT
06100 JRST RESTRT ;AND START ALL OVER
06200 NOCTX: CAIE A,177 ;RUBOUT OR
06300 CAIN A,"A"-100 ;CONTROL-A
06400 JRST .+2
06500 JRST NOCTA
06600 JUMPLE E,DOCTX ;IF NO CHARS THEN DO A CONTROL-X
06700 MOVEI A,"\"
06800 JSYS PBOUT
06900 LDB A,D ;LAST CHAR
07000 JSYS PBOUT
07100 MOVE A,D
07200 JSYS BKJFN
07300 JFCL
07400 MOVEM A,D ;BACK UP BP
07500 SOJA E,INLUP ;SUBTRACT 1 AND CONTINUE
07600 NOCTA: IDPB A,D
07700 AOJA E,INLUP ;ONE MORE CHAR
07800
07900 CNTEXH: SETO A, ;INDICATE NO COUNT
08000 DONE: MOVEM A,.SKIP. ;BREAK CHAR, -1 FOR EXHAUSTED
08100 PUSH P,[ORIGCNT]
08200 PUSH P,D ;NEW BP
08300 PUSHJ P,ZADJST ;FIX UP STRING SPACE, PUT STRING ON STACK
08400 MOVEI A,101
08500 POP P,B ;MODE SETTING
08600 JSYS SFMOD ;RESET
08700 MOVE LPSA,X11
08800 JRST RESTR ;AND RETURN
08900
09000 BEND INTTY
09100 ENDCOM(TT2)
09200 >;NOIMSSS
00100 COMMENT ⊗ TTY FUNCTIONS ⊗
00200
00300
00400 DSCR TTY FUNCTIONS
00500 CAL SAIL
00600 ⊗
00700
00800 Comment ⊗
00900 INTEGER PROCEDURE INCHRW;
01000 RETURN A CHAR FROM PBIN
01100
01200 INTEGER PROCEDURE INCHRS;
01300 RETURN -1 IF NO CHAR WAITING, ELSE FIRST CHAR (SIBE FOLLOWED BY PBIN)
01400
01500 STRING PROCEDURE INCHWL;
01600 WAIT FOR A LINE, THEN RETURN IT (PBINs, LINE EDITING)
01700
01800 STRING PROCEDURE INCHSL(REFERENCE INTEGER FLAG);
01900 FLAG←-1, STR←NULL IF NO LINE, ELSE FLAG←0,
02000 STR←LINE (SIBE, FOLLOWED BY PBINs)
02100
02200 STRING PROCEDURE INSTR(INTEGER BRCHAR);
02300 RETURN ALL CHARS TO AND NOT INCLUDING BRCHAR (PBINs)
02400
02500 STRING PROCEDURE INSTRL(INTEGER BRCHAR);
02600 WAIT FOR ONE LINE, THEN DO INSTR (PBINs WITH EDITING)
02700
02800 STRING PROCEDURE INSTRS(REFERENCE INTEGER FLAG; INTEGER BRCHAR);
02900 FLAG←-1, STR←NULL IF NO LINES, ELSE FLAG←0,
03000 STR←INSTR(BRCHAR)
03100
03200
03300 PROCEDURE OUTCHR(INTEGER CHAR);
03400 OUTPUT CHAR (PBOUT)
03500
03600 PROCEDURE OUTSTR(STRING STR);
03700 OUTPUT STR (SOUT)
03800
03900
04000 PROCEDURE CLRBUF;
04100 CLEARS INPUT BUFFER (CFIBF)
04200
04300 TTYIN, TTYINS, TTYINL (TABLE, @BRCHAR);
04400 TTYIN WORKS WITH TTCALL 0'S; TTYINS DOES A SKIP
04500 ON LINE FIRST, RETURNING NULL AND -1 IN BREAK IF NO LINES
04600 TTYINL DOES A WAIT FOR LINE FIRST.
04700 FULL BREAKSET CAPABILITIES EXCEPT FOR
04800 "R" MODE (AND OF COURSE, LINE NUM. STUFF)
04900
05000 TITLE TTYUUO
05100 ⊗
05200
05300 COMPIL(TTY,<PBIN,PBOUT,PSOUT,INCHRW,INCHRS,INCHWL,INCHSL,INSTR,OUTCHR,OUTSTR,INSTRL,INSTRS,CLRBUF,TTYIN,TTYINS,TTYINL,TTYUP
05400 >
05500 ,<SAVE,RESTR,X11,X22,X33,INSET,CAT,STRNGC,GOGTAB,BRKMSK,.SKIP.,CTLOSW>
05600 ,<TELETYPE FUNCTIONS>)
05700 ;;#GF# DCS 2-1-72 (1-3) INCHWL BREAKS ON ALL ACTIVATION, TELLS WHICH IN .SKIP.
05800 ; .SKIP. EXTERNAL ABOVE
05900 ;;#GF#
06000
00100 HERE(PBIN)
00200 HERE (INCHRW)
00300 SETZM CTLOSW ;INPUT REQUESTED
00400 INCHR1: JSYS PBIN
00500 POPJ P,
00600
00700 HERE (INCHRS)
00800 SETZM CTLOSW ;INPUT REQUESTED
00900 MOVEI 1,100
01000 JSYS SIBE
01100 JRST INCHR1
01200 SETO 1, ;RETURN -1
01300 POPJ P,
01400
01500 HERE(PBOUT)
01600 HERE (OUTCHR)
01700 SKIPE CTLOSW ;DOING OUTPUT?
01800 JRST OUTCRE ;NO
01900 EXCH 1,-1(P) ;GET PARAMETER, SAVING AC 1
02000 JSYS PBOUT ;OUTPUT CHAR
02100 EXCH 1,-1(P) ;GET BACK 1
02200 OUTCRE: SUB P,X22
02300 JRST @2(P) ;RETURN
02400
02500
02600 HERE(PSOUT)
02700 HERE (OUTSTR)
02800 SKIPE CTLOSW ;DOING OUTPUT?
02900 JRST [SUB SP,X22
03000 POPJ P,
03100 ]
03200 EXCH 2,(SP) ;BP WORD
03300 EXCH 3,-1(SP) ;LENGTH WORD
03400 PUSH P,1 ;ALSO NEED 1
03500 HRRZ 3,3 ;COUNT
03600 JUMPE 3,NULSTR ;DONT SEND EMPTY STR
03700 MOVEI 1,101 ;TERMINAL OUTPUT
03800 MOVN 3,3
03900 JSYS SOUT
04000 NULSTR: POP P,1
04100 POP SP,2
04200 POP SP,3 ;ADJUSTS STACK AUTOMATICALLY
04300 POPJ P, ;RETURN
04400
04500 ;REDSTR (0) MARKS CTLOSW THAT INPUT WAS REQUESTED
04600 ;(1) PREPARES TO MAKE A STRING OF 200 CHARS,
04700 ;(2) ZEROS C FOR COUNT
04800 ;(3) SETS UP D WITH THE ORIGINAL BYTE-POINTER
04900
05000 REDSTR: SETZM CTLOSW ;INPUT REQUESTED
05100 SKIPE SGLIGN(USER)
05200 PUSHJ P,INSET
05300 MOVEI A,=200
05400 ADDM A,REMCHR(USER)
05500 SKIPLE REMCHR(USER)
05600 PUSHJ P,STRNGC
05700 SETZ C, ;COUNT HERE
05800 MOVE D,TOPBYTE(USER) ;ORIGINAL BYTE-POINTER, IF NEEDED
05900 PUSH SP,[0] ;NULL STRING IF NOTHING DONE
06000 PUSH SP,TOPBYTE(USER)
06100 POPJ P,
06200
06300 FINSTR: MOVEI A,=200
06400 SUB A,C ;NUMBER USED
06500 ADDM A,REMCHR(USER)
06600 HRROM C,-1(SP) ;STRING COUNT WORD
06700 MOVEM D,TOPBYTE(USER) ;NEW TOPBYTE
06800 JRST RESTR
06900
07000 ;CALL TO HERE WITH A PUSHJ TO GET A CHAR IN AC1
07100 ;AC 3 HAS THE COUNT, D THE BYTE-POINTER
07200 EDICHR:
07300 JSYS PBIN ;GET A CHARACTER
07400 CAIN 1,DELLINE ;DELETE LINE CHAR
07500 JRST CTRLU
07600 CAIN 1,RUBCHAR ;RUBOUT?
07700 JRST RUBOUT
07800 CAIN 1,37 ;PHONEY TENEX EOL?
07900 MOVEI 1,12
08000 CAIN 1,33 ;PHONEY TENEX ALTMODE?
08100 MOVEI 1,ALTMODE ;DEC ALTMODE
08200 POPJ P, ;GOOD CHAR FOR USER
08300
08400 CTRLU:
08500 ;AC 1 IS FREE
08600 HRROI 1,[BYTE (7) 7,15,12,0,0]
08700 JSYS PSOUT
08800 JUMPE C,EDICHR ;IF NO CHARS THEN DO NOTHING
08900 SETZ C,
09000 MOVE D,TOPBYTE(USER)
09100 JRST EDICHR
09200
09300 RUBOUT: JUMPE C,CTRLU ;IF NO CHARS THEN DO CTRLU
09400 ;AC 1 IS AVAILABLE
09500 IMSSS<
09600 MOVEI 1,101 ;PRIMARY OUTPUT
09700 JSYS DELCH
09800 JFCL
09900 JRST DLTED ;DISPLAY -- LINE EMPTY
10000 JRST DLTED ;DISPLAY -- DELETE DONE
10100 >;IMSSS
10200 MOVEI 1,"\"
10300 JSYS PBOUT
10400 LDB 1,D ;GET LAST CHAR
10500 JSYS PBOUT ;AND SEND IT
10600 DLTED:
10700 SOJ D, ;BACK UP BP TO LAST CHAR
10800 IBP D
10900 IBP D
11000 IBP D
11100 IBP D
11200 SOJA C,EDICHR ;AND GET ANOTHER CHAR
11300
11400 HERE(INSTRL)
11500 HERE (INSTR)
11600 PUSHJ P,SAVE
11700 PUSHJ P,REDSTR
11800 MOVE B,-1(P) ;BREAK CHAR
11900 MOVE LPSA,X22 ;# TO REMOVE
12000
12100 INS1: CAIL C,=200 ;COUNT EXHAUSTED?
12200 JRST FINSTR ;YES
12300 INS2: PUSHJ P,EDICHR ;GET A CHAR IN 1, USING EDITING
12400 CAMN 1,B ;BREAK?
12500 JRST FINSTR ; YES, ALL DONE
12600 IDPB 1,D ;PUT IT AWAY AND
12700 AOJA C,INS1
12800
12900 HERE (INCHWL) PUSHJ P,SAVE
13000 PUSHJ P,REDSTR
13100 MOVE LPSA,X11
13200
13300 INS3: CAIL C,=200 ;COUNT EXHAUSTED?
13400 JRST DNSTR1 ;YES
13500 PUSHJ P,EDICHR ;GET A CHAR
13600 CAIE 1,ALTMODE
13700 CAIN 1,12
13800 JRST DNSTR
13900 CAIN 1,15 ;CR?
14000 JRST INS3 ;IGNORE
14100 IDPB 1,D ;PUT IT AWAY AND
14200 AOJA C,INS3 ;NEXT CHARACTER
14300
14400 DNSTR: MOVEM 1,.SKIP. ;SET BREAK CHAR
14500 JRST FINSTR
14600 DNSTR1: SETOM .SKIP. ;INDICATE COUNT EXHAUSTED
14700 JRST FINSTR
14800
14900
15000 HERE (INCHSL) PUSHJ P,SAVE
15100 MOVE LPSA,X22 ;PARAM (FLAG) AND RETURN
15200 PUSHJ P,REDSTR
15300 SETOM @-1(P) ;ASSUME FAILED
15400 MOVEI 1,100 ;PRIMARY INPUT
15500 JSYS SIBE ;CHARACTERS WAITING?
15600 SKIPA ;YES
15700 JRST FINSTR ;NO, FIX UP AND RETURN
15800 SETZM @-1(P)
15900 JRST INS3 ;AND USE INCHWL'S LOOP
16000
16100
16200 HERE(INSTRS)
16300 PUSHJ P,SAVE
16400 MOVE LPSA,X33
16500 PUSHJ P,REDSTR
16600 SETOM @-2(P) ;ASSUME FAILED
16700 MOVEI 1,100 ;RIMARY INPUT
16800 JSYS SIBE ;CHARACTERS WAITING
16900 SKIPA ;YES
17000 JRST FINSTR ;NO, FIX UP AND RETURN
17100 SETZM @-2(P) ;INDICATE SUCCESS
17200 MOVE B,-1(P) ;GET BREAK CHARACTER
17300 JRST INS2
17400
17500 HERE (CLRBUF)
17600 PUSH P,1
17700 MOVEI 1,100 ;PRIMARY INPUT
17800 JSYS CFIBF ;CLEAR BUFFER
17900 POP P,1
18000 POPJ P,
18100
18200 HERE (TTYINS) PUSHJ P,SAVE
18300 PUSHJ P,REDSTR ;PREPARE TO MAKE A STRING
18400 MOVE LPSA,X33
18500 SETOM @-1(P) ;ASSUME NO CHARS
18600 MOVEI 1,100 ;PRIMARY INPUT
18700 JSYS SIBE ;CHARS WAITING?
18800 SKIPA ;YES
18900 JRST FINSTR ;NONE WAITING
19000 JRST TYIN1 ;GO AHEAD
19100
19200
19300 HERE(TTYINL)
19400 HERE (TTYIN) PUSHJ P,SAVE
19500 TYIN: PUSHJ P,REDSTR ;PREPARE STACK,A,STRNGC FOR A STRING
19600 MOVE LPSA,X33 ;PREPARE TO RETURN
19700 TYIN1: SETZM @-1(P) ;ASSUME NO BREAK CHAR
19800 SKIPL E,-2(P) ;TABLE #
19900 CAILE E,=18
20000 ERR <TTYIN: THERE ARE ONLY 18 BREAK TABLES>
20100 HRRZ TEMP,USER
20200 ADD TEMP,E ;TABLE NO(USER)
20300 MOVEI Z,1 ;FOR TESTING LINE NUMBERS
20400 SKIPN LINTBL(TEMP) ;DON'T LET TEST SUCCEED IF
20500 MOVEI Z,0 ;WE'RE TO LET LINE NUMBERS THRU
20600 MOVE CHNL,BRKMSK(E) ;GET MASK FOR THIS TABLE
20700 HRRZ Y,USER
20800 ADD Y,[XWD 1,BRKTBL] ;BRKTBL+RLC(USER)
20900 TTYN: CAIL C,=200 ;COUNT EXCEEDED?
21000 JRST FINSTR ;YES
21100 PUSHJ P,EDICHR ;GET A CHAR
21200 TTYN1: TDNE CHNL,@Y ;BREAK OR OMIT?
21300 JRST TTYSPC ; YES, FIND OUT WHICH
21400 TTYC: IDPB 1,D ;PUT IT AWAY
21500 AOJA C,TTYN ;COUNT AND CONTINUE
21600 JRST FINSTR ;DONE
21700 TTYSPC: HLLZ TEMP,@Y ;WHICH?
21800 TDNN TEMP,CHNL
21900 JRST TTYN ;OMIT
22000 MOVEM 1,@-1(P)
22100 MOVE Y,-2(P) ;WHAT TO DO WITH IT
22200 ADD Y,USER
22300 SKIPN Y,DSPTBL(Y)
22400 JRST FINSTR ;DONE, NO SAVE
22500 JUMPL Y,TTYAPP ;APPEND
22600 PUSH P,1 ;SAVE
22700 MOVEI 1,100 ;PRIMARY INPUT
22800 JSYS BKJFN
22900 ERR <CAN'T RETAIN BREAK CHAR FROM TTYIN>,1
23000 POP P,1
23100 JRST FINSTR ;AND RETURN
23200 TTYAPP: IDPB 1,D ;COUNT THE BREAK CHAR
23300 ADDI C,1 ;ONE MORE HAPPY CHAR
23400 JRST FINSTR
23500
23600
23700 DSCR INTEGER PROCEDURE TTYUP(INTEGER NEWVALUE)
23800
23900 Using the RFMOD and SFMOD jsyses, sets lower-to-upper
24000 case conversion to NEWVALUE, returning the oldvalue. Tests
24100 and modifies bit 31 of the RFMOD word for the primary input
24200 file.
24300 ⊗;
24400 HERE(TTYUP)
24500 PUSHJ P,SAVE
24600 MOVE LPSA,X22 ;SET FOR RETURN
24700 MOVEI A,101 ;PRIMARY INPUT FILE
24800 JSYS RFMOD ;GET THE CURRENT SETTINGS
24900 SETZ C, ;ASSUME NOT CURRENTLY SET
25000 TRNE B,1B31 ;IS IT SET?
25100 SETO C, ;IT WAS
25200 MOVEM C,RACS+A(USER)
25300 MOVE C,[TRO B,1B31] ;ASSUME WE WANT TO SET UP
25400 SKIPN -1(P) ;DID WE REALLY?
25500 MOVE C,[TRZ B,1B31] ;NO, DONT
25600 XCT C
25700 JSYS SFMOD
25800 JRST RESTR ;AND RETURN
25900
26000
26100 ENDCOM(TTY)
26200 COMPIL(PTY)
26300 ENDCOM(PTY)
26400
26500 COMPIL(FIL,<FILNAM>,<FLSCAN,X22>,<FILNAM SCANNING ROUTINE>)
00100 COMMENT ⊗Filnam ⊗
00200
00300 DSCR FILNAM
00400 CAL PUSHJ
00500 PAR file name string on SP stack
00600 of form FILENAME<.EXT><[PROJ,PROG]>
00700 RES FNAME(USER) : SIXBIT /filename/
00800 EXT(USER): SIXBIT /extension,,0/
00900 0
01000 PRPN(USER): SIXBIT /PRJ PRG/ (or zero)
01100 SID uses D,X,Y (4-6), REMOVES STRING FROM STACK
01200 ⊗
01300
01400 ↑↑FILNAM:
01500 SUB SP,X22 ;ADJUST STACK
01600 FOR II←1,3 <
01700 SETZM FNAME+II(USER)>
01800 MOVEI X,FNAME(USER) ;WHERE TO PUT IT
01900 PUSHJ P,FLSCAN ;GET FILE NAME
02000 JUMPE Y,FLDUN ;FILE NAME ONLY
02100 CAIE Y,"." ;EXTENSION?
02200 JRST FLEXT ;NO, CHECK PPN
02300 MOVEI X,FNAME+1(USER)
02400 PUSHJ P,FLSCAN
02500 FLEXT: JUMPE Y,FLDUN ;NO PPN SPECIFIED
02600 CAIE Y,"["
02700 JRST FLERR ;INVALID CHARACTER
02800 PUSHJ P,[
02900
03000 RJUST: SETZM PROJ(USER)
03100 MOVEI X,PROJ(USER)
03200 PUSHJ P,FLSCAN ;GET PROJ OR PROG IN SIXBIT
03300 IFN SIXSW,<
03400 MOVE X,PROJ(USER)
03500 IMULI D,-6 ;SHIFT FACTOR
03600 LSH X,(D) ;RIGHT-JUSTIFY THE PROJ OR PROG
03700 >;IF SIXSW (SET IN HEAD, USUALLY CONDITIONED ON NOEXPO)
03800
03900 IFE SIXSW,<
04000 MOVEI X,0
04100 ;;#GT# DCS 5-11-72 ALLOW LARGE OCTAL NUMBERS AT STD DEC SYSTEMS
04200 MOVE D,PROJ(USER) ;WAS A HLLZ
04300 ;;
04400 FBACK: MOVEI C,0
04500 LSHC C,6 ;GET A SIXBIT CHAR
04600 CAIL C,'0'
04700 CAILE C,'7'
04800 JRST FLERR ;INVALID OCTAL
04900 LSH X,3
05000 IORI X,-'0'(C)
05100 JUMPN D,FBACK
05200 >;NOT SIXSW (USUALLY CONDITIONED ON EXPO)
05300 FPOP: POPJ P,]
05400
05500 HRLZM X,FNAME+3(USER)
05600 CAIE Y,","
05700 JRST FLERR ;INVALID CHAR
05800 PUSHJ P,RJUST ;JUSTIFY(AND CONVERT IF EXPORT) PROG #
05900 HRRM X,FNAME+3(USER)
06000 CAIN Y,"]"
06100 FLDUN: AOS (P) ;SUCCESSFUL
06200 FLERR: POPJ P, ;DONE, NOT NECESSARILY RIGHT
06300
06400 ENDCOM(FIL)
06500 COMPIL(FLS,<FLSCAN>,,<FLSCAN ROUTINE>)
00100 COMMENT ⊗Flscan ⊗
00200
00300 DSCR FLSCAN
00400 CAL PUSHJ
00500 PAR X -- addr of destination SIXBIT
00600 1(SP), 2(SP) -- input string
00700 RES sixbit for next filename, etc in word addressed by X
00800 break (punctuation) char in Y (0 if string exhausted)
00900 D,X, input string adjusted
01000 SID only those AC changes listed above (Y, for instance)
01100 ⊗
01200
01300 ↑↑FLSCAN:
01400 HRRZS 1(SP) ;WANT ONLY LENGTH PART
01500 MOVEI D,6 ;MAX NUMBER PICKED UP
01600 SETZM (X) ;ZERO DESTINATION
01700 HRLI X,440600 ;BYTE POINTER NOW
01800 FLN1: MOVEI Y,0 ;ASSUME NO STRING LEFT
01900 SOSGE 1(SP) ;TEST 0-LENGTH STRING
02000 POPJ P,
02100 ILDB Y,2(SP) ;GET BYTE
02200 CAIE Y,"." ;CHECK VALID BREAK CHAR
02300 CAIN Y,"["
02400 POPJ P,
02500 CAIE Y,"]"
02600 CAIN Y,","
02700 POPJ P,
02800 JUMPE D,FLN1 ;NEED NO MORE CHARS
02900 TRZN Y,100 ;MOVE 100 BIT TO 40 BIT
03000 TRZA Y,40 ; TO CONVERT TO SIXBIT
03100 TRO Y,40 ; (NO CHECKING)
03200 IDPB Y,X ;PUT IT AWAY
03300 SOJA D,FLN1 ;CONTINUE
03400
03500 ENDCOM(FLS)
00100 COMPIL(INP,<INPUT,CHARIN,SINI>
00200 ,<INSET,STRNGC,BRKMSK,X33,GOGTAB,JFNTBL,CDBTBL>
00300 ,<STRING INPUT ROUTINE>)
00400
00500
00600 DSCR CHAR←CHARIN(CHANNEL)
00700 ⊗
00800 HERE(CHARIN)
00900 BEGIN CHARIN
01000 PUSH P,CDB
01100 PUSH P,CHNL
01200 PUSH P,D
01300 SKIPL CHNL,-4(P)
01400 CAIL CHNL,JFNSIZE
01500 JRST CHALIT
01600 MOVE CDB,CDBTBL(CHNL) ;CDB
01700 LDB D,[POINT 6,OFL(CDB),5] ;GET BYTE SIZE
01800 CAIE D,=36 ;36-BIT?
01900 JRST CHA7 ;TRY 7
02000 HRRZ CHNL,JFNTBL(CHNL) ;JFN IN CHNL FOR DOINP
02100 SKIPN CHNL
02200 JRST CHABAD
02300 SKIPE ENDFL(CDB) ;EOF LOCATION?
02400 SETZM @ENDFL(CDB) ;YES, ASSUME GOOD
02500 SETZM .SKIP.
02600 SOSG ICOWNT(CDB)
02700 JRST [PUSHJ P,DOINP
02800 JRST IN1 ;36-BIT RETURN
02900 JRST INB ;7-BIT RETURN (WITH CHAR IN D)
03000 JRST CHAEOF ;END OF FILE OR ERROR
03100 ]
03200 IN1: ILDB D,IBP(CDB)
03300 INB: MOVE 1,D ;CHAR IN 1
03400 CHARET: POP P,D
03500 POP P,CHNL
03600 POP P,CDB
03700 SUB P,X22
03800 JRST @2(P)
03900
04000 CHA7: PUSH P,2 ;SAVE 2
04100 PUSHJ P,OPNCH1 ;MAKE SURE OPEN
04200 HRRZ 1,JFNTBL(CDB)
04300 JSYS BIN
04400 JUMPE 2,[JSYS GTSTS
04500 TLNE 2,(1B8)
04600 JRST CH7EOF ;END OF FILE
04700 SETZ 2,
04800 JRST .+1
04900 ]
05000 MOVE 1,2 ;GET CHAR
05100 POP P,2 ;RESTORE 2
05200 JRST CHARET
05300
05400 CH7EOF: SKIPE ENDFL(CDB)
05500 SETOM @ENDFL(CDB)
05600 SETOM .SKIP.
05700 POP P,2
05800
05900 CHAEOF:
06000 CHABA1: SETZ 1, ;RETURN NULL BYTE
06100 JRST CHARET
06200
06300 CHABAD: ERR <Illegal JFN>,1
06400 JRST CHABA1
06500
06600 CHALIT: PUSH P,2 ;HERE WITH A LITERAL CHAN
06700 MOVE 1,CHNL
06800 JSYS BIN
06900 MOVE 1,2
07000 POP P,2
07100 JRST CHARET
07200 BEND CHARIN
00100 DSCR STRING SIMPLE PROCEDURE SINI(INTEGER JFN,MAXLENGTH,BRKCHAR);
00200 Reads in a string of characters, terminated by BRKCHAR or
00300 reaching maxlength, whichever happens first.
00400 ⊗
00500
00600 HERE(SINI)
00700 BEGIN SINI
00800
00900 PUSHJ P,SAVE
01000 MOVE LPSA,X44
01100 VALCHN 1,<-3(P)>,SINBAD
01200 SKIPE ENDFL(CDB) ;EOF LOCATION?
01300 SETZM @ENDFL(CDB) ;YES, ASSUME NO EOF
01400 SETZM .SKIP.
01500 SKIPG C,-2(P) ;ANY COUNT?
01600 JRST NULRET
01700 LDB B,[POINT 6,OFL(CDB),5]
01800 CAIE B,=36 ;36-BIT BYTES?
01900 JRST SIN7
02000 ;WITH RF(=CHNL) STILL LOADED, IN CASE STRNGC IS CALLED
02100 PUSH P,1 ;SAVE 1 (WITH JFN)
02200 MOVE 1,C ;COUNT
02300 SKIPE SGLIGN(USER)
02400 PUSHJ P,INSET
02500 ADDM 1,REMCHR(USER) ;NEW REMCHR
02600 SKIPLE REMCHR(USER) ;COLLECT?
02700 PUSHJ P,STRNGC ;YES
02800 MOVE E,TOPBYTE(USER) ;GOOD BYTE-POINTER
02900 PUSH SP,[0]
03000 PUSH SP,E ;START OF THE STRING
03100 POP P,1
03200 HRRZ CHNL,1 ;JFN IN 1 FOR DOINP
03300 MOVN C,C ;NEGATE THE COUNT
03400 IN1: SOSG ICOWNT(CDB)
03500 JRST [PUSHJ P,DOINP
03600 JRST IN2 ;36-BIT
03700 JRST SINBAD ;7-BIT??
03800 JRST SINDUN]
03900 IN2: ILDB D,IBP(CDB)
04000 JUMPE D,IN1 ;IF NULL KEEP LOOKING
04100 CAMN D,-1(P) ;BREAK CHARACTER?
04200 JRST DOBRK ;YES
04300 IDPB D,E
04400 IN3: AOJL C,IN1 ;FALL THRU IF COUNT IS EXHAUSTED
04500
04600 SINDUN: ADDM C,REMCHR(USER) ;MAKE REMCHR HONEST
04700 MOVEM E,TOPBYTE(USER) ;SAVE NEW TOPBYTE
04800 ADD C,-2(P) ;GET ACTUAL NUMBER OF CHARACTERS TRANSFERRED
04900 HRROM C,-1(SP) ;SAVE COUNT FOR USER
05000 JRST RESTR
05100
05200 DOBRK: IDPB D,E ;SAVE THE BREAK CHARACTER (AS DOES THE SIN JSYS)
05300 AOJ C, ;ADD 1 TO THE COUNT
05400 JRST SINDUN ;AND FINISH UP
05500
05600
05700 SIN7: CAIE 2,7 ;MUST BE 7-BIT
05800 JRST SINBAD
05900 ;WITH RF (=CHNL) LOADED
06000 PUSH P,-2(P) ;MAXLENGTH
06100 PUSHJ P,ZSETST
06200 MOVE 2,1 ;BYTE-POINTER IN 2
06300 HRRZ 1,JFNTBL(CHNL) ;GET THE JFN BACK
06400 PUSHJ P,OPNCHK ;MAKE SURE OPEN
06500 MOVE 3,-2(P) ;MAXLENGTH
06600 MOVE 4,-1(P) ;OPTIONAL BREAKCHARACTER
06700 JSYS SIN
06800 PUSH P,-2(P) ;MAXLENGTH
06900 PUSH P,2 ;UPDATED BYTE-POINTER
07000 PUSHJ P,ZADJST ;GET STRING ON STACK
07100 HRRZ 1,JFNTBL(CHNL) ;JFN
07200 JSYS GTSTS ;CHECK STATUS
07300 TLNN 2,(1B8) ;LOOK FOR EOF
07400 JRST RESTR ;NO EOF
07500 SKIPE ENDFL(CDB)
07600 SETOM @ENDFL(CDB)
07700 SETOM .SKIP.
07800 SINRET: JRST RESTR
07900
08000 SINBAD: ERR <SINI: Illegal JFN OR ILLEGAL BYTE-SIZE>,1
08100 NULRET: PUSH SP,[0] ;RETURN NULL STRING
08200 PUSH SP,[0]
08300 JRST RESTR
08400
08500 BEND SINI
08600
00100 COMMENT ⊗Input ⊗
00200
00300 DSCR "STRING"←INPUT(CHANNEL,BREAK TABLE NUMBER);
00400 CAL SAIL
00500 SID NO ACS SAVED BY INPUT!!!!!!
00600 ⊗
00700
00800 .IN.:
00900 HERE (INPUT)
01000 MOVE USER,GOGTAB ;GET TABLE POINTER
01100 MOVEM RF,RACS+RF(USER);SAVE F-REGISTER
01200 SKIPE SGLIGN(USER)
01300 PUSHJ P,INSET
01400 SKIPL CHNL,-2(P) ;CHANNEL NUMBER
01500 CAIL CHNL,JFNSIZE
01600 JRST INPBAD
01700 MOVE CDB,CDBTBL(CHNL)
01800 HRRZ CHNL,JFNTBL(CHNL)
01900 SKIPN CHNL
02000 JRST INPBAD
02100 LDB E,[POINT 4,OFL(CDB),9] ;DATA MODE
02200 SKIPE ENDFL(CDB) ;EOF LOCATION
02300 SETZM @ENDFL(CDB) ;YES, HELP USER ASSUME NO EOF
02400 SETZM .SKIP.
02500 SKIPE BRCHAR(CDB) ;BRCHAR LOCATION
02600 SETZM @BRCHAR(CDB) ;ASSUME NO BREAK CHAR
02700 MOVEI A,=200 ;DEFAULT NO. OF CHARS
02800 SKIPE ICOUNT(CDB) ;USER-SPECIFIED COUNT?
02900 HRRZ A,@ICOUNT(CDB) ;MAX COUNT FOR INPUT STRING
03000 ADDM A,REMCHR(USER)
03100 SKIPLE REMCHR(USER) ;ENOUGH ROOM?
03200 PUSHJ P,STRNGC ;NO, TRY TO GET SOME
03300 SKIPL C,-1(P) ;GET TABLE #, CHECK IN BOUNDS
03400 CAILE C,=18
03500 ERR <IN: THERE ARE ONLY 18 BREAK TABLES>
03600 HRRZ TEMP,USER
03700 ADD TEMP,C ;TABLE NO(USER)
03800 MOVEI Z,1 ;FOR TESTING LINE NUMBERS
03900 SKIPN LINTBL(TEMP) ;DON'T LET TEST SUCCEED IF
04000 MOVEI Z,0 ;WE'RE TO LET LINE NUMBERS THRU
04100 MOVN B,A ;NEGATE MAX CHAR COUNT
04200 PUSH SP,[0] ;LEAVE ROOM FOR FIRST STR WORD
04300 PUSH SP,TOPBYTE(USER) ;SECOND STRING WORD
04400 MOVE FF,BRKMSK(C) ;GET MASK FOR THIS TABLE
04500 HRRZ Y,USER
04600 ADD Y,[XWD D,BRKTBL] ;BRKTBL+RLC(USER)
04700 JUMPE B,DONE1 ; BECAUSE THE AOJL WON'T
04800
04900 TRNE FF,@BRKCVT(USER) ;DOING UC COERCION?
05000 TLOA C,400000 ;YES
05100 TLZ C,400000 ;NO
05200
05300 .IN: SOSG ICOWNT(CDB) ;BUFFER EMPTY?
05400 JRST [ PUSHJ P,DOINP
05500 JRST IN1 ;36-BIT RETURN
05600 JRST INB ;7-BIT RETURN (WITH CHAR IN D)
05700 JRST DONE1 ;EOF OR ERROR
05800 ]
05900 IN1:
06000 ILDB D,IBP(CDB) ;GET NEXT CHARACTER
06100 TDNE Z,@IBP(CDB) ;LINE NUMBER (ALWAYS SKIPS IF NOT WORRIED)?
06200 JRST INLINN ;YES, GO SEE WHAT TO DO
06300 IN2:
06400 INB: JUMPE D,.IN ;ALWAYS IGNORE 0'S
06500 SKIPN LINNUM(CDB) ;COUNTING VIA SETPL FUNCTION??
06600 JRST INB1 ;NO
06700 CAIN D,12 ;LINE-FEED?
06800 AOS @LINNUM(CDB) ;INDICATE ANOTHER LINE
06900 CAIE D,14 ;FORM-FEED?
07000 JRST INB1 ;NO
07100 SKIPE PAGNUM(CDB)
07200 AOS @PAGNUM(CDB) ;COUNT PAGES ALSO
07300 SKIPE LINNUM(CDB)
07400 SETZM @LINNUM(CDB) ;SET LINNUM TO ZERO (NEW PAGE)
07500
07600 INB1: JUMPGE C,NOCV.I ;NOT COERCING?
07700 CAIL D,"a" ;ONLY COERCE LOWER CASE
07800 CAILE D,"z" ;
07900 JRST .+2 ;SPECIAL RHT "FAST SKIP"
08000 TRZ D,40 ;MAKE UPPER CASE
08100
08200 NOCV.I: TDNE FF,@Y ;MUST WE DO SOMETHING SPECIAL?
08300 JRST INSPC ;YES, HANDLE
08400
08500 MOVEC: IDPB D,TOPBYTE(USER) ;LENGTHEN STRING
08600 AOJL B,.IN ;GET SOME MORE
08700 JRST DONE1
08800
08900 INSPC: HLLZ TEMP,@Y ;IGNORE OR BREAK?
09000 TDNN TEMP,FF ; (CHOOSE ONE)
09100 JRST .IN ;IGNORE
09200
09300 ; BREAK -- STORE BREAK CHAR, FINISH OFF
09400
09500 DONE: SKIPE BRCHAR(CDB) ;USER BRCHAR VAR?
09600 MOVEM D,@BRCHAR(CDB) ;STORE BREAK CHAR
09700 MOVE Y,-1(P) ;TABLE # AGAIN
09800 ADD Y,USER ;RELOCATE
09900 SKIPN Y,DSPTBL(Y) ;WHAT TO DO WITH BREAK CHAR?
10000 JRST DONE1 ;SKIP IT
10100 JUMPL Y,APPEND ;ADD TO END OF INPUT STRING
10200
10300 RETAIN: PUSHJ P,BACKUP
10400 JRST DONE1
10500
10600 APPEND: IDPB D,TOPBYTE(USER) ;PUT ON END
10700 AOJA B,DONE1 ;ONE MORE TO COUNT
10800
10900
11000 ; DONE -- MARK STRING COUNT WORD
11100
11200 DONE1: ADDM B,REMCHR(USER) ;GIVE UP THOSE NOT USED
11300 SKIPN ICOUNT(CDB) ;USER SUPPLIED COUNT?
11400 JRST [ADDI B,=200 ;USER DEFAULT
11500 JRST .+2]
11600 ADD B,@ICOUNT(CDB) ;HOW MANY DID WE ACTUALLY GET?
11700 ;;#GI# DCS 2-5-72 REMOVE TOPSTR
11800 HRROM B,-1(SP) ;MARK RESULT, NON-CONSTANT
11900 ;;#GI#
12000 MOVE RF,RACS+RF(USER);GET F-REGISTER BACK
12100 SUB P,X33 ;REMOVE INPUT PARAMETER, RETURN ADDRESS
12200 JRST @3(P) ;RETURN
12300
12400 ; CAN EITHER DELETE LINE NUMBER (Y GT 0) OR STOP,
12500 ; TELL THE USER (BRCHAR=-1), AND MARK LINE NUMBER
12600 ; NOT A LINE NUMBER FOR NEXT TIME
12700
12800
12900
13000
00100 COMMENT ⊗ BACKUP, DOINP TO BACKUP JFN, DO INPUT. ⊗
00200
00300 ;CALL TO HERE WITH A PUSHJ, WITH CDB,CHNL LOADED
00400 ↑BACKUP:
00500 PUSH P,1
00600 LDB 1,[POINT 6,OFL(CDB),5] ;BYTE-SIZE
00700 CAIN 1,44
00800 JRST BACKU1
00900 ;HERE USE BKJFN
01000 HRRZ 1,CHNL ;THE JFN
01100 JSYS BKJFN
01200 ERR <BACKUP: CANNOT DO RETAIN MODE ON THIS FILE>,1
01300 BACRET: POP P,1
01400 POPJ P,
01500 BACKU1: SOS IBP(CDB)
01600 IBP IBP(CDB)
01700 IBP IBP(CDB)
01800 IBP IBP(CDB)
01900 IBP IBP(CDB)
02000 AOS ICOWNT(CDB)
02100 JRST BACRET
02200
02300
02400
02500 ;CALL TO HERE WITH PUSHJ
02600 ;RETURNS +1 FOR 36-BIT INPUT, +2 FOR 7 BIT INPUT (WITH CHAR IN D),
02700 ;+3 FOR END OF FILE
02800
02900 ↑DOINP: PUSH P,1
03000 PUSH P,2
03100 PUSH P,3
03200 SKIPE DECCLZ(CDB) ;CHANNEL CLOSED BY DEC?
03300 JRST [ ;YES
03400 HRRZ 1,CHNL ;JFN
03500 MOVE 2,OFL(CDB) ;FLAGS
03600 JSYS OPENF ;OPEN
03700 ERR <OPNCHK: CANNOT OPENF FILE>
03800 SETZM DECCLZ(CDB)
03900 JRST .+1
04000 ]
04100 OPNOK: LDB 1,[POINT 4,OFL(CDB),9] ;GET MODE
04200 CAIN 1,17 ;DUMP MODE
04300 JRST DMPI ; YES
04400 ;36 BIT BYTES (SIN) OR 7 BIT (BIN)
04500 LDB 1,[POINT 6,OFL(CDB),5] ;BYTE-SIZE
04600 CAIN 1,44 ;36 BIT
04700 JRST DOSIN
04800 CAIE 1,7 ;7-BIT
04900 JRST INPBAD ;ERROR
05000 ;HERE TO DO 7-BIT INPUT
05100 DOBIN:
05200 HRRZ 1,CHNL
05300 JSYS BIN
05400 JUMPE 2,[JSYS GTSTS ;CHECK STATUS
05500 TLNE 2,(1B8) ;EOF?
05600 JRST DOIEOF
05700 SETZ 2,
05800 JRST .+1
05900 ]
06000 MOVE D,2 ;GET THE CHAR IN D
06100 ;CHECK IF WE HAVE A TTY
06200 MOVE 1,DVTYP(CDB) ;GET DEVICE TYPE
06300 CAIE 1,12 ;A TTY?
06400 JRST NOTTTY ;NO
06500 CAIN D,32 ;A CONTROL-Z?
06600 JRST DOIEOF ;CTRL-Z FROM TTY MEANS EOF
06700 CAIN D,37 ;PHONEY TENEX EOL?
06800 MOVEI D,12 ;LINE-FEED
06900 CAIN D,33 ;ASCII ESCAPE?
07000 MOVEI D,ALTMODE ;MAKE ALTMODE
07100 NOTTTY: SETZM ICOWNT(CDB) ;0 COUNT (SINCE NO MORE ARE WAITING)
07200 POP P,3
07300 POP P,2
07400 POP P,1
07500 AOS (P) ;7-BIT RETURN
07600 POPJ P,
07700
07800 DOIEOF: SKIPE ENDFL(CDB) ;LOCATION?
07900 SETOM @ENDFL(CDB) ;YES, SET IT
08000 SETOM .SKIP.
08100 SETZM ICOWNT(CDB) ;ZERO THE COUNT
08200 SETZM IBP(CDB) ;AND THE BP
08300 POP P,3
08400 POP P,2
08500 POP P,1
08600 AOS (P) ;INDICATE EOF
08700 AOS (P)
08800 POPJ P,
08900
09000 DOSIN: MOVE 1,CHNL ;JFN
09100 SKIPE DVTYP(CDB) ;DEVICE DSK?
09200 JRST DOSIN1 ;NO, USE SIN JSYS
09300 ;HERE TO PMAP CORRECT PAGE
09400 ;1, CHNL HAVE THE JFN, CDB IS LOADED, 2 AND 3 ARE FREE
09500 MOVE 2,[XWD 2,11] ;READ TWO WORDS FROM FDB STARTING AT 11
09600 MOVEI 3,2 ;INTO ACS 2 AND 3
09700 JSYS GTFDB ;GET THE SIZE OF THE FILE IN 2
09800 LDB 2,[POINT 6,2,11] ;BYTE SIZE FROM FDB
09900 PUSH P,4
10000 PUSH P,5
10100 MOVEI 4,=36
10200 IDIV 4,2
10300 IDIV 3,4 ;3 NOW HAS THE NUMBER OF 36-BIT BYTES
10400 SKIPE 4 ;REMAINDER?
10500 AOJ 3, ;YES, ANOTHER WORD
10600 POP P,5
10700 POP P,4
10800 JSYS RFPTR ;READ CURRENT FILE POINTER INTO 2
10900 ERR <DRYROT AT DOINP>
11000 CAML 2,3 ;IS THE FILE POINTER LESS THAN THE SIZE OF THE FILE?
11100 JRST [MOVEI 2,STARTPAGE(1);PAGE
11200 HRLI 2,400000;
11300 SETO 1,
11400 SETZ 3,
11500 JSYS PMAP ;RELEASE PAGE
11600 JRST DOIEOF ;INDICATE EOF
11700 ]
11800 SUB 3,2 ;CALCULATE THE DIFFERENCE IN WORDS
11900 CAILE 3,1000
12000 MOVEI 3,1000
12100 PUSH P,3 ;NO. OF GOOD WORDS ON THIS PAGE, PUSH IT
12200 IDIVI 2,1000 ;CALCULATE THE PAGE NUMBER FOR THIS POINTER
12300 SKIPE 3 ;ANY REMAINDER?
12400 AOJ 2, ;YES, ANOTHER PAGE
12500 PUSH P,2 ;SAVE THE PAGE WE ARE READING IN
12600 HRL 1,CHNL
12700 HRR 1,2 ;XWD JFN,PAGE
12800 MOVEI 2,STARTPAGE(CHNL)
12900 HRLI 2,400000 ;XWD THISFORK, CORE PAGE
13000 SETO 3, ;FLAG WORD
13100 JSYS PMAP
13200 MOVE 1,CHNL
13300 POP P,2 ;GET BACK THE PAGE NO.
13400 AOJ 2, ;NEXT PAGE
13500 LSH 2,=9 ;CONVERT TO BYTES
13600 JSYS SFPTR ;AND SET THE FILE POINTER
13700 ERR <DRYROT AT DOINP>
13800 POP P,3 ;NUMBER OF GOOD WORDS
13900 IMULI 3,5 ;NUMBER OF CHARACTERS
14000 JRST DO36CN ;AND SET UP COUNT, BYTE-POINTERS
14100
14200 ;HERE TO DO 36-BIT INPUT WITH THE SIN JSYS
14300 DOSIN1: MOVEI 2,STARTPAGE(1)
14400 IMULI 2,1000 ;THE CORE ADDRESS
14500 HRL 3,2
14600 HRRI 3,1(2)
14700 SETZM (2)
14800 BLT 3,777(2) ;ZERO BUFFER
14900
15000 HRLI 2,444400 ;BYTE-POINTER
15100 MOVNI 3,1000 ;1000 WORDS
15200 JSYS SIN ;INPUT
15300 CAMG 3,[-1000] ;SOMETHING RECEIVED?
15400 JRST [CAMN 3,[-1000] ;NOTHING AT ALL?
15500 JRST DOIEOF ;NOT A SINGLE WORD
15600 JRST .+1
15700 ]
15800 ADDI 3,1000 ;GET NUMBER OF WORDS READ
15900 IMULI 3,5 ;NUMBER OF CHARACTERS
16000 DO36CN: MOVEM 3,ICOWNT(CDB) ;REMEMBER
16100 MOVEI 2,STARTPAGE(1)
16200 IMULI 2,1000
16300 HRLI 2,440700 ;BYTE-POINTER
16400 MOVEM 2,IBP(CDB) ;REMEMBER
16500 DOIRET: POP P,3
16600 POP P,2
16700 POP P,1
16800 POPJ P,
16900
17000
17100 ; DUMP MODE -- ESPECIALLY FOR MAGTAPES
17200 DMPI:
17300 PUSH P,4 ;SAVE AN EXTRA AC
17400 MOVE 1,CHNL
17500 MOVEI 3,STARTPAGE(1)
17600 IMULI 3,1000 ;THE ADDRESS OF THE BUFFER
17700
17800 HRL 2,3 ;ZERO BUFFER
17900 HRRI 2,1(3)
18000 SETZM (3)
18100 BLT 2,777(3)
18200
18300 SUBI 3,1
18400 HRLI 3,-1000 ;MAKE AN IOWD
18500 MOVEI 2,3 ;COMMAND LIST STARTS AT 3
18600 SETZ 4, ;COMMAND LIST ENDS AT 4
18700 JSYS DUMPI
18800 JRST DMIERR ;AN ERROR
18900 MOVEI 3,1000*5 ;NO. OF CHARACTERS
19000 POP P,4 ;RESTORE EXTRA AC
19100 JRST DO36CN ;SET UP COUNT, BP, AND RETURN
19200
19300 DMIERR: CAIE 1,600220 ;EOF?
19400 ERR <INPUT: DUMP MODE ERROR>
19500
19600 DMIEOF:
19700 POP P,4 ;FIRST RESTORE 4
19800 MOVE 1,DVTYP(CDB)
19900 CAIE 2,3 ;MAGTAPE?
20000 JRST DOIEOF ;NO JUST INDICATE EOF
20100 HRRZ 1,CHNL
20200 SETZ 2,
20300 JSYS MTOPR ;RESET STATUS
20400 JRST DOIEOF ;AND INDICATE EOF
20500
20600
20700 ;LINE NUMBER STUFF
20800
20900 INLINN:
21000 NOPGNN:
21100 SKIPE SOSNUM(CDB) ;WANT THE NUMBER?
21200 JRST [MOVE TEMP,@IBP(CDB) ;SAVE IT FOR THE USER
21300 MOVEM TEMP,@SOSNUM(CDB)
21400 JRST .+1]
21500 MOVE TEMP,-1(P) ;GET LINE NUMBER DISPOSITION FLAG,
21600 ADD TEMP,USER ;RLC+TABLE
21700 SKIPGE TEMP,LINTBL(TEMP) ;LINTBL+RLC+TABLE
21800 JRST GIVLIN ; WANTS IT NEXT TIME OR SOMETHING
21900
22000 JSP TEMP,EATLIN ;TOSS IT OUT, AND
22100 JRST .IN ; CONTINUE
22200
22300 EATLIN:
22400 AOS IBP(CDB) ;FORGET IT ENTIRELY
22500 MOVNI A,5 ;INDICATE SKIPPING SIX
22600 ADDB A,ICOWNT(CDB) ;IN COUNT
22700 JUMPG A,(TEMP) ;OVERFLOW BUFFER??
22900 PUSHJ P,DOINP
23000 JRST OKLN ;36-BIT RETURN
23100 ERR <INPUT: 7-BIT BYTES CANNOT HAVE LINE NUMBERS>
23200 JRST DONE1 ;END-OF-FILE
23300 OKLN:
23400 IBP IBP(CDB) ;GET OVER TAB FINALLY
23500 JRST (TEMP) ;AND CONTINUE
23600
23700
23800 GIVLIN: TRNE TEMP,-1 ;WANT LINE NO IN BRCHAR WORD?
23900 JRST GVLLN ;NO, WANTS IT NEXT TIME.
24000 SKIPL TEMP,@IBP(CDB) ;NEGATED LINE NO
24100 MOVNS TEMP
24200 SKIPE BRCHAR(CDB) ;USER LOCATION?
24300 MOVEM TEMP,@BRCHAR(CDB) ;STORE WHERE HE WANTS IT
24400 JSP TEMP,EATLIN ;GO EAT UP LINE NUMBER AND
24500 JRST DONE1 ;FINISH UP
24600 GVLLN:
24700 SKIPE BRCHAR(CDB)
24800 SETOM @BRCHAR(CDB) ;TELL THE USER
24900 AOS ICOWNT(CDB) ;REVERSE THE SOSLE
25000 MOVEI Y,1 ;TURN OFF LINE NUMBER
25100 ANDCAM Y,@IBP(CDB) ; BIT
25200 MOVSI Y,070000 ;BACK UP BYTE POINTER
25300 ADDM Y,IBP(CDB)
25400 JRST DONE1 ;FINISH OFF IN BAZE OF GORY
25500
25600 INPBAD: ERR <INPUT: Illegal JFN OR BAD INPUT>
25700
25800 ENDCOM(INP)
25900 COMPIL(NUM,<REALIN,REALSCAN,INTIN,INTSCAN>
26000 ,<SIMIO,SAVE,RESTR,X22,X33,GETCHN,NOTOPN,.CH.,.MT.,.TEN.,BACKUP,DOINP>
26100 ,<LOU PAUL'S NUMBER INPUT AND CONVERSION ROUTINES>)
00100 COMMENT ⊗Realin, Realscan ⊗
00200
00300 DSCR REAL←REALIN(CHANNEL NUMBER);
00400 CAL SAIL
00500 ⊗
00600
00700 HERE (REALIN)
00800 IFN ALWAYS,<BEGIN NUMIN>
00900
01000 PUSHJ P,SAVE
01100 PUSHJ P,NUMIN; GET NUMBER IN A AND TEN EXPONENT IN C
01200 MOVE LPSA,X22
01300 JRST REALFN
01400
01500 DSCR REAL←REALSCAN(@"STRING");
01600 CAL SAIL
01700 ⊗
01800
01900 HERE (REALSCAN)
02000 PUSHJ P,SAVE
02100 PUSHJ P,STRIN
02200 MOVE LPSA,X33
02300 REALFN: SETZ D,; POS SIGN
02400 JUMPE A,ADON
02500 JUMPG A,FPOS
02600 SETO D,; NUMBER NEGATIVE
02700 MOVNS A
02800 FPOS: ;WE NOW HAVE A POSITIVE NUMBER IN A WITH SIGN IN D
02900 JFFO A,.+1; NUMBER OF LEADING ZEROS IN B
03000 ASH A,-1(B); BIT0=0, BIT1=1
03100 MOVN X,B; BIN EXPONENT -2
03200 JUMPE C,FLO; IF TEN EXPONENT ZERO THEN FINISH
03300 JUMPL C,FNEG
03400 CAIL C,100; CHECK BOUND OF EXPOENT
03500 JRST ERROV1
03600 SETZ Y,
03700 JRST TEST
03800 FNEG: MOVNS C
03900 CAIL C,100
04000 JRST ERROV1
04100 MOVEI Y,6
04200 TEST: TRNE C,1; DEPENDING ON LOW ORDER BIT OF EXP
04300 JRST MULT; EITHER MULTIPLY
04400 NEXT: ASH C,-1; OR DON'T.
04500 AOJA Y,TEST; INDEX INTO MULTIPLIER TABLE
04600 MULT: ADD X,.CH.(Y); EXPONENT
04700 MUL A,.MT.(Y) ;MULTIPLY AND NORMALIZE
04800 TLNE A,200000
04900 JRST DTEST
05000 ASHC A,1
05100 SOJA X,.+1
05200 DTEST: SOJG C,NEXT
05300 FLO: IDIVI A,1B18
05400 FSC A,255
05500 FSC B,234
05600 FADR A,B
05700 SKIPE D
05800 MOVNS A
05900 FSC A,(X); SCALE
06000 JRST ALLDON
06100 SUBTTL INTIN INTEGER NUMBER INPUT ROUTINE LOU PAUL
00100 COMMENT ⊗Intin, Intscan ⊗
00200
00300 DSCR INTEGER←INTIN(CHANNEL NUMBER);
00400 CAL SAIL
00500 ⊗
00600
00700 HERE (INTIN)
00800 ;INTEGER NUMBER INPUT ROUTINE RETURNS VALUE IN A
00900 ;USES NUMIN TO PERFORM FREE FIELD SCAN
01000
01100 PUSHJ P,SAVE
01200 PUSHJ P,NUMIN; GET NUMBER IN A, TEN EXPONENT IN C
01300 MOVE LPSA,X22
01400 JRST INTFN
01500
01600 DSCR INTEGER←INTSCAN("STRING");
01700 CAL SAIL
01800 ⊗
01900
02000 HERE (INTSCAN)
02100 PUSHJ P,SAVE
02200 PUSHJ P,STRIN
02300 MOVE LPSA,X33
02400 INTFN: JUMPE A,ADON
02500 JUMPE C,ADON
02600 JUMPL C,DIVOUT; IF EXPONENT NEG WE WILL DIVIDE
02700 CAIL C,13
02800 JRST ERROV1
02900 IMUL A,.TEN.(C)
03000 JRST ALLDON
03100 DIVOUT: MOVNS C
03200 CAIL C,13
03300 JRST [SETZ A,
03400 JRST ADON ]
03500 MOVE C,.TEN.(C)
03600 IDIV A,C
03700 ASH C,-1
03800 CAML B,C; ROUND POSITIVELY
03900 AOJA A,ALLDON
04000 MOVNS B
04100 CAML B,C
04200 SOJ A,
04300 ALLDON: JOV ERROV1; CHECK FOR OVERFLOW
04400 ADON: MOVEM A,RACS+1(USER)
04500 JRST RESTR
04600 ERROV1: PUSHJ P,ERROV
04700 JRST ADON
04800 SUBTTL FREE FIELD NUMBER SCANNER LOU PAUL
00100 DSCR NUMIN
00200 DES THE COMMON ROUTINE USED BY REALIN, REALSCAN, INTIN, ETC.
00300 ⊗
00400 ;NUMIN PERFORMS A FREE FIELD READ AND RETURNS THE MOST SIGNIFICIANT
00500 ;PART OF THE NUMBER IN A AND THE APPROPIATE TENS EXPONENT IN C
00600 ;TAKING CARE OF LEADING ZEROS AND TRUNCATION ETC.
00700 ;SCANNING IS ACCORDING TO THE FOLLOWING BNF
00800 ;<NUMBER>::=<DEL><SIGN><NUM><DEL>
00900 ;<NUM> ::=<NO>|<NO><EXP>|<EXP>
01000 ;<NO> ::=<INTEGER>|<INTEGER>.|
01100 ; <INTEGER>.<INTEGER>|.<INTEGER>
01200 ;<INTEGER>::=<DIGIT>|<INTEGER><DIGIT>
01300 ;<EXP> ::=E<SIGN><INTEGER>|@<SIGN><INTEGER>
01400 ;<DIGIT>::=0|1|2|3|4|5|6|7|8|9
01500 ;<SIGN> ::=+|-|<EMPTY>
01600 ;NULL AND CARR. RET. ARE IGNORED.
01700 ;SCANNING IS FACILITATED BY A CHARACTER CLASS TABLE "TAB" AND
01800 ;TWO MACROS AHEAD AND ASTERN. THE LEFT HALF OF THE 200+1 WORD TABLE
01900 ;CONTAINS -1 IF NOT A DIGIT AND THE VALUE OF THE DIGIT IF IT IS A DIGIT
02000 ;THE RIGHT HALF CONTAINS -1 IF A DIGIT AND THE CLASS NUMBER IF NOT.
02100 ;CLASS 0 NULL, CARR RET, NOTHING
02200 ;CLASS 1 .
02300 ;CLASS 2 -
02400 ;CLASS 3 +
02500 ;CLASS 4 @,E
02600 ;CLASS 5 ANY OTHER CHARACETR
02700 ;CLASS 6 END OF FILE
02800 ;TAB(200) IS USED FOR FND OF FILE
02900 ;MACRO AHEAD IS USED FOR FORWARD SCANNING, ASTERN FOR SCANNING
03000 ;THE STACK CONSISTING OF AC Y WHICH HAS CLASS SYMBOLS SHIFTED INTO IT.
03100 DEFINE AHEAD(DIG,POINT,MINUS,PLUS,E,CHA,EOF)<
03200 HRRE X,TAB(D)
03300 JRST @.+2(X)
03400 JUMP DIG
03500 JRST .-4
03600 JUMP POINT
03700 JUMP MINUS
03800 JUMP PLUS
03900 JUMP E
04000 JUMP CHA
04100 JUMP EOF>
04200
04300 DEFINE ASTERN(NULL,POINT,MINUS,PLUS,E,CHA)<
04400 SETZ X,
04500 LSHC X,3
04600 JRST @.+1(X)
04700 JUMP NULL
04800 JUMP POINT
04900 JUMP MINUS
05000 JUMP PLUS
05100 JUMP E
05200 JUMP CHA
05300 JUMP CHA>
00100 ;NUMIN -- CONTD.
00200
00300 NUMIN:
00400 SKIPL CHNL,-2(P) ;
00500 CAIL CHNL,JFNSIZE
00600 PUSHJ P,NUMBAD
00700 MOVE CDB,CDBTBL(CHNL)
00800 SKIPN CHNL,JFNTBL(CHNL)
00900 PUSHJ P,NUMBAD
01000 SKIPE ENDFL(CDB)
01100 SETZM @ENDFL(CDB)
01200 SETZM .SKIP.
01300 SKIPE BRCHAR(CDB)
01400 SETZM @BRCHAR(CDB)
01500
01600 MOVE LPSA,[JSP X,NCH]
01700 MOVEI Z,1; FOR LINE NUMBER TEST
01800 PUSHJ P,SCAN
01900 SKIPE BRCHAR(CDB) ;USER WANTS BREAK CHARACTER?
02000 MOVEM D,@BRCHAR(CDB); FIX UP BREAK CHARACTER
02100 SOS IBP(CDB) ;BACK UP TO GET IT NEXT TIME
02200 FOR II←1,4 <
02300 IBP IBP(CDB)>
02400 AOS ICOWNT(CDB)
02500 POPJ P,
02600
02700 ; READ A CHARACTER FROM INPUT FILE -- FOR SCAN.
02800 NCH: SOSG ICOWNT(CDB); DECREMENT CHARACTER COUNT
02900 JRST [PUSHJ P,DOINP
03000 JRST NCH1 ;36-BIT RETURN
03100 JRST NCH1.1 ;7-BIT RETURN
03200 JRST NCH7 ;EOF OR ERROR
03300 ]
03400 NCH1: ILDB D,IBP(CDB); LOAD BYTE
03500 TDNE Z,@IBP(CDB); CHECK FOR LINE NUMBER
03600 JRST NCH5
03700 NCH1.1: SKIPN LINNUM(CDB) ;WANT SETPL THINGS?
03800 JRST (X) ;NO RETURN
03900 CAIN C,12 ;LINE FEED?
04000 AOS @LINNUM(CDB) ;YES
04100 CAIE D,14 ;FORM FEED?
04200 JRST (X) ;NOPE, NOTHING
04300 SKIPE PAGNUM(CDB)
04400 AOS @PAGNUM(CDB) ;INCREMENT PAGE COUNTER
04500 SKIPE LINNUM(CDB)
04600 SETZM @LINNUM(CDB) ;AND ZERO LINE COUNTER
04700 JRST (X); RETURN
04800
04900 NCH7: MOVEI D,200 ;EOF OR DATA ERROR.
05000 JRST (X)
05100
05200 NCH5: SKIPE SOSNUM(CDB) ;WANT SETPL STUFF?
05300 JRST [MOVE D,@IBP(CDB)
05400 MOVEM D,@SOSNUM(CDB) ;INFORM USER ABOUT LINE NUMBER
05500 JRST .+1]
05600 AOS IBP(CDB); WE HAVE A LINE NUMBER
05700 MOVNI D,5; MOVE OVER IT
05800 ADDB D,ICOWNT(CDB)
05900 SKIPLE D ;NOTHING LEFT?
06000 JRST NCH ;DO ANOTHER INPUT
06100 PUSHJ P,DOINP ;
06200 JRST NCH6 ;36-BIT RETURN -- MUST BE
06300 PUSHJ P,NUMBAD ;IMPOSSIBLE
06400 JRST NCH7 ;EOF OR SOME SUCH
06500
06600 NCH6: SOSG ICOWNT(CDB); REMOVE TAB
06700 JRST NCH7 ;NONE THERE OR ERROR
06800 IBP IBP(CDB)
06900 JRST NCH
07000
07100 ;SETUP FOR STRING INPUT (REALSCAN, INTSCAN)
07200 STRIN: MOVE LPSA,[JSP X,NCHA]
07300 HRRZ Z,-3(P)
07400 HRRZ Z,-1(Z)
07500 HRRZS -3(P) ;SO CAN INDIRECT THROUGH IT.
07600 PUSHJ P,SCAN
07700 HRRZ X,-3(P)
07800 SOS (X) ;BACK UP BYTE POINTER
07900 FOR II←1,4<
08000 IBP (X)>
08100 AOJ Z,
08200 HRRM Z,-1(X)
08300 MOVEM D,@-2(P) ;STORE BREAK CHARACTER
08400 POPJ P,
08500
08600 ;READ A CHARACTER ROUTINE FOR STRINGS.
08700 NCHA: SOJL Z,NCH7
08800 ILDB D,@-4(P)
08900 JRST (X)
09000
00100 ;SCAN (CALLED BY NUMIN AND STRIN)
00200
00300 SCAN: JOV .+1
00400 SETO TEMP, ;FLAG REGISTER.
00500 SETZ Y,
00600 SETZB A,C; NUMBER EXPOENT
00700 MORE: XCT LPSA; THIS GETS A CHARACTER IN D,200 IF FO EOF
00800 AHEAD(DIG1,STACK,STACK,STACK,STACK,STACK,DONE)
00900 STACK: LSHC X,-3; PUSH SYMBOL ONTO STACK "AC Y"
01000 JRST MORE
01100
01200 DIG1: SETZ TEMP,; FLAG REG.
01300 ASTERN(INT1,FRA1,SIG1,SIG2,EXP1,INT1)
01400
01500 SIG1: TRO TEMP,4; NEGATIVE SIGN
01600 SIG2: ASTERN(INT1,ERR2,ERR5,ERR5,EXP1,INT1)
01700
01800 EXP1: MOVEI A,1
01900 ASTERN(EXP2,ERR2,SIG3,SIG4,ERR1,EXP2)
02000
02100 SIG3: MOVNS A
02200 SIG4: ASTERN(EXP2,ERR2,ERR5,ERR5,ERR1,EXP2)
02300
02400 FRA1: TRO TEMP,1; DECIMAL POINT
02500 SOJ C,
02600 ASTERN(INT1,ERR2,SIG5,SIG6,ERR1,INT1)
02700
02800 SIG5: TRO TEMP,4; NEGATIVE SIGN
02900 SIG6: ASTERN(INT1,ERR2,ERR5,ERR5,ERR1,INT1)
03000
03100 EXP2: HLRE FF,TAB(D); FIRST DIGIT
03200 EXP5: XCT LPSA; GET NEXT CHARACTER
03300 EXP9: HLRE B,TAB(D)
03400 JUMPL B,EEXP; NEGATIVE IF NOT A DIGIT
03500 IMULI FF,12
03600 ADD FF,B
03700 JRST EXP5
03800
03900 XCT LPSA
04000 ;;#QD# SEE DONE5: BELOW
04100 EEXP: AHEAD(EXP9,ERR2,DONE5,DONE5,ERR1,EN,EN)
04200 EN: TRNE TEMP,4; SIGN OF EXPONENT
04300 MOVNS FF
04400 ADD C,FF; FIX UP EXPONENT
04500 JOV ERR3
04600
04700 ;#QD# CHANGE ALL 'ERR5'S IN AHEAD MACROS DO 'DONE5'S, TO AVOID SNARFING EXTRA
04800 ;SIGNS ..... RFS 12-15-73 (TWO PLACES BELOW AND ONE ABOVE ALSO)
04900 DONE5:
05000 DONE: ANDI D,177
05100 JUMPGE TEMP,.+2
05200 SETO D,
05300 POPJ P,
05400
05500 INT1: HLRE A,TAB(D); FIRST DIGIT
05600 TRNE TEMP,4
05700 MOVNS A; NEGATE IF NECESSARY
05800 INT2: XCT LPSA; GET NEXT CHARACTER
05900 INT5: HLRE B,TAB(D)
06000 JUMPL B,EON; NEGATIVE IF NOT A NUMBER
06100 TRNE TEMP,1; IF PASSED DECIMAL POINT THEN DEC EXP BY ONE
06200 SOJ C,
06300 TRNE TEMP,2; IF ENOUGH DIGITS THEN INC EXP BY ONE
06400 INT3: AOJA C,INT2
06500 MOVE X,A
06600 IMULI A,12
06700 TRNE TEMP,4; NEGATE DIGIT IS SIGN NEGATIVE
06800 MOVNS B
06900 ADD A,B
07000 JOV INT4; CHECK FOR OVERFLOW
07100 JRST INT2; IF SO USE LAST VALUE
07200
07300 INT4: TRO TEMP,2
07400 MOVE A,X
07500 JRST INT3
07600
07700 XCT LPSA
07800 EON: AHEAD(INT5,DP1,DONE,DONE,EXP6,DONE,DONE)
07900
08000 DP1: TROE TEMP,1
08100 JRST ERR2
08200 XCT LPSA
08300 ;#QD# (SEE DONE5: ABOVE)
08400 AHEAD(INT5,ERR2,DONE5,DONE5,EXP6,DONE,DONE)
08500
08600 EXP6: SETZ TEMP,
08700 XCT LPSA
08800 AHEAD(EXP2,ERR2,EXP7,EXP8,ERR1,ERR1,ERR1)
08900
09000 EXP7: TRO TEMP,4
09100 EXP8: XCT LPSA
09200 ;#QD# (SEE DONE5: ABOVE)
09300 AHEAD(EXP2,ERR2,DONE5,DONE5,ERR1,ERR1,ERR1)
09400
09500 ERR1: ERR(<NUMIN: IMPROPER EXPONENT>,1,RZ)
09600
09700 ERR2: ERR(<NUMIN: MISPLACED DECIMAL POINT>,1,RZ)
09800
09900 ERR3: ERR(<NUMIN: EXPONENT OUT OF BOUND>,1,RZ)
10000
10100 ERR5: ERR(<NUMIN: MISPLACED SIGN>,1,RZ)
10200
10300 ERROV: ERR(<NUMIN: NUMBER OUT OF BOUND>,1,RZ)
10400
10500 NUMBAD: ERR<NUMIN: Illegal JFN>
10600 POPJ P,
10700
10800 RZ: SETZ A,
10900 JRST DONE
00100 ; Character table for SCAN (Realscan,Intscan,Realin,Intin)
00200 TAB: FOR A IN (0,5,5,5,5,5,5,5)<XWD -1,A
00300 >
00400 FOR A IN (5,5,5,5,5,0,5,5)<XWD -1,A
00500 >
00600 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
00700 >
00800 ;#QC# MAKE 32 (CONTROL Z) IGNORED
00900 FOR A IN (5,5,0,5,5,5,5,5)<XWD -1,A
01000 >
01100 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
01200 >
01300 FOR A IN (5,5,5,3,5,2,1,5)<XWD -1,A
01400 >
01500 FOR A IN (0,1,2,3,4,5,6,7,10,11)<XWD A,-1
01600 >
01700 FOR A IN (5,5,5,5,5,5)<XWD -1,A
01800 >
01900 FOR A IN (4,5,5,5,5,5,5,5)<XWD -1,A
02000 >
02100 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
02200 >
02300 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
02400 >
02500 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
02600 >
02700 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
02800 >
02900 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
03000 >
03100 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
03200 >
03300 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
03400 >
03500 XWD -1,6
03600
03700 ENDCOM(NUM)
03800 COMPIL(TBB,<.CH.,.TEN.,.MT.>,,<TABLES FOR L PAUL'S ROUTINES>)
00100 DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
00200 ⊗
00300
00400 ↑↑.CH.: 4
00500 7
00600 16
00700 33
00800 66
00900 153
01000 777777777775
01100 777777777772
01200 777777777763
01300 777777777746
01400 777777777713
01500 777777777626
01600 ↑↑.MT.: 240000000000
01700 310000000000
01800 234200000000
01900 276570200000
02000 216067446770
02100 235613266501
02200 314631463147
02300 243656050754
02400 321556135310
02500 253630734215
02600 346453122767
02700 317542172553
02800 ↑↑.TEN.: 1
02900 =10
03000 =100
03100 =1000
03200 =10000
03300 =100000
03400 =1000000
03500 =10000000
03600 =100000000
03700 =1000000000
03800 =10000000000
03900
04000 ENDCOM(TBB)
04100 IFN ALWAYS,<
04200 BEND
04300 >;IFN ALWAYS
00100 COMPIL(STDBRK,<STDBRK>,<SAVE,RESTR,GOGTAB,X22>
00200 ,<STDBRK -- STANDARD BREAKSET ROUTINE>)
00300 COMMENT ⊗Stdbrk ⊗
00400
00500 DSCR STDBRK(CHANNEL);
00600 CAL SAIL
00700 ⊗
00800
00900 HERE (STDBRK)
01000 PUSHJ P,SAVE
01100 MOVSI 1,100001
01200 MOVE 2,[BKTFIL]
01300 JSYS GTJFN
01400 JRST STDERR
01500 MOVE 2,[XWD 440000,200000]
01600 JSYS OPENF
01700 JRST STDERR
01800 MOVE USER,GOGTAB
01900 MOVSI 2,444400 ;BYTE-POINTER
02000 HRR 2,DSPTBL(USER) ;ADDRESS
02100 MOVNI 3,=19+=19+=128 ;COUNT
02200 JSYS SIN
02300 JSYS CLOSF
02400 JFCL
02500 STDRET: MOVE LPSA,X22
02600 JRST RESTR
02700 STDERR: ERR <STDBRK: CANNOT READ IN FILE>,1
02800 JRST STDRET
02900
03000
03100
03200 IFN ALWAYS, <BEND IOSER>
03300 DSCR BEND IOSER ⊗
03400 >;TENX
00100
00200
00300
00400
00500
00600
00700
00800
00900
00100
00200
00300
00400
00500
00600
00700
00800