perm filename IOSER[X,AIL]6 blob
sn#106787 filedate 1974-06-15 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00034 PAGES VERSION 17-1(34)
RECORD PAGE DESCRIPTION
00001 00001
00004 00002 HISTORY
00011 00003 Indices, Bits for IOSER
00014 00004 Simio, Ioinst, Lpryer, Cserr
00022 00005 Getchn
00025 00006 Filnam
00029 00007 Flscan
00031 00008 Open
00037 00009
00043 00010 Release
00048 00011 Lookup, Enter
00051 00012 Fileinfo
00053 00013 Out
00056 00014 Input
00066 00015 Realin, Realscan
00068 00016 Intin, Intscan
00070 00017 DSCR NUMIN
00073 00018 NUMIN -- CONTD.
00077 00019 SCAN (CALLED BY NUMIN AND STRIN)
00081 00020 Character table for SCAN (Realscan,Intscan,Realin,Intin)
00083 00021 DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
00085 00022 Arryout, Wordout
00090 00023 Arryin, Wordin
00100 00024 Linout
00103 00025 Breakset
00107 00026 Setbreak
00109 00027 Stdbrk
00111 00028 Close, Closin, Closo
00113 00029 Mtape
00115 00030 Useti, Useto, Rename
00117 00031 Usercon
00119 00032 Ttyuuo functions
00122 00033
00133 00034 Ptyuuo functions
00141 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021 102100000042 ⊗;
COMMENT ⊗
VERSION 17-1(34) 6-15-74
VERSION 17-1(33) 6-15-74
VERSION 17-1(32) 3-26-74 BY RHT FEAT %AX% FINISH UP SETPL (POLISH IT LATER!!!)
VERSION 17-1(31) 3-26-74 BY RHT SOMEONE (ON 12 MARCH 1974) RAN SOS ON THIS FILE!
IF ANY TIME BOMBS WERE PLANTED, WE WILL FIND OUT!
VERSION 17-1(30) 2-22-74 BY RHT FEAT %BG% ADD BREAKSET MODE "F"
VERSION 17-1(29) 2-1-74 BY RHT BUG #QY# USBSTS NEEDED PATCHING
VERSION 17-1(28) 2-1-74
VERSION 17-1(27) 1-12-74 BY RHT MAKE COUNT RIGHT IN INOUT
VERSION 17-1(26) 1-12-74
VERSION 17-1(25) 1-12-74 BY RHT FIX COMPIL FOR SAITTY
VERSION 17-1(24) 1-11-74 BY RHT TTYINL STUFF
VERSION 17-1(23) 1-11-74 BY RHT MERGE IN CMU CHANGES
VERSION 17-1(22) 1-11-74
VERSION 17-1(21) 1-11-74
VERSION 17-1(20) 1-11-74
VERSION 17-1(19) 1-11-74
VERSION 17-1(18) 12-15-73 BY RFS FIX BUGS QC,QD.
VERSION 17-1(17) 12-10-73 BY JRL REMOVE LAST REFERENCES TO PGNNO
VERSION 17-1(16) 12-10-73
VERSION 17-1(15) 12-10-73
VERSION 17-1(14) 12-8-73 BY JRL REMOVE SPECIAL STANFORD CHARACTERS(WHERE POSSIBLE)
VERSION 17-1(13) 12-8-73 BY RFS MAKE ALTMODE 33 FOR EXPORT SYSTEMS
VERSION 17-1(12) 12-5-73 BY RHT BUG #PO#
VERSION 17-1(11) 12-5-73
VERSION 17-1(10) 12-5-73
VERSION 17-1(9) 12-3-73 BY RFS REMOVE ALL III DISPLAY STUFF
VERSION 17-1(8) 12-2-73 BY RHT FIX INPUT
VERSION 17-1(7) 12-2-73 BY RLS EDIT
VERSION 17-1(6) 12-2-73 BY RHT ALSO SOME WRD SPARES
VERSION 17-1(5) 12-2-73 BY RHT FEAT %AV% CHNCDB. ALSO SPARES ADDED TO OPN & BRK
VERSION 17-1(4) 12-2-73
VERSION 17-1(3) 12-1-73 BY RLS BUG #PM# DONT LOSE A CHAR IN INPUT
VERSION 17-1(2) 12-1-73 BY RLS ADD SETPL FUNCTION
VERSION 17-1(1) 7-27-73 BY JRL CHANGE OPEN TO FACT THAT RELEASE NOW TAKES TWO ARGUMENTS
VERSION 17-1(0) 7-26-73 BY RHT **** VERSION 17 ****
VERSION 16-2(45) 5-7-73 BY JRL CHANGE PTYALL TO HANDLE LARGER BUFFERS
VERSION 16-2(44) 3-21-73 BY JRL ADD COMPIL(SAIDM3)
VERSION 16-2(43) 2-25-73 BY RHT BUG #LP# GO TO OUT OF PROCESS SHOULDNT LOOP!
VERSION 16-2(42) 2-14-73 BY RHT BUG #LM# TYPO IN PITBND
VERSION 16-2(41) 1-9-73 BY RHT REPAIR COMPIL FOR SAIPIT
VERSION 16-2(40) 12-2-72 BY RHT MODIFY PIT STUFF FOR NEW INFOTAB &DATAB
VERSION 16-2(39) 12-1-72 BY JRL CHANGE LEAP INDEX USED TO CALL FRELS WITHIN BEXIT
VERSION 16-2(38) 11-28-72 BY RHT ADD CLEANUPS TO BEXIT CODE
VERSION 16-2(37) 9-24-72 BY JRL LIBRARY REQUESTS
VERSION 16-2(36) 9-21-72 BY JRL ADD DADDY CURSCB ETC TO DUM
VERSION 16-2(35) 8-31-72 BY JRL RELEASE VALUE SETS CORRECTLY IN STKUWD
VERSION 16-2(34) 8-27-72 BY RHT CHANGE SPOT IN WHICH STKUWD SAVES RETN
VERSION 16-2(33) 8-23-72 BY JRL ADD FORGET CONTEXT CODE TO BEXIT
VERSION 16-2(32) 8-14-72 BY RHT EVAL NOW NAMED APPLY
VERSION 16-2(31) 7-22-72 BY RHT ADD KILL LIST TO BEXIT
VERSION 16-2(30) 7-12-72 BY DCS BUG #IN# PTYALL INVALID REMCHR PROBLEM
VERSION 16-2(29) 7-3-72 BY DCS MANY THINGS
VERSION 16-2(28) 6-7-72 BY DCS BUG #HO# RETURN BOTH ADDRESSES FROM ..ARCOP FOR .MES2
VERSION 16-2(27) 5-24-72 BY RHT CHANGE STKUWD TO LOOK AT PPDA
VERSION 16-2(26) 5-15-72 BY JRL ARRPDP BUG AGAIN
VERSION 16-2(24) 5-11-72 BY DCS BUG #HC# BETTER EXPO OUTSTR
VERSION 16-2(23) 5-11-72 BY DCS BUG #HA# IMPRV. ERR. ENB, FIX MUDDY FEET IN EXPO
VERSION 16-2(22) 5-11-72 BY DCS BUG #GT# ALLOW LARGE OCTAL PPNS
VERSION 15-6(17-21) 5-4-72
VERSION 15-6(17) 3-7-72 BY DCS FIX OUTSTR(NULL) GARBAGING
VERSION 15-6(7-16) 2-20-72
VERSION 15-6(6) 2-18-72 BY RHT CREATE THE NEW WORLD
VERSION 15-2(5) 2-6-72 BY DCS BUG #FQ# (WD-ARRY)(IN-OUT) WORD COUNT KEPT RIGHT, IOERR OK, DUMP MODE OK
VERSION 15-2(4) 2-5-72 BY DCS BUG #GI# REMOVE TOPSTR
VERSION 15-2(3) 2-1-72 BY DCS BUG #GF# INCHWL BREAKS ON MORE THINGS, TELLS WHAT THEY ARE
VERSION 15-2(2) 1-25-72 BY DCS BUG #GD# Fix non-standard buffer size setup in OPEN
VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER
⊗;
COMMENT ⊗Indices, Bits for IOSER ⊗
LSTON (IOSER)
IFN ALWAYS,<BEGIN IOSER>
DSCR IOSER -- IOSER GENERAL DISCUSSION
;SEE GOGOL FOR MORE DETAILS
; FORMAT OF CDBs
DMODE ←← 0 ;DATA MODE
DNAME ←← 1 ;DEVICE
BFHED ←← 2 ;HEADER POINTERS
OBPNT ←← 3 ;OUTPUT BUFFER POINTER
OBP ←← 4 ;OUTPUT BYTE POINTER
OCOWNT ←← 5 ;OUTPUT BYTE COUNT
ONAME ←← 6 ;OUTPUT FILE NAME -- FOR INFORMATION ONLY
OBUF ←← 7 ;OUTPUT BUFFER LOCATION
IBPNT ←←10 ;SAME STUFF FOR INPUT
IBP ←←11
ICOWNT ←←12
INAME ←←13
IBUF ←←14
ICOUNT ←←15 ;INPUT DATA COUNT LIMIT ADDRESS
BRCHAR ←←16 ;XWD TTYDEV FLAG, INPUT BREAK CHAR ADDR
TTYDEV ←←16 ;LH -1 IF DEVICE IS A TTY -- USED BY OUT
ENDFL ←←17 ;INPUT END OF FILE FLAG ADDR
ERRTST ←←20 ;USER ERROR BITS SPECIFICATION WORD
LINNUM ←←21 ;ADDR OF LINE NUMBER WORD (SETPL FUNCTION)
PAGNUM ←←22 ;ADDR OF PAGE NUMBER WORD (SETPL FUNCTION)
SOSNUM ←←23 ;ADDR OF SOS NUMBER WORD (SETPL FUNCTION)
; SIMIO INDICES
?IOSTATUS ←←0
?IOIN ←←1 ;SEE EXPLANATIONS IN SIMIO ROUTINE
?IODIN ←←2
?IOOUT ←←3
?IODOUT ←←4
?IOCLOSE ←←5
?IORELEASE ←←6
?IOINBUF ←←7
?IOOUTBUF ←←10
?IOSETI ←←11
?IOSETO ←←12
;;%##% A NEW GOODIE
?SETIOSTS ←←13
?IOOPEN ←←14
?IOLOOKUP ←←15
?IOENTER ←←16
?IORENAME ←←17
⊗
COMPIL(SIM,<SIMIO,CSERR,LPRYER>,<GOGTAB>
,<SIMIO, CSERR, LPRYER -- SUPPORT ROUTINES>)
COMMENT ⊗Simio, Ioinst, Lpryer, Cserr ⊗
DSCR SIMIO
CAL XCT INDEX,SIMIO
PAR AC field is index into instruction table (see below)
CHNL contains I/O channel number
other params can be gleaned from instruction table
RES an I/O instruction is executed. Routine skips if I/O instr did.
If the INDEX is LEQ 12, and if the instruction skips (error or EOF),
status is presented in LH of user's EOF vbl (@ENDFL(CDB)), so he
can test it, or an error message is provided (depending on user-
enabling). This simplifies many I/O routines.
SID NONE
DES This routine makes I/O instructions re-entrant. The problem is
that the channel cannot be referenced indirectly.
⊗
↑↑SIMIO: PUSHJ P,.+1 ;SAVE PC OF XCT
PUSH P,C ;SAVE C
MOVE C,-1(P) ;ASSUME SKIP RETURN
LDB C,[POINT 4,-1(C),12] ;INDEX OF XCT
JUMPE C,USTST ;WANT STATUS BITS ONLY
CAIL C,13 ;NOW SPLIT HIGH AND LOW INDICES
JRST ALTIO ;SKIP RETURN CHECK ONLY
;;%##% CHECK TO NOT SCREW STANDARD DEC LOSERS
EXPO <
CAIN C,IOIN ;
JRST ISIOU ;
CAIE C,IOOUT ;IN OR OUT ?
JRST NOTIOU ;NOPE
ISIOU: SKIPG @USBTST(C) ;CHECK FOR NO BUFFERS (& MORE AT CMU)
JRST USFUNY ;NO BUFFERS, ETC.
>;EXPO
NOTIOU:MOVE C,IOINST(C) ;GET INSTRUCTION
DPB CHNL,[POINT 4,C,12] ;CHANNEL NUMBER
XCT C ;DO OPERATION
JRST USOUT ;ALL KOSHER, NO EOF OR ERR
USTST: MOVE C,[GETSTS C] ;WHA-
DPB CHNL,[POINT 4,C,12] ; T HAPPEN-
XCT C ; ED?
;;%##% SAVE STATUS BITS
MOVEM C,FSTATS(USER)
CMU <
USERF:
>;CMU
TRZ C,10000 ;IOACT BIT, USER LOOKUP CHECK BIT
HRLZM C,@ENDFL(CDB) ;GIVE USER THE BITS
TDNN C,ERRTST(CDB) ;ANY HE CAN'T HANDLE?
JUMPA CHNL,USSKIP ;NOPE, JUST SKIP-RETURN
ERR <I-O DEVICE ERROR ON CHANNEL >,7 ;JUMPA TO PROVIDE CHANNEL AC
USSKIP: AOS -1(P) ;SKIP-RETURN
USOUT: POP P,C ;RESTORE C
POPJ P, ;DONE
ALTIO: MOVE C,IOINST(C) ;GET INSTR
DPB CHNL,[POINT 4,C,12]
XCT C ;DO IT
JRST USOUT ;NO SKIP
JRST USSKIP ;SKIP
EXPO <
USFUNY:
CMU < SKIPE @USBTST(C) ;FUNNY DEVICE?
JRST REALTM ; YES.
>;CMU
JUMP CHNL, ;FOR THE ERR MSG
ERR <NO BUFFERS ASSIGNED FOR I-O CHAN >,7
JRST USSKIP
CMU,< COMMENT ⊗ THIS NONSENSE IS A SPECIAL MODE FOR
THE CMU SPEECH DEVICES. ESSENTIALLY, IT DOES EVERTHING
AS NORMAL, EXCEPT THAT IT PICKS UP THE TIMING ERR AND
RUN-OUT-OF BUFFERS BIT OF THE
I/O STATUS FROM THE STATUS WORD IN THE BUFFER HEADER,
INSTEAD OF USING THE BIT FROM THE GETSTS. ⊗
TIMERR←←100000 ;TIMING ERR BIT FOR SPEECH DEVICES
ROBERR←←200000 ;RUN-OUT-OF-BUFFER ERR
REALTM: PUSH P,D ;NEED ANOTHER AC
CAIE C,IOIN ;INPUTTING?
JRST REALOT ; NO
MOVSI C,(<IN>)
DPB CHNL,[POINT 4,C,12] ;CHAN #
XCT C ;DO THE INPUT
JRST REALOK ;NO ERR, SO FAR
MOVE C,[GETSTS C]
DPB CHNL,[POINT 4,C,12] ;LOOKS FAMILIAR
XCT C
TRZA C,TIMERR!ROBERR ;TURN OFF THE ONES FROM THE GETSTS
REALOK: MOVEI C,0
HRRZ D,IBPNT(CDB) ;ADDRESS OF THE NEW BUFFER
IOR C,-1(D) ;THE BITS FROM THE BUFFER
REALRT: POP P,D ;RESTORE THE AC
TRNN C,760000 ;ERR OR EOF?
JRST USOUT ; NO
JRST USERF ; YES, GO LOOK AT IT
REALOT: MOVE C,[GETSTS C]
DPB CHNL,[POINT 4,C,12]
XCT C
TRNN C,ROBERR ;STOPPED FOR A ROB?
JRST REAL5 ; NO
HRRI D,(C) ;GET THE BITS
TRZ D,760000 ;TURN OFF THE ERRS
HRLI D,(<SETSTS>)
DPB CHNL,[POINT 4,D,12]
XCT D
REAL5: MOVSI D,(<OUT>)
DPB CHNL,[POINT 4,D,12]
XCT D
JRST REALRT
JRST REALRT ;IGNORE NOW, CATCH THE NEXT TIME THRU
>;CMU
USBTST←.-1
XWD CDB,IBUF ;1
;;#QY# ! RHT 2-1-74 NEEDED A DUMMY HERE.
777777 ;@ THRU THIS WILL BE ILL MEM REF
XWD CDB,OBUF ;3
>;EXPO
DSCR INSTRUCTION TABLE
⊗
IOINST←.-1 ;IOSTATUS ←← 0 GET STATUS
IN ;IOIN ←← 1 BUFFERED INPUT
IN D ;IODIN ←← 2 DUMP MODE INPUT
OUT ;IOOUT ←← 3 BUFFERED OUTPUT
OUT D ;IODOUT ←← 4 DUMP MODE OUTPUT
CLOSE (D) ;IOCLOSE ←← 5 CLOSE I,O, OR BOTH
;; ALLOW USE OF INHIBIT BITS IN RELEASE
RELEASE (D) ;IORELEASE←← 6
INBUF (A) ;IOINBUF ←← 7
OUTBUF (A) ;IOOUTBUF ←←10
USETI (A) ;IOSETI ←←11
USETO (A) ;IOSETO ←←12
;;%##% A NEW GOODIE
SETSTS (A) ; SET IO STATUS
OPEN DMODE(CDB) ;IOOPEN ←←14
LOOKUP FNAME(USER);IOLOOKUP←←15
ENTER FNAME(USER);IOENTER ←←16
RENAME FNAME(USER);IORENAME←←17
HERE(CSERR) MOVE USER,GOGTAB
POP P,UUO1(USER) ;STANDARD PLACE
ERR <CASE INDEX OVERFLOW, VALUE IS >,13
JRST @UUO1(USER) ;RETURN OK
HERE (LPRYER) ERR <DATUM OF ARRAY NOT THERE>,1
POPJ P,
ENDCOM(SAV)
COMPIL(CHN,<GETCHN,NOTOPN,GETCHAN>,<GOGTAB>,<GETCHN, NOTOPN, GETCHAN>)
COMMENT ⊗Getchn ⊗
DSCR Getchn, Getchan
PAR A -- addr of ASCII for routine name
CHNL -- I/O channel number from SAIL call
RES -- CHNL contains actual I/O channel number (diff for shared TTY)
CDB contains ptr to actual CDB table for that channel
SID A(lh) is changed
DES normally just sets up CHNL and CDB
if error occurs (channel out of bounds, already open), a fatal message
is printed, using the address in A to get the routine name.
This routine is called by most I/O routines, having saved ACs and
fetched CHNL.
⊗
GETCHN:
HRLI A,(<PUUO 3,0>) ;PREPARE FOR ERR MESS
TRZE CHNL,777760 ;CHECK FOR VALID CHANNEL NO
JRST NOTVALID ;INVALID CHANNEL NUMBER
SKIPE CDB,@CDBLOC(USER) ;IS CHANNEL OPEN? (CDBLOC SET BY ALLOC)
POPJ P,
NOTOPN:
XCT A ;PRINT ROUTINE NAME
ERR <: CHANNEL OR FILE NOT OPEN>
NOTVALID:
XCT A ;ROUTINE NAME
ERR <: CHANNEL NUMBER INVALID>
DSCR INTEGER←GETCHAN;
CAL SAIL
⊗
HERE (GETCHAN)
MOVE USER,GOGTAB
ADD USER,[XWD A,CHANS] ;MAKE @ WORD
MOVEI A,1 ;START AT CHANNEL 1
CHLUP: SKIPN @USER ;IF CHANNEL IS FREE,
POPJ P, ; RETURN
CAIGE A,17 ;CYCLE TO 0?
AOJA A,CHLUP ;NO, TRY NEXT
MOVEI A,0 ;TRY 0
SKIPE @USER ;FREE?
HRROI A,-1 ;NOPE
POPJ P, ;DONE
ENDCOM(CHN)
COMPIL(FIL,<FILNAM>,<FLSCAN,X22>,<FILNAM SCANNING ROUTINE>)
COMMENT ⊗Filnam ⊗
DSCR FILNAM
CAL PUSHJ
PAR file name string on SP stack
of form FILENAME<.EXT><[PROJ,PROG]>
RES FNAME(USER) : SIXBIT /filename/
EXT(USER): SIXBIT /extension,,0/
0
PRPN(USER): SIXBIT /PRJ PRG/ (or zero)
SID uses D,X,Y (4-6), REMOVES STRING FROM STACK
⊗
↑↑FILNAM:
SUB SP,X22 ;ADJUST STACK
FOR II←1,3 <
SETZM FNAME+II(USER)>
MOVEI X,FNAME(USER) ;WHERE TO PUT IT
PUSHJ P,FLSCAN ;GET FILE NAME
JUMPE Y,FLDUN ;FILE NAME ONLY
CAIE Y,"." ;EXTENSION?
JRST FLEXT ;NO, CHECK PPN
MOVEI X,FNAME+1(USER)
PUSHJ P,FLSCAN
FLEXT: JUMPE Y,FLDUN ;NO PPN SPECIFIED
CAIE Y,"["
JRST FLERR ;INVALID CHARACTER
CMU < ;HANDLE PPNS VIA UUO, MAYBE
HRRZS 1(SP) ;LENGTH PART
;SNEAK A LOOK AT FIRST CHAR
SKIPN 1(SP) ;IS THERE A FIRST CHAR?
JRST FLERR ; NO.
MOVE X,2(SP)
ILDB X,X
CAIL X,"0"
CAILE X,"7"
SKIPA ; NOT OCTAL DIGIT
JRST OCTPPN
PUSH P,A ;NEED MORE ROOM
PUSH P,B
SETZM A ;CLEAR THE AREA
SETZM B
SETZM C
MOVEI D,=13+1 ;MAX #CHARS+1
MOVE X,[POINT 7,A] ;DUMP THEM THERE
FLN2: SOSGE 1(SP)
JRST FLERRC ;RAN OUT OF STRING
ILDB Y,2(SP) ;THE NEXT CHAR
CAIN Y,"]" ;THE END?
JRST GOTRB ; YES
JUMPLE D,FLERRC ;WE DON'T WANT ANY MORE CHARACTERS
IDPB Y,X ;STICK THE CHAR THERE
SOJA D,FLN2 ;GET ANOTHER
GOTRB: MOVEI X,A ;THATS WHERE THE UUO WILL FIND THEM
CALLI X,-2 ;CMUDEC UUO
JRST FLERRC ;SOMETHING WRONG
MOVEM X,FNAME+3(USER) ;SAVE IT
AOS -2(P) ;INDICATE SUCCESS
FLERRC: POP P,B
POP P,A
POPJ P,
OCTPPN:
>;CMU
PUSHJ P,[
RJUST: SETZM PROJ(USER)
MOVEI X,PROJ(USER)
PUSHJ P,FLSCAN ;GET PROJ OR PROG IN SIXBIT
IFN SIXSW,<
MOVE X,PROJ(USER)
IMULI D,-6 ;SHIFT FACTOR
LSH X,(D) ;RIGHT-JUSTIFY THE PROJ OR PROG
>;IF SIXSW (SET IN HEAD, USUALLY CONDITIONED ON NOEXPO)
IFE SIXSW,<
MOVEI X,0
;;#GT# DCS 5-11-72 ALLOW LARGE OCTAL NUMBERS AT STD DEC SYSTEMS
MOVE D,PROJ(USER) ;WAS A HLLZ
;;
FBACK: MOVEI C,0
LSHC C,6 ;GET A SIXBIT CHAR
CAIL C,'0'
CAILE C,'7'
JRST FLERR ;INVALID OCTAL
LSH X,3
IORI X,-'0'(C)
JUMPN D,FBACK
>;NOT SIXSW (USUALLY CONDITIONED ON EXPO)
FPOP: POPJ P,]
HRLZM X,FNAME+3(USER)
CAIE Y,","
JRST FLERR ;INVALID CHAR
PUSHJ P,RJUST ;JUSTIFY(AND CONVERT IF EXPORT) PROG #
HRRM X,FNAME+3(USER)
CAIN Y,"]"
FLDUN: AOS (P) ;SUCCESSFUL
FLERR: POPJ P, ;DONE, NOT NECESSARILY RIGHT
ENDCOM(FIL)
COMPIL(FLS,<FLSCAN>,,<FLSCAN ROUTINE>)
COMMENT ⊗Flscan ⊗
DSCR FLSCAN
CAL PUSHJ
PAR X -- addr of destination SIXBIT
1(SP), 2(SP) -- input string
RES sixbit for next filename, etc in word addressed by X
break (punctuation) char in Y (0 if string exhausted)
D,X, input string adjusted
SID only those AC changes listed above (Y, for instance)
⊗
↑↑FLSCAN:
HRRZS 1(SP) ;WANT ONLY LENGTH PART
MOVEI D,6 ;MAX NUMBER PICKED UP
SETZM (X) ;ZERO DESTINATION
HRLI X,440600 ;BYTE POINTER NOW
FLN1: MOVEI Y,0 ;ASSUME NO STRING LEFT
SOSGE 1(SP) ;TEST 0-LENGTH STRING
POPJ P,
ILDB Y,2(SP) ;GET BYTE
CAIE Y,"." ;CHECK VALID BREAK CHAR
CAIN Y,"["
POPJ P,
CAIE Y,"]"
CAIN Y,","
POPJ P,
JUMPE D,FLN1 ;NEED NO MORE CHARS
TRZN Y,100 ;MOVE 100 BIT TO 40 BIT
TRZA Y,40 ; TO CONVERT TO SIXBIT
TRO Y,40 ; (NO CHECKING)
IDPB Y,X ;PUT IT AWAY
SOJA D,FLN1 ;CONTINUE
ENDCOM(FLS)
COMPIL(OPN,<OPEN,RELEASE,SETPL,CHNCDB>
,<GETCHN,SAVE,RESTR,CORGET,FLSCAN,SIMIO,X33,X22,X11,CORREL>
,<OPEN RELEASE AND SETPL FUNCTIONS>)
COMMENT ⊗Open ⊗
DSCR OPEN(CHAN,"DEV",MODE,IBFS,OBFS,@INCNT,@INBRCHR,@INEOF);
CAL SAIL
⊗
COMMENT ⊗
Allocate IBFS input and OBFS output buffers on channel CHAN for
device DEV(SAIL/GOGOL string). Store INCNT, and the INBCHR and INEOF
addresses in a newly allocated CDB (channel data block). Store
all necessary information to carry out I/O on this channel
in the CDB. Mark the channel open.
⊗
.OPN:
HERE (OPEN)
; FIRST RELEASE IF ALREADY OPEN
PUSH P,-7(P)
; RELEAS NOW TAKES TWO ARGS
PUSH P,[0]
PUSHJ P,RELEASE ;SIMPLE
; NEXT SAVE AC'S, SET UP USER REGISTER, OBTAIN A CDB
PUSHJ P,SAVE ;SAVE ACS
MOVEI C,IOTLEN ;SIZE
PUSHJ P,CORGET ;OBTAIN A BLOCK
JRST BADOPN ;CAN'T GET IT
MOVE CDB,B ;CDB ptr to CHANNEL TABLE
MOVEI LPSA,0 ;NOW GET READY IN CASE OF ERROR
SUB SP,X22
; FILL IT WITH NON-CONTROVERSIAL THINGS
POP P,TEMP ;RETURN ADDRESS
POP P,ENDFL(CDB) ;END OF FILE FLAG ADDRESS
POP P,BRCHAR(CDB) ;BREAK CHAR ADDRESS
POP P,ICOUNT(CDB) ;INPUT COUNT ADDRESS
POP P,OBUF(CDB) ;NUMBER OF OUTPUT BUFFERS
POP P,IBUF(CDB) ;NUMBER OF INPUT BUFFERS
POP P,Z ;DATA MODE
POP P,CHNL ;DATA CHANNEL
;; #RX# (CMU = B7=)INITIALIZE SOSNUM AND FRIENDS
SETZM LINNUM(CDB)
SETZM SOSNUM(CDB)
SETZM PAGNUM(CDB)
;; #RX#
CHKCHN CHNL,<OPEN> ;ASSURE VALID
;;#HA# DCS 5-11-72 IMPROVE ERROR ENABLE. ALSO, IN EXPO SYSTEM,
;; AVOID REFERENCES TO PGNNO, WHICH IS same as ERRTST!
HRRZI X,750000 ;ERROR BITS POSSIBLY ENABLED -- WAS A HRROI
;;#HA#
ANDCM X,Z ;ERROR BITS ACTUALLY ENABLED ARE 0
MOVEM X,ERRTST(CDB) ;SAVE ENABLATIONS
TRZ Z,750000 ;REMOVE IRRELEVANT BITS
ILLMOD ←← 777777
CMU <
ILLMOD ←← 377776 ;BIT 400000 FOR SPECIAL DEVICE (CMU)
;BIT 000001 FOR KEEPING NULLS
TLZE Z,10000 ;IOACTIVE BIT TO BE SET ON OPEN ??? (LDE)
TRO Z,10000 ;YES
>;CMU
TLNE Z,ILLMOD ;CHECK VALIDITY SOMEWHAT
ERR <OPEN: INVALID DATA MODE>,1
MOVEM Z,DMODE(CDB) ;STORE MODE
; GET DEVICE NAME
MOVEI X,DNAME(CDB) ;WHERE SIXBIT'S TO GO
PUSHJ P,FLSCAN ;GET DEVICE NAME
;;%##% ONLY GIVE ERROR MESSAGE IF NOT ASKED NOT TO
JUMPN Y,[
SKIPN @ENDFL(CDB) ;FLAGGED??
ERR <INVALID DEVICE NAME FOR OPEN>,1
JRST .+1
]
;IF TTY, MARK TTYDEV FOR OUT
HLRZ TEMP,DNAME(CDB) ;GET LH DEVICE NAME
MOVSI Z,400000 ;BIT TO MARK WITH
;;%##% DO A DEVCHR NOW
;; CAIE TEMP,'TTY' ;IF TTY OR PTY,
CAIN TEMP,'PTY' ; ,
JRST MRKTYB ;MARK AS A TTY
MOVE TEMP,DNAME(CDB) ;PICK UP DEVICE AGAIN (FULL SIXBIT)
CALL6 (TEMP,DEVCHR) ;GET CHARACTERISTICS
TLNE TEMP,10 ;A TTY???
MRKTYB: IORM Z,TTYDEV(CDB); IT'S A TTY
;;%##%
; NOW SET HEADER PTRS IN CDB
HRRZI Z,-1 ;TO TEST RIGHT HALF
SETZM BFHED(CDB) ;CLEAR HEADER POINTER
LDB E,[POINT 4,DMODE(CDB),35] ;DATA MODE
CAIL E,15 ;DUMP MODE?
JRST AGNN ; YES, NO BUFFER HEADER WORD
MOVEI TEMP,OBPNT(CDB) ;IF OUTPUT, SET POINTER
TDNE Z,OBUF(CDB) ;ANY OUTPUT BUFFERS?
HRLM TEMP,BFHED(CDB)
MOVEI TEMP,IBPNT(CDB) ;SAME FOR INPUT
TDNE Z,IBUF(CDB) ;ANY INPUT BUFFERS?
HRRM TEMP,BFHED(CDB)
; NOW OPEN THE FILE, GET THE BUFFERS,ETC.
AGNN: XCT IOOPEN,SIMIO ; OPEN CHAN,MODE
JRST [SKIPE @ENDFL(CDB) ;DOES USER WANT TO KNOW?
JRST NORELO ;YES, RELEASE CDB, ERASE ALL OF ATTEMPT
JRST RTRY]
COMMENT ⊗
ERMAN'S IMPROVED BUFFER GETTER --- DEC. 1970
If a buffer size is specified (lh #buf word), allocate that size, else the
standard size (determined via a dummy XXXBUF, clever soul that LDE is).
"NOTICE WITH AWE THAT NO CORE IS EVER WASTED, AS IN THE INFERIOR OLD WAY" (sic).
⊗
MOVEI Z,0 ;FOR DUMMY (AND REAL) OUTBUF
PUSHJ P,GETBFS ;GET CORE, DO THE OUTBUFS (OR SIMULATIONS)
ADDI CDB,OBUF-OBPNT+1 ;RELOCATE FOR INPUT IN CDB
MOVEI Z,-1
PUSHJ P,GETBFS ;GET CORE, DO INBUFS
SUBI CDB,OBUF-OBPNT+1;RE-RELOCATE
CMU < ;FUNNY INPUT DEVICE
SKIPL DMODE(CDB) ;DID HE SPECIFY TO GET ERRS FROM
; BUFFER HEADER?
JRST STNIT ; NO.
HRLZI TEMP,400000
SKIPE IBUF(CDB) ;INPUT BUFFERS?
JRST [IORM TEMP,IBUF(CDB) ; YES
JRST STNIT]
SKIPE OBUF(CDB) ;OR OUTPUT BUFFERS?
JUMPA CHNL,[IORM TEMP,OBUF(CDB) ; YES
JRST STNIT]
ERR<OPEN: SPEECH DEV BUT NO BUFFERS, CHAN >,7
>;CMU
; FINISH OUT -- SET EOF FLAG IF DESIRED
STNIT: ;SETOM JOBFF ;ONE MUST KNOW WHAT HE IS DOING TO USE
MOVEM CDB,@CDBLOC(USER) ;STORE CDB ADDR IN CHANS TABLE
SETZM @ENDFL(CDB) ;MARK OPEN SUCCESSFUL
JRST RESTR ;RESTORE ACS, RETURN
BADOPN: HRRZ TEMP,JOBREN ;NEXT START WILL ASK ALLOC
HRRM TEMP,JOBSA ;QUESTION
ERR <TOO MANY CHANNELS OR I/O BUFFERS REQUESTED>,1,<(TEMP)>
RTRY: TERPRI <OPEN: DEVICE NOT AVAILABLE>
TERPRI <TYPE "R" TO RETRY, "X" TO GO ON WITHOUT>
PRINT <?>
PUUO TEMP
CAIN TEMP,"R" ;TRY AGAIN?
JRST AGNN ;YES
;;%##%
SETOM @ENDFL(CDB) ;MARK A LOSER
JRST NORELO
;;%##%
GETBFS: SETZM ONAME(CDB) ;CLEAR FILE NAME
HRRZ Y,OBUF(CDB) ;NUMBER OF BUFFERS
HLRZ D,OBUF(CDB) ;SIZE
EXPO <
HRRZS OBUF(CDB) ;MARK FOR SPECIAL TEST
>;EXPO
JUMPE Y,GBUFRT ;NO BUFFERS
JUMPE D,GETDES ;WANTS DEFAULT SIZE
ANDI D,7777 ;MAX BUFFER SIZE
HRLZ A,D ;SIZE IN LH
PUSHJ P,GETCOR ;GET THE CORE (SURPRISE!)
SETZM OCOWNT(CDB) ;IN CASE NO ACTUAL INBUF (OUTBUF) DONE
CAIL E,15 ;DUMP MODE?
JRST GBUFRT ; YES, DON'T ACTUALLY FUDGE UP BUFFERS
NOEXPO <;USE UINBF, UOUTBF
;;#GD# 01-25-72 DCS (1-2) set up JOBFF, Fix XCT, bad count
MOVEM B,JOBFF ;B FROM CORGET HAS BUFFER AREA ADDRESS
SUBI D,2 ;GETCOR INCREMENTED
;;#GD#
HRRZ C,Y
MOVE A,[UINBF C]
JUMPN Z,.+2
MOVE A,[UOUTBF C]
DPB CHNL,[POINT 4,A,12]
;;#GD# 01-25-72 DCS (2-2) (was XCT CHNL, clearly wrong)
XCT A ;DO THE ALLOCATIONS
;;#GD#
POPJ P,
>;NOEXPO
EXPO <
ADDI B,1 ;SECOND WORD
BUFC1: HRR A,B
SOJLE Y,BUFC2
ADD B,D ;NEXT ONE
MOVEM A,(B) ;MAKE POINT TO PREV
JRST BUFC1
BUFC2: MOVE B,OBUF(CDB) ;BACK TO FIRST
MOVEM A,1(B) ;LINK IT TOO
HRLI A,400000 ;RING-USE BIQ
MOVEM A,OBPNT(CDB) ;BUFFER PTR
POPJ P,
>;EXPO
GETCOR: ADDI D,2 ;+2 FOR ACCOUNTING
MOVE C,D
IMUL C,Y ;TOTAL CORE NEEDED
PUSHJ P,CORGET ;GRAB IT
ERR <OPEN: NOT ENUFF CORE FOR BUFFERS>
HRRZM B,OBUF(CDB) ;SAVE SO CAN RELEASE
POPJ P,
GETDES: MOVEI A,1 ;1 DUMMY BUFFER
CAIL E,15 ;GOOD OLD DUMP MODE?
JRST [MOVEI D,202 ;ASSUME THIS, SINCE INBUF/OUTBUF WON'T
JRST GDIT] ; WORK IN DUMP MODE
MOVEI TEMP,BRKDUM-1(USER)
MOVEM TEMP,JOBFF
PUSHJ P,GETIOB ;DUMMY IN/OUBUF
LDB D,[POINT 17,BRKDUM(USER),17] ;GET THE SIZE
GDIT: PUSHJ P,GETCOR ;GET THE CORE
SETZM OCOWNT(CDB) ;CLEAR BYTE COUNT
CAIL E,15 ;DUMP MODE?
JRST GBUFRT ;YES, NO BUFFER STRUCTURE
MOVEM B,JOBFF
MOVE A,Y ;NUMBER OF BUFFERS
PUSHJ P,GETIOB ;NOW FOR REAL
GBUFRT: SETOM JOBFF ;FOR SPITE
POPJ P,
GETIOB: SKIPN Z
XCT IOOUTBUF,SIMIO ;DO OUTBUF
SKIPE Z
XCT IOINBUF,SIMIO ;INBUF
POPJ P,
SUBTTL RELEASE
COMMENT ⊗Release ⊗
DSCR RELEASE(CHANNEL NO,INHIBIT BITS);
CAL SAIL
DES THIS USES THE DEFAULT PARAMETER MECHANISM, 0 DEFAULT FOR INHIBIT BITS
⊗
COMMENT ⊗
Release channel, i/o buffers, channel table if channel is open
Adjust special TTY stuff to reflect lossage if TTY channel
⊗
HERE(RELEASE)
.RELS:
SETOM JOBFF ;MARK INVALID
PUSHJ P,SAVE ;SAVE REGS, GET USER, SAVE RETURN
;; FOLLOWING WAS MOVE LPSA,X22
MOVE LPSA,X33
;; FOLOWING WAS CHNL,-1(P)
MOVE CHNL,-2(P) ;CHANNEL #
CHKCHN CHNL,<RELEASE> ;VALIDATE
SKIPN CDB,@CDBLOC(USER) ;GET ADDR FROM CHANS TABLE-- CHANNEL OPEN?
JRST RESTR ;CHANNEL NOT OPEN, FORGET IT
SETZM @CDBLOC(USER) ;CLEAR CHANS TABLE ENTRY
;; INHIBIT BITS;
HRRZ D,-1(P) ;THE DEFAULT OR USER SPECIFIED INHIBIT BITS
XCT IORELEASE,SIMIO ;RELEASE CHAN,0
HRRZ B,IBUF(CDB) ;RELEASE ANY INPUT
PUSHJ P,BUFREL ; BUFFERS
HRRZ B,OBUF(CDB) ;ALSO OUTPUT
PUSHJ P,BUFREL ; BUFFERS
NORELO: HRRZ B,CDB ;WHERE TO RELEASE
PUSHJ P,CORREL ;GIVE CDB BACK
JRST RESTR ;RESTORE AND RETURN
BUFREL: JUMPN B,CORREL ;RELEASE IF ANY TO RELEASE
POPJ P, ;ELSE RETURN
DSCR SETPL(CHANNEL,@LINNUM,@PAGNUM,@SOSNUM)
CAL SAIL
⊗
HERE(SETPL)
PUSHJ P,SAVE
MOVE CHNL,-4(P) ;GET CHANNEL
PUSHJ P,GETCHN ;VALIDATE, LOAD CDB
POP P,TEMP ;RETURN ADDRESS (GET OUT OF WAY)
POP P,SOSNUM(CDB)
SETZM @SOSNUM(CDB)
POP P,PAGNUM(CDB)
SETZM @PAGNUM(CDB)
POP P,LINNUM(CDB) ;LINE NUMBER
SETZM @LINNUM(CDB)
MOVE LPSA,X11 ;REMOVE CHANNEL NUMBER FROM STACK
JRST RESTR
;;%AV% -- rht
DSCR CHNCDB(CHANNEL);
CAL SAIL
DES RETURNS INTEGER = INPHDR,,OUTHDR
(ACTUALLY COULD BE GOTTEN FROM CDB BY USER, BUT THIS
PROMISSES MORE STABILITY)
⊗
HERE(CHNCDB)
PUSHJ P,SAVE ;
MOVE CHNL,-1(P) ;GET CHANNEL NUMBER
PUSHJ P,GETCHN ;CHECK & LOAD CDB
MOVEI 1,DMODE(CDB) ;GET VALUE
MOVEM 1,RACS+1(USER) ;SO RESTR WINS
MOVE LPSA,X22 ;
JRST RESTR ;RETURN
HERE(OPNSP1) ;PERHAPS PUT GETSTS HERE
;;%##% GOBBLED DOWN TWO SPARE HERES HERE FOR STATUS ROUTINES THAT FOLLOW
ERR <DRYROT IN OPEN SPARES>
ENDCOM (OPN)
;;%##%
COMPIL(STS,<GETSTS,SETSTS>
,<SAVE,RESTR,SIMIO,GOGTAB,GETCHN,X11,X33,X22>
,<GETSTS AND SETSTS>)
COMMENT ⊗GETSTS,SETSTS⊗
DSCR STATUS←GETSTS(CHANNEL);
CAL SAIL
⊗
.STS:
HERE(GETSTS)
PUSHJ P,SAVE
LOADI7 A,<GETSTS>
MOVE CHNL,-1(P) ;CHANNEL #
PUSHJ P,GETCHN
XCT IOSTATUS,SIMIO ;DO THE UUO
JFCL
MOVE A,FSTATS(USER) ;THE RESULT
MOVEM A,RACS+A(USER) ;SO RESTR WORKS
MOVE LPSA,X22
JRST RESTR
DSCR SETSTS(CHANNEL,STATURS);
CAL SAIL
⊗
HERE(SETSTS)
PUSHJ P,SAVE
LOADI7 A,<SETSTS>
MOVE CHNL,-2(P)
PUSHJ P,GETCHN
MOVE A,-1(P) ;INTENDED STATUS BITS
XCT SETIOSTS,SIMIO ;XECUTE THE INST
JFCL ;SHOULDN'T SKIP
MOVE LPSA,X33
JRST RESTR ;GO RESTORE
ENDCOM(STS)
COMPIL(LOK,<LOOKUP,ENTER,FILEINFO>
,<SAVE,RESTR,GETCHN,FILNAM,SIMIO,X33,X22,GOGTAB>
,<LOOKUP, ENTER, AND FILEINFO ROUTINES>)
COMMENT ⊗Lookup, Enter ⊗
DSCR LOOKUP(CHANNEL,"FILE NAME",@FAILURE FLAG);
CAL SAIL
⊗
Comment ⊗
LOOKUP or ENTER file FILENAME on channel CHANNEL, where FILENAME has
a format acceptable to FILNAM above. If successful,
FAILURE!FLAG (called by reference) is zeroed. It is
otherwise set to -1 in LH, error code in RH.
⊗
.LOK:
HERE (LOOKUP) PUSHJ P,SAVE
LOADI7 A,<LOOKUP>
PUSH P,[XCT IOLOOKUP,SIMIO] ;LOOKUP CH,FILE
MOVEI B,INAME ;TO STORE FILE NAME
JRST LOKENT ;DO THE OPERATION
DSCR ENTER(CHANNEL,"FILE NAME",@FAILURE FLAG);
CAL SAIL
⊗
HERE (ENTER)
PUSHJ P,SAVE
LOADI7 A,<ENTER>
PUSH P,[XCT IOENTER,SIMIO] ;ENTER CH,FILE
MOVEI B,ONAME ;TO STORE FILE NAME
LOKENT:
MOVE LPSA,X33 ;PARAM ADJUST FOR RESTR
MOVE CHNL,-3(P) ;GET CHANNEL #
PUSHJ P,GETCHN ;VALIDATE
SETZM @-2(P) ;ASSUME SUCCESS
PUSHJ P,FILNAM ;GET FILE
JRST BADSPC ; NO GOOD, REPORT ERROR
ADD B,CDB ;ADDR OF FILE NAME HOLDER
MOVEW (<(B)>,<FNAME(USER)>) ;STORE IT
POP P,X ;INSTRUCTION TO DO
MOVE Y,[JRST ELERR] ;FAILURE
MOVE Z,[JRST RESTR] ;SUCCESS
ENF1: JRST X ;ENTER/LOOKUP
BADSPC: POP P,(P) ;REMOVE IO INSTRUCTION
HRRZ TEMP,ERRTST(CDB) ;GET USER-ENABLE BITS
TRNE TEMP,10000 ;ENABLED FOR HANDLING BAD FILE SPECS?
ERR <LOOKUP OR ENTER: INVALID FILE SPECIFICATION>,1 ;NO, TELL HIM
SKIPA TEMP,[=8] ;ALWAYS REPORT NO GOOD LOOKUP/ENTER
ELERR: HRRZ TEMP,FNAME+1(USER) ;WHY DID IT BLOW?
HRROM TEMP,@-1(P) ;TELL THE USER
JRST RESTR
COMMENT ⊗Fileinfo ⊗
DSCR FILEINFO(INTEGER ARRAY INFO[1:6]);
CAL SAIL
⊗
Comment ⊗ This routine gives the user the entire 6 word block
from the last LOOKUP, ENTER, or RENAME operation done by SAIL.⊗
HERE (FILEINFO)
MOVE USER,GOGTAB
POP P,UUO1(USER) ;GET RID OF IT, MARK LAST SAIL CALL
POP P,LPSA ;ARRAY ADDRESS WHERE INFO IS TO GO
SKIPGE -2(LPSA) ;MAKE SURE IT'S NOT A STRING ARRAY
ERR <PASS 6 WORD INTEGER VECTOR TO FILEINFO>,1
MOVE TEMP,-1(LPSA) ;TOTAL ARRAY SIZE WORD
CAML TEMP,[XWD 1,6] ;MUST BE 1-D, AT LEAST 6 WORDS
CAMLE TEMP,[XWD 1,-1] ;BUT NOT 2-D
ERR <PASS 6 WORD INTEGER VECTOR TO FILEINFO>,1
MOVEI TEMP,5(LPSA) ;BLT TERMINATOR
HRLI LPSA,FNAME(USER) ;SOURCE OF VALUABLE INFORMATION
BLT LPSA,(TEMP) ;GIVE!
JRST @UUO1(USER) ;GONE
ENDCOM (LOK)
COMPIL(OUT,<OUT>,<SAVE,RESTR,GETCHN,SIMIO,NOTOPN,X11,X22>
,<STRING OUTPUT ROUTINE>)
COMMENT ⊗Out ⊗
DSCR OUT(CHANNEL,"STRING");
CAL SAIL
⊗
COMMENT ⊗
Simply places all characters of string in output buffer for channel.
Close file if device is TTY ⊗
.OUT.:
HERE (OUT) PUSHJ P,SAVE ;ACS, GET USER, SAVE RETURN FOR ERROR
MOVE LPSA,X22
MOVE CHNL,-1(P) ;CHANNEL NUMBER
LOADI7 A,<OUT>
PUSHJ P,GETCHN ;VALIDATE AND GET CDB, ETC.
HRRE Z,-1(SP) ;#CHARS
POP SP,D
SUB SP,X11
MOVE B,OBP(CDB)
MOVE A,OCOWNT(CDB)
JRST .OUT1
.OUT: SOJLE A,OUT1 ;NEED OUTPUT??
.OUT2: ILDB X,D ;GET A CHAR
IDPB X,B ;PUT IT AWAY
.OUT1: SOJGE Z,.OUT ;LOOP
OUTDUN: MOVEM B,OBP(CDB) ;PUT BP AWAY
MOVEM A,OCOWNT(CDB) ;COUNT AWAY
SKIPGE TTYDEV(CDB) ;TTY?
XCT IOOUT,SIMIO ; YES, FORCE OUTPUT
JRST RESTR
JRST RESTR
OUT1: LDB TEMP,[POINT 4,DMODE(CDB),35] ;MODE
CAIL TEMP,15 ;DUMP?
JRST DMPO ;YES
MOVEM B,OBP(CDB) ;PUT REAL BP AWAY
XCT IOOUT,SIMIO ;DO THE OUTPUT
JFCL ;ERRORS HANDLED IN SIMIO
MOVE B,OBP(CDB) ;NEW BP
MOVE A,OCOWNT(CDB) ;NEW COUNT
JRST .OUT2 ;CONTINUE
; SPECIAL DUMP-MODE OUTPUT STUFF
DMPO: PUSH P,D
HRRZ D,OBUF(CDB) ;PTR TO BUFFER AREA
SUBI D,1 ;ADDR-1 FOR IOWD
HRLI D,-=128 ;-WORD COUNT
MOVEI D+1,0
XCT IODOUT,SIMIO ;OUT D,
JFCL ;ERRORS HANDLED IN SIMIO
OKO: HRRZ B,D ;SAVE ADDR
HRLI D,1(D) ;BLT WORD
HRRI D,2(D)
SETZM -1(D)
BLT D,=128(B) ;CLEAR BUFFER
POP P,D ;RESTORE INPUT BYTE POINTER
AOS @ENDFL(CDB) ;SPECIAL TREATMENT
HRLI B,700 ;POINT 7,-1(1ST WORD),35
MOVEM B,OBP(CDB)
MOVEI A,5*=128 ;CHAR COUNT
MOVEM A,OCOWNT(CDB)
JRST .OUT2 ;AFTER OUTPUT SIMULATION, GO ON
ENDCOM(OUT)
COMPIL(INP,<INPUT>
,<SAVE,.SKIP.,INSET,RESTR,SIMIO,GETCHN,STRNGC,BRKMSK,X33,NOTOPN,GOGTAB
>
,<STRING INPUT ROUTINE>)
COMMENT ⊗Input ⊗
DSCR "STRING"←INPUT(CHANNEL,BREAK TABLE NUMBER);
CAL SAIL
SID NO ACS SAVED BY INPUT!!!!!!
⊗
.IN.:
HERE (INPUT)
MOVE USER,GOGTAB ;GET TABLE POINTER
;;%##% FOR BENEFIT OF ERR ROUTINE
MOVE TEMP,(P)
MOVEM TEMP,UUO1(USER)
;;%##%
MOVEM RF,RACS+RF(USER);SAVE F-REGISTER
SKIPE SGLIGN(USER)
PUSHJ P,INSET
MOVE CHNL,-2(P) ;CHANNEL #
LOADI7 A,<IN> ;ROUTINE NAME
PUSHJ P,GETCHN ;SET UP, VALIDATE
LDB E,[POINT 4,DMODE(CDB),35] ;DATA MODE
CAIGE E,15 ;DUMP MODE?
SETZM @ENDFL(CDB) ;NO, HELP USER ASSUME NO EOF,ERR
SETZM @BRCHAR(CDB) ;ASSUME NO BREAK CHAR
CMU <
SETZM .SKIP.
>;CMU
HRRZ A,@ICOUNT(CDB) ;MAX COUNT FOR INPUT STRING
ADDM A,REMCHR(USER)
SKIPLE REMCHR(USER) ;ENOUGH ROOM?
PUSHJ P,STRNGC ;NO, TRY TO GET SOME
SKIPL C,-1(P) ;GET TABLE #, CHECK IN BOUNDS
CAILE C,=18
ERR <IN: THERE ARE ONLY 18 BREAK TABLES>
HRRZ TEMP,USER
ADD TEMP,C ;TABLE NO(USER)
MOVEI Z,1 ;FOR TESTING LINE NUMBERS
SKIPN LINTBL(TEMP) ;DON'T LET TEST SUCCEED IF
MOVEI Z,0 ;WE'RE TO LET LINE NUMBERS THRU
MOVN B,A ;NEGATE MAX CHAR COUNT
PUSH SP,[0] ;LEAVE ROOM FOR FIRST STR WORD
PUSH SP,TOPBYTE(USER) ;SECOND STRING WORD
MOVE FF,BRKMSK(C) ;GET MASK FOR THIS TABLE
HRRZ Y,USER
ADD Y,[XWD D,BRKTBL] ;BRKTBL+RLC(USER)
JUMPE B,DONE1 ; BECAUSE THE AOJL WON'T
CMU <
MOVS C,DMODE(CDB) ;FUNNY MODE BITS TO RH
>;CMU
TRNE FF,@BRKCVT(USER) ;DOING UC COERCION?
TLOA C,400000 ;YES
TLZ C,400000 ;NO
.IN: SOSG ICOWNT(CDB) ;BUFFER EMPTY?
JRST DOINP ;YES, GET MORE
IN1:
ILDB D,IBP(CDB) ;GET NEXT CHARACTER
TDNE Z,@IBP(CDB) ;LINE NUMBER (ALWAYS SKIPS IF NOT WORRIED)?
JRST INLINN ;YES, GO SEE WHAT TO DO
IN2:
NOCMU <
JUMPE D,.IN ;ALWAYS IGNORE 0'S
>;NOCMU
CMU <
JUMPE D,[ TRNN C,1 ;REALLY IGNORE NULL??
JRST .IN ;YES
JRST .+1 ;NOPE
]
>;CMU
;;%AX% ugh! another instruction
SKIPE LINNUM(CDB) ;COUNTING VIA SETPL?
JRST [ CAIN D,12 ;LF?
AOS @LINNUM(CDB) ;YES -- BUMP COUNT
CAIE C,14 ;FF?
JRST .+1 ;NOPE
SKIPN PAGNUM(CDB) ;BE SURE NO MESSUP
ERR <DRYROT -- SETPL LOSSAGE DETECTED IN INPUT>,1,NOCV.I
AOS @PAGNUM(CDB) ;BUMP PAGE COUNT
SETZM @LINNUM(CDB) ;THE LINE COUNT ← 0
JRST NOCV.I ;SINCE KNOW NOT LOWER CASE
]
;;%##% COERCING ??
JUMPGE C,NOCV.I ;NOT COERCIING ??
CAIL D,"a" ;ONLY COERCE LOWER CASE
CAILE D,"z" ;
JRST .+2 ;FAST SKIP
TRZ D,40 ;MAKE UC
NOCV.I: TDNE FF,@Y ;MUST WE DO SOMETHING SPECIAL?
JRST INSPC ;YES, HANDLE
MOVEC: IDPB D,TOPBYTE(USER) ;LENGTHEN STRING
AOJL B,.IN ;GET SOME MORE
JRST DONE1
INSPC: HLLZ TEMP,@Y ;IGNORE OR BREAK?
TDNN TEMP,FF ; (CHOOSE ONE)
JRST .IN ;IGNORE
; BREAK -- STORE BREAK CHAR, FINISH OFF
DONE: MOVEM D,@BRCHAR(CDB) ;STORE BREAK CHAR
MOVE Y,-1(P) ;TABLE # AGAIN
ADD Y,USER ;RELOCATE
SKIPN Y,DSPTBL(Y) ;WHAT TO DO WITH BREAK CHAR?
JRST DONE1 ;SKIP IT
JUMPL Y,APPEND ;ADD TO END OF INPUT STRING
RETAIN: SOS IBP(CDB) ;BACK UP TO GET IT NEXT TIME
FOR II←1,4 <
IBP IBP(CDB)>
AOS ICOWNT(CDB)
JRST DONE1
APPEND: IDPB D,TOPBYTE(USER) ;PUT ON END
AOJA B,DONE1 ;ONE MORE TO COUNT
INEOF1: POP P,D+1 ;LEFT OVER FROM DUMP MODE ROUT
; DONE -- MARK STRING COUNT WORD
DONE1: ADDM B,REMCHR(USER) ;GIVE UP THOSE NOT USED
ADD B,@ICOUNT(CDB) ;HOW MANY DID WE ACTUALLY GET?
;;#GI# DCS 2-5-72 REMOVE TOPSTR
HRROM B,-1(SP) ;MARK RESULT, NON-CONSTANT
;;#GI#
MOVE RF,RACS+RF(USER);GET F-REGISTER BACK
SUB P,X33 ;REMOVE INPUT PARAMETER, RETURN ADDRESS
JRST @3(P) ;RETURN
; CAN EITHER DELETE LINE NUMBER (Y GT 0) OR STOP,
; TELL THE USER (BRCHAR=-1), AND MARK LINE NUMBER
; NOT A LINE NUMBER FOR NEXT TIME
; GET A NEW BUFFER
DOINP:
CMU <
AOS .SKIP.
>;CMU
CAIL E,15 ;DUMP MODE?
JRST DMPI ; YES
XCT IOIN,SIMIO ;IN CHAN,0
JRST IN1 ;ALL OK, CONTINUE
JRST DONE1 ;ERROR OR EOF, QUIT
; DUMP MODE SIMULATION OF SAME
DMPI: PUSH P,D+1
HRRZ D,IBUF(CDB) ;PTR TO BUFFER AREA
SUBI D,1
HRLI D,-=128
MOVEI D+1,0
XCT IODIN,SIMIO ;IN CHAN,D
JRST OKI
JRST INEOF1 ;REMOVE D,QUIT
OKI: POP P,D+1
AOS @ENDFL(CDB) ;SPECIAL TREATMENT
HRLI D,700
MOVEM D,IBP(CDB)
MOVEI A,5*=128
MOVEM A,ICOWNT(CDB)
JRST IN1 ;DONE SIMULATING, RETURN
INLINN:
;;%AX% MORE SETPL STUFF
SKIPE SOSNUM(CDB) ;DOES THE USER WANT IT???
JRST [ MOVE TEMP,@IBP(CDB) ;YES
MOVEM TEMP,@SOSNUM(CDB);
JRST .+1 ]
MOVE TEMP,-1(P) ;GET LINE NUMBER DISPOSITION FLAG,
ADD TEMP,USER ;RLC+TABLE
SKIPGE TEMP,LINTBL(TEMP) ;LINTBL+RLC+TABLE
JRST GIVLIN ; WANTS IT NEXT TIME OR SOMETHING
JSP TEMP,EATLIN ;TOSS IT OUT, AND
JRST .IN ; CONTINUE
EATLIN:
AOS IBP(CDB) ;FORGET IT ENTIRELY
MOVNI A,5 ;INDICATE SKIPPING SIX
ADDB A,ICOWNT(CDB) ;IN COUNT
;OVERFLOW BUFFER?
JUMPG A,(TEMP) ;NO, CONTINUE
CAIL E,15
ERR <CAN'T HANDLE THIS FILE IN DUMP MODE>
XCT IOIN,SIMIO ;YES, GET TAB FROM NEXT BUFFER
JRST OKLN ;GOT IT, CONTINUE
JRST DONE1
OKLN: SOSG ICOWNT(CDB) ;IF ONLY ONE CHAR,
JRST [MOVEI TEMP,20000 ;THEN EOF COMES NEXT
IORM TEMP,@ENDFL(CDB)
JRST DONE1] ;ALL DONE
IBP IBP(CDB) ;GET OVER TAB FINALLY
;;#PM 12-1-73 RLS DONT LOSE A CHARACTER IN THE (NEW) BUFFER
AOS ICOWNT(CDB) ;INCREMENT COUNT
;;#PM
JRST (TEMP) ;AND CONTINUE
GIVLIN: TRNE TEMP,-1 ;WANT LINE NO IN BRCHAR WORD?
JRST GVLLN ;NO, WANTS IT NEXT TIME.
SKIPL TEMP,@IBP(CDB) ;NEGATED LINE NO
MOVNS TEMP
MOVEM TEMP,@BRCHAR(CDB) ;STORE WHERE HE WANTS IT
JSP TEMP,EATLIN ;GO EAT UP LINE NUMBER AND
JRST DONE1 ;FINISH UP
GVLLN:
SETOM @BRCHAR(CDB) ;TELL THE USER
AOS ICOWNT(CDB) ;REVERSE THE SOSLE
MOVEI Y,1 ;TURN OFF LINE NUMBER
ANDCAM Y,@IBP(CDB) ; BIT
MOVSI Y,070000 ;BACK UP BYTE POINTER
ADDM Y,IBP(CDB)
JRST DONE1 ;FINISH OFF IN BAZE OF GORY
ENDCOM(INP)
COMPIL(NUM,<REALIN,REALSCAN,INTIN,INTSCAN>
,<SIMIO,SAVE,RESTR,X22,X33,GETCHN,NOTOPN,.CH.,.MT.,.TEN.>
,<LOU PAUL'S NUMBER INPUT AND CONVERSION ROUTINES>)
COMMENT ⊗Realin, Realscan ⊗
DSCR REAL←REALIN(CHANNEL NUMBER);
CAL SAIL
⊗
HERE (REALIN)
IFN ALWAYS,<BEGIN NUMIN>
PUSHJ P,SAVE
PUSHJ P,NUMIN; GET NUMBER IN A AND TEN EXPONENT IN C
MOVE LPSA,X22
JRST REALFN
DSCR REAL←REALSCAN(@"STRING");
CAL SAIL
⊗
HERE (REALSCAN)
PUSHJ P,SAVE
PUSHJ P,STRIN
MOVE LPSA,X33
REALFN: SETZ D,; POS SIGN
JUMPE A,ADON
JUMPG A,FPOS
SETO D,; NUMBER NEGATIVE
MOVNS A
FPOS: ;WE NOW HAVE A POSITIVE NUMBER IN A WITH SIGN IN D
JFFO A,.+1; NUMBER OF LEADING ZEROS IN B
ASH A,-1(B); BIT0=0, BIT1=1
MOVN X,B; BIN EXPONENT -2
JUMPE C,FLO; IF TEN EXPONENT ZERO THEN FINISH
JUMPL C,FNEG
CAIL C,100; CHECK BOUND OF EXPOENT
JRST ERROV1
SETZ Y,
JRST TEST
FNEG: MOVNS C
CAIL C,100
JRST ERROV1
MOVEI Y,6
TEST: TRNE C,1; DEPENDING ON LOW ORDER BIT OF EXP
JRST MULT; EITHER MULTIPLY
NEXT: ASH C,-1; OR DON'T.
AOJA Y,TEST; INDEX INTO MULTIPLIER TABLE
MULT: ADD X,.CH.(Y); EXPONENT
MUL A,.MT.(Y) ;MULTIPLY AND NORMALIZE
TLNE A,200000
JRST DTEST
ASHC A,1
SOJA X,.+1
DTEST: SOJG C,NEXT
FLO: IDIVI A,1B18
FSC A,255
FSC B,234
FADR A,B
SKIPE D
MOVNS A
FSC A,(X); SCALE
JRST ALLDON
SUBTTL INTIN INTEGER NUMBER INPUT ROUTINE LOU PAUL
COMMENT ⊗Intin, Intscan ⊗
DSCR INTEGER←INTIN(CHANNEL NUMBER);
CAL SAIL
⊗
HERE (INTIN)
;INTEGER NUMBER INPUT ROUTINE RETURNS VALUE IN A
;USES NUMIN TO PERFORM FREE FIELD SCAN
PUSHJ P,SAVE
PUSHJ P,NUMIN; GET NUMBER IN A, TEN EXPONENT IN C
MOVE LPSA,X22
JRST INTFN
DSCR INTEGER←INTSCAN("STRING");
CAL SAIL
⊗
HERE (INTSCAN)
PUSHJ P,SAVE
PUSHJ P,STRIN
MOVE LPSA,X33
INTFN: JUMPE A,ADON
JUMPE C,ADON
JUMPL C,DIVOUT; IF EXPONENT NEG WE WILL DIVIDE
CAIL C,13
JRST ERROV1
IMUL A,.TEN.(C)
JRST ALLDON
DIVOUT: MOVNS C
CAIL C,13
JRST [SETZ A,
JRST ADON ]
MOVE C,.TEN.(C)
IDIV A,C
ASH C,-1
CAML B,C; ROUND POSITIVELY
AOJA A,ALLDON
MOVNS B
CAML B,C
SOJ A,
ALLDON: JOV ERROV1; CHECK FOR OVERFLOW
ADON: MOVEM A,RACS+1(USER)
JRST RESTR
ERROV1: PUSHJ P,ERROV
JRST ADON
SUBTTL FREE FIELD NUMBER SCANNER LOU PAUL
DSCR NUMIN
DES THE COMMON ROUTINE USED BY REALIN, REALSCAN, INTIN, ETC.
⊗
;NUMIN PERFORMS A FREE FIELD READ AND RETURNS THE MOST SIGNIFICIANT
;PART OF THE NUMBER IN A AND THE APPROPIATE TENS EXPONENT IN C
;TAKING CARE OF LEADING ZEROS AND TRUNCATION ETC.
;SCANNING IS ACCORDING TO THE FOLLOWING BNF
;<NUMBER>::=<DEL><SIGN><NUM><DEL>
;<NUM> ::=<NO>|<NO><EXP>|<EXP>
;<NO> ::=<INTEGER>|<INTEGER>.|
; <INTEGER>.<INTEGER>|.<INTEGER>
;<INTEGER>::=<DIGIT>|<INTEGER><DIGIT>
;<EXP> ::=E<SIGN><INTEGER>|@<SIGN><INTEGER>
;<DIGIT>::=0|1|2|3|4|5|6|7|8|9
;<SIGN> ::=+|-|<EMPTY>
;NULL AND CARR. RET. ARE IGNORED.
;SCANNING IS FACILITATED BY A CHARACTER CLASS TABLE "TAB" AND
;TWO MACROS AHEAD AND ASTERN. THE LEFT HALF OF THE 200+1 WORD TABLE
;CONTAINS -1 IF NOT A DIGIT AND THE VALUE OF THE DIGIT IF IT IS A DIGIT
;THE RIGHT HALF CONTAINS -1 IF A DIGIT AND THE CLASS NUMBER IF NOT.
;CLASS 0 NULL, CARR RET, NOTHING
;CLASS 1 .
;CLASS 2 -
;CLASS 3 +
;CLASS 4 @,E
;CLASS 5 ANY OTHER CHARACETR
;CLASS 6 END OF FILE
;TAB(200) IS USED FOR FND OF FILE
;MACRO AHEAD IS USED FOR FORWARD SCANNING, ASTERN FOR SCANNING
;THE STACK CONSISTING OF AC Y WHICH HAS CLASS SYMBOLS SHIFTED INTO IT.
DEFINE AHEAD(DIG,POINT,MINUS,PLUS,E,CHA,EOF)<
HRRE X,TAB(D)
JRST @.+2(X)
JUMP DIG
JRST .-4
JUMP POINT
JUMP MINUS
JUMP PLUS
JUMP E
JUMP CHA
JUMP EOF>
DEFINE ASTERN(NULL,POINT,MINUS,PLUS,E,CHA)<
SETZ X,
LSHC X,3
JRST @.+1(X)
JUMP NULL
JUMP POINT
JUMP MINUS
JUMP PLUS
JUMP E
JUMP CHA
JUMP CHA>
;NUMIN -- CONTD.
NUMIN: MOVE CHNL,-2(P)
LOADI7 A,<IN>
PUSHJ P,GETCHN; SET UP FOR INPUT
SETZM @ENDFL(CDB); CLEAR EOF AND BREAK FLAGS
SETZM @BRCHAR(CDB)
MOVE LPSA,[JSP X,NCH]
MOVEI Z,1; FOR LINE NUMBER TEST
PUSHJ P,SCAN
MOVEM D,@BRCHAR(CDB); FIX UP BREAK CHARACTER
SOS IBP(CDB) ;BACK UP TO GET IT NEXT TIME
FOR II←1,4 <
IBP IBP(CDB)>
AOS ICOWNT(CDB)
POPJ P,
; READ A CHARACTER FROM INPUT FILE -- FOR SCAN.
NCH: SOSG ICOWNT(CDB); DECREMENT CHARACTER COUNT
JRST NCH2
NCH1: ILDB D,IBP(CDB); LOAD BYTE
TDNE Z,@IBP(CDB); CHECK FOR LINE NUMBER
JRST NCH5
;;%AX% UGH! MORE IN THE LOOP!!
SKIPN LINNUM(CDB) ;WANT SETPL STUFF???
JRST (X) ;NO, RETURN
CAIN D,12 ;YES, IS THIS A LF?
AOS @LINNUM(CDB) ;YES, BUMP LINE COUNT
CAIE D,14 ;A FF?
JRST (X) ;NOPE
SKIPN PAGNUM(CDB) ;BUG TRAP
JRST [ ERR <DRYROT -- SETPL LOSSAGE DETECTED BY NUMIN>,1
JRST (X) ]
AOS @PAGNUM(CDB) ;BUMP PAGE COUNT
SETZM @LINNUM(CDB) ;ZERO LINE COUNT
JRST (X) ;RETURN
;;%AX%
NCH2: XCT IOIN,SIMIO; INPUT
JRST NCH1 ;ALL OK
NCH7: MOVEI D,200 ;EOF OR DATA ERROR.
JRST (X)
NCH5:
;;%AX% MORE SETPL STUFF
SKIPE SOSNUM(CDB) ;DOES THE LOSER WANT IT??
JRST [ MOVE D,@IBP(CDB) ;YES, GET IT
MOVEM D,@SOSNUM(CDB) ;WHERE HE SAID TO PUT IT
JRST .+1]
;;%AX%
AOS IBP(CDB); WE HAVE A LINE NUMBER
MOVNI D,5; MOVE OVER IT
ADDB D,ICOWNT(CDB)
SKIPLE D; NOTHING LEFT
JRST NCH; DO ANOTHER INPUT
XCT IOIN,SIMIO
NCH6: SOSG ICOWNT(CDB); REMOVE TAB
JRST NCH7 ;NONE THERE OR ERROR
IBP IBP(CDB)
JRST NCH
;SETUP FOR STRING INPUT (REALSCAN, INTSCAN)
STRIN: MOVE LPSA,[JSP X,NCHA]
HRRZ Z,-3(P)
HRRZ Z,-1(Z)
HRRZS -3(P) ;SO CAN INDIRECT THROUGH IT.
PUSHJ P,SCAN
HRRZ X,-3(P)
SOS (X) ;BACK UP BYTE POINTER
FOR II←1,4<
IBP (X)>
AOJ Z,
HRRM Z,-1(X)
MOVEM D,@-2(P) ;STORE BREAK CHARACTER
POPJ P,
;READ A CHARACTER ROUTINE FOR STRINGS.
NCHA: SOJL Z,NCH7
ILDB D,@-4(P)
JRST (X)
;SCAN (CALLED BY NUMIN AND STRIN)
SCAN: JOV .+1
SETO TEMP, ;FLAG REGISTER.
SETZ Y,
SETZB A,C; NUMBER EXPOENT
MORE: XCT LPSA; THIS GETS A CHARACTER IN D,200 IF FO EOF
AHEAD(DIG1,STACK,STACK,STACK,STACK,STACK,DONE)
STACK: LSHC X,-3; PUSH SYMBOL ONTO STACK "AC Y"
JRST MORE
DIG1: SETZ TEMP,; FLAG REG.
ASTERN(INT1,FRA1,SIG1,SIG2,EXP1,INT1)
SIG1: TRO TEMP,4; NEGATIVE SIGN
SIG2: ASTERN(INT1,ERR2,ERR5,ERR5,EXP1,INT1)
EXP1: MOVEI A,1
ASTERN(EXP2,ERR2,SIG3,SIG4,ERR1,EXP2)
SIG3: MOVNS A
SIG4: ASTERN(EXP2,ERR2,ERR5,ERR5,ERR1,EXP2)
FRA1: TRO TEMP,1; DECIMAL POINT
SOJ C,
ASTERN(INT1,ERR2,SIG5,SIG6,ERR1,INT1)
SIG5: TRO TEMP,4; NEGATIVE SIGN
SIG6: ASTERN(INT1,ERR2,ERR5,ERR5,ERR1,INT1)
EXP2: HLRE FF,TAB(D); FIRST DIGIT
EXP5: XCT LPSA; GET NEXT CHARACTER
EXP9: HLRE B,TAB(D)
JUMPL B,EEXP; NEGATIVE IF NOT A DIGIT
IMULI FF,12
ADD FF,B
JRST EXP5
XCT LPSA
;;#QD# SEE DONE5: BELOW
EEXP: AHEAD(EXP9,ERR2,DONE5,DONE5,ERR1,EN,EN)
EN: TRNE TEMP,4; SIGN OF EXPONENT
MOVNS FF
ADD C,FF; FIX UP EXPONENT
JOV ERR3
;#QD# CHANGE ALL 'ERR5'S IN AHEAD MACROS DO 'DONE5'S, TO AVOID SNARFING EXTRA
;SIGNS ..... RFS 12-15-73 (TWO PLACES BELOW AND ONE ABOVE ALSO)
DONE5:
DONE: ANDI D,177
JUMPGE TEMP,.+2
SETO D,
POPJ P,
INT1: HLRE A,TAB(D); FIRST DIGIT
TRNE TEMP,4
MOVNS A; NEGATE IF NECESSARY
INT2: XCT LPSA; GET NEXT CHARACTER
INT5: HLRE B,TAB(D)
JUMPL B,EON; NEGATIVE IF NOT A NUMBER
TRNE TEMP,1; IF PASSED DECIMAL POINT THEN DEC EXP BY ONE
SOJ C,
TRNE TEMP,2; IF ENOUGH DIGITS THEN INC EXP BY ONE
INT3: AOJA C,INT2
MOVE X,A
IMULI A,12
TRNE TEMP,4; NEGATE DIGIT IS SIGN NEGATIVE
MOVNS B
ADD A,B
JOV INT4; CHECK FOR OVERFLOW
JRST INT2; IF SO USE LAST VALUE
INT4: TRO TEMP,2
MOVE A,X
JRST INT3
XCT LPSA
EON: AHEAD(INT5,DP1,DONE,DONE,EXP6,DONE,DONE)
DP1: TROE TEMP,1
JRST ERR2
XCT LPSA
;#QD# (SEE DONE5: ABOVE)
AHEAD(INT5,ERR2,DONE5,DONE5,EXP6,DONE,DONE)
EXP6: SETZ TEMP,
XCT LPSA
AHEAD(EXP2,ERR2,EXP7,EXP8,ERR1,ERR1,ERR1)
EXP7: TRO TEMP,4
EXP8: XCT LPSA
;#QD# (SEE DONE5: ABOVE)
AHEAD(EXP2,ERR2,DONE5,DONE5,ERR1,ERR1,ERR1)
ERR1: ERR(<NUMIN: IMPROPER EXPONENT>,1,RZ)
ERR2: ERR(<NUMIN: MISPLACED DECIMAL POINT>,1,RZ)
ERR3: ERR(<NUMIN: EXPONENT OUT OF BOUND>,1,RZ)
ERR5: ERR(<NUMIN: MISPLACED SIGN>,1,RZ)
ERROV: ERR(<NUMIN: NUMBER OUT OF BOUND>,1,RZ)
RZ: SETZ A,
JRST DONE
; Character table for SCAN (Realscan,Intscan,Realin,Intin)
TAB: FOR A IN (0,5,5,5,5,5,5,5)<XWD -1,A
>
FOR A IN (5,5,5,5,5,0,5,5)<XWD -1,A
>
FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
;#QC# MAKE 32 (CONTROL Z) IGNORED
FOR A IN (5,5,0,5,5,5,5,5)<XWD -1,A
>
FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
FOR A IN (5,5,5,3,5,2,1,5)<XWD -1,A
>
FOR A IN (0,1,2,3,4,5,6,7,10,11)<XWD A,-1
>
FOR A IN (5,5,5,5,5,5)<XWD -1,A
>
FOR A IN (4,5,5,5,5,5,5,5)<XWD -1,A
>
FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
XWD -1,6
ENDCOM(NUM)
COMPIL(TBB,<.CH.,.TEN.,.MT.>,,<TABLES FOR L PAUL'S ROUTINES>)
DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
⊗
↑↑.CH.: 4
7
16
33
66
153
777777777775
777777777772
777777777763
777777777746
777777777713
777777777626
↑↑.MT.: 240000000000
310000000000
234200000000
276570200000
216067446770
235613266501
314631463147
243656050754
321556135310
253630734215
346453122767
317542172553
↑↑.TEN.: 1
=10
=100
=1000
=10000
=100000
=1000000
=10000000
=100000000
=1000000000
=10000000000
ENDCOM(TBB)
IFN ALWAYS,<
BEND
>;IFN ALWAYS
COMPIL(WRD,<ARRYOUT,WORDOUT,ARRYIN,WORDIN>
,<GETCHN,SAVE,RESTR,GOGTAB,SIMIO,X22,X33,X44,NOTOPN>
,<ARRYIN, ARRYOUT, WORDIN, AND WORDOUT>)
COMMENT ⊗Arryout, Wordout ⊗
DSCR ARRYOUT(CHANNEL,@STARTING LOC,EXTENT);
CAL SAIL
⊗
HERE (ARRYOUT)
PUSHJ P,SAVE
MOVE LPSA,[XWD 4,4]
ARO: MOVE CHNL,-3(P)
LOADI7 A,<ARRYOUT>
PUSHJ P,GETCHN
;;%##% CONSIDER THIS
CMU <
SETZM @ENDFL(CDB) ;CLEAR ERROR FLAG
>;CMU
LDB TEMP,[POINT 4,DMODE(CDB),35] ;CHECK MODE
CMU <
;;=B4= 1 OF 13 -- FOR CMU SPECIAL MODES.
MOVEI Z,1 ;ASSUME NOT IMP MODE
CAIN TEMP,3 ;IS THE MODE 3?
TRZA Z,-1 ; YES - CMU 32-BIT IMP MODE.
; WE WILL USE Z BOTH AS SIGNAL AND AS
; A GUARANTEED 0 THAT CAN BE USED FOR A DPB
CAIN TEMP,4 ; (THIS ONE IS CMU-IMAGE MODE)
JRST OUTRAY ; THEN OKAY, NOT DUMP MODE EITHER.
;;=B4=
>;CMU
CAIGE TEMP,10 ;MAKE SURE AT LEAST BINARY MODE
ERR <ARRYOUT: mode must be '14,'10, or '17, not >,6
MOVE 0,[XCT IODOUT,SIMIO] ;IN CASE DUMP MODE
CAIL TEMP,15
JRST ARYDMP ;COMMON DUMP MODE ROUTINE
OUTRAY: MOVE A,-2(P) ;STARTING LOC
SKIPGE B,-1(P) ;EXTENT
ERR <ARRYOUT: negative word count, value is>,6
;;#FQ# DCS 2-6-72 (1-4) COUNT NO LONGER HELD EXCESSIVE
WOUT2: SKIPG E,OCOWNT(CDB) ;# WORDS LEFT IN BUFFER
JRST WOUT5 ;BETTER GET ANOTHER BUFFER
JUMPE B,RESTR ;NOTHING LEFT TO DO
CMU <
;;=B4= 2 OF 13
CAIN Z,0 ;IMP MODE?
LSH E,-2 ;DIVIDE BY 4 TO GET WORD COUNT
;;=B4=
>;CMU
IBP OBP(CDB) ;MAKE SURE PTRS TO FIRST WORD
CMU <
;;=B4= 3 OF 13
CAIN Z,0 ;IMP MODE?
DPB Z,[POINT 6,OBP(CDB),5]
;;=B4=
>;CMU
MOVE C,OBP(CDB) ;"TO" ADDR
HRRZI D,(C) ;FOR BLT TERMINATION CALCULATION
HRLI C,(A) ;"FROM" ADDR
CAIGE B,(E) ;ENUFF IN BUFFER?? (NOTICE THAT CAIGE
;AS OPPOSED TO CAIG WILL FORCE AN OUTPUT
;IF WE JUST FILL THE BUFFER)
JRST WOUT3 ;YES
ADDI D,-1(E) ;FINAL ADDR
BLT C,(D) ;DO IT!
ADDI A,(E) ;UPDATE PTR
SUBI B,(E) ;AND COUNT
SETZM OCOWNT(CDB)
HRRM D,OBP(CDB)
WOUT5: XCT IOOUT,SIMIO ;DO THE OUTPUT
JFCL ;ERRORS HANDLED ALREADY
JRST WOUT2 ;TRY NEXT CHUNK
WOUT3: JUMPLE B,RESTR ;NOTHING TO MOVE
SUBI B,1
ADD D,B ;END OF BLOCK
BLT C,(D) ;MOVE IT
SUBI E,1(B) ;FIX LENGTH
CMU <
;;=B4= 4 OF 13
CAIN Z,0 ;IMP MODE?
LSH E,2 ;MULTIPLY BY 4 FOR BYTE COUNT
;;=B4=
>;CMU
MOVEM E,OCOWNT(CDB) ;
ADDM B,OBP(CDB) ;FIX BYTE POINTER
;;#FQ# (1-4)
JRST RESTR ;LEAVE LIKE A TREE AND MAKE
DSCR WORDOUT(CHAN,VALUE);
CAL SAIL
⊗
HERE (WORDOUT) ;WRITE ONE WORD
PUSHJ P,SAVE
MOVE LPSA,X33
MOVE CHNL,-2(P)
LOADI7 A,<WORDOUT>
PUSHJ P,GETCHN
;;%##% CONSIDER THIS
CMU <
SETZM @ENDFL(CDB) ;CLEAR ERROR FLAG
>;CMU
LDB A,[POINT 4,DMODE(CDB),35];DATA MODE
CAIL A,15 ;A DUMP MODE?
JRST DMPWO ;WO IS ME, YES
;;#FQ# DCS 2-6-72 (2-4) WORD COUNT KEPT CORRECT, DUMP MODE OK
WDO: SOSL OCOWNT(CDB) ;BUFFER FULL?
JRST WOKO ;NO
XCT IOOUT,SIMIO ;YES, WRITE IT
JFCL ; ERRORS HANDLED ELSEWHERE
JRST WDO ;GO BACK AND DO IT RIGHT
WOKO: MOVE TEMP,-1(P) ;THING TO BE WRITTEN
IDPB TEMP,OBP(CDB) ;WRITE IT
JRST RESTR
DMPWO: MOVE LPSA,[XWD 7,7] ;ACCOUNT FOR EVERYTHING
MOVEI TEMP,-1(P) ;PNT TO WORD TO BE WRITTEN
PUSH P,-2(P) ;CHANNEL
PUSH P,TEMP ;ADDR OF WORD
PUSH P,[1] ;COUNT
PUSHJ P,ARO ;JOIN THE ROUTINE (RETAD JUST FOR STACK SYNCH)
;;#FQ# (2-4)
COMMENT ⊗Arryin, Wordin ⊗
DSCR ARRYIN(CHAN,@STARTING LOC,EXTENT);
CAL SAIL
⊗
HERE (ARRYIN)
PUSHJ P,SAVE
MOVE LPSA,X44
ARI: MOVE CHNL,-3(P)
LOADI7 A,<ARRYIN>
PUSHJ P,GETCHN
SETZM @ENDFL(CDB) ;ASSUME NO END OF FILE
LDB TEMP,[POINT 4,DMODE(CDB),35] ;CHECK DUMP MODE
CMU <
;;=B4= 5 OF 13
MOVEI Z,1 ;ASSUME NOT IMP MODE
CAIN TEMP,3 ;IS THE MODE 3?
TRZA Z,-1 ; YES - CMU 32-BIT IMP MODE.
CAIN TEMP,4 ;IF ONE OF THE SPECIAL CMU MODES,
JRST INARY ; THEN OKAY, NOT DUMP MODE EITHER
;;=B4=
>;CMU
CAIGE TEMP,10
ERR <ARRYIN: mode must be '10 or '14 or '17, not >,6
MOVE 0,[XCT IODIN,SIMIO] ;IN CASE DUMP MODE
CAIL TEMP,15
JRST ARYDMP ;USE COMMON ROUTINE
;;#FQ# DCS 2-6-72 (3-4) COUNT NO LONGER HELD EXCESSIVE
INARY: MOVE A,-2(P) ;STARTING LOC
SKIPGE B,-1(P) ;EXTENT
ERR <ARRYIN: negative word count, value is >,6
WIN3: JUMPE B,RESTR ;NOTHING LEFT TO DO
SKIPG E,ICOWNT(CDB) ;#LEFT IN BUFFER
JRST WIN5
CMU <
;;=B4= 6 OF 13
CAIN Z,0 ;IMP MODE?
LSH E,-2 ;DIVIDE BY 4 TO GET WORD COUNT
;;=B4=
>;CMU
IBP IBP(CDB) ;MAKE SURE PTS TO NEXT
HRL C,IBP(CDB) ;ADDR OF FIRST WORD TO READ
MOVEI D,(A) ;FOR BLT TERMINATION
HRR C,A ;"TO" ADDRESS
CAIG B,(E) ;ENOUGH HERE?
JRST WIN4 ;YES
ADDI D,-1(E) ;NO, FINISH THIS BUFFER
BLT C,(D)
ADD A,E ;FIX INPUT POINTER
SUB B,E ;FIX INPUT COUNT
WIN5: XCT IOIN,SIMIO ;DO INPUT
JRST WIN3 ;OK, GO AHEAD
JRST WIEOF1 ;EOF OR ERROR, LEAVE
WIN4: ADDI D,-1(B) ;FINISH UP
BLT C,(D)
SUB E,B ;FIX UP COUNT
CMU <
;;=B4= 7 OF 13
CAIE Z,0 ;IMP MODE?
JRST .+3
LSH E,2 ;MULTIPLY BY 4 FOR BYTE COUNT
DPB Z,[POINT 6,IBP(CDB),5]
;;=B4=
>;CMU
SUBI B,1 ;PREPARE TO CORRECT BP
MOVEM E,ICOWNT(CDB) ;UPDATE WORDS LEFT
ADDM B,IBP(CDB) ; POINTER
;;#FQ# (3-4)
JRST RESTR ;LEAVE
WIEOF1: MOVE TEMP,-1(P) ;#WORDS WANTED -1
SUBM TEMP,B ;#INPUT IN RH
WIN2: HRRM B,@ENDFL(CDB) ;#INPUT IN RH, ERR OR EOF BITS IN LH
JRST RESTR
DSCR VALUE←WORDIN(CHAN);
CAL SAIL
⊗
HERE (WORDIN) ;READ ONE WORD -- USE ARRYIN
PUSHJ P,SAVE
MOVE LPSA,X22
LOADI7 A,<WORDIN>
MOVE CHNL,-1(P) ;CHANNEL NUMBER
PUSHJ P,GETCHN
;;#FQ# DCS 2-6-72 (4-4) WORD COUNT KEPT CORRECT, DUMP MODE OK
LDB TEMP,[POINT 4,DMODE(CDB),35];DATA MODE
CAIL TEMP,15 ;DUMP MODE?
JRST DUMPWI ; YES
SETZM @ENDFL(CDB)
WI: SOSL ICOWNT(CDB)
JRST WOKI ;ALL OK
XCT IOIN,SIMIO
JRST WI ;OK, GO BACK TO KEEP COUNT RIGHT
TDZA A,A ;RETURN 0, WITH ERROR
WOKI: ILDB A,IBP(CDB) ;OK, RETURN NEXT WORD
MOVEM A,RACS+1(USER) ;RESULT
JRST RESTR
DUMPWI: MOVE LPSA,[XWD 6,6]
MOVEI TEMP,RACS+1(USER);RESULT GOES HERE
PUSH P,-1(P) ;CHANNEL
PUSH P,TEMP ;ADDRESS
PUSH P,[1] ;1 WORD TRANSFER
PUSHJ P,ARI ;WON'T RETURN, JUST SYNCH STACK
;;#FQ# (4-4)
ARYDMP:
MOVN TEMP,-1(P) ;-WORD COUNT
JUMPGE TEMP,[ERR <DUMP MODE WORD COUNT NOT POSITIVE, VALUE IS >,6]
SOS D,-2(P) ;STARTING ADDR - 1
HRL D,TEMP ;IOWD -COUNT,STARTING ADDR -1
MOVEI D+1,0 ;TERMINATE THE READ
MOVE A,[JRST RESTR] ;IF IT SUCCEEDS
MOVE B,[JRST RESTR] ;IF IT FAILS (EOF OR ERR, ALREADY HANDLED)
JRST 0 ;GO DO DUMP I/O
HERE(WRDSP1)
HERE(WRDSP2)
HERE(WRDSP3)
ERR <DRYROT WRD SPARES>
ENDCOM(WRD)
COMPIL(THR,<INOUT>,<SIMIO,SAVE,RESTR,GETCHN>
,<THROUGH I/O ROUTINE>)
COMMENT ⊗ INOUT ⊗
DSCR INOUT(INCHAN,OUTCHAN,EXTENT);
CAL SAIL
⊗
HEREFK (INOUT,.INOUT)
PUSHJ P,SAVE ;SAVE AC'S,GET GOGTAB
MOVE LPSA,[XWD 6,6]
MOVE CHNL,-2(P) ;OUTPUT CH NUMBER
LOADI7 A,<INOUT (OUTPUT SIDE)>
PUSHJ P,GETCHN
SETZM @ENDFL(CDB) ;CLEAR ERROR INDICATOR
LDB TEMP,[POINT 4,DMODE(CDB),35] ;CHECK MODE
CMU <
;;=B4= 8 OF 13
MOVEI Z,1
CAIN TEMP,3 ;IS THE MODE 3
TRZA Z,-1 ; YES!!!
CAIN TEMP,4 ;OR CMU IMAGE MODE?
JRST .+4 ;UGLY, BE CAREFUL OF CODE CHANGES!
;;=B4=
>;CMU
CAIL TEMP,10 ;MUST BE BINARY MODE
CAILE TEMP,14 ;AND NOT DUMP MODE
ERR <INOUT (OUTPUT SIDE): ILLEGAL DATA MODE:>,6
PUSH P,CDB ;SAVE -
PUSH P,CHNL ;WELL DO IT AGAIN
MOVE CHNL,-5(P) ;SEE...
LOADI7 A,<INOUT (INPUT SIDE)>
PUSHJ P,GETCHN ;DO YOUR THING
SETZM @ENDFL(CDB) ;CLEAR ERROR INDICATOR
LDB TEMP,[POINT 4,DMODE(CDB),35]
CMU <
;;=B4= 9 OF 13
MOVEI Y,1
CAIN TEMP,3 ;IS THE MODE 3
TRZA Y,-1 ;YES!!!
CAIN TEMP,4 ;OR CMU IMAGE MODE
JRST .+4 ;CAREFUL OF RELATIVE JUMPS!
;;=B4=
>;CMU
CAIL TEMP,10
CAILE TEMP,14
ERR <INOUT (INPUT SIDE): ILLEGAL DATA MODE:>,6
SKIPGE B,-3(P) ;# OF WORDS
HRLOI B,377777 ;ARBITRARILY LARGE NUMBER OF WDS
TH1: JUMPE B,RESTR ;NO MORE TO DO
SKIPG E,ICOWNT(CDB) ;#OF WORDS IN BUFFER
JRST TH5 ;BETTER GET SOME MORE
CMU <
;;=B4= 10 OF 13
CAIN Y,0 ;IMP MODE?
LSH E,-2 ;DIVIDE BY 4 TO GET WORD COUNT
;;=B4=
>;CMU
IBP IBP(CDB) ;MAKE SURE POINT TRIGHT
HRL C,IBP(CDB) ;INPUT POINTER
EXCH CHNL,(P) ;NOW FREEN OUTPUT STUFF
EXCH CDB,-1(P)
SKIPG OCOWNT(CDB) ;SOME LEFT
XCT IOOUT,SIMIO
SKIPA
JRST THERR
IBP OBP(CDB)
HRR C,OBP(CDB) ;OUTPUT POINTER
CAML E,B ;FIND # OF WORDS
MOVE E,B ;TO BLIT
NOCMU <
;;=B4= 11 OF 13
CAML E,OCOWNT(CDB) ;=MIN(B,ICOWNT,OCOWNT)
MOVE E,OCOWNT(CDB)
>;NOCMU
CMU <
CAMGE E,OCOWNT(CDB) ;=MIN(B,ICOWNT,OCOWNT)
JRST .+4
MOVE E,OCOWNT(CDB)
CAIN Z,0 ;IMP MODE?
LSH E,-2 ;DIVIDE BYTE COUNT BY 4
;;=B4=
>;CMU
MOVEI D,(C) ;MAKE BLT TERMINATOR
ADDI D,-1(E) ;FINAL ADDRESS
BLT C,(D) ;CHOMP CHOMP
SUB B,E ;WE'VE DONE THESE
MOVEI A,-1(E) ;TO UPDATE BYTE POINTER
ADDM A,OBP(CDB) ;TOLD YOU SO
CMU <
;;=B4= 12 OF 13
CAIE Z,0 ;IMP MODE?
JRST .+3
LSH E,2 ;MULTIPLY BY 4 FOR BYTE COUNT
DPB Z,[POINT 6,OBP(CDB),5]
;;=B4=
>;CMU
SUBM E,OCOWNT(CDB) ;UPDATE WORD COUNT
MOVNS OCOWNT(CDB) ;CLEVER,EH?
TH6: EXCH CHNL,(P) ;BACK TO INPUT SETUP
EXCH CDB,-1(P)
ADDM A,IBP(CDB) ;UPDATE INPUT PTR
CMU <
;;=B4= 13 OF 13
CAIE Y,0 ;IMP MODE?
JRST .+3
LSH E,2 ;MULTIPLY BY 4 FOR BYTE COUNT
DPB Y,[POINT 6,IBP(CDB),5]
;;=B4=
>;CMU
SUBM E,ICOWNT(CDB) ;UPDATE WORD COUNT
MOVNS ICOWNT(CDB) ;SUBTRACTION WAS BACKWARDS
JRST TH1 ;MORE OF SAME
TH5: XCT IOIN,SIMIO ;DO SOME INPUT
JRST TH1 ;NOW GO PLAY
THERR: SKIPGE TEMP,-3(P) ;# THE GUY WANTED
HRLOI TEMP,377777 ;IT WAS A FUDGE
SUB TEMP,B ;SUBTRACT #LEFT TO GET
HRRM TEMP,@ENDFL(CDB);#HE GOT
JRST RESTR
ENDCOM(THR)
COMPIL(LIN,<LINOUT>,<SIMIO,SAVE,RESTR,GETCHN,X33>,<LINOUT ROUTINE>)
COMMENT ⊗Linout ⊗
DSCR LINOUT(CHANNEL,VALUE);
CAL SAIL
⊗
HERE (LINOUT)
PUSHJ P,SAVE
MOVE CHNL,-2(P) ;CHANNEL
LOADI7 A,<LINOUT>
PUSHJ P,GETCHN ;CHANNEL DATA
MOVE TEMP,OBP(CDB) ;ADJUST TO FULL WORD
HRRZ A,OCOWNT(CDB) ;DON'T FORGET COUNT
LINOLP: TLNN TEMP,760000 ;LINED UP?
JRST OKLIGN ; YES
IBP TEMP ;0 WILL BE THERE
SOJA A,LINOLP
OKLIGN: MOVEM TEMP,OBP(CDB)
MOVEM A,OCOWNT(CDB) ;REPLACE UPDATED THINGS
CAIGE A,=10 ;ENOUGH ROOM FOR 2 WORDS?
XCT IOOUT,SIMIO ;NO, OUTPUT
JFCL ;IN CASE OUTPUT HAPPENED
SKIPGE B,-1(P) ;GET LINE NUMBER
JRST [MOVNS B
MOVNI A,5 ;ONLY PUT OUT 5 CHARS
JRST NOCONV] ;WAS GIVEN TO US IN TOTO
MOVNI A,6 ;PUT OUT TAB AFTER
MOVE C,[<ASCII /00000/>/2] ;TO MAKE 5
EXCH B,C
PUSH P,LNBAK ;RETURN ADDR
LNCONV: IDIVI C,=10
IORI D,"0"
DPB D,[POINT 7,(P),6]
SKIPE C ;THE RECURSIVE PRINTER
PUSHJ P,LNCONV
HLL C,(P) ;ONE CHAR, LEFT JUST
LSHC B,7
LNBAK: POPJ P,.+1
LSH B,1
TRO B,1
NOCONV: AOS C,OBP(CDB) ;MOVE OUT A WORD
MOVEM B,(C)
ADDM A,OCOWNT(CDB) ;UPDATE COUNT
MOVEI B,11
CAME A,[-5]
IDPB B,OBP(CDB) ;OUTPUT A TAB
NOTAB: MOVE LPSA,X33
JRST RESTR ;THAT'S IT
ENDCOM(LIN)
COMPIL(BRK,<BREAKSET,SETBREAK,STDBRK>
,<SAVE,RESTR,BRKMSK,SIMIO,GOGTAB,X22,X33>
,<BREAKSET, SETBREAK, STDBRK ROUTINES>)
COMMENT ⊗Breakset ⊗
DSCR BREAKSET(TABLE #,"STRING",WAY);
CAL SAIL
⊗
HERE (BREAKSET)
PUSHJ P,SAVE ;SAVE ACS AND THINGS
MOVE LPSA,X33
SUB SP,X22
SKIPLE A,-2(P) ;TABLE #
CAILE A,=18
ERR <THERE ARE ONLY 18 BREAK TABLES>
HLLZ B,BRKMSK(A) ;BREAK MASK FOR THIS TABLE
ADD A,USER
MOVE C,[ANDCAM B,(D)] ;USUAL CLEARING INSTR
LDB X,[POINT 4,-1(P),35] ;COMMAND
TRZN X,10 ;LEFT OR RIGHT HALF OF TABLE?
SKIPA X,BKCOM(X) ;RIGHT HALF
HLRZ X,BKCOM(X) ;LEFT HALF
JRST (X) ;DISPATCH
BKCOM: XWD XCLUDE,PASLINS ;X,,P
XWD INCL,PENDCH ;I,,A
XWD ILLSET,RETCH ;-,,R
;;%##% ADD BREAK MODE FOR COERCIONS
XWD UCASE,SKIPCH ;K,,S
XWD BRKLIN,RESTR ;L,,D
XWD ILLSET,ERMAN ;-,,E
;;%BG% ! ADD WAY TO UNDO "K"
XWD NOLINS,LCASE ;N,,F
XWD OMIT,ILLSET ;O,,-
ILLSET: ERR <ILLEGAL COMMAND TO BREAKSET>,1
JRST RESTR
XCLUDE: SKIPA C,[IORM B,(D)] ;YES, SET ALL TO 1 TO INITIALIZE
OMIT: MOVSS B ;OMIT, PUT BIT IN RH
INCL: MOVSI D,-200
HRRI D,BRKTBL(USER) ;RELOCATABLE IOWD
BRKLUP: XCT C ;CLEAR (OR SET) PROPER (HALF OF PROPER) TABLE
AOBJN D,BRKLUP
MOVE C,[IORM B,BRKTBL(D)] ;USUAL SETTING INSTR
CAIN X,XCLUDE ;BY EXCEPTION?
MOVE C,[ANDCAM B,BRKTBL(D)] ;YES, WANT TO TURN OFF BITS
ADDI C,(USER) ;RELOCATE IT
HRRZ A,1(SP) ;LENGTH OF STRING
MOVE X,2(SP) ;BYTE POINTER
JRST BRKL2
BRKL1: ILDB D,X ;GET A CHAR
XCT C ;DO RIGHT THING TO RIGHT BIT
BRKL2: SOJGE A,BRKL1
JRST RESTR
PASLINS: TDZA B,B ;PASS LINE NOS. SINE COMMENT
NOLINS: MOVEI B,-1 ;INFORM IN THAT IT SHOULD
MOVEM B,LINTBL(A) ; DELETE LINE NOS.
JRST RESTR
BRKLIN: SKIPA B,[-1] ;MARK BREAK ON LINE NOS. FOR THIS TBL
ERMAN: MOVSI B,-1 ;LH NEG SIGNALS ERMAN'S SCHEME
MOVEM B,LINTBL(A)
JRST RESTR
PENDCH: SETOM DSPTBL(A) ;APPEND TO END OF INPUT
JRST RESTR
SKIPCH: TDZA B,B ;CHAR NEVER APPEARS IN INPUT STRING
RETCH: MOVEI B,-1 ;RETAIN FOR NEXT TIME
MOVEM B,DSPTBL(A)
JRST RESTR
;;%##%
UCASE: MOVSS B ;INTO RIGHT HLF
IORM B,BRKCVT(USER)
JRST RESTR
;;%BG% =A1=
LCASE: MOVSS B
ANDCAM B,BRKCVT(USER)
JRST RESTR
COMMENT ⊗Setbreak
TBL IS AS IN BREAKSET
BRKSTRNG IS USED FOR ANY "I" OR "X" APPEARING IN MODESTRNG
OMITSTRNG (IF NOT NULL) IS USED TO SET THE "OMIT" SIDE OF THE TABLE
MODESTRNG CAN CONTAIN ANY OF THE VALID BREAKSET "MODE" CHARACTERS
I,X,O,N,R,A,P, or S.
This function is not attainable by the user unless he declares it.
⊗
DSCR SETBREAK(TABLE,"BREAKSTRING","OMITSTRING",MODESTRING");
CAL SAIL
⊗
HERE (SETBREAK)
HRRZ TEMP,-3(SP) ;DO OMIT STRING, IF PRESENT
JUMPE TEMP,NO.O ;NULL STRING DOESN'T COUNT
PUSH P,-1(P) ;TABLE #
PUSH SP,-3(SP) ;OMIT CHARACTERS
PUSH SP,-3(SP)
PUSH P,["O"] ;OMIT!
PUSHJ P,BREAKSET ;DO THAT
NO.O: HRRZS -1(SP) ;COUNT OF # OF COMMANDS
BKSLUP: SOSGE -1(SP) ;DONE?
JRST BKSDUN ; YES
PUSH P,-1(P) ;TABLE #
ILDB TEMP,(SP) ;COMMAND
PUSH P,TEMP
PUSH SP,-5(SP)
PUSH SP,-5(SP) ;STRING TO USE IF NECESSARY
PUSHJ P,BREAKSET
JRST BKSLUP ;DO IT -- AGAIN
BKSDUN: SUB P,X22
SUB SP,[XWD 6,6]
JRST @2(P)
COMMENT ⊗Stdbrk ⊗
DSCR STDBRK(CHANNEL);
CAL SAIL
⊗
HERE (STDBRK)
PUSHJ P,SAVE
MOVE LPSA,X22
MOVE CHNL,-1(P)
MOVEI CDB,D-DMODE ;SO WE CAN USE SIMIO'S OPEN
MOVEI D,17 ;DUMP MODE
MOVE D+1,['SYS ']
MOVEI D+2,0 ;NO HEADERS
XCT IOOPEN,SIMIO ;DO THE OPEN
ERR <DSK NOT AVAILABLE?>
MOVEI USER,D-FNAME ;SO WE CAN USE SIMIO'S LOOKUP
MOVE D,['BKTBL ']
MOVE D+1,['BKT '] ;FUNNY NAME AND EXTENSION
SETZB D+2,D+3
XCT IOLOOKUP,SIMIO ;DO THE LOOKUP
ERR <Standard break table not available>
MOVE USER,GOGTAB
MOVEI D,DSPTBL-1(USER)
HRLI D,-(=19+=19+=128) ;IOWD SIZE,LOC
MOVEI D+1,0 ;TERMINATE COMMAND LIST
XCT IODIN,SIMIO ;DO THE INPUT
SKIPA ;ALL WENT WELL
ERR <Error reading standard break table>
;; XCT IORELEASE NOW TAKES INHIBIT BITS IN RH OF D
MOVEI D,0 ;NO INHIBIT BITS TO RELEASE
XCT IORELEASE,SIMIO ;RELEASE FILE
JRST RESTR
HERE(BRKSP1) ; SPARES *******
HERE(BRKSP2);
ERR <DRYROT IN BRK SPARES>
ENDCOM(BRK)
COMPIL(CLS,<CLOSIN,CLOSO,CLOSE>,<SAVE,RESTR,SIMIO,X22>,<CLOSE ROUTINES>)
COMMENT ⊗Close, Closin, Closo
CLOSE(CHAN)
CLOSIN closes only the input side
CLOSO closes only the output side
⊗
DSCR CLOSIN(CHAN)
CAL SAIL
⊗
HERE (CLOSIN) PUSHJ P,SAVE ;CLOSE INPUT ONLY
MOVEI D,1
JRST CLSS
DSCR CLOSO(CHANNEL);
CAL SAIL
⊗
HERE (CLOSO)
PUSHJ P,SAVE ;CLOSE OUTPUT ONLY
MOVEI D,2
JRST CLSS
DSCR CLOSE(CHANNEL);
CAL SAIL
⊗
.CLS:
HERE (CLOSE) ;CLOSE BOTH
PUSHJ P,SAVE ;SAVE ACS AND THINGS
MOVEI D,0
CLSS: MOVE CHNL,-1(P)
MOVE LPSA,X22
CHKCHN CHNL,<CLOSE> ;VERIFY OK CHANNEL
SKIPN CDB,@CDBLOC(USER) ;GET CDB
JRST RESTR ;NOT OPEN, DON'T CLOSE
XCT IOCLOSE,SIMIO ;CLOSE CHAN,SPEC
SETZM INAME(CDB)
SETZM ONAME(CDB) ;NO FILE NAMES OPEN
JRST RESTR ;RETURN
ENDCOM(CLS)
COMPIL(MTP,<MTAPE,USETI,USETO,RENAME>
,<SAVE,RESTR,GETCHN,SIMIO,FILNAM,X22,X33,X44>
,<MTAPE, USETI, USETO, RENAME ROUTINES>)
COMMENT ⊗Mtape ⊗
DSCR MTAPE(CHANNEL,MODE);
CAL SAIL
⊗
.MTP:
HERE (MTAPE)
PUSHJ P,SAVE
MOVE LPSA,X33
MOVE CHNL,-2(P) ;CHANNEL NUMBER
LOADI7 A,<MTAPE>
PUSHJ P,GETCHN
LDB C,[POINT 5,-1(P),35] ;PART OF COMMAND CHAR
EXPO <
MOVEI B,101
CAIN C,11 ;MTAPE "I" DOES SPECIAL THINGS.
JRST MTAPQ ;GO SET IBM COMPABILITY MODE
>;EXPO
;;%##% ALLOW MTAPE(NULL) TO DO A MTAPE 0 -- WAIT
MOVEI B,0
JUMPE C,MTAPQ ;THIS IS DEFINITELY NOT A NO-OP
MOVE A,OPTAB ;COMMAND BITS
MOVE B,OPTAB+1 ;MORE
TRZE C,30 ;COMPRESS TABLE
ADDI C,5
LSH C,2 ;EACH COMMAND IS 4 BITS
ROTC A,(C) ;GET RIGHT COMMAND
ANDI B,17 ;DO IF SYSTEM DOESN'T
JUMPE B,[ERR <MTAPE: ILLEGAL CODE>,1
JRST RESTR]
MTAPQ: HRLI B,(<MTAPE>) ;CREATE MTAPE OPERATION
DPB CHNL,[POINT 4,B,12]
;%##% TRNE B,-1 ;IS THERE AN OPERATION?
XCT B ;YES, DO IT
JRST RESTR
OPTAB: BYTE (4) 16,17,0,0,3,6,7,13,10 ;A,B,,,E,F,R,S,T
BYTE (4) 11,0,1 ;U,,W
COMMENT ⊗ Useti, Useto, Rename ⊗
DSCR USETI,USETO(CHANNEL,BLOCK #);
CAL SAIL
⊗
HERE (USETI)
↑↑.USETI:
SKIPA LPSA,[XCT IOSETI,SIMIO] ;USETI
HERE (USETO)
↑↑.USETO:
MOVE LPSA,[XCT IOSETO,SIMIO] ;USETO
PUSHJ P,SAVE
MOVE CHNL,-2(P)
LOADI7 A,<USET>
PUSHJ P,GETCHN
MOVE A,-1(P) ;VALUE TO USETO
MOVE LPSA+1,[JRST .+2] ;BE ABLE TO GET BACK
JRST LPSA ;GO TO USETI/O
MOVE LPSA,X33
JRST RESTR
DSCR RENAME(CHANNEL,"NEW NAME",PROTECTION,@FAILURE FLAG);
CAL SAIL
⊗
HERE (RENAME)
↑↑.RENAME:
PUSHJ P,SAVE
SETZM @-1(P)
MOVE LPSA,X44
LOADI7 A,<RENAME>
MOVE CHNL,-3(P)
PUSHJ P,GETCHN
PUSHJ P,FILNAM ;PARSE FILENAME SPEC
JRST BDSPC ;SPECIFICATION NO GOOD
MOVE TEMP,-2(P)
ROT TEMP,-=9
MOVEM TEMP,FNAME+2(USER)
XCT IORENAME,SIMIO ;DO THE RENAME
JRST RNERR ;NO GOOD
JRST RESTR
BDSPC: HRRZ TEMP,ERRTST(CDB) ;SEE IF
TRNE TEMP,10000 ;WILLING TO HANDLE ERROR
ERR <RENAME: INVALID FILE SPECIFICATION>,1 ;NO, TELL HIM
SKIPA TEMP,[=8] ;ALWAYS REPORT CODE
RNERR: HRRZ TEMP,FNAME+1(USER) ;RETURN HORSESHIT NUMBER
HRROM TEMP,@-1(P) ;TO THE USER
JRST RESTR
ENDCOM(MTP)
COMPIL(USC,<USERCON>,<SAVE,RESTR,GOGTAB>,<USERCON ROUTINE>)
COMMENT ⊗Usercon ⊗
DSCR USERCON(@INDEX,@SETGET,FLAG);
CAL SAIL
PAR INDEX is USER-table displacement (usually obtained from HEAD.REL)
SETGET is used to communicate USER table values
FLAG is "OPCODE" input to USERCON
RES The INDEXth USER table entry is accessed (GLUSER table if FLAG negative).
On exit, SETGET contains old value of this entry.
If FLAG is odd, the original SETGET value replaces this entry.
⊗
CMU <
GGAS <
IFE ALWAYS, <EXTERNAL GLUSER>
>;GGAS
>;CMU
HERE(USERCON)
PUSHJ P,SAVE
MOVE LPSA,[XWD 4,4]
MOVE A,-1(P) ;THE FLAG
CMU < GGGON
>;CMU
GLOB <
MOVEI B,ENDREN
JUMPL A,[MOVEI USER,GLUSER
MOVEI B,ZAPEND ;USE GLOBAL TABLE
JRST .+1]
SKIPL C,-3(P) ;THE INDEX
CAML C,B
>;GLOB
NOGLOB <
SKIPL C,-3(P) ;THE INDEX
CAIL C,ENDREN ;CHECK BOUNDS
>;NOGLOB
ERR <USERCON: index out of bounds >,7,RESTR
ADD C,USER ;POINT AT CORRECT ENTRY
MOVE B,(C) ;GET OLD VALUE
MOVE D,@-2(P) ;(PERHAPS) NEW VALUE
TRNE A,1 ;STORE NEW VALUE?
MOVEM D,(C) ;YES
MOVEM B,@-2(P) ;RETURN OLD VALUE
GLOB <
MOVE USER,GOGTAB ;RESET
>;GLOB
JRST RESTR
CMU < GGGOFF
>;CMU
ENDCOM(USC)
COMMENT ⊗Ttyuuo functions ⊗
DSCR TTYUUO FUNCTIONS
CAL SAIL
⊗
Comment ⊗
INTEGER PROCEDURE INCHRW;
RETURN A CHAR FROM TTCALL 0,
INTEGER PROCEDURE INCHRS;
RETURN -1 IF NO CHAR WAITING, ELSE FIRST CHAR (TTCALL 2,)
STRING PROCEDURE INCHWL;
WAIT FOR A LINE, THEN RETURN IT (TTCALL 4, FOLLOWED BY TTCALL 0'S)
STRING PROCEDURE INCHSL(REFERENCE INTEGER FLAG);
FLAG←-1, STR←NULL IF NO LINE, ELSE FLAG←0,
STR←LINE (TTCALL 5, FOLLOWED BY TTCALL 0'S)
STRING PROCEDURE INSTR(INTEGER BRCHAR);
RETURN ALL CHARS TO AND NOT INCLUDING BRCHAR (TTCALL 0'S)
STRING PROCEDURE INSTRL(INTEGER BRCHAR);
WAIT FOR ONE LINE, THEN DO INSTR (TTCALL 4, FOLLOWED BY INSTR)
STRING PROCEDURE INSTRS(REFERENCE INTEGER FLAG; INTEGER BRCHAR);
FLAG←-1, STR←NULL IF NO LINES, ELSE FLAG←0,
STR←INSTR(BRCHAR)
PROCEDURE OUTCHR(INTEGER CHAR);
OUTPUT CHAR (TTCALL 1)
PROCEDURE OUTSTR(STRING STR);
OUTPUT STR (TTCALL 3)
PROCEDURE CLRBUF;
CLEARS INPUT BUFFER (TTCALL 11,)
TTYIN, TTYINS, TTYINL (TABLE, @BRCHAR);
TTYIN WORKS WITH TTCALL 0'S; TTYINS DOES A SKIP
ON LINE FIRST, RETURNING NULL AND -1 IN BREAK IF NO LINES
TTYINL DOES A WAIT FOR LINE FIRST.
FULL BREAKSET CAPABILITIES EXCEPT FOR
"R" MODE (AND OF COURSE, LINE NUM. STUFF)
TITLE TTYUUO
⊗
;;%##% ADD TTYUP TO ALL THIS
COMPIL(TTY,<INCHRW,INCHRS,INCHWL,INCHSL,INSTR,OUTCHR,OUTSTR,TTYUP
ENTINT <INSTRL,INSTRS,CLRBUF,TTYIN,TTYINS,TTYINL>>
,<SAVE,RESTR,X11,X22,X33,INSET,CAT,STRNGC,GOGTAB,BRKMSK,.SKIP.,.SONTP>
,<TELETYPE FUNCTIONS>)
;;#GF# DCS 2-1-72 (1-3) INCHWL BREAKS ON ALL ACTIVATION, TELLS WHICH IN .SKIP.
; .SKIP. EXTERNAL ABOVE
;;#GF#
EXPO <
IFE ALWAYS,<
EXTERN OTSTRBF
>;IFE ALWAYS
>;EXPO
;;%##% FOR TTYUP THING
DEFINE KONVERT(AC) <
SKIPN TTYCVT(USER)
JRST .+5
CAIL AC,"a"
CAILE AC,"z"
JRST .+2
TRZ AC,40 ;FORCE TO BE LOWER CASE
>
HERE (INCHRW) TTCALL A
;;%##%
MOVE USER,GOGTAB
KONVERT (A)
POPJ P,
HERE (INCHRS) TTCALL 2,A ;SKIP IF CHAR WAITING
MOVNI A,1 ;ELSE RETURN -1
;;%##%
MOVE USER,GOGTAB
KONVERT(A)
POPJ P,
HERE (OUTCHR) TTYUUO 1,-1(P) ;OUTPUT THE PARAMETER
SUB P,X22 ;REMOVE PARAMETER
JRST @2(P)
HERE (OUTSTR)
;;#FO# 11-18-71 DCS (1-2)
EXPO <
;;#FO#
;;#HC# 5-11-72 DCS MAKE OUTSTR BETTER IN EXPO VERSION (DUE TO LDE)
;;#MM# 5-25-73 ! MAKE SURE ITS LOADED BEFORE WE USE IT
MOVE USER,GOGTAB
EXCH A,-1(SP) ;LENGTH OF STRING
HRRZS A ; REALLY
EXCH B,(SP) ;PTR TO THE STRING
PUSH P,C ;NEED ANOTHER AC
JUMPLE A,OU.OUT ;DON'T DO ANYTHING
OSLOOP: MOVE C,A
SUBI A,14*5-1 ;# CHARS/CHOMP
SKIPLE A ;LOTS LEFT??
MOVEI C,14*5-1 ; YES,
;;%##% BETTER PLACE THAN SGACS
MOVE LPSA,[POINT 7,OTSTRBF];AS GOOD A PLACE AS ANY
ILDB TEMP,B
SKIPE TEMP ;NULL??
IDPB TEMP,LPSA ; NO
SOJG C,.-3
MOVEI TEMP,0 ;A NULL FOR THE END
IDPB TEMP,LPSA
TTCALL 3,OTSTRBF ;RAISON D'ETRE
JUMPG A,OSLOOP
OU.OUT: POP SP,B
POP SP,A
POP P,C
POPJ P,
;;#HC#
;;#FO# 11-18-71 DCS (2-2) MAKE OUTSTR WORK EFFICIENTLY USING TTYMES (STANFO ONLY)
>;EXPO
NOEXPO <
HLRZ TEMP,(SP) ;SIZE/POSITION FIELDS OF BP
TRZ TEMP,7777 ;CLEAR SIZE FIELD
OR TEMP,-1(SP) ;POSITION, COUNT IN RH FOR DDTOUT
TRNN TEMP,7777 ;IF NULL STRING, QUIT
JRST QUIT
HRLM TEMP,(SP)
MOVE TEMP,[SIXBIT /TTY/] ;DEVICE FOR TTYMES
MOVEM TEMP,-1(SP)
MOVEI TEMP,-1(SP) ;POINT AT SPEC
CALLI TEMP,400047 ;WRITE FIRST CHAR FOR LENGTH CHARS
;THIS IS THE SPECIAL TTYMES UUO AS PROVIDED BY HELLIWELL
JFCL ;IT HAS BEEN KNOW TO SKIP-RETURN
QUIT: SUB SP,X22 ;REMOVE THE ARGUMENT
>;NOEXPO
;;#FO#
POPJ P, ;DONE
TTWCHR←←=100 ;MAX NUMBER OF CHARS ON TTY INPUT
CMU < ;EXCEPT WE HAVE LARGER INPUT BUFFERS
TTWCHR←←=140
>;CMU
REDSTR: SKIPE SGLIGN(USER)
PUSHJ P,INSET
MOVEI A,TTWCHR
ADDM A,REMCHR(USER)
SKIPLE REMCHR(USER)
PUSHJ P,STRNGC
MOVNI A,TTWCHR
PUSH SP,[0] ;NULL STRING IF NOTHING DONE
PUSH SP,TOPBYTE(USER)
POPJ P,
FINSTR: CAIN TEMP,15 ;REMOVE LFD IF CR BROKE IT
TTCALL TEMP
FINS1: ADDM A,REMCHR(USER) ;NUMBER NOT USED
ADDI A,TTWCHR ;NUMBER USED
;;#GI# DCS 2-5-72 REMOVE TOPSTR
;;%##% ALLOW FOR ITERATIVE GETTING OF TTWCHR CHARS
HRROS -1(SP) ; TO STRING COUNT WORD
ADDM A,-1(SP) ;UPDATE COUNT WORD
;;#GI#
JRST RESTR
HERE (INSTR) PUSHJ P,SAVE
PUSHJ P,REDSTR
MOVE B,-1(P) ;BREAK CHAR
MOVE LPSA,X22 ;# TO REMOVE
INS1: PUUO 0,TEMP ;NEXT CHAR
;;%##%
KONVERT (TEMP) ;**** CONVERT BEFORE TEST BREAKEDNESS *****
INS2: CAMN TEMP,B ;BREAK?
JRST FINSTR ; YES, ALL DONE
IDPB TEMP,TOPBYTE(USER) ;PUT IT AWAY AND
;;% % LDE BETTER NOT READ IN TOO MANY CHARACTERS
AOJL A,INS1 ; IF ROOM, GO BACK FOR MORE
PUSHJ P,CHRMOR ;MAKE ROOM, THEN GO BACK
JRST INS1 ;
HERE (INCHWL) PUSHJ P,SAVE
PUSHJ P,REDSTR
MOVE LPSA,X11
TTCALL 4,TEMP
;;#GF# DCS 2-1-72 (2-3) DO LOOP HERE, DON'T USE INS1 LIKE BEFORE
INS3: CAIE TEMP,12
NOCMU < ;WE WILL JUST BREAK ON CR OR LF, THANK YOU
EXPO <
CAIN TEMP,33 ;NORMAL ALTMODE.
>;EXPO
NOEXPO <
CAIN TEMP,175
>;NOEXPO
JRST DNSTR
CAIE TEMP,15 ;CR?
TRNE TEMP,600 ;CONTROL BITS ON?
>;NOCMU
CMU < CAIE TEMP,15 ;CR?
CAIN TEMP,12 ; OR LF?
>;CMU
JRST DNSTR ;YES
;;%##%
KONVERT(TEMP)
IDPB TEMP,TOPBYTE(USER) ;PUT IT AWAY
TTCALL TEMP ;GET ANOTHER AND
;;%##% RHT -- MADE A BIT BETTER (ALLOW FOR GETTING MORE ROOM)
AOJL A,INS3 ;GO HANDLE IT (IF STILL HAVE ROOM)
PUSHJ P,CHRMOR ;GET ROOM FOR MORE CHARS
JRST INS3 ;GO HANDLE
DNSTR: MOVEM TEMP,.SKIP. ;SET BREAK CHAR
JRST FINSTR
;;#GF#
HERE (INCHSL) PUSHJ P,SAVE
MOVE LPSA,X22 ;PARAM (FLAG) AND RETURN
PUSHJ P,REDSTR
SETOM @-1(P) ;ASSUME FAILED
TTCALL 5,TEMP ;ARE THERE CHARS?
JRST FINSTR ;NO
SETZM @-1(P) ;YES, GET THEM
;;#GF# DCS 2-1-72 (3-3)
JRST INS3 ;USE INCHWL'S LOOP, NOT INSTR'S
;;#GF#
HERE (INSTRL) PUSHJ P,SAVE
MOVE LPSA,X22
PUSHJ P,REDSTR
TTCALL 4,TEMP
MOVE B,-1(P)
JRST INS2
HERE (INSTRS) PUSHJ P,SAVE
MOVE LPSA,X33
PUSHJ P,REDSTR
SETOM @-2(P)
TTCALL 5,TEMP
JRST FINSTR
SETZM @-2(P)
MOVE B,-1(P)
JRST INS2
HERE (CLRBUF) TTCALL 11,
POPJ P,
HERE (TTYINS) PUSHJ P,SAVE
PUSHJ P,REDSTR ;PREPARE TO MAKE A STRING
MOVE LPSA,X33
SETOM @-1(P) ;ASSUME NO CHARS
TTCALL 5,D ;SEE IF LINES WAITING
JRST FINS1 ;NONE WAINTING
;;%##% WILL DO INCHRW UUO IN LOOP
MOVE B,[TTCALL D]
JRST TYIN1 ;GO AHEAD
HERE (TTYINL)
PUSHJ P,SAVE
TTCALL 4,D ;WAIT FOR A LINE
MOVE B,[ TTCALL 4,D]
JRST TYIN
HERE (TTYIN) PUSHJ P,SAVE
TTCALL D ;GET A CHAR
MOVE B,[TTCALL D] ;FOR LOOP
TYIN: PUSHJ P,REDSTR ;PREPARE STACK,A,STRNGC FOR A STRING
MOVE LPSA,X33 ;PREPARE TO RETURN
TYIN1: SETZM @-1(P) ;ASSUME NO BREAK CHAR
SKIPL C,-2(P) ;TABLE #
CAILE C,=18
ERR <TTYIN: there are only 18 break tables>
HRRZ TEMP,USER
ADD TEMP,C ;TABLE NO(USER)
MOVEI Z,1 ;FOR TESTING LINE NUMBERS
SKIPN LINTBL(TEMP) ;DON'T LET TEST SUCCEED IF
MOVEI Z,0 ;WE'RE TO LET LINE NUMBERS THRU
MOVE FF,BRKMSK(C) ;GET MASK FOR THIS TABLE
;;%##% BREAK TABLE CONVERSION
TRNE FF,@BRKCVT(USER) ;SPECIFY UC COERCION
TLOA C,400000 ;YES
TLZ C,400000 ;NO
;;%##%
HRRZ Y,USER
ADD Y,[XWD D,BRKTBL] ;BRKTBL+RLC(USER)
JRST TTYN1
;;%##%
TTYN: XCT B ;1 CHAR
TTYN1:
;;%##%
JUMPGE C,TT.NUC ;COERCE BECAUSE OF BRK TBL ?
CAIL D,"a" ;ONLY IF LC
CAILE D,"z"
JRST TT.TSB ;GO TEST BREAK
TRZ D,40 ;MAKE UC
JRST TT.TSB
TT.NUC: KONVERT(D) ;MAY TURN TO UC BECAUSE OF TTY
TT.TSB:
;;%##%
TDNE FF,@Y ;BREAK OR OMIT?
JRST TTYSPC ; YES, FIND OUT WHICH
TTYC: IDPB D,TOPBYTE(USER) ;PUT IT AWAY
;;%##% BE SURE DONT EAT MORE AT A TIME THAN CAN BLOAT
AOJL A,TTYN ;COUNT AND CONTINUE
TTNMOR: PUSHJ P,CHRMOR ;ALLOW FOR MORE CHARS
JRST TTYN ;GO GO GO
TTYSPC: HLLZ TEMP,@Y ;WHICH?
TDNN TEMP,FF
JRST TTYN ;OMIT
MOVEM D,@-1(P)
MOVE Y,-2(P) ;WHAT TO DO WITH IT
ADD Y,USER
SKIPN Y,DSPTBL(Y)
JRST FINS1 ;DONE, NO SAVE
JUMPL Y,TTYAPP ;APPEND
ERR <TTYIN: cannot retain break char>,1,FINS1
TTYAPP: IDPB D,TOPBYTE(USER) ;COUNT THE BREAK CHAR
ADDI A,1 ;ONE MORE HAPPY CHAR
JRST FINS1
;;%##% ALLOW FOR ANOTHER CHUNK OF CHARS
CHRMOR: ADDI A,TTWCHR ;A ← NUMBER CHARS USED
ADDM A,-1(SP) ;UPDATE COUNT
PUSH P,[TTWCHR] ;GET SOME MORE
PUSHJ P,.SONTP ;BE SURE ROOM & ALIGNED
MOVNI A,TTWCHR ;REFRESH THE COUNT
POPJ P,
HEREFK(TTYUP,.TTYUP)
;;%##% FLAGS TTY TRANSLATION TO UPPER CASE & RETURNS OLD FLAG
MOVE USER,GOGTAB
MOVE A,-1(P)
EXCH A,TTYCVT(USER)
SUB P,X22
JRST @2(P) ;RETURN
ENDCOM(TTY)
EXPO <
COMPIL(PTY)
ENDCOM(PTY)
>;EXPO
NOEXPO <
COMPIL(PTY,<PTYGET,PTYREL,PTIFRE,PTOCNT,PTCHRW,PTCHRS
ENTINT <PTOCHS,PTOCHW,PTOSTR,BACKUP,LODED,PTYALL,PTYSTR,PTYIN>
ENTINT <PTYSTL,PTYGTL>>
,<SAVE,RESTR,X11,X22,X33,INSET,CAT,STRNGC,GOGTAB,BRKMSK,.SKIP.>
,<PTY ROUTINES>)
COMMENT ⊗Ptyuuo functions ⊗
OPDEF PTYUUO [711B8]
DSCR PTYUUO FUNCTIONS
CAL SAIL
⊗
COMMENT ⊗
BEGIN "PTYSPC"
INTEGER PROCEDURE PTYGET;
PROCEDURE PTYREL(INTEGER LINE);
INTEGER PROCEDURE PTIFRE(INTEGER LINE);
INTEGER PROCEDURE PTOCNT(INTEGER LINE);
INTEGER PROCEDURE PTCHRS(INTEGER LINE);
PROCEDURE PTOCHS(INTEGER LINE,CHAR);
PROCEDURE PTOCHW(INTEGER LINE,CHAR);
PROCEDURE PTOSTR(INTEGER LINE; STRING INFORMATION);
PROCEDURE LODED(STRING TRYAGAIN);
STRING PROCEDURE PTYALL(INTEGER LINE);
PROCEDURE BACKUP;
STRING PROCEDURE PTYSTR(INTEGER LINE,BRCHAR);
STRING PROCEDURE PTYIN(INTEGER LINE,BKTBL; REFERENCE INTEGER BRCHAR);
END "PTYSPC"
⊗
HERE (PTYGET)
SETOM .SKIP.
MOVEI A,0
PTYUUO A
SETZM .SKIP.
POPJ P,
HERE (PTYREL)
POP P,(P)
EXCH A,(P)
PTYUUO 1,A
POP P,A
JRST @2(P)
HERE (PTYGTL) PUSH P,(P) ;ANOTHER COPY OF RETURN ADDRESS.
PTYUUO 13,-2(P);POINT AT PTY LINE NUMBER
MOVE A,-1(P) ;RESULT.
SUB P,X33
JRST @3(P) ;AND RETURN.
HERE (PTYSTL) PTYUUO 14,-2(P);POINTED AT LINE NUMBER!
SUB P,X33
JRST @3(P)
HERE (PTIFRE)
MOVE TEMP,[PTYUUO 2,0]
JRST %PTY1
HERE (PTOCNT)
SKIPA TEMP,[PTYUUO 3,0]
HERE (PTCHRW)
MOVE TEMP,[PTYUUO 5,0]
%PTY1: POP P,(P)
EXCH 0,(P)
XCT TEMP
POP P,0
JRST @2(P)
HERE (PTCHRS)
POP P,(P)
EXCH 0,(P)
PTYUUO 4,0
MOVNI A,1
POP P,0
JRST @2(P)
HERE (PTOCHS)
SKIPA TEMP,[PTYUUO 6,0]
HERE (PTOCHW)
MOVE TEMP,[PTYUUO 7,0]
SETOM .SKIP.
POP P,(P)
EXCH A,(P)
EXCH 0,-1(P)
XCT TEMP
SETZM .SKIP.
POP P,A
POP P,0
JRST @3(P)
HERE (LODED)
MOVEI TEMP,0
EXCH TEMP,(P)
PUSH P,TEMP
SKIPA TEMP,[PTYUUO 15,-1(SP)]
HERE (PTOSTR)
MOVE TEMP,[PTYUUO 11,-1(SP)]
PUSH P,TEMP
MOVE USER,GOGTAB
PUSHJ P,INSET
PUSH SP,[1]
PUSH SP,[POINT 7,[0]]
PUSHJ P,CAT
POP P,TEMP
POP P,(P)
POP P,-1(SP)
XCT TEMP
SUB SP,X22
JRST @2(P)
HERE (BACKUP)
TTYUUO 10,
POPJ P,
HERE (PTYALL)
PUSHJ P,SAVE
MOVE 0,-1(P) ;LINE NUMBER
PTYUUO 3,0
JUMPE A,[PUSH SP,[0]
PUSH SP,[0]
JRST ALLQ]
MOVEI A,=450
ADDM A,REMCHR(USER)
SKIPL REMCHR(USER)
PUSHJ P,STRNGC
PUSHJ P,INSET
PUSH SP,-1(P) ;PTY LINE NUMBER
PUSH SP,TOPBYTE(USER) ;AND BYTE POINTER.
PTYUUO 10,-1(SP) ;AND ASK FOR ALL THAT IS THERE.
MOVEI B,0
MOVE C,(SP) ;BYTE POINTER.
;;#IN# 7-11-72 DCS TOPBYTE INVALIDLY UPDATED (ONE TOO FAR)
SOMMOR: MOVE LPSA,C ;LAG BY ONE #IN#
ILDB 0,C ;GET CHAR
JUMPE 0,ALLDUN
AOJA B,SOMMOR
ALLDUN: CAILE B,=445
ERR <PTYALL OVERFLOW -- IT JUST CAN'T HAPPEN!!!!>
HRROM B,-1(SP) ;SAVE AS RESULT.
MOVEM LPSA,TOPBYTE(USER);THIS IS WHERE TO START ENXT ITEM. #IN#
;;#IN#
SUBI B,=156 ;-ESTIMATE
ADDM B,REMCHR(USER) ;AND UPDATE FREE COUTN.
ALLQ: MOVE LPSA,X22
JRST RESTR
%REDSTR:SKIPE SGLIGN(USER)
PUSHJ P,INSET
MOVEI A,=100
ADDM A,REMCHR(USER)
SKIPLE REMCHR(USER)
PUSHJ P,STRNGC
MOVNI A,=100
PUSH SP,[0] ;NULL STRING IF NOTHING DONE
PUSH SP,TOPBYTE(USER)
POPJ P,
%FINSTR: CAIN TEMP,15 ;REMOVE LFD IF CR BROKE IT
;;#PO# ! RHT THIS USED TO BE CDB (=11) & MUNGED 12
;; USE C & D INSTEAD
PTYUUO 5,C ;HE USED TO SAY CDB
%FINS1: ADDM A,REMCHR(USER) ;NUMBER NOT USED
ADDI A,=100 ;NUMBER USED
HRROM A,-1(SP) ; AND TO STRING COUNT WORD
JRST RESTR
HERE (PTYSTR)
PUSHJ P,SAVE
PUSHJ P,%REDSTR
;;#PO#
MOVE C,-2(P)
MOVE B,-1(P) ;BREAK CHAR
MOVE LPSA,X33 ;# TO REMOVE
;;#PO# (2 LINES)
%INS1: PTYUUO 5,C ;NEXT CHAR
%INS2: CAMN D,B ;BREAK?
JRST %FINSTR ; YES, ALL DONE
;;#PO#
IDPB D,TOPBYTE(USER) ;PUT IT AWAY AND
AOJA A,%INS1 ; GO BACK FOR MORE
JRST %INS2
HERE (PTYIN) PUSHJ P,SAVE
;;#PO# (2 LINES)
MOVE C,-3(P)
PTYUUO 5,C
%TYIN: PUSHJ P,%REDSTR ;PREPARE STACK,A,STRNGC FOR A STRING
MOVE LPSA,[XWD 4,4] ;PREPARE TO RETURN
%TYIN1: SETZM @-1(P) ;ASSUME NO BREAK CHAR
SKIPL T,-2(P) ;TABLE # (INTO AC 11)
CAILE T,=18
ERR <PTYIN: there are only 18 break tables>
HRRZ TEMP,USER
ADD TEMP,T ;TABLE NO(USER)
MOVEI Z,1 ;FOR TESTING LINE NUMBERS
SKIPN LINTBL(TEMP) ;DON'T LET TEST SUCCEED IF
MOVEI Z,0 ;WE'RE TO LET LINE NUMBERS THRU
MOVE FF,BRKMSK(T) ;GET MASK FOR THIS TABLE
HRRZ Y,USER
;;#PO# !
ADD Y,[XWD D,BRKTBL] ;BRKTBL+RLC(USER)
JRST %TTYN1
;;#PO# !
%TTYN: PTYUUO 5,C
%TTYN1: TDNE FF,@Y ;BREAK OR OMIT?
JRST %TTYSPC ; YES, FIND OUT WHICH
;;#PO# !
%TTYC: IDPB D,TOPBYTE(USER) ;PUT IT AWAY
AOJL A,%TTYN ;COUNT AND CONTINUE
JRST %FINS1 ;DONE
%TTYSPC: HLLZ TEMP,@Y ;WHICH?
TDNN TEMP,FF
JRST %TTYN ;OMIT
;;#PO# !
MOVEM D,@-1(P)
MOVE Y,-2(P) ;WHAT TO DO WITH IT
ADD Y,USER
SKIPN Y,DSPTBL(Y)
JRST %FINS1 ;DONE, NO SAVE
JUMPL Y,%TTYAPP ;APPEND
ERR <PTYIN: cannot retain break char>,1,%FINS1
;;#PO#
%TTYAPP: IDPB D,TOPBYTE(USER) ;COUNT THE BREAK CHAR
ADDI A,1 ;ONE MORE HAPPY CHAR
JRST %FINS1
ENDCOM(PTY)
>;NOEXPO
IFN ALWAYS,<
BEND IOSER>
DSCR BEND IOSER
⊗