perm filename IOSER[CMU,AIL] blob
sn#090713 filedate 1974-03-11 generic text, type T, neo UTF8
00100 COMMENT ⊗ VALID 00034 PAGES VERSION 17-1(30)
00200 RECORD PAGE DESCRIPTION
00300 00001 00001
00400 00007 00002 HISTORY
00500 00013 00003 Indices, Bits for IOSER
00600 00016 00004 Simio, Ioinst, Lpryer, Cserr
00700 00024 00005 Getchn
00800 00027 00006 Filnam
00900 00031 00007 Flscan
01000 00033 00008 Open
01100 00038 00009
01200 00044 00010 Release
01300 00049 00011 Lookup, Enter
01400 00052 00012 Fileinfo
01500 00054 00013 Out
01600 00057 00014 Input
01700 00066 00015 Realin, Realscan
01800 00068 00016 Intin, Intscan
01900 00070 00017 DSCR NUMIN
02000 00073 00018 NUMIN -- CONTD.
02100 00076 00019 SCAN (CALLED BY NUMIN AND STRIN)
02200 00080 00020 Character table for SCAN (Realscan,Intscan,Realin,Intin)
02300 00082 00021 DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
02400 00084 00022 Arryout, Wordout
02500 00089 00023 Arryin, Wordin
02600 00097 00024 Linout
02700 00100 00025 Breakset
02800 00104 00026 Setbreak
02900 00106 00027 Stdbrk
03000 00108 00028 Close, Closin, Closo
03100 00110 00029 Mtape
03200 00112 00030 Useti, Useto, Rename
03300 00114 00031 Usercon
03400 00116 00032 Ttyuuo functions
03500 00120 00033
03600 00132 00034 Ptyuuo functions
03700 00140 ENDMK
03800 ⊗;
00100 COMMENT ⊗HISTORY
00200 AUTHOR,REASON
00300 021 102100000036 ⊗;
00400
00500
00600 COMMENT ⊗
00650 VERSION 17-1(30) 2-22-74 BY RHT FEAT %BG% ADD BREAKSET MODE "F"
00700 VERSION 17-1(29) 2-1-74 BY RHT BUG #QY# USBSTS NEEDED PATCHING
00800 VERSION 17-1(28) 2-1-74
00900 VERSION 17-1(27) 1-12-74 BY RHT MAKE COUNT RIGHT IN INOUT
01000 VERSION 17-1(26) 1-12-74
01100 VERSION 17-1(25) 1-12-74 BY RHT FIX COMPIL FOR SAITTY
01200 VERSION 17-1(24) 1-11-74 BY RHT TTYINL STUFF
01300 VERSION 17-1(23) 1-11-74 BY RHT MERGE IN CMU CHANGES
01400 VERSION 17-1(22) 1-11-74
01500 VERSION 17-1(21) 1-11-74
01600 VERSION 17-1(20) 1-11-74
01700 VERSION 17-1(19) 1-11-74
01800 VERSION 17-1(18) 12-15-73 BY RFS FIX BUGS QC,QD.
01900 VERSION 17-1(17) 12-10-73 BY JRL REMOVE LAST REFERENCES TO PGNNO
02000 VERSION 17-1(16) 12-10-73
02100 VERSION 17-1(15) 12-10-73
02200 VERSION 17-1(14) 12-8-73 BY JRL REMOVE SPECIAL STANFORD CHARACTERS(WHERE POSSIBLE)
02300 VERSION 17-1(13) 12-8-73 BY RFS MAKE ALTMODE 33 FOR EXPORT SYSTEMS
02400 VERSION 17-1(12) 12-5-73 BY RHT BUG #PO#
02500 VERSION 17-1(11) 12-5-73
02600 VERSION 17-1(10) 12-5-73
02700 VERSION 17-1(9) 12-3-73 BY RFS REMOVE ALL III DISPLAY STUFF
02800 VERSION 17-1(8) 12-2-73 BY RHT FIX INPUT
02900 VERSION 17-1(7) 12-2-73 BY RLS EDIT
03000 VERSION 17-1(6) 12-2-73 BY RHT ALSO SOME WRD SPARES
03100 VERSION 17-1(5) 12-2-73 BY RHT FEAT %AV% CHNCDB. ALSO SPARES ADDED TO OPN & BRK
03200 VERSION 17-1(4) 12-2-73
03300 VERSION 17-1(3) 12-1-73 BY RLS BUG #PM# DONT LOSE A CHAR IN INPUT
03400 VERSION 17-1(2) 12-1-73 BY RLS ADD SETPL FUNCTION
03500 VERSION 17-1(1) 7-27-73 BY JRL CHANGE OPEN TO FACT THAT RELEASE NOW TAKES TWO ARGUMENTS
03600 VERSION 17-1(0) 7-26-73 BY RHT **** VERSION 17 ****
03700 VERSION 16-2(45) 5-7-73 BY JRL CHANGE PTYALL TO HANDLE LARGER BUFFERS
03800 VERSION 16-2(44) 3-21-73 BY JRL ADD COMPIL(SAIDM3)
03900 VERSION 16-2(43) 2-25-73 BY RHT BUG #LP# GO TO OUT OF PROCESS SHOULDNT LOOP!
04000 VERSION 16-2(42) 2-14-73 BY RHT BUG #LM# TYPO IN PITBND
04100 VERSION 16-2(41) 1-9-73 BY RHT REPAIR COMPIL FOR SAIPIT
04200 VERSION 16-2(40) 12-2-72 BY RHT MODIFY PIT STUFF FOR NEW INFOTAB &DATAB
04300 VERSION 16-2(39) 12-1-72 BY JRL CHANGE LEAP INDEX USED TO CALL FRELS WITHIN BEXIT
04400 VERSION 16-2(38) 11-28-72 BY RHT ADD CLEANUPS TO BEXIT CODE
04500 VERSION 16-2(37) 9-24-72 BY JRL LIBRARY REQUESTS
04600 VERSION 16-2(36) 9-21-72 BY JRL ADD DADDY CURSCB ETC TO DUM
04700 VERSION 16-2(35) 8-31-72 BY JRL RELEASE VALUE SETS CORRECTLY IN STKUWD
04800 VERSION 16-2(34) 8-27-72 BY RHT CHANGE SPOT IN WHICH STKUWD SAVES RETN
04900 VERSION 16-2(33) 8-23-72 BY JRL ADD FORGET CONTEXT CODE TO BEXIT
05000 VERSION 16-2(32) 8-14-72 BY RHT EVAL NOW NAMED APPLY
05100 VERSION 16-2(31) 7-22-72 BY RHT ADD KILL LIST TO BEXIT
05200 VERSION 16-2(30) 7-12-72 BY DCS BUG #IN# PTYALL INVALID REMCHR PROBLEM
05300 VERSION 16-2(29) 7-3-72 BY DCS MANY THINGS
05400 VERSION 16-2(28) 6-7-72 BY DCS BUG #HO# RETURN BOTH ADDRESSES FROM ..ARCOP FOR .MES2
05500 VERSION 16-2(27) 5-24-72 BY RHT CHANGE STKUWD TO LOOK AT PPDA
05600 VERSION 16-2(26) 5-15-72 BY JRL ARRPDP BUG AGAIN
05700 VERSION 16-2(24) 5-11-72 BY DCS BUG #HC# BETTER EXPO OUTSTR
05800 VERSION 16-2(23) 5-11-72 BY DCS BUG #HA# IMPRV. ERR. ENB, FIX MUDDY FEET IN EXPO
05900 VERSION 16-2(22) 5-11-72 BY DCS BUG #GT# ALLOW LARGE OCTAL PPNS
06000 VERSION 15-6(17-21) 5-4-72
06100 VERSION 15-6(17) 3-7-72 BY DCS FIX OUTSTR(NULL) GARBAGING
06200 VERSION 15-6(7-16) 2-20-72
06300 VERSION 15-6(6) 2-18-72 BY RHT CREATE THE NEW WORLD
06400 VERSION 15-2(5) 2-6-72 BY DCS BUG #FQ# (WD-ARRY)(IN-OUT) WORD COUNT KEPT RIGHT, IOERR OK, DUMP MODE OK
06500 VERSION 15-2(4) 2-5-72 BY DCS BUG #GI# REMOVE TOPSTR
06600 VERSION 15-2(3) 2-1-72 BY DCS BUG #GF# INCHWL BREAKS ON MORE THINGS, TELLS WHAT THEY ARE
06700 VERSION 15-2(2) 1-25-72 BY DCS BUG #GD# Fix non-standard buffer size setup in OPEN
06800 VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER
06900
07000 ⊗;
00100 COMMENT ⊗Indices, Bits for IOSER ⊗
00200 LSTON (IOSER)
00300
00400 IFN ALWAYS,<BEGIN IOSER>
00500 DSCR IOSER -- IOSER GENERAL DISCUSSION
00600 ;SEE GOGOL FOR MORE DETAILS
00700 ; FORMAT OF CDBs
00800 DMODE ←← 0 ;DATA MODE
00900 DNAME ←← 1 ;DEVICE
01000 BFHED ←← 2 ;HEADER POINTERS
01100 OBPNT ←← 3 ;OUTPUT BUFFER POINTER
01200 OBP ←← 4 ;OUTPUT BYTE POINTER
01300 OCOWNT ←← 5 ;OUTPUT BYTE COUNT
01400 ONAME ←← 6 ;OUTPUT FILE NAME -- FOR INFORMATION ONLY
01500 OBUF ←← 7 ;OUTPUT BUFFER LOCATION
01600 IBPNT ←←10 ;SAME STUFF FOR INPUT
01700 IBP ←←11
01800 ICOWNT ←←12
01900 INAME ←←13
02000 IBUF ←←14
02100 ICOUNT ←←15 ;INPUT DATA COUNT LIMIT ADDRESS
02200 BRCHAR ←←16 ;XWD TTYDEV FLAG, INPUT BREAK CHAR ADDR
02300 TTYDEV ←←16 ;LH -1 IF DEVICE IS A TTY -- USED BY OUT
02400 ENDFL ←←17 ;INPUT END OF FILE FLAG ADDR
02500 ERRTST ←←20 ;USER ERROR BITS SPECIFICATION WORD
02600 LINNUM ←←21 ;ADDR OF LINE NUMBER WORD (SETPL FUNCTION)
02700 PAGNUM ←←22 ;ADDR OF PAGE NUMBER WORD (SETPL FUNCTION)
02800 SOSNUM ←←23 ;ADDR OF SOS NUMBER WORD (SETPL FUNCTION)
02900
03000 ; SIMIO INDICES
03100
03200 ?IOSTATUS ←←0
03300 ?IOIN ←←1 ;SEE EXPLANATIONS IN SIMIO ROUTINE
03400 ?IODIN ←←2
03500 ?IOOUT ←←3
03600 ?IODOUT ←←4
03700 ?IOCLOSE ←←5
03800 ?IORELEASE ←←6
03900 ?IOINBUF ←←7
04000 ?IOOUTBUF ←←10
04100 ?IOSETI ←←11
04200 ?IOSETO ←←12
04300 ;;%##% A NEW GOODIE
04400 ?SETIOSTS ←←13
04500 ?IOOPEN ←←14
04600 ?IOLOOKUP ←←15
04700 ?IOENTER ←←16
04800 ?IORENAME ←←17
04900 ⊗
05000 COMPIL(SIM,<SIMIO,CSERR,LPRYER>,<GOGTAB>
05100 ,<SIMIO, CSERR, LPRYER -- SUPPORT ROUTINES>)
00100 COMMENT ⊗Simio, Ioinst, Lpryer, Cserr ⊗
00200
00300 DSCR SIMIO
00400 CAL XCT INDEX,SIMIO
00500 PAR AC field is index into instruction table (see below)
00600 CHNL contains I/O channel number
00700 other params can be gleaned from instruction table
00800 RES an I/O instruction is executed. Routine skips if I/O instr did.
00900 If the INDEX is LEQ 12, and if the instruction skips (error or EOF),
01000 status is presented in LH of user's EOF vbl (@ENDFL(CDB)), so he
01100 can test it, or an error message is provided (depending on user-
01200 enabling). This simplifies many I/O routines.
01300 SID NONE
01400 DES This routine makes I/O instructions re-entrant. The problem is
01500 that the channel cannot be referenced indirectly.
01600 ⊗
01700
01800 ↑↑SIMIO: PUSHJ P,.+1 ;SAVE PC OF XCT
01900 PUSH P,C ;SAVE C
02000 MOVE C,-1(P) ;ASSUME SKIP RETURN
02100 LDB C,[POINT 4,-1(C),12] ;INDEX OF XCT
02200 JUMPE C,USTST ;WANT STATUS BITS ONLY
02300 CAIL C,13 ;NOW SPLIT HIGH AND LOW INDICES
02400 JRST ALTIO ;SKIP RETURN CHECK ONLY
02500 ;;%##% CHECK TO NOT SCREW STANDARD DEC LOSERS
02600 EXPO <
02700 CAIN C,IOIN ;
02800 JRST ISIOU ;
02900 CAIE C,IOOUT ;IN OR OUT ?
03000 JRST NOTIOU ;NOPE
03100 ISIOU: SKIPG @USBTST(C) ;CHECK FOR NO BUFFERS (& MORE AT CMU)
03200 JRST USFUNY ;NO BUFFERS, ETC.
03300 >;EXPO
03400 NOTIOU:MOVE C,IOINST(C) ;GET INSTRUCTION
03500 DPB CHNL,[POINT 4,C,12] ;CHANNEL NUMBER
03600 XCT C ;DO OPERATION
03700 JRST USOUT ;ALL KOSHER, NO EOF OR ERR
03800 USTST: MOVE C,[GETSTS C] ;WHA-
03900 DPB CHNL,[POINT 4,C,12] ; T HAPPEN-
04000 XCT C ; ED?
04100 ;;%##% SAVE STATUS BITS
04200 MOVEM C,FSTATS(USER)
04300 CMU <
04400 USERF:
04500 >;CMU
04600 TRZ C,10000 ;IOACT BIT, USER LOOKUP CHECK BIT
04700 HRLZM C,@ENDFL(CDB) ;GIVE USER THE BITS
04800 TDNN C,ERRTST(CDB) ;ANY HE CAN'T HANDLE?
04900 JUMPA CHNL,USSKIP ;NOPE, JUST SKIP-RETURN
05000 ERR <I-O DEVICE ERROR ON CHANNEL >,7 ;JUMPA TO PROVIDE CHANNEL AC
05100 USSKIP: AOS -1(P) ;SKIP-RETURN
05200 USOUT: POP P,C ;RESTORE C
05300 POPJ P, ;DONE
05400
05500 ALTIO: MOVE C,IOINST(C) ;GET INSTR
05600 DPB CHNL,[POINT 4,C,12]
05700 XCT C ;DO IT
05800 JRST USOUT ;NO SKIP
05900 JRST USSKIP ;SKIP
06000 EXPO <
06100 USFUNY:
06200 CMU < SKIPE @USBTST(C) ;FUNNY DEVICE?
06300 JRST REALTM ; YES.
06400 >;CMU
06500 JUMP CHNL, ;FOR THE ERR MSG
06600 ERR <NO BUFFERS ASSIGNED FOR I-O CHAN >,7
06700 JRST USSKIP
06800 CMU,< COMMENT ⊗ THIS NONSENSE IS A SPECIAL MODE FOR
06900 THE CMU SPEECH DEVICES. ESSENTIALLY, IT DOES EVERTHING
07000 AS NORMAL, EXCEPT THAT IT PICKS UP THE TIMING ERR AND
07100 RUN-OUT-OF BUFFERS BIT OF THE
07200 I/O STATUS FROM THE STATUS WORD IN THE BUFFER HEADER,
07300 INSTEAD OF USING THE BIT FROM THE GETSTS. ⊗
07400 TIMERR←←100000 ;TIMING ERR BIT FOR SPEECH DEVICES
07500 ROBERR←←200000 ;RUN-OUT-OF-BUFFER ERR
07600
07700 REALTM: PUSH P,D ;NEED ANOTHER AC
07800 CAIE C,IOIN ;INPUTTING?
07900 JRST REALOT ; NO
08000 MOVSI C,(<IN>)
08100 DPB CHNL,[POINT 4,C,12] ;CHAN #
08200 XCT C ;DO THE INPUT
08300 JRST REALOK ;NO ERR, SO FAR
08400 MOVE C,[GETSTS C]
08500 DPB CHNL,[POINT 4,C,12] ;LOOKS FAMILIAR
08600 XCT C
08700 TRZA C,TIMERR!ROBERR ;TURN OFF THE ONES FROM THE GETSTS
08800 REALOK: MOVEI C,0
08900 HRRZ D,IBPNT(CDB) ;ADDRESS OF THE NEW BUFFER
09000 IOR C,-1(D) ;THE BITS FROM THE BUFFER
09100 REALRT: POP P,D ;RESTORE THE AC
09200 TRNN C,760000 ;ERR OR EOF?
09300 JRST USOUT ; NO
09400 JRST USERF ; YES, GO LOOK AT IT
09500
09600 REALOT: MOVE C,[GETSTS C]
09700 DPB CHNL,[POINT 4,C,12]
09800 XCT C
09900 TRNN C,ROBERR ;STOPPED FOR A ROB?
10000 JRST REAL5 ; NO
10100 HRRI D,(C) ;GET THE BITS
10200 TRZ D,760000 ;TURN OFF THE ERRS
10300 HRLI D,(<SETSTS>)
10400 DPB CHNL,[POINT 4,D,12]
10500 XCT D
10600 REAL5: MOVSI D,(<OUT>)
10700 DPB CHNL,[POINT 4,D,12]
10800 XCT D
10900 JRST REALRT
11000 JRST REALRT ;IGNORE NOW, CATCH THE NEXT TIME THRU
11100
11200 >;CMU
11300
11400 USBTST←.-1
11500 XWD CDB,IBUF ;1
11600 ;;#QY# ! RHT 2-1-74 NEEDED A DUMMY HERE.
11700 777777 ;@ THRU THIS WILL BE ILL MEM REF
11800 XWD CDB,OBUF ;3
11900 >;EXPO
12000
12100
12200 DSCR INSTRUCTION TABLE
12300 ⊗
12400 IOINST←.-1 ;IOSTATUS ←← 0 GET STATUS
12500 IN ;IOIN ←← 1 BUFFERED INPUT
12600 IN D ;IODIN ←← 2 DUMP MODE INPUT
12700 OUT ;IOOUT ←← 3 BUFFERED OUTPUT
12800 OUT D ;IODOUT ←← 4 DUMP MODE OUTPUT
12900 CLOSE (D) ;IOCLOSE ←← 5 CLOSE I,O, OR BOTH
13000 ;; ALLOW USE OF INHIBIT BITS IN RELEASE
13100 RELEASE (D) ;IORELEASE←← 6
13200 INBUF (A) ;IOINBUF ←← 7
13300 OUTBUF (A) ;IOOUTBUF ←←10
13400 USETI (A) ;IOSETI ←←11
13500 USETO (A) ;IOSETO ←←12
13600 ;;%##% A NEW GOODIE
13700 SETSTS (A) ; SET IO STATUS
13800 OPEN DMODE(CDB) ;IOOPEN ←←14
13900 LOOKUP FNAME(USER);IOLOOKUP←←15
14000 ENTER FNAME(USER);IOENTER ←←16
14100 RENAME FNAME(USER);IORENAME←←17
14200
14300 HERE(CSERR) MOVE USER,GOGTAB
14400 POP P,UUO1(USER) ;STANDARD PLACE
14500 ERR <CASE INDEX OVERFLOW, VALUE IS >,13
14600 JRST @UUO1(USER) ;RETURN OK
14700
14800 HERE (LPRYER) ERR <DATUM OF ARRAY NOT THERE>,1
14900 POPJ P,
15000
15100 ENDCOM(SAV)
15200 COMPIL(CHN,<GETCHN,NOTOPN,GETCHAN>,<GOGTAB>,<GETCHN, NOTOPN, GETCHAN>)
00100 COMMENT ⊗Getchn ⊗
00200
00300 DSCR Getchn, Getchan
00400
00500 PAR A -- addr of ASCII for routine name
00600 CHNL -- I/O channel number from SAIL call
00700 RES -- CHNL contains actual I/O channel number (diff for shared TTY)
00800 CDB contains ptr to actual CDB table for that channel
00900 SID A(lh) is changed
01000 DES normally just sets up CHNL and CDB
01100 if error occurs (channel out of bounds, already open), a fatal message
01200 is printed, using the address in A to get the routine name.
01300 This routine is called by most I/O routines, having saved ACs and
01400 fetched CHNL.
01500 ⊗
01600
01700 GETCHN:
01800 HRLI A,(<PUUO 3,0>) ;PREPARE FOR ERR MESS
01900 TRZE CHNL,777760 ;CHECK FOR VALID CHANNEL NO
02000 JRST NOTVALID ;INVALID CHANNEL NUMBER
02100 SKIPE CDB,@CDBLOC(USER) ;IS CHANNEL OPEN? (CDBLOC SET BY ALLOC)
02200 POPJ P,
02300
02400 NOTOPN:
02500 XCT A ;PRINT ROUTINE NAME
02600 ERR <: CHANNEL OR FILE NOT OPEN>
02700
02800
02900 NOTVALID:
03000 XCT A ;ROUTINE NAME
03100 ERR <: CHANNEL NUMBER INVALID>
03200
03300
03400 DSCR INTEGER←GETCHAN;
03500 CAL SAIL
03600 ⊗
03700
03800 HERE (GETCHAN)
03900 MOVE USER,GOGTAB
04000 ADD USER,[XWD A,CHANS] ;MAKE @ WORD
04100 MOVEI A,1 ;START AT CHANNEL 1
04200 CHLUP: SKIPN @USER ;IF CHANNEL IS FREE,
04300 POPJ P, ; RETURN
04400 CAIGE A,17 ;CYCLE TO 0?
04500 AOJA A,CHLUP ;NO, TRY NEXT
04600 MOVEI A,0 ;TRY 0
04700 SKIPE @USER ;FREE?
04800 HRROI A,-1 ;NOPE
04900 POPJ P, ;DONE
05000
05100 ENDCOM(CHN)
05200 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 CMU < ;HANDLE PPNS VIA UUO, MAYBE
02900 HRRZS 1(SP) ;LENGTH PART
03000 ;SNEAK A LOOK AT FIRST CHAR
03100 SKIPN 1(SP) ;IS THERE A FIRST CHAR?
03200 JRST FLERR ; NO.
03300 MOVE X,2(SP)
03400 ILDB X,X
03500 CAIL X,"0"
03600 CAILE X,"7"
03700 SKIPA ; NOT OCTAL DIGIT
03800 JRST OCTPPN
03900 PUSH P,A ;NEED MORE ROOM
04000 PUSH P,B
04100 SETZM A ;CLEAR THE AREA
04200 SETZM B
04300 SETZM C
04400 MOVEI D,=13+1 ;MAX #CHARS+1
04500 MOVE X,[POINT 7,A] ;DUMP THEM THERE
04600 FLN2: SOSGE 1(SP)
04700 JRST FLERRC ;RAN OUT OF STRING
04800 ILDB Y,2(SP) ;THE NEXT CHAR
04900 CAIN Y,"]" ;THE END?
05000 JRST GOTRB ; YES
05100 JUMPLE D,FLERRC ;WE DON'T WANT ANY MORE CHARACTERS
05200 IDPB Y,X ;STICK THE CHAR THERE
05300 SOJA D,FLN2 ;GET ANOTHER
05400
05500 GOTRB: MOVEI X,A ;THATS WHERE THE UUO WILL FIND THEM
05600 CALLI X,-2 ;CMUDEC UUO
05700 JRST FLERRC ;SOMETHING WRONG
05800 MOVEM X,FNAME+3(USER) ;SAVE IT
05900
06000 AOS -2(P) ;INDICATE SUCCESS
06100 FLERRC: POP P,B
06200 POP P,A
06300 POPJ P,
06400 OCTPPN:
06500 >;CMU
06600 PUSHJ P,[
06700
06800 RJUST: SETZM PROJ(USER)
06900 MOVEI X,PROJ(USER)
07000 PUSHJ P,FLSCAN ;GET PROJ OR PROG IN SIXBIT
07100 IFN SIXSW,<
07200 MOVE X,PROJ(USER)
07300 IMULI D,-6 ;SHIFT FACTOR
07400 LSH X,(D) ;RIGHT-JUSTIFY THE PROJ OR PROG
07500 >;IF SIXSW (SET IN HEAD, USUALLY CONDITIONED ON NOEXPO)
07600
07700 IFE SIXSW,<
07800 MOVEI X,0
07900 ;;#GT# DCS 5-11-72 ALLOW LARGE OCTAL NUMBERS AT STD DEC SYSTEMS
08000 MOVE D,PROJ(USER) ;WAS A HLLZ
08100 ;;
08200 FBACK: MOVEI C,0
08300 LSHC C,6 ;GET A SIXBIT CHAR
08400 CAIL C,'0'
08500 CAILE C,'7'
08600 JRST FLERR ;INVALID OCTAL
08700 LSH X,3
08800 IORI X,-'0'(C)
08900 JUMPN D,FBACK
09000 >;NOT SIXSW (USUALLY CONDITIONED ON EXPO)
09100 FPOP: POPJ P,]
09200
09300 HRLZM X,FNAME+3(USER)
09400 CAIE Y,","
09500 JRST FLERR ;INVALID CHAR
09600 PUSHJ P,RJUST ;JUSTIFY(AND CONVERT IF EXPORT) PROG #
09700 HRRM X,FNAME+3(USER)
09800 CAIN Y,"]"
09900 FLDUN: AOS (P) ;SUCCESSFUL
10000 FLERR: POPJ P, ;DONE, NOT NECESSARILY RIGHT
10100
10200 ENDCOM(FIL)
10300 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)
03600 COMPIL(OPN,<OPEN,RELEASE,SETPL,CHNCDB>
03700 ,<GETCHN,SAVE,RESTR,CORGET,FLSCAN,SIMIO,X33,X22,X11,CORREL>
03800 ,<OPEN RELEASE AND SETPL FUNCTIONS>)
03900
00100 COMMENT ⊗Open ⊗
00200
00300 DSCR OPEN(CHAN,"DEV",MODE,IBFS,OBFS,@INCNT,@INBRCHR,@INEOF);
00400 CAL SAIL
00500 ⊗
00600 COMMENT ⊗
00700 Allocate IBFS input and OBFS output buffers on channel CHAN for
00800 device DEV(SAIL/GOGOL string). Store INCNT, and the INBCHR and INEOF
00900 addresses in a newly allocated CDB (channel data block). Store
01000 all necessary information to carry out I/O on this channel
01100 in the CDB. Mark the channel open.
01200 ⊗
01300
01400 .OPN:
01500 HERE (OPEN)
01600 ; FIRST RELEASE IF ALREADY OPEN
01700 PUSH P,-7(P)
01800 ; RELEAS NOW TAKES TWO ARGS
01900 PUSH P,[0]
02000 PUSHJ P,RELEASE ;SIMPLE
02100
02200 ; NEXT SAVE AC'S, SET UP USER REGISTER, OBTAIN A CDB
02300
02400 PUSHJ P,SAVE ;SAVE ACS
02500 MOVEI C,IOTLEN ;SIZE
02600 PUSHJ P,CORGET ;OBTAIN A BLOCK
02700 JRST BADOPN ;CAN'T GET IT
02800 MOVE CDB,B ;CDB ptr to CHANNEL TABLE
02900 MOVEI LPSA,0 ;NOW GET READY IN CASE OF ERROR
03000 SUB SP,X22
03100
03200 ; FILL IT WITH NON-CONTROVERSIAL THINGS
03300
03400 POP P,TEMP ;RETURN ADDRESS
03500 POP P,ENDFL(CDB) ;END OF FILE FLAG ADDRESS
03600 POP P,BRCHAR(CDB) ;BREAK CHAR ADDRESS
03700 POP P,ICOUNT(CDB) ;INPUT COUNT ADDRESS
03800 POP P,OBUF(CDB) ;NUMBER OF OUTPUT BUFFERS
03900 POP P,IBUF(CDB) ;NUMBER OF INPUT BUFFERS
04000 POP P,Z ;DATA MODE
04100 POP P,CHNL ;DATA CHANNEL
04200 CHKCHN CHNL,<OPEN> ;ASSURE VALID
04300 ;;#HA# DCS 5-11-72 IMPROVE ERROR ENABLE. ALSO, IN EXPO SYSTEM,
04400 ;; AVOID REFERENCES TO PGNNO, WHICH IS same as ERRTST!
04500 HRRZI X,750000 ;ERROR BITS POSSIBLY ENABLED -- WAS A HRROI
04600 ;;#HA#
04700 ANDCM X,Z ;ERROR BITS ACTUALLY ENABLED ARE 0
04800 MOVEM X,ERRTST(CDB) ;SAVE ENABLATIONS
04900 TRZ Z,750000 ;REMOVE IRRELEVANT BITS
05000 ILLMOD ←← 777777
05100 CMU <
05200 ILLMOD ←← 377776 ;BIT 400000 FOR SPECIAL DEVICE (CMU)
05300 ;BIT 000001 FOR KEEPING NULLS
05400 TLZE Z,10000 ;IOACTIVE BIT TO BE SET ON OPEN ??? (LDE)
05500 TRO Z,10000 ;YES
05600 >;CMU
05700 TLNE Z,ILLMOD ;CHECK VALIDITY SOMEWHAT
05800 ERR <OPEN: INVALID DATA MODE>,1
05900 MOVEM Z,DMODE(CDB) ;STORE MODE
06000
06100 ; GET DEVICE NAME
06200
06300 MOVEI X,DNAME(CDB) ;WHERE SIXBIT'S TO GO
06400 PUSHJ P,FLSCAN ;GET DEVICE NAME
06500 ;;%##% ONLY GIVE ERROR MESSAGE IF NOT ASKED NOT TO
06600 JUMPN Y,[
06700 SKIPN @ENDFL(CDB) ;FLAGGED??
06800 ERR <INVALID DEVICE NAME FOR OPEN>,1
06900 JRST .+1
07000 ]
07100
07200 ;IF TTY, MARK TTYDEV FOR OUT
07300
07400 HLRZ TEMP,DNAME(CDB) ;GET LH DEVICE NAME
07500 MOVSI Z,400000 ;BIT TO MARK WITH
07600 ;;%##% DO A DEVCHR NOW
07700 ;; CAIE TEMP,'TTY' ;IF TTY OR PTY,
07800 CAIN TEMP,'PTY' ; ,
07900 JRST MRKTYB ;MARK AS A TTY
08000 MOVE TEMP,DNAME(CDB) ;PICK UP DEVICE AGAIN (FULL SIXBIT)
08100 CALL6 (TEMP,DEVCHR) ;GET CHARACTERISTICS
08200 TLNE TEMP,10 ;A TTY???
08300 MRKTYB: IORM Z,TTYDEV(CDB); IT'S A TTY
08400 ;;%##%
08500
08600 ; NOW SET HEADER PTRS IN CDB
08700
08800 HRRZI Z,-1 ;TO TEST RIGHT HALF
08900 SETZM BFHED(CDB) ;CLEAR HEADER POINTER
09000 LDB E,[POINT 4,DMODE(CDB),35] ;DATA MODE
09100 CAIL E,15 ;DUMP MODE?
09200 JRST AGNN ; YES, NO BUFFER HEADER WORD
09300 MOVEI TEMP,OBPNT(CDB) ;IF OUTPUT, SET POINTER
09400 TDNE Z,OBUF(CDB) ;ANY OUTPUT BUFFERS?
09500 HRLM TEMP,BFHED(CDB)
09600 MOVEI TEMP,IBPNT(CDB) ;SAME FOR INPUT
09700 TDNE Z,IBUF(CDB) ;ANY INPUT BUFFERS?
09800 HRRM TEMP,BFHED(CDB)
09900
10000 ; NOW OPEN THE FILE, GET THE BUFFERS,ETC.
10100
10200 AGNN: XCT IOOPEN,SIMIO ; OPEN CHAN,MODE
10300 JRST [SKIPE @ENDFL(CDB) ;DOES USER WANT TO KNOW?
10400 JRST NORELO ;YES, RELEASE CDB, ERASE ALL OF ATTEMPT
10500 JRST RTRY]
00100
00200 COMMENT ⊗
00300 ERMAN'S IMPROVED BUFFER GETTER --- DEC. 1970
00400 If a buffer size is specified (lh #buf word), allocate that size, else the
00500 standard size (determined via a dummy XXXBUF, clever soul that LDE is).
00600 "NOTICE WITH AWE THAT NO CORE IS EVER WASTED, AS IN THE INFERIOR OLD WAY" (sic).
00700 ⊗
00800 MOVEI Z,0 ;FOR DUMMY (AND REAL) OUTBUF
00900 PUSHJ P,GETBFS ;GET CORE, DO THE OUTBUFS (OR SIMULATIONS)
01000 ADDI CDB,OBUF-OBPNT+1 ;RELOCATE FOR INPUT IN CDB
01100 MOVEI Z,-1
01200 PUSHJ P,GETBFS ;GET CORE, DO INBUFS
01300 SUBI CDB,OBUF-OBPNT+1;RE-RELOCATE
01400 CMU < ;FUNNY INPUT DEVICE
01500 SKIPL DMODE(CDB) ;DID HE SPECIFY TO GET ERRS FROM
01600 ; BUFFER HEADER?
01700 JRST STNIT ; NO.
01800 HRLZI TEMP,400000
01900 SKIPE IBUF(CDB) ;INPUT BUFFERS?
02000 JRST [IORM TEMP,IBUF(CDB) ; YES
02100 JRST STNIT]
02200 SKIPE OBUF(CDB) ;OR OUTPUT BUFFERS?
02300 JUMPA CHNL,[IORM TEMP,OBUF(CDB) ; YES
02400 JRST STNIT]
02500 ERR<OPEN: SPEECH DEV BUT NO BUFFERS, CHAN >,7
02600 >;CMU
02700
02800 ; FINISH OUT -- SET EOF FLAG IF DESIRED
02900
03000 STNIT: ;SETOM JOBFF ;ONE MUST KNOW WHAT HE IS DOING TO USE
03100 MOVEM CDB,@CDBLOC(USER) ;STORE CDB ADDR IN CHANS TABLE
03200 SETZM @ENDFL(CDB) ;MARK OPEN SUCCESSFUL
03300 JRST RESTR ;RESTORE ACS, RETURN
03400
03500 BADOPN: HRRZ TEMP,JOBREN ;NEXT START WILL ASK ALLOC
03600 HRRM TEMP,JOBSA ;QUESTION
03700 ERR <TOO MANY CHANNELS OR I/O BUFFERS REQUESTED>,1,<(TEMP)>
03800
03900 RTRY: TERPRI <OPEN: DEVICE NOT AVAILABLE>
04000 TERPRI <TYPE "R" TO RETRY, "X" TO GO ON WITHOUT>
04100 PRINT <?>
04200 PUUO TEMP
04300 CAIN TEMP,"R" ;TRY AGAIN?
04400 JRST AGNN ;YES
04500 ;;%##%
04600 SETOM @ENDFL(CDB) ;MARK A LOSER
04700 JRST NORELO
04800 ;;%##%
04900
05000 GETBFS: SETZM ONAME(CDB) ;CLEAR FILE NAME
05100 HRRZ Y,OBUF(CDB) ;NUMBER OF BUFFERS
05200 HLRZ D,OBUF(CDB) ;SIZE
05300 EXPO <
05400 HRRZS OBUF(CDB) ;MARK FOR SPECIAL TEST
05500 >;EXPO
05600 JUMPE Y,GBUFRT ;NO BUFFERS
05700 JUMPE D,GETDES ;WANTS DEFAULT SIZE
05800 ANDI D,7777 ;MAX BUFFER SIZE
05900 HRLZ A,D ;SIZE IN LH
06000 PUSHJ P,GETCOR ;GET THE CORE (SURPRISE!)
06100 SETZM OCOWNT(CDB) ;IN CASE NO ACTUAL INBUF (OUTBUF) DONE
06200 CAIL E,15 ;DUMP MODE?
06300 JRST GBUFRT ; YES, DON'T ACTUALLY FUDGE UP BUFFERS
06400 NOEXPO <;USE UINBF, UOUTBF
06500 ;;#GD# 01-25-72 DCS (1-2) set up JOBFF, Fix XCT, bad count
06600 MOVEM B,JOBFF ;B FROM CORGET HAS BUFFER AREA ADDRESS
06700 SUBI D,2 ;GETCOR INCREMENTED
06800 ;;#GD#
06900 HRRZ C,Y
07000 MOVE A,[UINBF C]
07100 JUMPN Z,.+2
07200 MOVE A,[UOUTBF C]
07300 DPB CHNL,[POINT 4,A,12]
07400 ;;#GD# 01-25-72 DCS (2-2) (was XCT CHNL, clearly wrong)
07500 XCT A ;DO THE ALLOCATIONS
07600 ;;#GD#
07700 POPJ P,
07800 >;NOEXPO
07900 EXPO <
08000 ADDI B,1 ;SECOND WORD
08100 BUFC1: HRR A,B
08200 SOJLE Y,BUFC2
08300 ADD B,D ;NEXT ONE
08400 MOVEM A,(B) ;MAKE POINT TO PREV
08500 JRST BUFC1
08600
08700 BUFC2: MOVE B,OBUF(CDB) ;BACK TO FIRST
08800 MOVEM A,1(B) ;LINK IT TOO
08900 HRLI A,400000 ;RING-USE BIQ
09000 MOVEM A,OBPNT(CDB) ;BUFFER PTR
09100 POPJ P,
09200 >;EXPO
09300
09400 GETCOR: ADDI D,2 ;+2 FOR ACCOUNTING
09500 MOVE C,D
09600 IMUL C,Y ;TOTAL CORE NEEDED
09700 PUSHJ P,CORGET ;GRAB IT
09800 ERR <OPEN: NOT ENUFF CORE FOR BUFFERS>
09900 HRRZM B,OBUF(CDB) ;SAVE SO CAN RELEASE
10000 POPJ P,
10100
10200 GETDES: MOVEI A,1 ;1 DUMMY BUFFER
10300 CAIL E,15 ;GOOD OLD DUMP MODE?
10400 JRST [MOVEI D,202 ;ASSUME THIS, SINCE INBUF/OUTBUF WON'T
10500 JRST GDIT] ; WORK IN DUMP MODE
10600 MOVEI TEMP,BRKDUM-1(USER)
10700 MOVEM TEMP,JOBFF
10800 PUSHJ P,GETIOB ;DUMMY IN/OUBUF
10900 LDB D,[POINT 17,BRKDUM(USER),17] ;GET THE SIZE
11000 GDIT: PUSHJ P,GETCOR ;GET THE CORE
11100 SETZM OCOWNT(CDB) ;CLEAR BYTE COUNT
11200 CAIL E,15 ;DUMP MODE?
11300 JRST GBUFRT ;YES, NO BUFFER STRUCTURE
11400 MOVEM B,JOBFF
11500 MOVE A,Y ;NUMBER OF BUFFERS
11600 PUSHJ P,GETIOB ;NOW FOR REAL
11700 GBUFRT: SETOM JOBFF ;FOR SPITE
11800 POPJ P,
11900
12000 GETIOB: SKIPN Z
12100 XCT IOOUTBUF,SIMIO ;DO OUTBUF
12200 SKIPE Z
12300 XCT IOINBUF,SIMIO ;INBUF
12400 POPJ P,
12500 SUBTTL RELEASE
00100 COMMENT ⊗Release ⊗
00200
00300 DSCR RELEASE(CHANNEL NO,INHIBIT BITS);
00400 CAL SAIL
00500 DES THIS USES THE DEFAULT PARAMETER MECHANISM, 0 DEFAULT FOR INHIBIT BITS
00600 ⊗
00700
00800 COMMENT ⊗
00900 Release channel, i/o buffers, channel table if channel is open
01000 Adjust special TTY stuff to reflect lossage if TTY channel
01100 ⊗
01200
01300
01400 HERE(RELEASE)
01500 .RELS:
01600 SETOM JOBFF ;MARK INVALID
01700 PUSHJ P,SAVE ;SAVE REGS, GET USER, SAVE RETURN
01800 ;; FOLLOWING WAS MOVE LPSA,X22
01900 MOVE LPSA,X33
02000 ;; FOLOWING WAS CHNL,-1(P)
02100 MOVE CHNL,-2(P) ;CHANNEL #
02200 CHKCHN CHNL,<RELEASE> ;VALIDATE
02300 SKIPN CDB,@CDBLOC(USER) ;GET ADDR FROM CHANS TABLE-- CHANNEL OPEN?
02400 JRST RESTR ;CHANNEL NOT OPEN, FORGET IT
02500 SETZM @CDBLOC(USER) ;CLEAR CHANS TABLE ENTRY
02600 ;; INHIBIT BITS;
02700 HRRZ D,-1(P) ;THE DEFAULT OR USER SPECIFIED INHIBIT BITS
02800 XCT IORELEASE,SIMIO ;RELEASE CHAN,0
02900 HRRZ B,IBUF(CDB) ;RELEASE ANY INPUT
03000 PUSHJ P,BUFREL ; BUFFERS
03100 HRRZ B,OBUF(CDB) ;ALSO OUTPUT
03200 PUSHJ P,BUFREL ; BUFFERS
03300 NORELO: HRRZ B,CDB ;WHERE TO RELEASE
03400 PUSHJ P,CORREL ;GIVE CDB BACK
03500 JRST RESTR ;RESTORE AND RETURN
03600
03700 BUFREL: JUMPN B,CORREL ;RELEASE IF ANY TO RELEASE
03800 POPJ P, ;ELSE RETURN
03900
04000
04100 DSCR SETPL(CHANNEL,@LINNUM,@PAGNUM,@SOSNUM)
04200 CAL SAIL
04300 ⊗
04400
04500 HERE(SETPL)
04600 PUSHJ P,SAVE
04700 MOVE CHNL,-4(P) ;GET CHANNEL
04800 PUSHJ P,GETCHN ;VALIDATE, LOAD CDB
04900 POP P,TEMP ;RETURN ADDRESS (GET OUT OF WAY)
05000 POP P,SOSNUM(CDB)
05100 SETZM @SOSNUM(CDB)
05200 POP P,PAGNUM(CDB)
05300 SETZM @PAGNUM(CDB)
05400 POP P,LINNUM(CDB) ;LINE NUMBER
05500 SETZM @LINNUM(CDB)
05600 MOVE LPSA,X11 ;REMOVE CHANNEL NUMBER FROM STACK
05700 JRST RESTR
05800
05900 ;;%AV% -- rht
06000 DSCR CHNCDB(CHANNEL);
06100 CAL SAIL
06200 DES RETURNS INTEGER = INPHDR,,OUTHDR
06300 (ACTUALLY COULD BE GOTTEN FROM CDB BY USER, BUT THIS
06400 PROMISSES MORE STABILITY)
06500 ⊗
06600
06700 HERE(CHNCDB)
06800 PUSHJ P,SAVE ;
06900 MOVE CHNL,-1(P) ;GET CHANNEL NUMBER
07000 PUSHJ P,GETCHN ;CHECK & LOAD CDB
07100 MOVEI 1,DMODE(CDB) ;GET VALUE
07200 MOVEM 1,RACS+1(USER) ;SO RESTR WINS
07300 MOVE LPSA,X22 ;
07400 JRST RESTR ;RETURN
07500
07600 HERE(OPNSP1) ;PERHAPS PUT GETSTS HERE
07700 ;;%##% GOBBLED DOWN TWO SPARE HERES HERE FOR STATUS ROUTINES THAT FOLLOW
07800 ERR <DRYROT IN OPEN SPARES>
07900
08000 ENDCOM (OPN)
08100 ;;%##%
08200 COMPIL(STS,<GETSTS,SETSTS>
08300 ,<SAVE,RESTR,SIMIO,GOGTAB,GETCHN,X11,X33,X22>
08400 ,<GETSTS AND SETSTS>)
08500
08600
08700 COMMENT ⊗GETSTS,SETSTS⊗
08800
08900 DSCR STATUS←GETSTS(CHANNEL);
09000 CAL SAIL
09100 ⊗
09200
09300 .STS:
09400 HERE(GETSTS)
09500 PUSHJ P,SAVE
09600 LOADI7 A,<GETSTS>
09700 MOVE CHNL,-1(P) ;CHANNEL #
09800 PUSHJ P,GETCHN
09900 XCT IOSTATUS,SIMIO ;DO THE UUO
10000 JFCL
10100 MOVE A,FSTATS(USER) ;THE RESULT
10200 MOVEM A,RACS+A(USER) ;SO RESTR WORKS
10300 MOVE LPSA,X22
10400 JRST RESTR
10500
10600 DSCR SETSTS(CHANNEL,STATURS);
10700 CAL SAIL
10800 ⊗
10900
11000 HERE(SETSTS)
11100 PUSHJ P,SAVE
11200 LOADI7 A,<SETSTS>
11300 MOVE CHNL,-2(P)
11400 PUSHJ P,GETCHN
11500 MOVE A,-1(P) ;INTENDED STATUS BITS
11600 XCT SETIOSTS,SIMIO ;XECUTE THE INST
11700 JFCL ;SHOULDN'T SKIP
11800 MOVE LPSA,X33
11900 JRST RESTR ;GO RESTORE
12000
12100 ENDCOM(STS)
12200 COMPIL(LOK,<LOOKUP,ENTER,FILEINFO>
12300 ,<SAVE,RESTR,GETCHN,FILNAM,SIMIO,X33,X22,GOGTAB>
12400 ,<LOOKUP, ENTER, AND FILEINFO ROUTINES>)
00100 COMMENT ⊗Lookup, Enter ⊗
00200
00300 DSCR LOOKUP(CHANNEL,"FILE NAME",@FAILURE FLAG);
00400 CAL SAIL
00500 ⊗
00600
00700 Comment ⊗
00800 LOOKUP or ENTER file FILENAME on channel CHANNEL, where FILENAME has
00900 a format acceptable to FILNAM above. If successful,
01000 FAILURE!FLAG (called by reference) is zeroed. It is
01100 otherwise set to -1 in LH, error code in RH.
01200 ⊗
01300
01400
01500 .LOK:
01600 HERE (LOOKUP) PUSHJ P,SAVE
01700 LOADI7 A,<LOOKUP>
01800 PUSH P,[XCT IOLOOKUP,SIMIO] ;LOOKUP CH,FILE
01900 MOVEI B,INAME ;TO STORE FILE NAME
02000 JRST LOKENT ;DO THE OPERATION
02100
02200 DSCR ENTER(CHANNEL,"FILE NAME",@FAILURE FLAG);
02300 CAL SAIL
02400 ⊗
02500
02600 HERE (ENTER)
02700 PUSHJ P,SAVE
02800 LOADI7 A,<ENTER>
02900 PUSH P,[XCT IOENTER,SIMIO] ;ENTER CH,FILE
03000 MOVEI B,ONAME ;TO STORE FILE NAME
03100 LOKENT:
03200 MOVE LPSA,X33 ;PARAM ADJUST FOR RESTR
03300 MOVE CHNL,-3(P) ;GET CHANNEL #
03400 PUSHJ P,GETCHN ;VALIDATE
03500 SETZM @-2(P) ;ASSUME SUCCESS
03600 PUSHJ P,FILNAM ;GET FILE
03700 JRST BADSPC ; NO GOOD, REPORT ERROR
03800 ADD B,CDB ;ADDR OF FILE NAME HOLDER
03900 MOVEW (<(B)>,<FNAME(USER)>) ;STORE IT
04000 POP P,X ;INSTRUCTION TO DO
04100 MOVE Y,[JRST ELERR] ;FAILURE
04200 MOVE Z,[JRST RESTR] ;SUCCESS
04300 ENF1: JRST X ;ENTER/LOOKUP
04400
04500 BADSPC: POP P,(P) ;REMOVE IO INSTRUCTION
04600 HRRZ TEMP,ERRTST(CDB) ;GET USER-ENABLE BITS
04700 TRNE TEMP,10000 ;ENABLED FOR HANDLING BAD FILE SPECS?
04800 ERR <LOOKUP OR ENTER: INVALID FILE SPECIFICATION>,1 ;NO, TELL HIM
04900 SKIPA TEMP,[=8] ;ALWAYS REPORT NO GOOD LOOKUP/ENTER
05000 ELERR: HRRZ TEMP,FNAME+1(USER) ;WHY DID IT BLOW?
05100 HRROM TEMP,@-1(P) ;TELL THE USER
05200 JRST RESTR
00100 COMMENT ⊗Fileinfo ⊗
00200
00300 DSCR FILEINFO(INTEGER ARRAY INFO[1:6]);
00400 CAL SAIL
00500 ⊗
00600
00700 Comment ⊗ This routine gives the user the entire 6 word block
00800 from the last LOOKUP, ENTER, or RENAME operation done by SAIL.⊗
00900
01000 HERE (FILEINFO)
01100 MOVE USER,GOGTAB
01200 POP P,UUO1(USER) ;GET RID OF IT, MARK LAST SAIL CALL
01300 POP P,LPSA ;ARRAY ADDRESS WHERE INFO IS TO GO
01400 SKIPGE -2(LPSA) ;MAKE SURE IT'S NOT A STRING ARRAY
01500 ERR <PASS 6 WORD INTEGER VECTOR TO FILEINFO>,1
01600 MOVE TEMP,-1(LPSA) ;TOTAL ARRAY SIZE WORD
01700 CAML TEMP,[XWD 1,6] ;MUST BE 1-D, AT LEAST 6 WORDS
01800 CAMLE TEMP,[XWD 1,-1] ;BUT NOT 2-D
01900 ERR <PASS 6 WORD INTEGER VECTOR TO FILEINFO>,1
02000 MOVEI TEMP,5(LPSA) ;BLT TERMINATOR
02100 HRLI LPSA,FNAME(USER) ;SOURCE OF VALUABLE INFORMATION
02200 BLT LPSA,(TEMP) ;GIVE!
02300 JRST @UUO1(USER) ;GONE
02400
02500 ENDCOM (LOK)
02600 COMPIL(OUT,<OUT>,<SAVE,RESTR,GETCHN,SIMIO,NOTOPN,X11,X22>
02700 ,<STRING OUTPUT ROUTINE>)
00100 COMMENT ⊗Out ⊗
00200
00300 DSCR OUT(CHANNEL,"STRING");
00400 CAL SAIL
00500 ⊗
00600 COMMENT ⊗
00700 Simply places all characters of string in output buffer for channel.
00800 Close file if device is TTY ⊗
00900
01000 .OUT.:
01100 HERE (OUT) PUSHJ P,SAVE ;ACS, GET USER, SAVE RETURN FOR ERROR
01200 MOVE LPSA,X22
01300 MOVE CHNL,-1(P) ;CHANNEL NUMBER
01400 LOADI7 A,<OUT>
01500 PUSHJ P,GETCHN ;VALIDATE AND GET CDB, ETC.
01600 HRRE Z,-1(SP) ;#CHARS
01700 POP SP,D
01800 SUB SP,X11
01900 MOVE B,OBP(CDB)
02000 MOVE A,OCOWNT(CDB)
02100 JRST .OUT1
02200
02300
02400 .OUT: SOJLE A,OUT1 ;NEED OUTPUT??
02500 .OUT2: ILDB X,D ;GET A CHAR
02600 IDPB X,B ;PUT IT AWAY
02700 .OUT1: SOJGE Z,.OUT ;LOOP
02800 OUTDUN: MOVEM B,OBP(CDB) ;PUT BP AWAY
02900 MOVEM A,OCOWNT(CDB) ;COUNT AWAY
03000 SKIPGE TTYDEV(CDB) ;TTY?
03100 XCT IOOUT,SIMIO ; YES, FORCE OUTPUT
03200 JRST RESTR
03300 JRST RESTR
03400
03500 OUT1: LDB TEMP,[POINT 4,DMODE(CDB),35] ;MODE
03600 CAIL TEMP,15 ;DUMP?
03700 JRST DMPO ;YES
03800 MOVEM B,OBP(CDB) ;PUT REAL BP AWAY
03900 XCT IOOUT,SIMIO ;DO THE OUTPUT
04000 JFCL ;ERRORS HANDLED IN SIMIO
04100 MOVE B,OBP(CDB) ;NEW BP
04200 MOVE A,OCOWNT(CDB) ;NEW COUNT
04300 JRST .OUT2 ;CONTINUE
04400
04500 ; SPECIAL DUMP-MODE OUTPUT STUFF
04600
04700 DMPO: PUSH P,D
04800 HRRZ D,OBUF(CDB) ;PTR TO BUFFER AREA
04900 SUBI D,1 ;ADDR-1 FOR IOWD
05000 HRLI D,-=128 ;-WORD COUNT
05100 MOVEI D+1,0
05200 XCT IODOUT,SIMIO ;OUT D,
05300 JFCL ;ERRORS HANDLED IN SIMIO
05400 OKO: HRRZ B,D ;SAVE ADDR
05500 HRLI D,1(D) ;BLT WORD
05600 HRRI D,2(D)
05700 SETZM -1(D)
05800 BLT D,=128(B) ;CLEAR BUFFER
05900 POP P,D ;RESTORE INPUT BYTE POINTER
06000 AOS @ENDFL(CDB) ;SPECIAL TREATMENT
06100 HRLI B,700 ;POINT 7,-1(1ST WORD),35
06200 MOVEM B,OBP(CDB)
06300 MOVEI A,5*=128 ;CHAR COUNT
06400 MOVEM A,OCOWNT(CDB)
06500 JRST .OUT2 ;AFTER OUTPUT SIMULATION, GO ON
06600
06700 ENDCOM(OUT)
06800 COMPIL(INP,<INPUT>
06900 ,<SAVE,.SKIP.,INSET,RESTR,SIMIO,GETCHN,STRNGC,BRKMSK,X33,NOTOPN,GOGTAB
07000 >
07100 ,<STRING INPUT ROUTINE>)
00100 COMMENT ⊗Input ⊗
00200
00300 DSCR "STRING"←INPUT(CHANNEL,BREAK TABLE NUMBER);
00400 CAL SAIL
00500 SID NO ACS SAVED BY INPUT!!!!!!
00600 ⊗
00700
00800 .IN.:
00900 HERE (INPUT)
01000 MOVE USER,GOGTAB ;GET TABLE POINTER
01100 ;;%##% FOR BENEFIT OF ERR ROUTINE
01200 MOVE TEMP,(P)
01300 MOVEM TEMP,UUO1(USER)
01400 ;;%##%
01500 MOVEM RF,RACS+RF(USER);SAVE F-REGISTER
01600 SKIPE SGLIGN(USER)
01700 PUSHJ P,INSET
01800 MOVE CHNL,-2(P) ;CHANNEL #
01900 LOADI7 A,<IN> ;ROUTINE NAME
02000 PUSHJ P,GETCHN ;SET UP, VALIDATE
02100 LDB E,[POINT 4,DMODE(CDB),35] ;DATA MODE
02200 CAIGE E,15 ;DUMP MODE?
02300 SETZM @ENDFL(CDB) ;NO, HELP USER ASSUME NO EOF,ERR
02400 SETZM @BRCHAR(CDB) ;ASSUME NO BREAK CHAR
02500 CMU <
02600 SETZM .SKIP.
02700 >;CMU
02800 HRRZ A,@ICOUNT(CDB) ;MAX COUNT FOR INPUT STRING
02900 ADDM A,REMCHR(USER)
03000 SKIPLE REMCHR(USER) ;ENOUGH ROOM?
03100 PUSHJ P,STRNGC ;NO, TRY TO GET SOME
03200 SKIPL C,-1(P) ;GET TABLE #, CHECK IN BOUNDS
03300 CAILE C,=18
03400 ERR <IN: THERE ARE ONLY 18 BREAK TABLES>
03500 HRRZ TEMP,USER
03600 ADD TEMP,C ;TABLE NO(USER)
03700 MOVEI Z,1 ;FOR TESTING LINE NUMBERS
03800 SKIPN LINTBL(TEMP) ;DON'T LET TEST SUCCEED IF
03900 MOVEI Z,0 ;WE'RE TO LET LINE NUMBERS THRU
04000 MOVN B,A ;NEGATE MAX CHAR COUNT
04100 PUSH SP,[0] ;LEAVE ROOM FOR FIRST STR WORD
04200 PUSH SP,TOPBYTE(USER) ;SECOND STRING WORD
04300 MOVE FF,BRKMSK(C) ;GET MASK FOR THIS TABLE
04400 HRRZ Y,USER
04500 ADD Y,[XWD D,BRKTBL] ;BRKTBL+RLC(USER)
04600 JUMPE B,DONE1 ; BECAUSE THE AOJL WON'T
04700 CMU <
04800 MOVS C,DMODE(CDB) ;FUNNY MODE BITS TO RH
04900 >;CMU
05000 TRNE FF,@BRKCVT(USER) ;DOING UC COERCION?
05100 TLOA C,400000 ;YES
05200 TLZ C,400000 ;NO
05300
05400 .IN: SOSG ICOWNT(CDB) ;BUFFER EMPTY?
05500 JRST DOINP ;YES, GET MORE
05600 IN1:
05700 ILDB D,IBP(CDB) ;GET NEXT CHARACTER
05800 TDNE Z,@IBP(CDB) ;LINE NUMBER (ALWAYS SKIPS IF NOT WORRIED)?
05900 JRST INLINN ;YES, GO SEE WHAT TO DO
06000 IN2:
06100 NOCMU <
06200 JUMPE D,.IN ;ALWAYS IGNORE 0'S
06300 >;NOCMU
06400 CMU <
06500 JUMPE D,[ TRNN C,1 ;REALLY IGNORE NULL??
06600 JRST .IN ;YES
06700 JRST .+1 ;NOPE
06800 ]
06900 >;CMU
07000 ;;%##% COERCING ??
07100 JUMPGE C,NOCV.I ;NOT COERCIING ??
07200 CAIL D,"a" ;ONLY COERCE LOWER CASE
07300 CAILE D,"z" ;
07400 JRST .+2 ;FAST SKIP
07500 TRZ D,40 ;MAKE UC
07600 NOCV.I: TDNE FF,@Y ;MUST WE DO SOMETHING SPECIAL?
07700 JRST INSPC ;YES, HANDLE
07800
07900 MOVEC: IDPB D,TOPBYTE(USER) ;LENGTHEN STRING
08000 AOJL B,.IN ;GET SOME MORE
08100 JRST DONE1
08200
08300 INSPC: HLLZ TEMP,@Y ;IGNORE OR BREAK?
08400 TDNN TEMP,FF ; (CHOOSE ONE)
08500 JRST .IN ;IGNORE
08600
08700 ; BREAK -- STORE BREAK CHAR, FINISH OFF
08800
08900 DONE: MOVEM D,@BRCHAR(CDB) ;STORE BREAK CHAR
09000 MOVE Y,-1(P) ;TABLE # AGAIN
09100 ADD Y,USER ;RELOCATE
09200 SKIPN Y,DSPTBL(Y) ;WHAT TO DO WITH BREAK CHAR?
09300 JRST DONE1 ;SKIP IT
09400 JUMPL Y,APPEND ;ADD TO END OF INPUT STRING
09500
09600 RETAIN: SOS IBP(CDB) ;BACK UP TO GET IT NEXT TIME
09700 FOR II←1,4 <
09800 IBP IBP(CDB)>
09900 AOS ICOWNT(CDB)
10000 JRST DONE1
10100
10200 APPEND: IDPB D,TOPBYTE(USER) ;PUT ON END
10300 AOJA B,DONE1 ;ONE MORE TO COUNT
10400
10500 INEOF1: POP P,D+1 ;LEFT OVER FROM DUMP MODE ROUT
10600
10700 ; DONE -- MARK STRING COUNT WORD
10800
10900 DONE1: ADDM B,REMCHR(USER) ;GIVE UP THOSE NOT USED
11000 ADD B,@ICOUNT(CDB) ;HOW MANY DID WE ACTUALLY GET?
11100 ;;#GI# DCS 2-5-72 REMOVE TOPSTR
11200 HRROM B,-1(SP) ;MARK RESULT, NON-CONSTANT
11300 ;;#GI#
11400 MOVE RF,RACS+RF(USER);GET F-REGISTER BACK
11500 SUB P,X33 ;REMOVE INPUT PARAMETER, RETURN ADDRESS
11600 JRST @3(P) ;RETURN
11700
11800 ; CAN EITHER DELETE LINE NUMBER (Y GT 0) OR STOP,
11900 ; TELL THE USER (BRCHAR=-1), AND MARK LINE NUMBER
12000 ; NOT A LINE NUMBER FOR NEXT TIME
12100 ; GET A NEW BUFFER
12200
12300 DOINP:
12400 CMU <
12500 AOS .SKIP.
12600 >;CMU
12700 CAIL E,15 ;DUMP MODE?
12800 JRST DMPI ; YES
12900 XCT IOIN,SIMIO ;IN CHAN,0
13000 JRST IN1 ;ALL OK, CONTINUE
13100 JRST DONE1 ;ERROR OR EOF, QUIT
13200
13300 ; DUMP MODE SIMULATION OF SAME
13400 DMPI: PUSH P,D+1
13500 HRRZ D,IBUF(CDB) ;PTR TO BUFFER AREA
13600 SUBI D,1
13700 HRLI D,-=128
13800 MOVEI D+1,0
13900 XCT IODIN,SIMIO ;IN CHAN,D
14000 JRST OKI
14100 JRST INEOF1 ;REMOVE D,QUIT
14200 OKI: POP P,D+1
14300 AOS @ENDFL(CDB) ;SPECIAL TREATMENT
14400 HRLI D,700
14500 MOVEM D,IBP(CDB)
14600 MOVEI A,5*=128
14700 MOVEM A,ICOWNT(CDB)
14800 JRST IN1 ;DONE SIMULATING, RETURN
14900
15000 INLINN:
15100 MOVE TEMP,-1(P) ;GET LINE NUMBER DISPOSITION FLAG,
15200 ADD TEMP,USER ;RLC+TABLE
15300 SKIPGE TEMP,LINTBL(TEMP) ;LINTBL+RLC+TABLE
15400 JRST GIVLIN ; WANTS IT NEXT TIME OR SOMETHING
15500
15600 JSP TEMP,EATLIN ;TOSS IT OUT, AND
15700 JRST .IN ; CONTINUE
15800
15900 EATLIN:
16000 AOS IBP(CDB) ;FORGET IT ENTIRELY
16100 MOVNI A,5 ;INDICATE SKIPPING SIX
16200 ADDB A,ICOWNT(CDB) ;IN COUNT
16300 ;OVERFLOW BUFFER?
16400 JUMPG A,(TEMP) ;NO, CONTINUE
16500 CAIL E,15
16600 ERR <CAN'T HANDLE THIS FILE IN DUMP MODE>
16700 XCT IOIN,SIMIO ;YES, GET TAB FROM NEXT BUFFER
16800 JRST OKLN ;GOT IT, CONTINUE
16900 JRST DONE1
17000
17100 OKLN: SOSG ICOWNT(CDB) ;IF ONLY ONE CHAR,
17200 JRST [MOVEI TEMP,20000 ;THEN EOF COMES NEXT
17300 IORM TEMP,@ENDFL(CDB)
17400 JRST DONE1] ;ALL DONE
17500 IBP IBP(CDB) ;GET OVER TAB FINALLY
17600 ;;#PM 12-1-73 RLS DONT LOSE A CHARACTER IN THE (NEW) BUFFER
17700 AOS ICOWNT(CDB) ;INCREMENT COUNT
17800 ;;#PM
17900 JRST (TEMP) ;AND CONTINUE
18000
18100
18200 GIVLIN: TRNE TEMP,-1 ;WANT LINE NO IN BRCHAR WORD?
18300 JRST GVLLN ;NO, WANTS IT NEXT TIME.
18400 SKIPL TEMP,@IBP(CDB) ;NEGATED LINE NO
18500 MOVNS TEMP
18600 MOVEM TEMP,@BRCHAR(CDB) ;STORE WHERE HE WANTS IT
18700 JSP TEMP,EATLIN ;GO EAT UP LINE NUMBER AND
18800 JRST DONE1 ;FINISH UP
18900 GVLLN:
19000 SETOM @BRCHAR(CDB) ;TELL THE USER
19100 AOS ICOWNT(CDB) ;REVERSE THE SOSLE
19200 MOVEI Y,1 ;TURN OFF LINE NUMBER
19300 ANDCAM Y,@IBP(CDB) ; BIT
19400 MOVSI Y,070000 ;BACK UP BYTE POINTER
19500 ADDM Y,IBP(CDB)
19600 JRST DONE1 ;FINISH OFF IN BAZE OF GORY
19700
19800 ENDCOM(INP)
19900 COMPIL(NUM,<REALIN,REALSCAN,INTIN,INTSCAN>
20000 ,<SIMIO,SAVE,RESTR,X22,X33,GETCHN,NOTOPN,.CH.,.MT.,.TEN.>
20100 ,<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: MOVE CHNL,-2(P)
00400 LOADI7 A,<IN>
00500 PUSHJ P,GETCHN; SET UP FOR INPUT
00600 SETZM @ENDFL(CDB); CLEAR EOF AND BREAK FLAGS
00700 SETZM @BRCHAR(CDB)
00800 MOVE LPSA,[JSP X,NCH]
00900 MOVEI Z,1; FOR LINE NUMBER TEST
01000 PUSHJ P,SCAN
01100 MOVEM D,@BRCHAR(CDB); FIX UP BREAK CHARACTER
01200 SOS IBP(CDB) ;BACK UP TO GET IT NEXT TIME
01300 FOR II←1,4 <
01400 IBP IBP(CDB)>
01500 AOS ICOWNT(CDB)
01600 POPJ P,
01700
01800 ; READ A CHARACTER FROM INPUT FILE -- FOR SCAN.
01900 NCH: SOSG ICOWNT(CDB); DECREMENT CHARACTER COUNT
02000 JRST NCH2
02100 NCH1: ILDB D,IBP(CDB); LOAD BYTE
02200 TDNE Z,@IBP(CDB); CHECK FOR LINE NUMBER
02300 JRST NCH5
02400 JRST (X); RETURN
02500
02600 NCH2: XCT IOIN,SIMIO; INPUT
02700 JRST NCH1 ;ALL OK
02800 NCH7: MOVEI D,200 ;EOF OR DATA ERROR.
02900 JRST (X)
03000
03100 NCH5: AOS IBP(CDB); WE HAVE A LINE NUMBER
03200 MOVNI D,5; MOVE OVER IT
03300 ADDB D,ICOWNT(CDB)
03400 SKIPLE D; NOTHING LEFT
03500 JRST NCH; DO ANOTHER INPUT
03600 XCT IOIN,SIMIO
03700
03800 NCH6: SOSG ICOWNT(CDB); REMOVE TAB
03900 JRST NCH7 ;NONE THERE OR ERROR
04000 IBP IBP(CDB)
04100 JRST NCH
04200
04300 ;SETUP FOR STRING INPUT (REALSCAN, INTSCAN)
04400 STRIN: MOVE LPSA,[JSP X,NCHA]
04500 HRRZ Z,-3(P)
04600 HRRZ Z,-1(Z)
04700 HRRZS -3(P) ;SO CAN INDIRECT THROUGH IT.
04800 PUSHJ P,SCAN
04900 HRRZ X,-3(P)
05000 SOS (X) ;BACK UP BYTE POINTER
05100 FOR II←1,4<
05200 IBP (X)>
05300 AOJ Z,
05400 HRRM Z,-1(X)
05500 MOVEM D,@-2(P) ;STORE BREAK CHARACTER
05600 POPJ P,
05700
05800 ;READ A CHARACTER ROUTINE FOR STRINGS.
05900 NCHA: SOJL Z,NCH7
06000 ILDB D,@-4(P)
06100 JRST (X)
06200
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 RZ: SETZ A,
10600 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
04400 COMPIL(WRD,<ARRYOUT,WORDOUT,ARRYIN,WORDIN>
04500 ,<GETCHN,SAVE,RESTR,GOGTAB,SIMIO,X22,X33,X44,NOTOPN>
04600 ,<ARRYIN, ARRYOUT, WORDIN, AND WORDOUT>)
00100 COMMENT ⊗Arryout, Wordout ⊗
00200
00300 DSCR ARRYOUT(CHANNEL,@STARTING LOC,EXTENT);
00400 CAL SAIL
00500 ⊗
00600
00700 HERE (ARRYOUT)
00800 PUSHJ P,SAVE
00900 MOVE LPSA,[XWD 4,4]
01000 ARO: MOVE CHNL,-3(P)
01100 LOADI7 A,<ARRYOUT>
01200 PUSHJ P,GETCHN
01300 ;;%##% CONSIDER THIS
01400 CMU <
01500 SETZM @ENDFL(CDB) ;CLEAR ERROR FLAG
01600 >;CMU
01700 LDB TEMP,[POINT 4,DMODE(CDB),35] ;CHECK MODE
01725 CMU <
01730 ;;=B4= 1 OF 13 -- FOR CMU SPECIAL MODES.
01740 MOVEI Z,1 ;ASSUME NOT IMP MODE
01755 CAIN TEMP,3 ;IS THE MODE 3?
01770 TRZA Z,-1 ; YES - CMU 32-BIT IMP MODE.
01777 ; WE WILL USE Z BOTH AS SIGNAL AND AS
01780 ; A GUARANTEED 0 THAT CAN BE USED FOR A DPB
01790 CAIN TEMP,4 ; (THIS ONE IS CMU-IMAGE MODE)
01792 JRST OUTRAY ; THEN OKAY, NOT DUMP MODE EITHER.
01793 ;;=B4=
01795 >;CMU
01800 CAIGE TEMP,10 ;MAKE SURE AT LEAST BINARY MODE
02300 ERR <ARRYOUT: mode must be '14,'10, or '17, not >,6
02400 MOVE 0,[XCT IODOUT,SIMIO] ;IN CASE DUMP MODE
02500 CAIL TEMP,15
02600 JRST ARYDMP ;COMMON DUMP MODE ROUTINE
02700
02800 OUTRAY: MOVE A,-2(P) ;STARTING LOC
02900 SKIPGE B,-1(P) ;EXTENT
03000 ERR <ARRYOUT: negative word count, value is>,6
03100
03200 ;;#FQ# DCS 2-6-72 (1-4) COUNT NO LONGER HELD EXCESSIVE
03300
03400 WOUT2: SKIPG E,OCOWNT(CDB) ;# WORDS LEFT IN BUFFER
03500 JRST WOUT5 ;BETTER GET ANOTHER BUFFER
03600 JUMPE B,RESTR ;NOTHING LEFT TO DO
03625 CMU <
03630 ;;=B4= 2 OF 13
03643 CAIN Z,0 ;IMP MODE?
03661 LSH E,-2 ;DIVIDE BY 4 TO GET WORD COUNT
03666 ;;=B4=
03679 >;CMU
03700 IBP OBP(CDB) ;MAKE SURE PTRS TO FIRST WORD
03720 CMU <
03725 ;;=B4= 3 OF 13
03740 CAIN Z,0 ;IMP MODE?
03760 DPB Z,[POINT 6,OBP(CDB),5]
03765 ;;=B4=
03780 >;CMU
03800 MOVE C,OBP(CDB) ;"TO" ADDR
03900 HRRZI D,(C) ;FOR BLT TERMINATION CALCULATION
04000 HRLI C,(A) ;"FROM" ADDR
04100 CAIGE B,(E) ;ENUFF IN BUFFER?? (NOTICE THAT CAIGE
04200 ;AS OPPOSED TO CAIG WILL FORCE AN OUTPUT
04300 ;IF WE JUST FILL THE BUFFER)
04400 JRST WOUT3 ;YES
04500 ADDI D,-1(E) ;FINAL ADDR
04600 BLT C,(D) ;DO IT!
04700 ADDI A,(E) ;UPDATE PTR
04800 SUBI B,(E) ;AND COUNT
04900 SETZM OCOWNT(CDB)
05000 HRRM D,OBP(CDB)
05100 WOUT5: XCT IOOUT,SIMIO ;DO THE OUTPUT
05200 JFCL ;ERRORS HANDLED ALREADY
05300 JRST WOUT2 ;TRY NEXT CHUNK
05400
05500 WOUT3: JUMPLE B,RESTR ;NOTHING TO MOVE
05600 SUBI B,1
05700 ADD D,B ;END OF BLOCK
05800 BLT C,(D) ;MOVE IT
05900 SUBI E,1(B) ;FIX LENGTH
05920 CMU <
05925 ;;=B4= 4 OF 13
05940 CAIN Z,0 ;IMP MODE?
05960 LSH E,2 ;MULTIPLY BY 4 FOR BYTE COUNT
05965 ;;=B4=
05980 >;CMU
06000 MOVEM E,OCOWNT(CDB) ;
06100 ADDM B,OBP(CDB) ;FIX BYTE POINTER
06200 ;;#FQ# (1-4)
06300 JRST RESTR ;LEAVE LIKE A TREE AND MAKE
06400
06500 DSCR WORDOUT(CHAN,VALUE);
06600 CAL SAIL
06700 ⊗
06800
06900 HERE (WORDOUT) ;WRITE ONE WORD
07000 PUSHJ P,SAVE
07100 MOVE LPSA,X33
07200 MOVE CHNL,-2(P)
07300 LOADI7 A,<WORDOUT>
07400 PUSHJ P,GETCHN
07500 ;;%##% CONSIDER THIS
07600 CMU <
07700 SETZM @ENDFL(CDB) ;CLEAR ERROR FLAG
07800 >;CMU
07900 LDB A,[POINT 4,DMODE(CDB),35];DATA MODE
08000 CAIL A,15 ;A DUMP MODE?
08100 JRST DMPWO ;WO IS ME, YES
08200 ;;#FQ# DCS 2-6-72 (2-4) WORD COUNT KEPT CORRECT, DUMP MODE OK
08300 WDO: SOSL OCOWNT(CDB) ;BUFFER FULL?
08400 JRST WOKO ;NO
08500 XCT IOOUT,SIMIO ;YES, WRITE IT
08600 JFCL ; ERRORS HANDLED ELSEWHERE
08700 JRST WDO ;GO BACK AND DO IT RIGHT
08800 WOKO: MOVE TEMP,-1(P) ;THING TO BE WRITTEN
08900 IDPB TEMP,OBP(CDB) ;WRITE IT
09000 JRST RESTR
09100
09200 DMPWO: MOVE LPSA,[XWD 7,7] ;ACCOUNT FOR EVERYTHING
09300 MOVEI TEMP,-1(P) ;PNT TO WORD TO BE WRITTEN
09400 PUSH P,-2(P) ;CHANNEL
09500 PUSH P,TEMP ;ADDR OF WORD
09600 PUSH P,[1] ;COUNT
09700 PUSHJ P,ARO ;JOIN THE ROUTINE (RETAD JUST FOR STACK SYNCH)
09800 ;;#FQ# (2-4)
00100 COMMENT ⊗Arryin, Wordin ⊗
00200
00300 DSCR ARRYIN(CHAN,@STARTING LOC,EXTENT);
00400 CAL SAIL
00500 ⊗
00600
00700 HERE (ARRYIN)
00800 PUSHJ P,SAVE
00900 MOVE LPSA,X44
01000 ARI: MOVE CHNL,-3(P)
01100 LOADI7 A,<ARRYIN>
01200 PUSHJ P,GETCHN
01300 SETZM @ENDFL(CDB) ;ASSUME NO END OF FILE
01400 LDB TEMP,[POINT 4,DMODE(CDB),35] ;CHECK DUMP MODE
01425 CMU <
01427 ;;=B4= 5 OF 13
01430 MOVEI Z,1 ;ASSUME NOT IMP MODE
01435 CAIN TEMP,3 ;IS THE MODE 3?
01440 TRZA Z,-1 ; YES - CMU 32-BIT IMP MODE.
01455 CAIN TEMP,4 ;IF ONE OF THE SPECIAL CMU MODES,
01457 JRST INARY ; THEN OKAY, NOT DUMP MODE EITHER
01470 ;;=B4=
01490 >;CMU
01500 CAIGE TEMP,10
02000 ERR <ARRYIN: mode must be '10 or '14 or '17, not >,6
02100 MOVE 0,[XCT IODIN,SIMIO] ;IN CASE DUMP MODE
02200 CAIL TEMP,15
02300 JRST ARYDMP ;USE COMMON ROUTINE
02400
02500 ;;#FQ# DCS 2-6-72 (3-4) COUNT NO LONGER HELD EXCESSIVE
02600 INARY: MOVE A,-2(P) ;STARTING LOC
02700 SKIPGE B,-1(P) ;EXTENT
02800 ERR <ARRYIN: negative word count, value is >,6
02900 WIN3: JUMPE B,RESTR ;NOTHING LEFT TO DO
03000 SKIPG E,ICOWNT(CDB) ;#LEFT IN BUFFER
03100 JRST WIN5
03125 CMU <
03130 ;;=B4= 6 OF 13
03150 CAIN Z,0 ;IMP MODE?
03175 LSH E,-2 ;DIVIDE BY 4 TO GET WORD COUNT
03180 ;;=B4=
03187 >;CMU
03200 IBP IBP(CDB) ;MAKE SURE PTS TO NEXT
03300 HRL C,IBP(CDB) ;ADDR OF FIRST WORD TO READ
03400 MOVEI D,(A) ;FOR BLT TERMINATION
03500 HRR C,A ;"TO" ADDRESS
03600 CAIG B,(E) ;ENOUGH HERE?
03700 JRST WIN4 ;YES
03800 ADDI D,-1(E) ;NO, FINISH THIS BUFFER
03900 BLT C,(D)
04000 ADD A,E ;FIX INPUT POINTER
04100 SUB B,E ;FIX INPUT COUNT
04200 WIN5: XCT IOIN,SIMIO ;DO INPUT
04300 JRST WIN3 ;OK, GO AHEAD
04400 JRST WIEOF1 ;EOF OR ERROR, LEAVE
04500
04600 WIN4: ADDI D,-1(B) ;FINISH UP
04700 BLT C,(D)
04800 SUB E,B ;FIX UP COUNT
04825 CMU <
04830 ;;=B4= 7 OF 13
04850 CAIE Z,0 ;IMP MODE?
04862 JRST .+3
04875 LSH E,2 ;MULTIPLY BY 4 FOR BYTE COUNT
04881 DPB Z,[POINT 6,IBP(CDB),5]
04886 ;;=B4=
04887 >;CMU
04900 SUBI B,1 ;PREPARE TO CORRECT BP
05000 MOVEM E,ICOWNT(CDB) ;UPDATE WORDS LEFT
05100 ADDM B,IBP(CDB) ; POINTER
05200 ;;#FQ# (3-4)
05300 JRST RESTR ;LEAVE
05400
05500 WIEOF1: MOVE TEMP,-1(P) ;#WORDS WANTED -1
05600 SUBM TEMP,B ;#INPUT IN RH
05700 WIN2: HRRM B,@ENDFL(CDB) ;#INPUT IN RH, ERR OR EOF BITS IN LH
05800 JRST RESTR
05900
06000 DSCR VALUE←WORDIN(CHAN);
06100 CAL SAIL
06200 ⊗
06300
06400 HERE (WORDIN) ;READ ONE WORD -- USE ARRYIN
06500 PUSHJ P,SAVE
06600 MOVE LPSA,X22
06700 LOADI7 A,<WORDIN>
06800 MOVE CHNL,-1(P) ;CHANNEL NUMBER
06900 PUSHJ P,GETCHN
07000 ;;#FQ# DCS 2-6-72 (4-4) WORD COUNT KEPT CORRECT, DUMP MODE OK
07100 LDB TEMP,[POINT 4,DMODE(CDB),35];DATA MODE
07200 CAIL TEMP,15 ;DUMP MODE?
07300 JRST DUMPWI ; YES
07400 SETZM @ENDFL(CDB)
07500 WI: SOSL ICOWNT(CDB)
07600 JRST WOKI ;ALL OK
07700 XCT IOIN,SIMIO
07800 JRST WI ;OK, GO BACK TO KEEP COUNT RIGHT
07900 TDZA A,A ;RETURN 0, WITH ERROR
08000 WOKI: ILDB A,IBP(CDB) ;OK, RETURN NEXT WORD
08100 MOVEM A,RACS+1(USER) ;RESULT
08200 JRST RESTR
08300
08400 DUMPWI: MOVE LPSA,[XWD 6,6]
08500 MOVEI TEMP,RACS+1(USER);RESULT GOES HERE
08600 PUSH P,-1(P) ;CHANNEL
08700 PUSH P,TEMP ;ADDRESS
08800 PUSH P,[1] ;1 WORD TRANSFER
08900 PUSHJ P,ARI ;WON'T RETURN, JUST SYNCH STACK
09000 ;;#FQ# (4-4)
09100
09200 ARYDMP:
09300 MOVN TEMP,-1(P) ;-WORD COUNT
09400 JUMPGE TEMP,[ERR <DUMP MODE WORD COUNT NOT POSITIVE, VALUE IS >,6]
09500 SOS D,-2(P) ;STARTING ADDR - 1
09600 HRL D,TEMP ;IOWD -COUNT,STARTING ADDR -1
09700 MOVEI D+1,0 ;TERMINATE THE READ
09800 MOVE A,[JRST RESTR] ;IF IT SUCCEEDS
09900 MOVE B,[JRST RESTR] ;IF IT FAILS (EOF OR ERR, ALREADY HANDLED)
10000 JRST 0 ;GO DO DUMP I/O
10100
10200 HERE(WRDSP1)
10300 HERE(WRDSP2)
10400 HERE(WRDSP3)
10500
10600 ERR <DRYROT WRD SPARES>
10700
10800 ENDCOM(WRD)
10900 COMPIL(THR,<INOUT>,<SIMIO,SAVE,RESTR,GETCHN>
11000 ,<THROUGH I/O ROUTINE>)
11100
11200
11300 COMMENT ⊗ INOUT ⊗
11400
11500 DSCR INOUT(INCHAN,OUTCHAN,EXTENT);
11600 CAL SAIL
11700 ⊗
11800
11900 HEREFK (INOUT,.INOUT)
12000 PUSHJ P,SAVE ;SAVE AC'S,GET GOGTAB
12100 MOVE LPSA,[XWD 6,6]
12200 MOVE CHNL,-2(P) ;OUTPUT CH NUMBER
12300 LOADI7 A,<INOUT (OUTPUT SIDE)>
12400 PUSHJ P,GETCHN
12500 SETZM @ENDFL(CDB) ;CLEAR ERROR INDICATOR
12600 LDB TEMP,[POINT 4,DMODE(CDB),35] ;CHECK MODE
12616 CMU <
12621 ;;=B4= 8 OF 13
12632 MOVEI Z,1
12648 CAIN TEMP,3 ;IS THE MODE 3
12664 TRZA Z,-1 ; YES!!!
12666 CAIN TEMP,4 ;OR CMU IMAGE MODE?
12667 JRST .+4 ;UGLY, BE CAREFUL OF CODE CHANGES!
12669 ;;=B4=
12680 >;CMU
12700 CAIL TEMP,10 ;MUST BE BINARY MODE
12800 CAILE TEMP,14 ;AND NOT DUMP MODE
12900 ERR <INOUT (OUTPUT SIDE): ILLEGAL DATA MODE:>,6
13000 PUSH P,CDB ;SAVE -
13100 PUSH P,CHNL ;WELL DO IT AGAIN
13200 MOVE CHNL,-5(P) ;SEE...
13300 LOADI7 A,<INOUT (INPUT SIDE)>
13400 PUSHJ P,GETCHN ;DO YOUR THING
13500 SETZM @ENDFL(CDB) ;CLEAR ERROR INDICATOR
13600 LDB TEMP,[POINT 4,DMODE(CDB),35]
13616 CMU <
13621 ;;=B4= 9 OF 13
13632 MOVEI Y,1
13648 CAIN TEMP,3 ;IS THE MODE 3
13664 TRZA Y,-1 ;YES!!!
13666 CAIN TEMP,4 ;OR CMU IMAGE MODE
13668 JRST .+4 ;CAREFUL OF RELATIVE JUMPS!
13669 ;;=B4=
13680 >;CMU
13700 CAIL TEMP,10
13800 CAILE TEMP,14
13900 ERR <INOUT (INPUT SIDE): ILLEGAL DATA MODE:>,6
14000 SKIPGE B,-3(P) ;# OF WORDS
14100 HRLOI B,377777 ;ARBITRARILY LARGE NUMBER OF WDS
14200 TH1: JUMPE B,RESTR ;NO MORE TO DO
14300 SKIPG E,ICOWNT(CDB) ;#OF WORDS IN BUFFER
14400 JRST TH5 ;BETTER GET SOME MORE
14420 CMU <
14425 ;;=B4= 10 OF 13
14440 CAIN Y,0 ;IMP MODE?
14460 LSH E,-2 ;DIVIDE BY 4 TO GET WORD COUNT
14465 ;;=B4=
14480 >;CMU
14500 IBP IBP(CDB) ;MAKE SURE POINT TRIGHT
14600 HRL C,IBP(CDB) ;INPUT POINTER
14700 EXCH CHNL,(P) ;NOW FREEN OUTPUT STUFF
14800 EXCH CDB,-1(P)
14900 SKIPG OCOWNT(CDB) ;SOME LEFT
15000 XCT IOOUT,SIMIO
15100 SKIPA
15200 JRST THERR
15300 IBP OBP(CDB)
15400 HRR C,OBP(CDB) ;OUTPUT POINTER
15500 CAML E,B ;FIND # OF WORDS
15600 MOVE E,B ;TO BLIT
15650 NOCMU <
15655 ;;=B4= 11 OF 13
15700 CAML E,OCOWNT(CDB) ;=MIN(B,ICOWNT,OCOWNT)
15800 MOVE E,OCOWNT(CDB)
15805 >;NOCMU
15850 CMU <
15855 CAMGE E,OCOWNT(CDB) ;=MIN(B,ICOWNT,OCOWNT)
15860 JRST .+4
15865 MOVE E,OCOWNT(CDB)
15875 CAIN Z,0 ;IMP MODE?
15887 LSH E,-2 ;DIVIDE BYTE COUNT BY 4
15890 ;;=B4=
15893 >;CMU
15900 MOVEI D,(C) ;MAKE BLT TERMINATOR
16000 ADDI D,-1(E) ;FINAL ADDRESS
16100 BLT C,(D) ;CHOMP CHOMP
16200 SUB B,E ;WE'VE DONE THESE
16300 MOVEI A,-1(E) ;TO UPDATE BYTE POINTER
16400 ADDM A,OBP(CDB) ;TOLD YOU SO
16414 CMU <
16419 ;;=B4= 12 OF 13
16428 CAIE Z,0 ;IMP MODE?
16442 JRST .+3
16456 LSH E,2 ;MULTIPLY BY 4 FOR BYTE COUNT
16470 DPB Z,[POINT 6,OBP(CDB),5]
16475 ;;=B4=
16484 >;CMU
16500 SUBM E,OCOWNT(CDB) ;UPDATE WORD COUNT
16600 MOVNS OCOWNT(CDB) ;CLEVER,EH?
16700 TH6: EXCH CHNL,(P) ;BACK TO INPUT SETUP
16800 EXCH CDB,-1(P)
16900 ADDM A,IBP(CDB) ;UPDATE INPUT PTR
16914 CMU <
16919 ;;=B4= 13 OF 13
16928 CAIE Y,0 ;IMP MODE?
16942 JRST .+3
16956 LSH E,2 ;MULTIPLY BY 4 FOR BYTE COUNT
16970 DPB Y,[POINT 6,IBP(CDB),5]
16975 ;;=B4=
16984 >;CMU
17000 SUBM E,ICOWNT(CDB) ;UPDATE WORD COUNT
17100 MOVNS ICOWNT(CDB) ;SUBTRACTION WAS BACKWARDS
17200 JRST TH1 ;MORE OF SAME
17300 TH5: XCT IOIN,SIMIO ;DO SOME INPUT
17400 JRST TH1 ;NOW GO PLAY
17500 THERR: SKIPGE TEMP,-3(P) ;# THE GUY WANTED
17600 HRLOI TEMP,377777 ;IT WAS A FUDGE
17700 SUB TEMP,B ;SUBTRACT #LEFT TO GET
17800 HRRM TEMP,@ENDFL(CDB);#HE GOT
17900 JRST RESTR
18000
18100 ENDCOM(THR)
18200 COMPIL(LIN,<LINOUT>,<SIMIO,SAVE,RESTR,GETCHN,X33>,<LINOUT ROUTINE>)
00100 COMMENT ⊗Linout ⊗
00200
00300 DSCR LINOUT(CHANNEL,VALUE);
00400 CAL SAIL
00500 ⊗
00600
00700 HERE (LINOUT)
00800 PUSHJ P,SAVE
00900 MOVE CHNL,-2(P) ;CHANNEL
01000 LOADI7 A,<LINOUT>
01100 PUSHJ P,GETCHN ;CHANNEL DATA
01200 MOVE TEMP,OBP(CDB) ;ADJUST TO FULL WORD
01300 HRRZ A,OCOWNT(CDB) ;DON'T FORGET COUNT
01400 LINOLP: TLNN TEMP,760000 ;LINED UP?
01500 JRST OKLIGN ; YES
01600 IBP TEMP ;0 WILL BE THERE
01700 SOJA A,LINOLP
01800
01900 OKLIGN: MOVEM TEMP,OBP(CDB)
02000 MOVEM A,OCOWNT(CDB) ;REPLACE UPDATED THINGS
02100 CAIGE A,=10 ;ENOUGH ROOM FOR 2 WORDS?
02200 XCT IOOUT,SIMIO ;NO, OUTPUT
02300 JFCL ;IN CASE OUTPUT HAPPENED
02400
02500 SKIPGE B,-1(P) ;GET LINE NUMBER
02600 JRST [MOVNS B
02700 MOVNI A,5 ;ONLY PUT OUT 5 CHARS
02800 JRST NOCONV] ;WAS GIVEN TO US IN TOTO
02900 MOVNI A,6 ;PUT OUT TAB AFTER
03000 MOVE C,[<ASCII /00000/>/2] ;TO MAKE 5
03100 EXCH B,C
03200 PUSH P,LNBAK ;RETURN ADDR
03300 LNCONV: IDIVI C,=10
03400 IORI D,"0"
03500 DPB D,[POINT 7,(P),6]
03600 SKIPE C ;THE RECURSIVE PRINTER
03700 PUSHJ P,LNCONV
03800 HLL C,(P) ;ONE CHAR, LEFT JUST
03900 LSHC B,7
04000 LNBAK: POPJ P,.+1
04100 LSH B,1
04200 TRO B,1
04300 NOCONV: AOS C,OBP(CDB) ;MOVE OUT A WORD
04400 MOVEM B,(C)
04500 ADDM A,OCOWNT(CDB) ;UPDATE COUNT
04600 MOVEI B,11
04700 CAME A,[-5]
04800 IDPB B,OBP(CDB) ;OUTPUT A TAB
04900 NOTAB: MOVE LPSA,X33
05000 JRST RESTR ;THAT'S IT
05100
05200 ENDCOM(LIN)
05300 COMPIL(BRK,<BREAKSET,SETBREAK,STDBRK>
05400 ,<SAVE,RESTR,BRKMSK,SIMIO,GOGTAB,X22,X33>
05500 ,<BREAKSET, SETBREAK, STDBRK ROUTINES>)
00100 COMMENT ⊗Breakset ⊗
00200
00300 DSCR BREAKSET(TABLE #,"STRING",WAY);
00400 CAL SAIL
00500 ⊗
00600
00700 HERE (BREAKSET)
00800 PUSHJ P,SAVE ;SAVE ACS AND THINGS
00900 MOVE LPSA,X33
01000 SUB SP,X22
01100 SKIPLE A,-2(P) ;TABLE #
01200 CAILE A,=18
01300 ERR <THERE ARE ONLY 18 BREAK TABLES>
01400 HLLZ B,BRKMSK(A) ;BREAK MASK FOR THIS TABLE
01500 ADD A,USER
01600 MOVE C,[ANDCAM B,(D)] ;USUAL CLEARING INSTR
01700 LDB X,[POINT 4,-1(P),35] ;COMMAND
01800 TRZN X,10 ;LEFT OR RIGHT HALF OF TABLE?
01900 SKIPA X,BKCOM(X) ;RIGHT HALF
02000 HLRZ X,BKCOM(X) ;LEFT HALF
02100 JRST (X) ;DISPATCH
02200
02300 BKCOM: XWD XCLUDE,PASLINS ;X,,P
02400 XWD INCL,PENDCH ;I,,A
02500 XWD ILLSET,RETCH ;-,,R
02600 ;;%##% ADD BREAK MODE FOR COERCIONS
02700 XWD UCASE,SKIPCH ;K,,S
02800 XWD BRKLIN,RESTR ;L,,D
02900 XWD ILLSET,ERMAN ;-,,E
02950 ;;%BG% ! ADD WAY TO UNDO "K"
03000 XWD NOLINS,LCASE ;N,,F
03100 XWD OMIT,ILLSET ;O,,-
03200
03300 ILLSET: ERR <ILLEGAL COMMAND TO BREAKSET>,1
03400 JRST RESTR
03500
03600 XCLUDE: SKIPA C,[IORM B,(D)] ;YES, SET ALL TO 1 TO INITIALIZE
03700 OMIT: MOVSS B ;OMIT, PUT BIT IN RH
03800 INCL: MOVSI D,-200
03900 HRRI D,BRKTBL(USER) ;RELOCATABLE IOWD
04000 BRKLUP: XCT C ;CLEAR (OR SET) PROPER (HALF OF PROPER) TABLE
04100 AOBJN D,BRKLUP
04200 MOVE C,[IORM B,BRKTBL(D)] ;USUAL SETTING INSTR
04300 CAIN X,XCLUDE ;BY EXCEPTION?
04400 MOVE C,[ANDCAM B,BRKTBL(D)] ;YES, WANT TO TURN OFF BITS
04500 ADDI C,(USER) ;RELOCATE IT
04600 HRRZ A,1(SP) ;LENGTH OF STRING
04700 MOVE X,2(SP) ;BYTE POINTER
04800 JRST BRKL2
04900 BRKL1: ILDB D,X ;GET A CHAR
05000 XCT C ;DO RIGHT THING TO RIGHT BIT
05100 BRKL2: SOJGE A,BRKL1
05200 JRST RESTR
05300
05400 PASLINS: TDZA B,B ;PASS LINE NOS. SINE COMMENT
05500 NOLINS: MOVEI B,-1 ;INFORM IN THAT IT SHOULD
05600 MOVEM B,LINTBL(A) ; DELETE LINE NOS.
05700 JRST RESTR
05800
05900 BRKLIN: SKIPA B,[-1] ;MARK BREAK ON LINE NOS. FOR THIS TBL
06000 ERMAN: MOVSI B,-1 ;LH NEG SIGNALS ERMAN'S SCHEME
06100 MOVEM B,LINTBL(A)
06200 JRST RESTR
06300
06400 PENDCH: SETOM DSPTBL(A) ;APPEND TO END OF INPUT
06500 JRST RESTR
06600
06700 SKIPCH: TDZA B,B ;CHAR NEVER APPEARS IN INPUT STRING
06800 RETCH: MOVEI B,-1 ;RETAIN FOR NEXT TIME
06900 MOVEM B,DSPTBL(A)
07000 JRST RESTR
07100
07200 ;;%##%
07300 UCASE: MOVSS B ;INTO RIGHT HLF
07400 IORM B,BRKCVT(USER)
07500 JRST RESTR
07512
07525 ;;%BG% =A1=
07700 LCASE: MOVSS B
07800 ANDCAM B,BRKCVT(USER)
07900 JRST RESTR
00100 COMMENT ⊗Setbreak
00200
00300 TBL IS AS IN BREAKSET
00400 BRKSTRNG IS USED FOR ANY "I" OR "X" APPEARING IN MODESTRNG
00500 OMITSTRNG (IF NOT NULL) IS USED TO SET THE "OMIT" SIDE OF THE TABLE
00600 MODESTRNG CAN CONTAIN ANY OF THE VALID BREAKSET "MODE" CHARACTERS
00700 I,X,O,N,R,A,P, or S.
00800 This function is not attainable by the user unless he declares it.
00900 ⊗
01000
01100 DSCR SETBREAK(TABLE,"BREAKSTRING","OMITSTRING",MODESTRING");
01200 CAL SAIL
01300 ⊗
01400
01500 HERE (SETBREAK)
01600 HRRZ TEMP,-3(SP) ;DO OMIT STRING, IF PRESENT
01700 JUMPE TEMP,NO.O ;NULL STRING DOESN'T COUNT
01800 PUSH P,-1(P) ;TABLE #
01900 PUSH SP,-3(SP) ;OMIT CHARACTERS
02000 PUSH SP,-3(SP)
02100 PUSH P,["O"] ;OMIT!
02200 PUSHJ P,BREAKSET ;DO THAT
02300 NO.O: HRRZS -1(SP) ;COUNT OF # OF COMMANDS
02400 BKSLUP: SOSGE -1(SP) ;DONE?
02500 JRST BKSDUN ; YES
02600 PUSH P,-1(P) ;TABLE #
02700 ILDB TEMP,(SP) ;COMMAND
02800 PUSH P,TEMP
02900 PUSH SP,-5(SP)
03000 PUSH SP,-5(SP) ;STRING TO USE IF NECESSARY
03100 PUSHJ P,BREAKSET
03200 JRST BKSLUP ;DO IT -- AGAIN
03300
03400 BKSDUN: SUB P,X22
03500 SUB SP,[XWD 6,6]
03600 JRST @2(P)
03700
00100 COMMENT ⊗Stdbrk ⊗
00200
00300 DSCR STDBRK(CHANNEL);
00400 CAL SAIL
00500 ⊗
00600
00700 HERE (STDBRK)
00800 PUSHJ P,SAVE
00900 MOVE LPSA,X22
01000 MOVE CHNL,-1(P)
01100 MOVEI CDB,D-DMODE ;SO WE CAN USE SIMIO'S OPEN
01200 MOVEI D,17 ;DUMP MODE
01300 MOVE D+1,['SYS ']
01400 MOVEI D+2,0 ;NO HEADERS
01500 XCT IOOPEN,SIMIO ;DO THE OPEN
01600 ERR <DSK NOT AVAILABLE?>
01700 MOVEI USER,D-FNAME ;SO WE CAN USE SIMIO'S LOOKUP
01800 MOVE D,['BKTBL ']
01900 MOVE D+1,['BKT '] ;FUNNY NAME AND EXTENSION
02000 SETZB D+2,D+3
02100 XCT IOLOOKUP,SIMIO ;DO THE LOOKUP
02200 ERR <Standard break table not available>
02300 MOVE USER,GOGTAB
02400 MOVEI D,DSPTBL-1(USER)
02500 HRLI D,-(=19+=19+=128) ;IOWD SIZE,LOC
02600 MOVEI D+1,0 ;TERMINATE COMMAND LIST
02700 XCT IODIN,SIMIO ;DO THE INPUT
02800 SKIPA ;ALL WENT WELL
02900 ERR <Error reading standard break table>
03000 ;; XCT IORELEASE NOW TAKES INHIBIT BITS IN RH OF D
03100 MOVEI D,0 ;NO INHIBIT BITS TO RELEASE
03200 XCT IORELEASE,SIMIO ;RELEASE FILE
03300 JRST RESTR
03400
03500 HERE(BRKSP1) ; SPARES *******
03600 HERE(BRKSP2);
03700 ERR <DRYROT IN BRK SPARES>
03800 ENDCOM(BRK)
03900 COMPIL(CLS,<CLOSIN,CLOSO,CLOSE>,<SAVE,RESTR,SIMIO,X22>,<CLOSE ROUTINES>)
00100 COMMENT ⊗Close, Closin, Closo
00200 CLOSE(CHAN)
00300
00400 CLOSIN closes only the input side
00500 CLOSO closes only the output side
00600
00700 ⊗
00800 DSCR CLOSIN(CHAN)
00900 CAL SAIL
01000 ⊗
01100
01200 HERE (CLOSIN) PUSHJ P,SAVE ;CLOSE INPUT ONLY
01300 MOVEI D,1
01400 JRST CLSS
01500
01600 DSCR CLOSO(CHANNEL);
01700 CAL SAIL
01800 ⊗
01900 HERE (CLOSO)
02000 PUSHJ P,SAVE ;CLOSE OUTPUT ONLY
02100 MOVEI D,2
02200 JRST CLSS
02300 DSCR CLOSE(CHANNEL);
02400 CAL SAIL
02500 ⊗
02600 .CLS:
02700 HERE (CLOSE) ;CLOSE BOTH
02800 PUSHJ P,SAVE ;SAVE ACS AND THINGS
02900 MOVEI D,0
03000 CLSS: MOVE CHNL,-1(P)
03100 MOVE LPSA,X22
03200 CHKCHN CHNL,<CLOSE> ;VERIFY OK CHANNEL
03300 SKIPN CDB,@CDBLOC(USER) ;GET CDB
03400 JRST RESTR ;NOT OPEN, DON'T CLOSE
03500 XCT IOCLOSE,SIMIO ;CLOSE CHAN,SPEC
03600 SETZM INAME(CDB)
03700 SETZM ONAME(CDB) ;NO FILE NAMES OPEN
03800 JRST RESTR ;RETURN
03900
04000 ENDCOM(CLS)
04100 COMPIL(MTP,<MTAPE,USETI,USETO,RENAME>
04200 ,<SAVE,RESTR,GETCHN,SIMIO,FILNAM,X22,X33,X44>
04300 ,<MTAPE, USETI, USETO, RENAME ROUTINES>)
00100 COMMENT ⊗Mtape ⊗
00200
00300 DSCR MTAPE(CHANNEL,MODE);
00400 CAL SAIL
00500 ⊗
00600
00700 .MTP:
00800 HERE (MTAPE)
00900 PUSHJ P,SAVE
01000 MOVE LPSA,X33
01100 MOVE CHNL,-2(P) ;CHANNEL NUMBER
01200 LOADI7 A,<MTAPE>
01300 PUSHJ P,GETCHN
01400 LDB C,[POINT 5,-1(P),35] ;PART OF COMMAND CHAR
01500 EXPO <
01600 MOVEI B,101
01700 CAIN C,11 ;MTAPE "I" DOES SPECIAL THINGS.
01800 JRST MTAPQ ;GO SET IBM COMPABILITY MODE
01900 >;EXPO
02000 ;;%##% ALLOW MTAPE(NULL) TO DO A MTAPE 0 -- WAIT
02100 MOVEI B,0
02200 JUMPE C,MTAPQ ;THIS IS DEFINITELY NOT A NO-OP
02300 MOVE A,OPTAB ;COMMAND BITS
02400 MOVE B,OPTAB+1 ;MORE
02500 TRZE C,30 ;COMPRESS TABLE
02600 ADDI C,5
02700 LSH C,2 ;EACH COMMAND IS 4 BITS
02800 ROTC A,(C) ;GET RIGHT COMMAND
02900 ANDI B,17 ;DO IF SYSTEM DOESN'T
03000 JUMPE B,[ERR <MTAPE: ILLEGAL CODE>,1
03100 JRST RESTR]
03200 MTAPQ: HRLI B,(<MTAPE>) ;CREATE MTAPE OPERATION
03300 DPB CHNL,[POINT 4,B,12]
03400 ;%##% TRNE B,-1 ;IS THERE AN OPERATION?
03500 XCT B ;YES, DO IT
03600 JRST RESTR
03700
03800 OPTAB: BYTE (4) 16,17,0,0,3,6,7,13,10 ;A,B,,,E,F,R,S,T
03900 BYTE (4) 11,0,1 ;U,,W
00100 COMMENT ⊗ Useti, Useto, Rename ⊗
00200
00300 DSCR USETI,USETO(CHANNEL,BLOCK #);
00400 CAL SAIL
00500 ⊗
00600
00700 HERE (USETI)
00800 ↑↑.USETI:
00900 SKIPA LPSA,[XCT IOSETI,SIMIO] ;USETI
01000 HERE (USETO)
01100 ↑↑.USETO:
01200 MOVE LPSA,[XCT IOSETO,SIMIO] ;USETO
01300 PUSHJ P,SAVE
01400 MOVE CHNL,-2(P)
01500 LOADI7 A,<USET>
01600 PUSHJ P,GETCHN
01700 MOVE A,-1(P) ;VALUE TO USETO
01800 MOVE LPSA+1,[JRST .+2] ;BE ABLE TO GET BACK
01900 JRST LPSA ;GO TO USETI/O
02000 MOVE LPSA,X33
02100 JRST RESTR
02200
02300 DSCR RENAME(CHANNEL,"NEW NAME",PROTECTION,@FAILURE FLAG);
02400 CAL SAIL
02500 ⊗
02600
02700 HERE (RENAME)
02800 ↑↑.RENAME:
02900 PUSHJ P,SAVE
03000 SETZM @-1(P)
03100 MOVE LPSA,X44
03200 LOADI7 A,<RENAME>
03300 MOVE CHNL,-3(P)
03400 PUSHJ P,GETCHN
03500 PUSHJ P,FILNAM ;PARSE FILENAME SPEC
03600 JRST BDSPC ;SPECIFICATION NO GOOD
03700 MOVE TEMP,-2(P)
03800 ROT TEMP,-=9
03900 MOVEM TEMP,FNAME+2(USER)
04000 XCT IORENAME,SIMIO ;DO THE RENAME
04100 JRST RNERR ;NO GOOD
04200 JRST RESTR
04300 BDSPC: HRRZ TEMP,ERRTST(CDB) ;SEE IF
04400 TRNE TEMP,10000 ;WILLING TO HANDLE ERROR
04500 ERR <RENAME: INVALID FILE SPECIFICATION>,1 ;NO, TELL HIM
04600 SKIPA TEMP,[=8] ;ALWAYS REPORT CODE
04700 RNERR: HRRZ TEMP,FNAME+1(USER) ;RETURN HORSESHIT NUMBER
04800 HRROM TEMP,@-1(P) ;TO THE USER
04900 JRST RESTR
05000
05100 ENDCOM(MTP)
05200 COMPIL(USC,<USERCON>,<SAVE,RESTR,GOGTAB>,<USERCON ROUTINE>)
00100 COMMENT ⊗Usercon ⊗
00200
00300 DSCR USERCON(@INDEX,@SETGET,FLAG);
00400 CAL SAIL
00500 PAR INDEX is USER-table displacement (usually obtained from HEAD.REL)
00600 SETGET is used to communicate USER table values
00700 FLAG is "OPCODE" input to USERCON
00800 RES The INDEXth USER table entry is accessed (GLUSER table if FLAG negative).
00900 On exit, SETGET contains old value of this entry.
01000 If FLAG is odd, the original SETGET value replaces this entry.
01100 ⊗
01200
01300 CMU <
01400 GGAS <
01500 IFE ALWAYS, <EXTERNAL GLUSER>
01600 >;GGAS
01700 >;CMU
01800
01900 HERE(USERCON)
02000 PUSHJ P,SAVE
02100 MOVE LPSA,[XWD 4,4]
02200 MOVE A,-1(P) ;THE FLAG
02300 CMU < GGGON
02400 >;CMU
02500 GLOB <
02600 MOVEI B,ENDREN
02700 JUMPL A,[MOVEI USER,GLUSER
02800 MOVEI B,ZAPEND ;USE GLOBAL TABLE
02900 JRST .+1]
03000 SKIPL C,-3(P) ;THE INDEX
03100 CAML C,B
03200 >;GLOB
03300 NOGLOB <
03400 SKIPL C,-3(P) ;THE INDEX
03500 CAIL C,ENDREN ;CHECK BOUNDS
03600 >;NOGLOB
03700 ERR <USERCON: index out of bounds >,7,RESTR
03800 ADD C,USER ;POINT AT CORRECT ENTRY
03900 MOVE B,(C) ;GET OLD VALUE
04000 MOVE D,@-2(P) ;(PERHAPS) NEW VALUE
04100 TRNE A,1 ;STORE NEW VALUE?
04200 MOVEM D,(C) ;YES
04300 MOVEM B,@-2(P) ;RETURN OLD VALUE
04400 GLOB <
04500 MOVE USER,GOGTAB ;RESET
04600 >;GLOB
04700 JRST RESTR
04800 CMU < GGGOFF
04900 >;CMU
05000 ENDCOM(USC)
00100 COMMENT ⊗Ttyuuo functions ⊗
00200
00300 DSCR TTYUUO FUNCTIONS
00400 CAL SAIL
00500 ⊗
00600
00700 Comment ⊗
00800 INTEGER PROCEDURE INCHRW;
00900 RETURN A CHAR FROM TTCALL 0,
01000
01100 INTEGER PROCEDURE INCHRS;
01200 RETURN -1 IF NO CHAR WAITING, ELSE FIRST CHAR (TTCALL 2,)
01300
01400 STRING PROCEDURE INCHWL;
01500 WAIT FOR A LINE, THEN RETURN IT (TTCALL 4, FOLLOWED BY TTCALL 0'S)
01600
01700 STRING PROCEDURE INCHSL(REFERENCE INTEGER FLAG);
01800 FLAG←-1, STR←NULL IF NO LINE, ELSE FLAG←0,
01900 STR←LINE (TTCALL 5, FOLLOWED BY TTCALL 0'S)
02000
02100 STRING PROCEDURE INSTR(INTEGER BRCHAR);
02200 RETURN ALL CHARS TO AND NOT INCLUDING BRCHAR (TTCALL 0'S)
02300
02400 STRING PROCEDURE INSTRL(INTEGER BRCHAR);
02500 WAIT FOR ONE LINE, THEN DO INSTR (TTCALL 4, FOLLOWED BY INSTR)
02600
02700 STRING PROCEDURE INSTRS(REFERENCE INTEGER FLAG; INTEGER BRCHAR);
02800 FLAG←-1, STR←NULL IF NO LINES, ELSE FLAG←0,
02900 STR←INSTR(BRCHAR)
03000
03100
03200 PROCEDURE OUTCHR(INTEGER CHAR);
03300 OUTPUT CHAR (TTCALL 1)
03400
03500 PROCEDURE OUTSTR(STRING STR);
03600 OUTPUT STR (TTCALL 3)
03700
03800
03900 PROCEDURE CLRBUF;
04000 CLEARS INPUT BUFFER (TTCALL 11,)
04100
04200 TTYIN, TTYINS, TTYINL (TABLE, @BRCHAR);
04300 TTYIN WORKS WITH TTCALL 0'S; TTYINS DOES A SKIP
04400 ON LINE FIRST, RETURNING NULL AND -1 IN BREAK IF NO LINES
04500 TTYINL DOES A WAIT FOR LINE FIRST.
04600 FULL BREAKSET CAPABILITIES EXCEPT FOR
04700 "R" MODE (AND OF COURSE, LINE NUM. STUFF)
04800
04900 TITLE TTYUUO
05000 ⊗
05100
05200 ;;%##% ADD TTYUP TO ALL THIS
05300 COMPIL(TTY,<INCHRW,INCHRS,INCHWL,INCHSL,INSTR,OUTCHR,OUTSTR,TTYUP
05400 ENTINT <INSTRL,INSTRS,CLRBUF,TTYIN,TTYINS,TTYINL>>
05500 ,<SAVE,RESTR,X11,X22,X33,INSET,CAT,STRNGC,GOGTAB,BRKMSK,.SKIP.,.SONTP>
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
06100 EXPO <
06200 IFE ALWAYS,<
06300 EXTERN OTSTRBF
06400 >;IFE ALWAYS
06500 >;EXPO
06600
06700 ;;%##% FOR TTYUP THING
06800 DEFINE KONVERT(AC) <
06900 SKIPN TTYCVT(USER)
07000 JRST .+5
07100 CAIL AC,"a"
07200 CAILE AC,"z"
07300 JRST .+2
07400 TRZ AC,40 ;FORCE TO BE LOWER CASE
07500 >
00100
00200 HERE (INCHRW) TTCALL A
00300 ;;%##%
00400 MOVE USER,GOGTAB
00500 KONVERT (A)
00600 POPJ P,
00700
00800 HERE (INCHRS) TTCALL 2,A ;SKIP IF CHAR WAITING
00900 MOVNI A,1 ;ELSE RETURN -1
01000 ;;%##%
01100 MOVE USER,GOGTAB
01200 KONVERT(A)
01300 POPJ P,
01400
01500 HERE (OUTCHR) TTYUUO 1,-1(P) ;OUTPUT THE PARAMETER
01600 SUB P,X22 ;REMOVE PARAMETER
01700 JRST @2(P)
01800
01900 HERE (OUTSTR)
02000 ;;#FO# 11-18-71 DCS (1-2)
02100 EXPO <
02200 ;;#FO#
02300 ;;#HC# 5-11-72 DCS MAKE OUTSTR BETTER IN EXPO VERSION (DUE TO LDE)
02400 ;;#MM# 5-25-73 ! MAKE SURE ITS LOADED BEFORE WE USE IT
02500 MOVE USER,GOGTAB
02600 EXCH A,-1(SP) ;LENGTH OF STRING
02700 HRRZS A ; REALLY
02800 EXCH B,(SP) ;PTR TO THE STRING
02900 PUSH P,C ;NEED ANOTHER AC
03000 JUMPLE A,OU.OUT ;DON'T DO ANYTHING
03100 OSLOOP: MOVE C,A
03200 SUBI A,14*5-1 ;# CHARS/CHOMP
03300 SKIPLE A ;LOTS LEFT??
03400 MOVEI C,14*5-1 ; YES,
03500 ;;%##% BETTER PLACE THAN SGACS
03600 MOVE LPSA,[POINT 7,OTSTRBF];AS GOOD A PLACE AS ANY
03700 ILDB TEMP,B
03800 SKIPE TEMP ;NULL??
03900 IDPB TEMP,LPSA ; NO
04000 SOJG C,.-3
04100 MOVEI TEMP,0 ;A NULL FOR THE END
04200 IDPB TEMP,LPSA
04300 TTCALL 3,OTSTRBF ;RAISON D'ETRE
04400 JUMPG A,OSLOOP
04500 OU.OUT: POP SP,B
04600 POP SP,A
04700 POP P,C
04800 POPJ P,
04900 ;;#HC#
05000 ;;#FO# 11-18-71 DCS (2-2) MAKE OUTSTR WORK EFFICIENTLY USING TTYMES (STANFO ONLY)
05100 >;EXPO
05200 NOEXPO <
05300 HLRZ TEMP,(SP) ;SIZE/POSITION FIELDS OF BP
05400 TRZ TEMP,7777 ;CLEAR SIZE FIELD
05500 OR TEMP,-1(SP) ;POSITION, COUNT IN RH FOR DDTOUT
05600 TRNN TEMP,7777 ;IF NULL STRING, QUIT
05700 JRST QUIT
05800 HRLM TEMP,(SP)
05900 MOVE TEMP,[SIXBIT /TTY/] ;DEVICE FOR TTYMES
06000 MOVEM TEMP,-1(SP)
06100 MOVEI TEMP,-1(SP) ;POINT AT SPEC
06200 CALLI TEMP,400047 ;WRITE FIRST CHAR FOR LENGTH CHARS
06300 ;THIS IS THE SPECIAL TTYMES UUO AS PROVIDED BY HELLIWELL
06400 JFCL ;IT HAS BEEN KNOW TO SKIP-RETURN
06500 QUIT: SUB SP,X22 ;REMOVE THE ARGUMENT
06600 >;NOEXPO
06700 ;;#FO#
06800 POPJ P, ;DONE
06900
07000 TTWCHR←←=100 ;MAX NUMBER OF CHARS ON TTY INPUT
07100 CMU < ;EXCEPT WE HAVE LARGER INPUT BUFFERS
07200 TTWCHR←←=140
07300 >;CMU
07400 REDSTR: SKIPE SGLIGN(USER)
07500 PUSHJ P,INSET
07600 MOVEI A,TTWCHR
07700 ADDM A,REMCHR(USER)
07800 SKIPLE REMCHR(USER)
07900 PUSHJ P,STRNGC
08000 MOVNI A,TTWCHR
08100 PUSH SP,[0] ;NULL STRING IF NOTHING DONE
08200 PUSH SP,TOPBYTE(USER)
08300 POPJ P,
08400
08500 FINSTR: CAIN TEMP,15 ;REMOVE LFD IF CR BROKE IT
08600 TTCALL TEMP
08700 FINS1: ADDM A,REMCHR(USER) ;NUMBER NOT USED
08800 ADDI A,TTWCHR ;NUMBER USED
08900 ;;#GI# DCS 2-5-72 REMOVE TOPSTR
09000 ;;%##% ALLOW FOR ITERATIVE GETTING OF TTWCHR CHARS
09100 HRROS -1(SP) ; TO STRING COUNT WORD
09200 ADDM A,-1(SP) ;UPDATE COUNT WORD
09300 ;;#GI#
09400 JRST RESTR
09500
09600 HERE (INSTR) PUSHJ P,SAVE
09700 PUSHJ P,REDSTR
09800 MOVE B,-1(P) ;BREAK CHAR
09900 MOVE LPSA,X22 ;# TO REMOVE
10000
10100 INS1: PUUO 0,TEMP ;NEXT CHAR
10200 ;;%##%
10300 KONVERT (TEMP) ;**** CONVERT BEFORE TEST BREAKEDNESS *****
10400 INS2: CAMN TEMP,B ;BREAK?
10500 JRST FINSTR ; YES, ALL DONE
10600 IDPB TEMP,TOPBYTE(USER) ;PUT IT AWAY AND
10700 ;;% % LDE BETTER NOT READ IN TOO MANY CHARACTERS
10800 AOJL A,INS1 ; IF ROOM, GO BACK FOR MORE
10900 PUSHJ P,CHRMOR ;MAKE ROOM, THEN GO BACK
11000 JRST INS1 ;
11100
11200 HERE (INCHWL) PUSHJ P,SAVE
11300 PUSHJ P,REDSTR
11400 MOVE LPSA,X11
11500 TTCALL 4,TEMP
11600 ;;#GF# DCS 2-1-72 (2-3) DO LOOP HERE, DON'T USE INS1 LIKE BEFORE
11700 INS3: CAIE TEMP,12
11800 NOCMU < ;WE WILL JUST BREAK ON CR OR LF, THANK YOU
11900 EXPO <
12000 CAIN TEMP,33 ;NORMAL ALTMODE.
12100 >;EXPO
12200 NOEXPO <
12300 CAIN TEMP,175
12400 >;NOEXPO
12500 JRST DNSTR
12600 CAIE TEMP,15 ;CR?
12700 TRNE TEMP,600 ;CONTROL BITS ON?
12800 >;NOCMU
12900 CMU < CAIE TEMP,15 ;CR?
13000 CAIN TEMP,12 ; OR LF?
13100 >;CMU
13200 JRST DNSTR ;YES
13300 ;;%##%
13400 KONVERT(TEMP)
13500 IDPB TEMP,TOPBYTE(USER) ;PUT IT AWAY
13600 TTCALL TEMP ;GET ANOTHER AND
13700 ;;%##% RHT -- MADE A BIT BETTER (ALLOW FOR GETTING MORE ROOM)
13800 AOJL A,INS3 ;GO HANDLE IT (IF STILL HAVE ROOM)
13900 PUSHJ P,CHRMOR ;GET ROOM FOR MORE CHARS
14000 JRST INS3 ;GO HANDLE
14100
14200 DNSTR: MOVEM TEMP,.SKIP. ;SET BREAK CHAR
14300 JRST FINSTR
14400 ;;#GF#
14500
14600 HERE (INCHSL) PUSHJ P,SAVE
14700 MOVE LPSA,X22 ;PARAM (FLAG) AND RETURN
14800 PUSHJ P,REDSTR
14900 SETOM @-1(P) ;ASSUME FAILED
15000 TTCALL 5,TEMP ;ARE THERE CHARS?
15100 JRST FINSTR ;NO
15200 SETZM @-1(P) ;YES, GET THEM
15300 ;;#GF# DCS 2-1-72 (3-3)
15400 JRST INS3 ;USE INCHWL'S LOOP, NOT INSTR'S
15500 ;;#GF#
15600
15700 HERE (INSTRL) PUSHJ P,SAVE
15800 MOVE LPSA,X22
15900 PUSHJ P,REDSTR
16000 TTCALL 4,TEMP
16100 MOVE B,-1(P)
16200 JRST INS2
16300
16400 HERE (INSTRS) PUSHJ P,SAVE
16500 MOVE LPSA,X33
16600 PUSHJ P,REDSTR
16700 SETOM @-2(P)
16800 TTCALL 5,TEMP
16900 JRST FINSTR
17000 SETZM @-2(P)
17100 MOVE B,-1(P)
17200 JRST INS2
17300
17400 HERE (CLRBUF) TTCALL 11,
17500 POPJ P,
17600
17700 HERE (TTYINS) PUSHJ P,SAVE
17800 PUSHJ P,REDSTR ;PREPARE TO MAKE A STRING
17900 MOVE LPSA,X33
18000 SETOM @-1(P) ;ASSUME NO CHARS
18100 TTCALL 5,D ;SEE IF LINES WAITING
18200 JRST FINS1 ;NONE WAINTING
18300 ;;%##% WILL DO INCHRW UUO IN LOOP
18400 MOVE B,[TTCALL D]
18500 JRST TYIN1 ;GO AHEAD
18600
18700 HERE (TTYINL)
18800 PUSHJ P,SAVE
18900 TTCALL 4,D ;WAIT FOR A LINE
19000 MOVE B,[ TTCALL 4,D]
19100 JRST TYIN
19200
19300 HERE (TTYIN) PUSHJ P,SAVE
19400 TTCALL D ;GET A CHAR
19500 MOVE B,[TTCALL D] ;FOR LOOP
19600
19700 TYIN: PUSHJ P,REDSTR ;PREPARE STACK,A,STRNGC FOR A STRING
19800 MOVE LPSA,X33 ;PREPARE TO RETURN
19900 TYIN1: SETZM @-1(P) ;ASSUME NO BREAK CHAR
20000 SKIPL C,-2(P) ;TABLE #
20100 CAILE C,=18
20200 ERR <TTYIN: there are only 18 break tables>
20300 HRRZ TEMP,USER
20400 ADD TEMP,C ;TABLE NO(USER)
20500 MOVEI Z,1 ;FOR TESTING LINE NUMBERS
20600 SKIPN LINTBL(TEMP) ;DON'T LET TEST SUCCEED IF
20700 MOVEI Z,0 ;WE'RE TO LET LINE NUMBERS THRU
20800 MOVE FF,BRKMSK(C) ;GET MASK FOR THIS TABLE
20900 ;;%##% BREAK TABLE CONVERSION
21000 TRNE FF,@BRKCVT(USER) ;SPECIFY UC COERCION
21100 TLOA C,400000 ;YES
21200 TLZ C,400000 ;NO
21300 ;;%##%
21400 HRRZ Y,USER
21500 ADD Y,[XWD D,BRKTBL] ;BRKTBL+RLC(USER)
21600 JRST TTYN1
21700 ;;%##%
21800 TTYN: XCT B ;1 CHAR
21900 TTYN1:
22000 ;;%##%
22100 JUMPGE C,TT.NUC ;COERCE BECAUSE OF BRK TBL ?
22200 CAIL D,"a" ;ONLY IF LC
22300 CAILE D,"z"
22400 JRST TT.TSB ;GO TEST BREAK
22500 TRZ D,40 ;MAKE UC
22600 JRST TT.TSB
22700 TT.NUC: KONVERT(D) ;MAY TURN TO UC BECAUSE OF TTY
22800 TT.TSB:
22900 ;;%##%
23000 TDNE FF,@Y ;BREAK OR OMIT?
23100 JRST TTYSPC ; YES, FIND OUT WHICH
23200 TTYC: IDPB D,TOPBYTE(USER) ;PUT IT AWAY
23300 ;;%##% BE SURE DONT EAT MORE AT A TIME THAN CAN BLOAT
23400 AOJL A,TTYN ;COUNT AND CONTINUE
23500 TTNMOR: PUSHJ P,CHRMOR ;ALLOW FOR MORE CHARS
23600 JRST TTYN ;GO GO GO
23700
23800 TTYSPC: HLLZ TEMP,@Y ;WHICH?
23900 TDNN TEMP,FF
24000 JRST TTYN ;OMIT
24100 MOVEM D,@-1(P)
24200 MOVE Y,-2(P) ;WHAT TO DO WITH IT
24300 ADD Y,USER
24400 SKIPN Y,DSPTBL(Y)
24500 JRST FINS1 ;DONE, NO SAVE
24600 JUMPL Y,TTYAPP ;APPEND
24700 ERR <TTYIN: cannot retain break char>,1,FINS1
24800 TTYAPP: IDPB D,TOPBYTE(USER) ;COUNT THE BREAK CHAR
24900 ADDI A,1 ;ONE MORE HAPPY CHAR
25000 JRST FINS1
25100
25200 ;;%##% ALLOW FOR ANOTHER CHUNK OF CHARS
25300
25400 CHRMOR: ADDI A,TTWCHR ;A ← NUMBER CHARS USED
25500 ADDM A,-1(SP) ;UPDATE COUNT
25600 PUSH P,[TTWCHR] ;GET SOME MORE
25700 PUSHJ P,.SONTP ;BE SURE ROOM & ALIGNED
25800 MOVNI A,TTWCHR ;REFRESH THE COUNT
25900 POPJ P,
26000
26100
26200
26300 HEREFK(TTYUP,.TTYUP)
26400 ;;%##% FLAGS TTY TRANSLATION TO UPPER CASE & RETURNS OLD FLAG
26500 MOVE USER,GOGTAB
26600 MOVE A,-1(P)
26700 EXCH A,TTYCVT(USER)
26800 SUB P,X22
26900 JRST @2(P) ;RETURN
27000
27100
27200 ENDCOM(TTY)
27300 EXPO <
27400 COMPIL(PTY)
27500 ENDCOM(PTY)
27600 >;EXPO
27700 NOEXPO <
27800 COMPIL(PTY,<PTYGET,PTYREL,PTIFRE,PTOCNT,PTCHRW,PTCHRS
27900 ENTINT <PTOCHS,PTOCHW,PTOSTR,BACKUP,LODED,PTYALL,PTYSTR,PTYIN>
28000 ENTINT <PTYSTL,PTYGTL>>
28100 ,<SAVE,RESTR,X11,X22,X33,INSET,CAT,STRNGC,GOGTAB,BRKMSK,.SKIP.>
28200 ,<PTY ROUTINES>)
00100 COMMENT ⊗Ptyuuo functions ⊗
00200
00300 OPDEF PTYUUO [711B8]
00400
00500 DSCR PTYUUO FUNCTIONS
00600 CAL SAIL
00700 ⊗
00800 COMMENT ⊗
00900 BEGIN "PTYSPC"
01000 INTEGER PROCEDURE PTYGET;
01100 PROCEDURE PTYREL(INTEGER LINE);
01200 INTEGER PROCEDURE PTIFRE(INTEGER LINE);
01300 INTEGER PROCEDURE PTOCNT(INTEGER LINE);
01400 INTEGER PROCEDURE PTCHRS(INTEGER LINE);
01500 PROCEDURE PTOCHS(INTEGER LINE,CHAR);
01600 PROCEDURE PTOCHW(INTEGER LINE,CHAR);
01700 PROCEDURE PTOSTR(INTEGER LINE; STRING INFORMATION);
01800 PROCEDURE LODED(STRING TRYAGAIN);
01900 STRING PROCEDURE PTYALL(INTEGER LINE);
02000 PROCEDURE BACKUP;
02100 STRING PROCEDURE PTYSTR(INTEGER LINE,BRCHAR);
02200 STRING PROCEDURE PTYIN(INTEGER LINE,BKTBL; REFERENCE INTEGER BRCHAR);
02300
02400 END "PTYSPC"
02500
02600 ⊗
02700
02800
02900 HERE (PTYGET)
03000 SETOM .SKIP.
03100 MOVEI A,0
03200 PTYUUO A
03300 SETZM .SKIP.
03400 POPJ P,
03500
03600 HERE (PTYREL)
03700 POP P,(P)
03800 EXCH A,(P)
03900 PTYUUO 1,A
04000 POP P,A
04100 JRST @2(P)
04200
04300 HERE (PTYGTL) PUSH P,(P) ;ANOTHER COPY OF RETURN ADDRESS.
04400 PTYUUO 13,-2(P);POINT AT PTY LINE NUMBER
04500 MOVE A,-1(P) ;RESULT.
04600 SUB P,X33
04700 JRST @3(P) ;AND RETURN.
04800
04900 HERE (PTYSTL) PTYUUO 14,-2(P);POINTED AT LINE NUMBER!
05000 SUB P,X33
05100 JRST @3(P)
05200
05300 HERE (PTIFRE)
05400 MOVE TEMP,[PTYUUO 2,0]
05500 JRST %PTY1
05600
05700 HERE (PTOCNT)
05800 SKIPA TEMP,[PTYUUO 3,0]
05900
06000 HERE (PTCHRW)
06100 MOVE TEMP,[PTYUUO 5,0]
06200 %PTY1: POP P,(P)
06300 EXCH 0,(P)
06400 XCT TEMP
06500 POP P,0
06600 JRST @2(P)
06700
06800 HERE (PTCHRS)
06900 POP P,(P)
07000 EXCH 0,(P)
07100 PTYUUO 4,0
07200 MOVNI A,1
07300 POP P,0
07400 JRST @2(P)
07500
07600 HERE (PTOCHS)
07700 SKIPA TEMP,[PTYUUO 6,0]
07800
07900 HERE (PTOCHW)
08000 MOVE TEMP,[PTYUUO 7,0]
08100 SETOM .SKIP.
08200 POP P,(P)
08300 EXCH A,(P)
08400 EXCH 0,-1(P)
08500 XCT TEMP
08600 SETZM .SKIP.
08700 POP P,A
08800 POP P,0
08900 JRST @3(P)
09000
09100 HERE (LODED)
09200 MOVEI TEMP,0
09300 EXCH TEMP,(P)
09400 PUSH P,TEMP
09500 SKIPA TEMP,[PTYUUO 15,-1(SP)]
09600
09700 HERE (PTOSTR)
09800 MOVE TEMP,[PTYUUO 11,-1(SP)]
09900 PUSH P,TEMP
10000 MOVE USER,GOGTAB
10100 PUSHJ P,INSET
10200 PUSH SP,[1]
10300 PUSH SP,[POINT 7,[0]]
10400 PUSHJ P,CAT
10500 POP P,TEMP
10600 POP P,(P)
10700 POP P,-1(SP)
10800 XCT TEMP
10900 SUB SP,X22
11000 JRST @2(P)
11100
11200 HERE (BACKUP)
11300 TTYUUO 10,
11400 POPJ P,
11500
11600 HERE (PTYALL)
11700 PUSHJ P,SAVE
11800 MOVE 0,-1(P) ;LINE NUMBER
11900 PTYUUO 3,0
12000 JUMPE A,[PUSH SP,[0]
12100 PUSH SP,[0]
12200 JRST ALLQ]
12300 MOVEI A,=450
12400 ADDM A,REMCHR(USER)
12500 SKIPL REMCHR(USER)
12600 PUSHJ P,STRNGC
12700 PUSHJ P,INSET
12800 PUSH SP,-1(P) ;PTY LINE NUMBER
12900 PUSH SP,TOPBYTE(USER) ;AND BYTE POINTER.
13000 PTYUUO 10,-1(SP) ;AND ASK FOR ALL THAT IS THERE.
13100 MOVEI B,0
13200 MOVE C,(SP) ;BYTE POINTER.
13300 ;;#IN# 7-11-72 DCS TOPBYTE INVALIDLY UPDATED (ONE TOO FAR)
13400 SOMMOR: MOVE LPSA,C ;LAG BY ONE #IN#
13500 ILDB 0,C ;GET CHAR
13600 JUMPE 0,ALLDUN
13700 AOJA B,SOMMOR
13800 ALLDUN: CAILE B,=445
13900 ERR <PTYALL OVERFLOW -- IT JUST CAN'T HAPPEN!!!!>
14000 HRROM B,-1(SP) ;SAVE AS RESULT.
14100 MOVEM LPSA,TOPBYTE(USER);THIS IS WHERE TO START ENXT ITEM. #IN#
14200 ;;#IN#
14300 SUBI B,=156 ;-ESTIMATE
14400 ADDM B,REMCHR(USER) ;AND UPDATE FREE COUTN.
14500 ALLQ: MOVE LPSA,X22
14600 JRST RESTR
14700
14800 %REDSTR:SKIPE SGLIGN(USER)
14900 PUSHJ P,INSET
15000 MOVEI A,=100
15100 ADDM A,REMCHR(USER)
15200 SKIPLE REMCHR(USER)
15300 PUSHJ P,STRNGC
15400 MOVNI A,=100
15500 PUSH SP,[0] ;NULL STRING IF NOTHING DONE
15600 PUSH SP,TOPBYTE(USER)
15700 POPJ P,
15800
15900 %FINSTR: CAIN TEMP,15 ;REMOVE LFD IF CR BROKE IT
16000 ;;#PO# ! RHT THIS USED TO BE CDB (=11) & MUNGED 12
16100 ;; USE C & D INSTEAD
16200 PTYUUO 5,C ;HE USED TO SAY CDB
16300 %FINS1: ADDM A,REMCHR(USER) ;NUMBER NOT USED
16400 ADDI A,=100 ;NUMBER USED
16500 HRROM A,-1(SP) ; AND TO STRING COUNT WORD
16600 JRST RESTR
16700
16800 HERE (PTYSTR)
16900 PUSHJ P,SAVE
17000 PUSHJ P,%REDSTR
17100 ;;#PO#
17200 MOVE C,-2(P)
17300 MOVE B,-1(P) ;BREAK CHAR
17400 MOVE LPSA,X33 ;# TO REMOVE
17500 ;;#PO# (2 LINES)
17600 %INS1: PTYUUO 5,C ;NEXT CHAR
17700 %INS2: CAMN D,B ;BREAK?
17800 JRST %FINSTR ; YES, ALL DONE
17900 ;;#PO#
18000 IDPB D,TOPBYTE(USER) ;PUT IT AWAY AND
18100 AOJA A,%INS1 ; GO BACK FOR MORE
18200
18300 JRST %INS2
18400
18500 HERE (PTYIN) PUSHJ P,SAVE
18600 ;;#PO# (2 LINES)
18700 MOVE C,-3(P)
18800 PTYUUO 5,C
18900
19000 %TYIN: PUSHJ P,%REDSTR ;PREPARE STACK,A,STRNGC FOR A STRING
19100 MOVE LPSA,[XWD 4,4] ;PREPARE TO RETURN
19200 %TYIN1: SETZM @-1(P) ;ASSUME NO BREAK CHAR
19300 SKIPL T,-2(P) ;TABLE # (INTO AC 11)
19400 CAILE T,=18
19500 ERR <PTYIN: there are only 18 break tables>
19600 HRRZ TEMP,USER
19700 ADD TEMP,T ;TABLE NO(USER)
19800 MOVEI Z,1 ;FOR TESTING LINE NUMBERS
19900 SKIPN LINTBL(TEMP) ;DON'T LET TEST SUCCEED IF
20000 MOVEI Z,0 ;WE'RE TO LET LINE NUMBERS THRU
20100 MOVE FF,BRKMSK(T) ;GET MASK FOR THIS TABLE
20200 HRRZ Y,USER
20300 ;;#PO# !
20400 ADD Y,[XWD D,BRKTBL] ;BRKTBL+RLC(USER)
20500 JRST %TTYN1
20600 ;;#PO# !
20700 %TTYN: PTYUUO 5,C
20800 %TTYN1: TDNE FF,@Y ;BREAK OR OMIT?
20900 JRST %TTYSPC ; YES, FIND OUT WHICH
21000 ;;#PO# !
21100 %TTYC: IDPB D,TOPBYTE(USER) ;PUT IT AWAY
21200 AOJL A,%TTYN ;COUNT AND CONTINUE
21300 JRST %FINS1 ;DONE
21400 %TTYSPC: HLLZ TEMP,@Y ;WHICH?
21500 TDNN TEMP,FF
21600 JRST %TTYN ;OMIT
21700 ;;#PO# !
21800 MOVEM D,@-1(P)
21900 MOVE Y,-2(P) ;WHAT TO DO WITH IT
22000 ADD Y,USER
22100 SKIPN Y,DSPTBL(Y)
22200 JRST %FINS1 ;DONE, NO SAVE
22300 JUMPL Y,%TTYAPP ;APPEND
22400 ERR <PTYIN: cannot retain break char>,1,%FINS1
22500 ;;#PO#
22600 %TTYAPP: IDPB D,TOPBYTE(USER) ;COUNT THE BREAK CHAR
22700 ADDI A,1 ;ONE MORE HAPPY CHAR
22800 JRST %FINS1
22900
23000 ENDCOM(PTY)
23100 >;NOEXPO
23200
23300 IFN ALWAYS,<
23400 BEND IOSER>
23500 DSCR BEND IOSER
23600 ⊗
23700