perm filename IOSER.TNX[IMS,AIL] blob
sn#051749 filedate 1973-07-03 generic text, type T, neo UTF8
COMMENT ⊗ TENEX-IOSER -- R. SMITH ⊗
LSTON (IOSER)
IFN ALWAYS, <BEGIN IOSER>
COMMENT ⊗ INDICES, BITS FOR TENEX VERSION OF IOSER ⊗
;WORDS IN CDB BLOCK FOR EACH CHANNEL
↓GFL←←0 ;FLAGS FOR GTJFN
↓OFL←←1 ;FLAGS FOR OPENF
↓BRCHAR←←2 ;BRCHAR ADDRESS
↓ICOUNT←←3 ;COUNT ADDRESS
↓ENDFL←←4 ;EOF ADDRESS
↓ICOWNT←←5 ;INPUT COUNT
↓IBP←←6 ;INPUT BYTE-POINTER
↓OCNT←←7 ;OUTPUT COUNT
↓OBP←←10 ;OUTPUT BYTE-POINTER
↓DVTYP←←11 ;DEVICE TYPE
↓DVDSG←←12 ;DEVICE DESIGNATOR
↓OPNDUN←←13 ;TRUE IF OPENED WITH THE OPEN STATEMENT
↓DVCH←←14 ;DEVICE CHARACTERISTICS
↓DMPED←←15 ;TRUE IF DUMP MODE OUTPUT SEEN
;IN PARTICULAR USED TO NOTE IF A MAGTAPE
;HAS BEEN WRITTEN BUT NOT YET CLOSED,
;SINCE EOF'S ARE WRITTEN AT THE CLOSE
;BY CLOSF,CFILE,CLOSE,ETC.
↓LINNUM←←16 ;LINE NO (FOR INPUT FUNCTION)
↓PAGNUM←←17 ;PAGE NO (FOR INPUT FUNCTION)
↓SOSNUM←←20 ;SOS LINE NO (FOR INPUT FUNCTION)
↓IOTLEN←←21 ;CURRENT LENGTH OF CDB BLOCK
IFNDEF JFNSIZE, <↓JFNSIZE←←20> ;NUMBER OF CHANNELS ALLOWED
↓DMOCNT←←200 ;(DEFAULT) COUNT FOR DUMP MODE OUTPUT
IFNDEF STARTPAGE,<↓STARTPAGE←←610 ;STARTING PAGE FOR BUFFERS>
;BITS FOR SCAN FLAGS FOR OPENFILE ROUTINE
;THE BITS OF THE FLAGS WORD ARE THE SAME AS THE BITS OF GTJFN AND OPENF
;HOPEFULLY (WHERE APPLICABLE)
↓STARBIT←←1B11 ;B11 OF GTJFN FOR INDEXED FILES
↓TEMBIT←←1B5 ;B5 OF GTJFN FOR TEMPORARY FILE
↓DELBIT←←1B8 ;GTJFN -- IGNORE DELETED BIT
↓RDBIT←←1B19 ;B19 OF OPENF FOR READING
↓WRBIT←←1B20 ;B20 OF OPENF FOR WRITING
↓APPBIT←←1B22 ;B22 OF OPENF FOR APPEND
↓CONFB1←←1B3 ;GTJFN BIT TO PRINT [CONFIRM] ETC
↓CONFB2←←1B4 ;GTJFN BIT TO REQUIRE CONFIRMATION FROM USER
;ODDLY ENOUGH 3 AND 4 ARE ILLEGAL
↓OUTBIT←←1B0 ;GTJFN -- FILE FOR OUTPUT USE
↓OLDBIT←←1B2 ;GTJFN -- OLD FILE
↓NEWBIT←←1B1 ;GTJFN -- NEW FILE
↓ERTNBIT←←1B27 ;ERROR RETURN BIT -- INTERNAL
↓BINBIT←←1B26 ;BINARY BIT -- INTERNAL
↓THAWBIT←←1B25 ;THAWBIT GTJFN
↓ERSNBIT←←1B28 ;ERROR SEEN -- INTERNAL
↓CONFBIT←←1B29 ;CONFIRMATION -- INTERNAL
;MACROS FOR BIT TESTING
DEFINE .ZZZ $ (X,Y,Z)<
IFN Z&777777000000, <TL$X Y,Z⊗-=18> ;Z LSH -=18
IFN Z&777777, <TR$X Y,Z>
>
DEFINE TESTE (Y,Z) <.ZZZ NE,Y,Z> ;TDNE Y,[Z]
DEFINE TESTN (Y,Z) <.ZZZ NN,Y,Z> ;TDNN Y,[Z]
DEFINE TESTO (Y,Z) <.ZZZ O,Y,Z> ;TDO Y,[Z]
DEFINE TESTZ (Y,W) <.ZZZ Z,Y,W> ;TDZ Y,[Z]
;MACRO TO GET THE JFN NUMBER IN X FROM Y. IF INVALID, JUMP TO LABEL Z
;LOADS CDB (I.E., 11) WITH THE CDB ADDRESS
;LOADS Q WITH THE CHANNEL NUMBER
DEFINE VALCHN(X,Y,Z) <
SKIPL Q,Y
CAIL Q,JFNSIZE
JRST Z
MOVE CDB,CDBTBL(Q)
HRRZ X,JFNTBL(Q)
SKIPN X
JRST Z
>
;ONLY USES AC X
DEFINE VALCH1(X,Y,Z) <
SKIPL X,Y
CAIL X,JFNSIZE
JRST Z
HRRZ X,JFNTBL(X)
SKIPN X
JRST Z
>
;TTY STUFF
;CHAR FOR LINE DELETION (DELLINE) AND CHARACTER DELETION (RUBCHAR)
IFN IMSSS,<
↓DELLINE←←"U"-100 ;CTRL-U
↓RUBCHAR←←177 ;RUBOUT
>;IFN IMSSS
IFE IMSSS,<
↓DELLINE←←"X"-100 ;CTRL-X
↓RUBCHAR←←"A"-100 ;CTRL-A
>;IFE IMSSS
COMPIL(PAT,<OPEN,LOOKUP,ENTER,USETI,USETO,MTAPE,RELEASE,CLOSE,CLOSIN,CLOSO,GETCHAN,CVJFN,RENAME>
,<SAVE,RESTR,RELEASE,CORGET>
,<PAT -- TENEX ROUTINES EMULATING DEC CALLS>)
BEGIN PAT
DSCR PROCEDURE OPEN(INTEGER CHAN; STRING DEV; INTEGER MODE,IBUF,OBUF;
REFERENCE INTEGER COUNT,BR,EOF)
⊗
HERE(OPEN)
BEGIN OPEN
GTFLAGS←←4
OPFLAGS←←5
PUSH P,-7(P)
PUSHJ P,RELEASE ;RELEASE IF ALREADY OPEN
;SEE WHAT KIND OF DEVICE WE HAVE
PUSH SP,-1(SP)
PUSH SP,-1(SP)
PUSH P,[0]
PUSHJ P,CATCHR ;PUT ON A NULL CHAR
PUSHJ P,MAKUP ;MAKE UPPER CASE (DAMMIT)
PUSH SP,-3(SP)
PUSH SP,-3(SP)
PUSH SP,[3]
PUSH SP,[POINT 7,[ASCIZ/:
/]]
PUSHJ P,CAT ;PUT ON A STRING
POP SP,-4(SP)
POP SP,-4(SP) ;SAVE ABOVE
PUSHJ P,SAVE ;NOW SAVE ACS
SETZ LPSA, ;NO PARAMETERS TO REMOVE
MOVE Q,-7(P) ;USER CHANNEL NUMBER
MOVE 1,(SP) ;STRING FOR DEVICE
SUB SP,X22 ;ADJUST STACK
JSYS STDEV
JRST BADOPN ;NOT A PLAUSIBLE DEVICE
PUSH P,2 ;SAVE DEVICE DESIGNATOR
;ITS A PLAUSIBLE DEVICE
MOVEI C,IOTLEN
PUSHJ P,CORGET
ERR <OPEN: CANNOT GET CORE>
MOVE CDB,B ;IO BLOCK ADDRESS
MOVEM CDB,CDBTBL(Q) ;SAVE
;ZERO OUT CORE (SINCE CORGET DOESNT!!!)
HRL B,B
ADDI B,1
SETZM (CDB)
BLT B,IOTLEN-1(CDB)
POP P,1 ;GET DEVICE DESIGNATOR
MOVEM 1,DVDSG(CDB) ;AND SAVE IT
JSYS DVCHR
MOVEM 2,DVCH(CDB) ;SAVE DEVICE CHARACTERISTICS
HLRZ 1,2
ANDI 1,777 ;DEVICE TYPE
MOVEM 1,DVTYP(CDB) ;SAVE IT
TLNN 2,100000 ;IS DEVICE A DIRECTORY DEVICE
JRST GTNOW ;NOPE, DO GTJFN AND OPENF NO
HASDIR:
;GET THE MODE IN 4
MOVE 4,-6(P) ;MODE
ANDI 4,17 ;FORGET OTHER JUNK
;IF DEVICE IS A DECTAPE IN DUMP MODE THEN DO IT NOW ALSO
CAIE 1,3 ;IS IT A DECTAPE?
JRST HASDI1 ;NO
CAIN 4,17 ;IN DUMP MODE?
JRST DOMNT ;YES MOUNT AND THEN OPEN
;SO DONT DO GTJFN NOW, BUT WAIT
HASDI1: SETZM JFNTBL(Q) ;BE SURE
MOVEM 4,GFL(CDB) ;SAVE THE MODE AS THE GTJFN FLAGS
HRL 4,-5(P) ;INPUT BUFFERS
HRR 4,-4(P) ;OUTPUT BUFFERS
MOVEM 4,OFL(CDB) ;SAVE AS THE OPENF FLAGS
JRST GUDRET ;AND RETURN
;MOUNT AND OPEN DECTAPE IN DUMP MODE
DOMNT: MOVE A,DVDSG(CDB) ;GET DEVICE DESIGNATOR
TLO A,(1B3) ;DONT READ DIRECTORY FOR DUMP MODE
JSYS MOUNT
JRST BADOPN ;CANNOT MOUNT
MOVSI GTFLAGS,100001
MOVE 1,GTFLAGS
MOVE 2,(SP)
JSYS GTJFN
JRST BADOPN
MOVEM 1,JFNTBL(Q)
MOVEM GTFLAGS,GFL(CDB)
MOVE OPFLAGS,[447400000000!RDBIT!WRBIT]
MOVE 2,OPFLAGS
JSYS OPENF
JRST CNTOPN
JRST OPOK
GTNOW:
MOVSI GTFLAGS,100001
MOVE 1,GTFLAGS
MOVE 2,(SP) ;DEVICE STRING
JSYS GTJFN
JRST BADOPN ;NOPE CANNOT GET
MOVEM 1,JFNTBL(Q) ;SAVE JFN
MOVEM GTFLAGS,GFL(CDB) ;AND SAVE THEM
;COMPUTE OPENF FLAGS
SETZ OPFLAGS,
MOVE 2,DVCH(CDB) ;DEVICE CHARACTERISTICS
TESTE 2,<1B1> ;CAN DO INPUT?
TESTO OPFLAGS,RDBIT
TESTE 2,<1B0> ;CAN DO OUTPUT?
TESTO OPFLAGS,WRBIT
;NOW TRY VARIOUS THINGS, LOOKING FOR SOMETHING THAT WORKS
HRRZ 1,JFNTBL(Q)
HRLI OPFLAGS,440000
MOVE 2,OPFLAGS ;36-BIT, MODE 0
JSYS OPENF
SKIPA
JRST OPOK
HRRZ 1,JFNTBL(Q)
HRLI OPFLAGS,447400 ;36-BIT, MODE 17
MOVE 2,OPFLAGS
JSYS OPENF
SKIPA
JRST OPOK
HRRZ 1,JFNTBL(Q)
HRLI OPFLAGS,70000 ;7-BIT, MODE 0
MOVE 2,OPFLAGS
JSYS OPENF
JRST NOOPN
OPOK: MOVEM OPFLAGS,OFL(CDB) ;SAVE OP FLAGS
GUDRET:
;SAVE FLAGS
SETOM OPNDUN(CDB) ;INDICATE OPENED WITH OPEN
POP P,TEMP ;RETURN ADDRESS
POP P,ENDFL(CDB) ;SAVE GOOD THINGS
POP P,BRCHAR(CDB)
POP P,ICOUNT(CDB)
SETZM @ENDFL(CDB) ;INDICATE GOOD OPENING
SUB SP,X22 ;CLEAN UP STACKS
SUB P,X44
JRST RESTR ;AND RETURN
NOOPN:
CNTOPN: SKIPN 1,JFNTBL(Q) ;RELEASE JFN
JSYS RLJFN
JFCL
BADOPN:
SKIPE B,CDBTBL(Q) ;CORE ALLOCATED?
PUSHJ P,CORREL ;RELEASE CORE
SETZM JFNTBL(Q)
SETZM CDBTBL(Q)
SKIPN @-1(P) ;USER WANTS ERROR?
ERR <OPEN: IO ERROR OR ILLEGAL SPECIFICATIONS>,1
SETOM @-1(P)
POP P,TEMP
SUB P,[XWD 7,7]
SUB SP,X22
JRST RESTR
BEND OPEN
;MAKE UPPER CASE LETTERS
MAKUP: PUSHJ P,SAVE
HRRZ A,-1(SP) ;LENGTH OF STRING
ADDM A,REMCHR(USER)
SKIPLE REMCHR(USER) ;OK?
PUSHJ P,STRNGC ;NO, COLLECT
MOVE B,A
HRRO A,A
PUSH SP,A
PUSH SP,TOPBYTE(USER)
UPPER1: JUMPLE B,UPPER2 ;DONE YET?
ILDB C,-2(SP) ;NEXT CHAR
CAIL C,141
CAILE C,172
SKIPA
SUBI C,40 ;CONVERT TO UPPER CASE
IDPB C,TOPBYTE(USER)
SOJA B,UPPER1
UPPER2: POP SP,-2(SP)
POP SP,-2(SP)
SETZ LPSA,
POP P,TEMP ;RETURN ADDR
JRST RESTR ;RETURN
DSCR PROCEDURE LOOKUP(INTEGER Q; STRING FILE; REFERENCE INTEGER FLAG)
⊗
HERE(LOOKUP)
BEGIN LOOKUP
PUSHJ P,TENXFI ;MAKE THE FILE SPEC TENEX
PUSH P,1
PUSH P,2
PUSH P,3
PUSH P,Q
PUSH P,CDB
DEFINE CHNARG <-7(P)>
DEFINE FLGARG <-6(P)>
SKIPL Q,CHNARG
CAIL Q,JFNSIZE
JRST BADLU1
MOVE CDB,CDBTBL(Q)
SKIPN OPNDUN(CDB) ;ERROR IF NOT OPENED
JRST BADLU1
MOVE 2,DVCH(CDB) ;GET DEVICE CHARACTERISTICS
TLNN 2,100000 ;DOES DEVICE HAVE A DIRECTORY?
JRST LUKRET ;NO, NO LOOKUP
SKIPE JFNTBL(Q) ;JFN ALREADY ASSIGNED?
PUSHJ P,RELNOW ;YES, RELEASE IT
PUSHJ P,DEVCAT
MOVSI 1,100001 ;OLD FILE
MOVE 2,(SP)
JSYS GTJFN
JRST BADLUK
MOVEM 1,JFNTBL(Q)
MOVSI 3,100001
MOVEM 3,GFL(CDB)
MOVE 2,[XWD 440000,200000] ;36-BIT
JSYS OPENF
SKIPA
JRST GUDLUK
MOVE 1,JFNTBL(Q)
MOVE 2,[XWD 447400,200000] ;36-BIT, DUMP
JSYS OPENF
SKIPA
JRST GUDLUK
MOVE 1,JFNTBL(Q)
MOVE 2,[XWD 70000,200000] ;7-BIT
JSYS OPENF
JRST BADLUK
GUDLUK: MOVEM 2,OFL(CDB)
SETZM @FLGARG
LUKRET: POP P,CDB
POP P,Q
POP P,3
POP P,2
POP P,1
SUB SP,X22
SUB P,X33
JRST @3(P)
BADLUK: MOVEM 1,@FLGARG
JRST LUKRET
BADLU1: SETOM @FLGARG
JRST LUKRET
BEND LOOKUP
DEVCAT:
;HERE WITH CDB LOADED, FILENAME ON THE SP STACK
;RETURN WITH "DEV:FILE" & 0 ON THE SP STACK
;MUST NOT HAVE CALLED SAVE WHEN THIS IS CALLED
PUSH P,1
PUSH P,2
PUSH P,[=100]
PUSHJ P,ZSETST ;BP IN 1
MOVE 2,DVDSG(CDB) ;DEVICE DESIGNATOR
JSYS DEVST
ERR <LOOKUP, ENTER, OR RENAME: CANNOT DO DEVST>
PUSH P,[=100]
PUSH P,1 ;UPDATED BP
PUSHJ P,ZADJST
PUSH P,[":"]
PUSHJ P,CATCHR
PUSHJ P,CAT.RV
PUSH P,[0]
PUSHJ P,CATCHR
POP P,2
POP P,1
POPJ P,
;RELEASE JFN ALREADY THERE
RELNOW:
PUSH P,Q ;CHANNEL
PUSHJ P,CLOSF ;CLOSE DANCE
PUSH P,1
MOVE 1,JFNTBL(Q) ;GET JFN
JSYS RLJFN ;RELEASE
ERR <LOOKUP: CANNOT RELEASE JFN>,1
SETZM JFNTBL(CDB) ;AND ZERO OUT
POP P,1
POPJ P,
HERE(ENTER)
BEGIN ENTER
PUSHJ P,TENXFI
PUSH P,1
PUSH P,2
PUSH P,3
PUSH P,Q
PUSH P,CDB
DEFINE CHNARG <-7(P)>
DEFINE FLGARG <-6(P)>
SKIPL Q,CHNARG
CAIL Q,JFNSIZE
JRST BADEN1
MOVE CDB,CDBTBL(Q)
SKIPN OPNDUN(CDB)
JRST BADEN1 ;WAS AN OPEN PERFORMED HERE?
SKIPN 1,JFNTBL(Q)
JRST NOTOPN
MOVE 2,DVCH(CDB) ;GET DEVICE CHARACTERISTICS
TLNN 2,100000 ;DOES DEVICE HAVE DIRECTORY?
JRST ENTRET ;NO
PUSH P,1 ;SAVE JFN
JSYS CLOSF
JRST BADENT ;ERROR IN 1
POP P,1
MOVE 2,OFL(CDB)
TESTO 2,WRBIT ;TURN ON WRITE BIT
MOVEM 2,OFL(CDB) ;AND SAVE NEW FLAGS
JSYS OPENF
JRST BADENT ;ERROR IN 1
JRST ENTRET ;RETURN
NOTOPN:
PUSHJ P,DEVCAT
MOVSI 1,600001 ;NEW FILE
MOVE 2,(SP)
JSYS GTJFN
JRST BADENT ;CANNOT GTJFN
MOVEM 1,JFNTBL(Q)
MOVSI 2,600001 ;THE
MOVEM 2,GFL(CDB) ;SAVE THE GTJFN FLAGS
B36: HRRZ 1,JFNTBL(Q)
MOVE 2,[XWD 440000,100000] ;36-BIT
JSYS OPENF
SKIPA
JRST ENT1
HRRZ 1,JFNTBL(Q)
MOVE 2,[XWD 447400,100000] ;36-BIT, DUMP
JSYS OPENF
SKIPA
JRST ENT1
HRRZ 1,JFNTBL(Q)
MOVE 2,[XWD 70000,100000]
JSYS OPENF
JRST BADENT
ENT1: MOVEM 2,OFL(CDB)
ENTRET: SETZM @FLGARG
ENTPOP: POP P,CDB
POP P,Q
POP P,3
POP P,2
POP P,1
SUB SP,X22
SUB P,X33
JRST @3(P)
BADENT: MOVEM 1,@FLGARG
JRST ENTPOP
BADEN1: SETOM @FLGARG
JRST ENTPOP
BEND ENTER
DSCR
RENAME(CHNL,"STR",PROT,@FLAG)
Since protection is not implemented in TENEX,
the feature will be ignored.
⊗
HERE(RENAME)
BEGIN RENAME
PUSH P,1
PUSH P,2
PUSH P,3
PUSH P,Q
PUSH P,CDB
DEFINE CHNARG <-10(p)>
DEFINE FLGARG <-6(P)>
VALCHN 1,CHNARG,RENBAD
MOVE 2,DVCH(CDB) ;DEVICE CHARS
TLNN 2,100000 ;DIRECTORY DEVICE?
JRST RENRET ;NO, NOP
PUSHJ P,TENXFI ;MAKE A TENEX FILE NAME
;PERHAPS ONLY A DELETE?
HRRZ 2,-1(SP) ;NULL FILE SPEC?
JUMPE 2,RENDEL ;YES, DELETE
;ACTUALLY RENAME (ON THE SAME DEVICE)
PUSH P,CHNARG
PUSHJ P,CLOSF ;FIRST CLOSE THE FILE
PUSHJ P,DEVCAT
MOVE 3,1 ;SAVE FIRST JFN
MOVE 1,GFL(CDB) ;USE SAME FLAGS
TESTZ 1,OLDBIT ;EXCEPT NOT OLD
TESTO 1,NEWBIT ;BUT DO WANT NEW
TESTO 1,OUTBIT ;AND VERSION DEFAULTING
MOVEM 1,GFL(CDB) ;SAVE FLAGS
MOVE 2,(SP)
JSYS GTJFN
JRST RENERR ;ERROR BITS IN 1
MOVE 2,1 ;NEW JFN
MOVE 1,3 ;OLD JFN
JSYS RNAMF
JRST RENERR ;ERROR BITS IN 1
MOVE 1,2 ;NEW JFN
MOVE 2,OFL(CDB) ;OPENF FLAGS
JSYS OPENF
JRST RENERR ;ERROR BITS IN 1
MOVEM 1,JFNTBL(Q) ;SAVE THE NEW JFN
RENRET: SETZM @FLGARG ;INDICATE A GOOD RETURN
RENRE1: POP P,CDB
POP P,Q
POP P,3
POP P,2
POP P,1
SUB SP,X22
SUB P,X44
JRST @4(P)
RENERR: MOVEM 1,@FLGARG
JRST RENRE1
RENBAD: SETOM @FLGARG
JRST RENRE1
RENDEL: JSYS DELF ;JFN IN 1
JRST RENERR
JRST RENRET
BEND RENAME
DSCR PROCEDURE USETI,USETO(INTEGER CHANNEL,BLOCK)
⊗
HERE(USETI)
HERE(USETO)
PUSHJ P,SAVE
MOVE LPSA,X33
VALCHN 1,-2(P),USETER
MOVE 2,DVTYP(CDB)
CAIN 2,3 ;IS IT A DECTAPE?
JRST USEDTA ;YES
DOSFPT: MOVE 2,-1(P)
SUBI 2,1
IMULI 2,200 ;BLOCK NUMBER
JSYS SFPTR
ERR <USETI OR USETO: CANNOT DO SFPTR>,1
JRST RESTR
USEDTA:
;SFPTR DOES NOT SEEM TO WORK TO THE DECTAPE IN TENEX
;;; LDB 2,[POINT 4,OFL(CDB),9] ;MODE
;;; CAIE 2,17 ;DUMP?
;;; JRST DOSFPT ;NO
MOVEI 2,30 ;OPERATION 30 FOR DECTAPES
HRRZ 3,-1(P) ;TAPE BLOCK
JSYS MTOPR ;SET DIRECTLY
JRST RESTR ;AND RETURN
USETER: ERR <USETI OR USETO: ILLEGAL JFN>,1
JRST RESTR ;AND RETURN
DSCR
PROCEDURE CLOSE(INTEGER CHANNEL)
PROCEDURE CLOSO(INTEGER CHANNEL)
PROCEDURE CLOSIN(INTEGER CHANNEL)
⊗
BEGIN CLOSES
HERE(CLOSIN)
HERE(CLOSO)
HERE(CLOSE)
DOOPN: PUSH P,-1(P)
PUSHJ P,CLOSF ;FORCE BUFFERS OUT, WRITE MAGT EOFS, CLOSF
PUSHJ P,SAVE
VALCHN 1,-1(P),CLORET
MOVE 2,OFL(CDB)
JSYS OPENF ;NOW OPEN AGAIN (IN CASE OF FURTHER USAGE)
ERR <CLOSE,CLOSO OR CLOSIN: CANNOT OPENF>,1
CLORET: MOVE LPSA,X22
JRST RESTR
BEND CLOSES
HERE(RELEASE)
PUSH P,1
PUSH P,-2(P) ;CHANNEL
PUSHJ P,CFILE
POP P,1 ;RESTORE 1
SUB P,X22
JRST @2(P) ;RETURN
DSCR
PROCEDURE MTAPE(INTEGER CHAN,OPERATION)
(the operation is a character e.g., "U" to unload)
as in the SAIL manual.
⊗
HERE(MTAPE)
BEGIN MTAPE
PUSHJ P,SAVE
MOVE LPSA,X33
LDB C,[POINT 5,-1(P),35]
MOVE A,OPTAB
MOVE B,OPTAB+1
TRZE C,30 ;COMPRESS TABLE
ADDI C,5
LSH C,2
ROTC A,(C)
ANDI B,17
VALCHN 1,-2(P),MTAERR
JSYS MTOPR
JRST RESTR
MTAERR: ERR <MTAPE: ILLEGAL JFN>,1
JRST RESTR
OPTAB: BYTE (4) 16,17,0,0,3,6,7,13,10 ;A,B,E,F,R,S,T
BYTE (4) 11,0,1 ;U,W
BEND MTAPE
DSCR
STRING PROCEDURE TENXFI(STRING DECFILE)
Converts the string to a TENEX file specification.
A la Alex Cannara.
⊗
BEGIN TENXFI
CTRLV←←"V"-100
FIND←←2
HERE(TENXFI)
PUSH P,1
PUSH P,2
PUSH P,3
SETZM FIND
PUSH SP,[0] ;DIR TEMPORARY
PUSH SP,[0]
PUSH SP,[0] ;NAM TEMPORARY
PUSH SP,[0]
DEFINE ORIG <-5(SP)>
DEFINE ORIG1 <-4(SP)>
DEFINE DIR <-3(SP)>
DEFINE DIR1 <-2(SP)>
DEFINE NAM <-1(SP)>
DEFINE NAM1 <(SP)>
;SIMPLE SINCE NAME IS AT THE TOP OF SP
DEFINE CATNAM (X) <
PUSH P,X
PUSHJ P,CATCHR
>
DEFINE CATDIR (X) <
PUSH P,X
PUSH SP,DIR
PUSH SP,DIR
PUSHJ P,CATCHR
POP SP,-4(SP)
POP SP,-4(SP)
>
DEFINE GCH <
HRRZ 1,ORIG
JUMPE 1,TENDUN
ILDB 3,ORIG1
SOS ORIG
>
TENX1: GCH
CAIE 3,CTRLV
JRST NOQUOTE
SKIPE FIND
JRST QUODIR
PUSHJ P,CATNA3
GCH
PUSHJ P,CATNA3 ;AND THE CHAR FOLLOWING THE CTRLV
JRST TENX1
QUODIR: PUSHJ P,CATDI3
GCH
PUSHJ P,CATDI3
JRST TENX1 ;AND CONTINUE
NOQUOTE:
CAIN 3,","
JRST TENX1 ;IGNORE COMMA
CAIE 3,40 ;SPACE
CAIN 3,11 ;OR TAB
JRST TENX1
CAIE 3,"<"
CAIN 3,"["
JRST STDIR
CAIE 3,">"
CAIN 3,"]"
JRST ENDDIR
SKIPE FIND
JRST [PUSHJ P,CATDI3
JRST TENX1]
PUSHJ P,CATNA3
JRST TENX1
STDIR: SETOM FIND
SKIPE DIR ;ANYTHING THERE?
JRST TENX1 ;YES, IGNORE
CATDIR <[74]>
JRST TENX1
ENDDIR: SETZM FIND
JRST TENX1
TENDUN:
;CHECK TO SEE WHAT LAST CHAR OF DIR IS
HRRZ 1,DIR
JUMPE 1,NODIR ;NO DIRECTORY
CATDIR <[76]> ;PUT ON A ">"
;NOW STACK HAS ORIG,DIR,NAM
GOTDIR:
PUSHJ P,CAT
POP SP,-2(SP)
POP SP,-2(SP)
TXFRET:
POP P,3
POP P,2
POP P,1
POPJ P,
NODIR:
;STACK IS ORIG,DIR,NAM (AND DIR IS EMPTY)
POP SP,-4(SP) ;REPLACE ORIG WITH NAM
POP SP,-4(SP)
SUB SP,X22 ;REMOVE DIR
JRST TXFRET ;AND RETURN
;CALL CAT MACROS WITH AC 3 AS THE ARG
CATNA3: CATNAM 3
POPJ P,
CATDI3: CATDIR 3
POPJ P,
BEND TENXFI
DSCR
INTEGER PROCEDURE GETCHAN(INTEGER I)
RETURNS AN UNUSED CHANNEL NUMBER, AND MARKS IT
FOR USE, SO THAT NO ONE WILL TRY TO USE IT.
⊗
HERE(GETCHAN)
MOVE A,[XWD -JFNSIZE,0]
GETCH1: SKIPN CDBTBL(A) ;ALLOCATED YET?
JRST GETCH2 ;NO, TAKE IT
AOBJN A,GETCH1 ;YES
SETOM A ;INDICATE ERROR
POPJ P,
GETCH2: HRRZ A,A
PUSH P,B ;NOW ALLOCATE A TABLE
PUSH P,C
MOVEI C,IOTLEN
PUSHJ P,CORGET
ERR <GETCHAN: CANNOT GET CORE>
MOVEM B,CDBTBL(A)
HRL C,B ;ZERO OUT BLOCK
HRRI C,1(B)
SETZM (B)
BLT C,IOTLEN-1(B)
SETZM JFNTBL(A) ;BUT NO JFN (YET)
POP P,C
POP P,B
POPJ P,
DSCR
INTEGER PROCEDURE CVJFN(INTEGER CHAN)
Returns the JFN (XWD flags,jfn) associated
with a logical channel, -1 if no jfn assigned.
Hereby, the user of these routines can access
the system directly if the need arises.
⊗
HERE(CVJFN)
SKIPL 1,-1(P)
CAIL 1,JFNSIZE
JRST CVJFER
SKIPN 1,JFNTBL(1)
JRST CVJFER
CVJFR: SUB P,X22
JRST @2(P)
CVJFER: SETO 1,
JRST CVJFR
BEND PAT
ENDCOM(PAT)
COMPIL(JOBINF,<ODTIM,IDTIM,RUNTM>,<ZSETST,ZADJST,X22,X33,X44,.SKIP.,CATCHR>
,<JOBINF -- JOB UTILITY ROUTINES>)
DSCR STRING SIMPLE PROCEDURE ODTIM(INTEGER DT,FORMAT)
Returns the string representation of DT
(which is in internal TENEX representation). If DT
is -1 the current date and time are used. If format
is -1, the standard format is used.
⊗
HERE(ODTIM)
PUSH P,[=100] ; 100 CHARS
PUSHJ P,ZSETST ;GET BP IN 1
MOVE 2,-2(P) ;TIME
MOVE 3,-1(P) ;FORMAT
JSYS ODTIM
PUSH P,[=100]
PUSH P,1 ;UPDATED BP
PUSHJ P,ZADJST ;GET STRING
SUB P,X33 ;ADJUST STACK
JRST @3(P) ;RETURN
DSCR INTEGER SIMPLE PROCEDURE IDTIM(STRING S)
Returns the internal TENEX representation of S, which
is assumed to be the date and time in some reasonable format.
If the format cannot be scanned, the error is returned in .SKIP.
⊗
HERE(IDTIM)
PUSH P,[0]
PUSHJ P,CATCHR
MOVE 1,(SP) ;BYTE-POINTER
SETZB 2,.SKIP. ;NO SPECIAL FORMAT, ASSUME NO ERROR
JSYS IDTIM
MOVEM 1,.SKIP. ;ERROR TO USER
MOVE 1,2 ;ANSWER
SUB SP,X22 ;ADJUST SP STACK
POPJ P, ;RETURN
DSCR INTEGER SIMPLE PROCEDURE RUNTM(INTEGER FORK; REFERENCE INTEGER CONSOLE);
Returns the runtime of a fork. If FORK=-5, then then
whole job. Time is returned as milliseconds for you. Console time,
similarly converted, is returned in CONSOLE.
⊗
HERE(RUNTM)
MOVE 1,-2(P)
JSYS RUNTM
MOVEM 3,@-1(P)
SUB P,X33
JRST @3(P)
DSCR INTEGER SIMPLE PROCEDURE GTAD;
Returns the current date and time. See Jsys manual,
3-3.
⊗
HERE(GTAD)
JSYS GTAD
POPJ P,
DSCR INTEGER SIMPLE PROCEDURE GJINF(REFERENCE INTEGER LOGDIR,CONDIR,TTYNO);
Returns the TENEX jobnumber. LOGDIR is the directory
no. logged in, CONDIR is the connected directory number. TTYNO is the
TENEX teletype number, which is -1 if the job is detached.
See the DIRST routine for converting directory numbers to
directory strings.
⊗
HERE(GJINF)
JSYS GJINF
MOVEM 1,@-3(P)
MOVEM 2,@-2(P)
MOVEM 4,@-1(P)
MOVE 1,3;
SUB P,X44
JRST @4(P)
DSCR
Does the HALTF jsys.
⊗
HERE(HALTF)
JSYS HALTF
POPJ P, ;RETURN UPON CONTINUATION
ENDCOM(JOBINF)
COMPIL(DIRECT,<STDIR,DIRST>,<X22,X33,CATCHR,ZSETST,ZADJST.SKIP.>
,<DIRECT -- TENEX DIRECTORY SPECS>)
DSCR INTEGER SIMPLE PROCEDURE STDIR(STRING S; BOOLEAN DORECOGNITION)
DESR
Returns the directory number associated with a string.
Any problems are returned in .SKIP. with the code:
1 string does not match
2 string is ambiguous.
⊗
HERE(STDIR)
PUSH P,[0]
PUSHJ P,CATCHR ;TACK ON 0
SETZ 3, ;
MOVEI 1,1 ; ASSUME NO RECOGNITION
SKIPE -1(P) ; DO WE WANT IT?
SETO 1, ; YES AFTER ALL
MOVE 2,(SP) ;BYTE-POINTER
JSYS STDIR
MOVEI 3,1 ; NO MATCH;
MOVEI 3,2 ; AMBIGUOUS
MOVEM 3,.SKIP. ; SAVE IT FOR USER
HRRZ 1,1 ; SAVE DIR NO. (ONLY)
SUB SP,X22 ;ADJUST STRING STACK
SUB P,X22
JRST @2(P) ;RETURN
DSCR STRING SIMPLE PROCEDURE DIRST(INTEGER I)
Returns the string name for directory I. Any problems
cause .SKIP. to be set TRUE.
⊗
HERE(DIRST)
PUSH P,[=100]
PUSHJ P,ZSETST
SETZM .SKIP.
MOVE 2,-1(P) ;DIRECTORY NO.
JSYS DIRST
SETOM .SKIP.
PUSH P,[=100]
PUSH P,1 ;UPDATED BP
PUSHJ P,ZADJST ;GET STRING ON STACK
SUB P,X22
JRST @2(P)
ENDCOM(DIRECT)
COMPIL(RUNPRG,<RUNPRG>,<X22,X33,CATCHR>,<RUNPRG -- RUN A PROGRAM>)
DSCR INTEGER SIMPLE PROCEDURE RUNPRG(STRING PROGRAM; INTEGER INCREM; BOOLEAN NEWFORK)
This does two entirely different things depending on whether
NEWFORK is true or not.
If NEWFORK then a new fork is created, capabilities transmitted,
and PROGRAM is run there. INCREM is added to the entry vector. Any problems
cause the routine to return FALSE, otherwise it returns TRUE.
If not NEWFORK then the current job is destroyed and replaced
with PROGRAM, with INCREM added to the entry vector location. This is
like the DEC RUN uuo, and hence if the increment is 1, the program is
started at the CCL address. If the routine returns at all, there was a problem
with the file.
Remember to say .SAV as the PROGRAM extension.
⊗
HERE(RUNPRG)
BEGIN
JFN←←0
FORK←←14
PUSH P,[0]
PUSHJ P,CATCHR
MOVSI 1,100001 ; OLD FILE, PTR IN 2
MOVE 2,(SP) ; STRING POINTER
JSYS GTJFN ; TRY FOR JFN
JRST RUNERR ; ERROR
MOVEM 1,JFN ; SAVE JFN
SKIPN -1(P) ; USER WANTS FORK?
JRST SWP ; NO, REPLACE CURRENT PRG
MOVSI 1,100000 ; XMIT CAPABILITIES
JSYS CFORK
JRST RUNERR ; CANNOT CREATE FORK
MOVEM 1,FORK ; SAVE HANDLE
SETOB 2,3 ; INDICATE ALL PRIVILEDGES
JSYS EPCAP
HRLZ 1,1 ; FORK HANDLE
HRR 1,JFN ; THE JFN
JSYS GET ; JSYS GET THE FILE
MOVEI 1,400000 ; CURRENT FORK
JSYS GPJFN ;PRIMARY JFNS IN 2
MOVE 1,FORK ; SET PRIMARY IO
JSYS SPJFN ;FOR NEW FORK
MOVE 1,FORK ; FORK
MOVE 2,-2(P) ; USER VALUE FOR ENTRY VECTOR
JSYS SFRKV ;START THE FORK
MOVE 1,FORK ;
JSYS WFORK
SKIPE 1,FORK ; SET TO KILL
JSYS KFORK ;KILL THE FORK
HRRZ 1,JFN ;
JSYS RLJFN ; RELEASE
JFCL ; IGNORE
JRST RUNRET ; AND RETURN SAFELY
SWP:
PUSH P,JFN ;SAVE THE JFN
HRLI A1 ; BLT INTO ACS
HRRI 1 ;
BLT 15 ; THE INSTRUCTIONS -- NOTE THAT RF IS NOW CLOBBERED
POP P,0 ; RESTORE JFN TO AC0
HRLI 0,400000 ; XWD FORK, JFN
MOVE 16,-2(P) ; THE INCREMENT -- NOTE THAT SP IS NOW CLOBBERED
MOVE 17,[254000400010] ; FOR COMPARISON -- NOTE THAT THE P STACK IS GONE
JRST 4 ; AND GO
A1: -1 ; FOR PMAP
A2: 400000000677 ; THIS FORK, START AT 677 (LEAVING EMULATOR)
A3: 0 ;
A4: JSYS PMAP
A5: SOJL 2,4 ; LOOP THROUGH PAGES
A6: MOVE 1,0 ; XWD 400000,JFN
A7: JSYS GET ;
A10: MOVEI 1,400000 ; THIS FORK
A11: JSYS GEVEC ; JSYS GET ENTRY VECTOR
A12: CAMN 2,17 ; DEC STYLE??
A13: HRRZ 2,120 ; YES
A14: ADD 2,16 ; ADD THE INCREMREMENT
A15: JRST (2) ; AND START THE JOB
RUNERR: TDZA 1,[-1] ;ZERO 1 AND SKIP
RUNRET: SETO 1, ;INDICATE SUCCESS
SUB SP,X22
SUB P,X33
JRST @3(P)
BEND;RUNPRG
ENDCOM(RUNPRG)
COMPIL(OPF,<OPENFILE,SETINPUT,SETPL,INDEXFILE>,<.SKIP.>,<OPENFILE -- OPEN A FILE>)
DSCR INTEGER SIMPLE PROCEDURE OPENFILE(STRING NAME,OPTIONS)
Name is the name of the file to be opened. If it is null, then
OPENFILE goes to the user's console for the filname (with recognition).
The value of the call is the jfn returned to the user.
OPTIONS is a string of options available to the user. Legal
characters are:
One of these:
R read
W write
A append
Version numbering
O old file
N new file
T temporary file
* index with INDEXFILE routine
Independent:
C require confirmation
D ignore deleted bit
H "thawed" access
Error handling
E return errors to user in the external
integer !skip!. TENEX error codes are used.
(JFN will be released in this case.)
OPENFILE does a GTJFN followed by a OPENF. If GTJFN fails, a new
attempt is made, from the user's console.
⊗
BEGIN OPENFILE
JFN←3 ;WHERE TO PUT THINGS
FLAGS←4
GTFLAGS←5
OPFLAGS←6
DEFINE EQ $ (X,Y) <
CAIE A,"$X$"
JRST .+3
TESTO FLAGS,Y
JRST CONT
>
DEFINE JTRUE $ (X) <
TESTN FLAGS,X
>
DEFINE JFALSE (X) <
TESTE FLAGS,X
>
DEFINE SGT (X) <
TESTO GTFLAGS,X
>
DEFINE SOF (X) <
TESTO OPFLAGS,X
>
DEFINE TGT (X) <
TESTE FLAGS,X
TESTO GTFLAGS,X
>
DEFINE TOP (X) <
TESTE FLAGS,X
TESTO OPFLAGS,X
>
HERE(OPENFILE)
SETZB FLAGS,.SKIP.
SETZB GTFLAGS,OPFLAGS
HRRZ B,-1(SP) ;COUNT OF OPTIONS WORD
WHIOPT: JUMPE B,OPTDUN
ILDB A,(SP) ;GET AN OPTION
CAIGE A,141
JRST .+3
CAIG A,172
SUBI A,40 ;CONVERT TO UPPER CASE
;ANY NON-ALPHABETIC CHARS GO HERE
EQ *,STARBIT
;NOW ALLOW ONLY ALPHABETIC CHARS
CAIL A,101 ;MUST BE
CAILE A,132
JRST OPTERR
SKIPN BITTBL-"A"(A) ;SOMETHING THERE?
JRST OPTERR ;NOPE, ERROR
TDO FLAGS,BITTBL-"A"(A) ;RIGHT SPOT IN TABLE
SOJGE B,WHIOPT
JRST OPTDUN
;HERE ON ERROR
OPTERR: ERR <OPENFILE: ILLEGAL OPTION >,1
TESTO FLAGS,ERSNBIT
CONT:
SOJGE B,WHIOPT
;NOW SET UP GTFLAGS ACCORDING TO THE SCANNED INFORMATION
OPTDUN:
JFALSE NEWBIT ;NEW
JRST [TGT OLDBIT ;ALSO OLD?
JRST OPTDU1
]
JTRUE OLDBIT ;OLD?
JRST NEITHER ;NEITHER
SGT OLDBIT ;YES, SET OLDBIT
JRST OPTDU1
NEITHER:
JTRUE RDBIT
JFALSE APPBIT
SGT OLDBIT
JTRUE WRBIT
JRST OPTDU1
JFALSE RDBIT
JTRUE APPBIT
SGT OUTBIT
OPTDU1:
;NOW TEST FOR INDEPENDANT THINGS
TOP RDBIT
TOP WRBIT
TOP APPBIT
TGT TEMBIT
TGT STARBIT
TGT THAWBIT
JFALSE CONFBIT
JRST [SGT CONFB1
SGT CONFB2
JRST .+1]
TLO GTFLAGS,1 ;SHORT CALL OF GTJFN
GTAGAIN:
HRRZ A,-3(SP) ;LENGTH OF NAME
JUMPE A,[TRYAGN:
TLO GTFLAGS,2
MOVE 2,[XWD 100,101]
JRST GT]
AND GTFLAGS,[717777777777]
PUSH SP,-3(SP)
PUSH SP,-3(SP)
PUSH P,[0]
PUSHJ P,CATCHR ;CONCATENATE A NULL CHAR
MOVE 2,(SP) ;BYTE-POINTER
SUB SP,X22 ;ADJUST STACK
GT: MOVE 1,GTFLAGS
JSYS GTJFN
JRST GTERR
MOVEM 1,JFN ;REMEMBER JFN
PUSHJ P,SETCHN ;SET A CHANNEL, ALLOCATE, GET CDB, SET DVTYP, RETURN CHANNEL
MOVEM 1,Q ;REMEMBER CHANNEL
MOVEM GTFLAGS,GFL(CDB)
COMMENT ⊗ Do the open.
⊗
B36: HRRZ 1,JFN ;JFN
HRRZ 2,OPFLAGS
HRLI 2,440000 ;36-BIT, MODE 0
JSYS OPENF
JRST B36DMP ;TRY 36-BIT, DUMP MODE
JRST OPNOK
B36DMP: HRRZ 1,JFN
HRRZ 2,OPFLAGS
HRLI 2,447400 ;36 BITS, DUMP MODE
JSYS OPENF
JRST B7
JRST OPNOK
B7: HRRZ 1,JFN
HRRZ 2,OPFLAGS
HRLI 2,70000 ;7 BIT
JSYS OPENF
JRST OPERR ;NOPE
OPNOK: MOVEM 2,OFL(CDB) ;SAVE
MOVE 1,Q ;RETURN CHANNEL NO
OPFRET: SUB SP,X44 ;ADJUST
POPJ P, ;AND RETURN
GTERR:
;HERE WITH ERROR ON GTJFN
JTRUE ERTNBIT ;USER WANT'S ERRORS?
JRST GTER1 ;NO
ERRRET: MOVEM 1,.SKIP. ;STORE FOR USER
SETO 1, ;SOMETHING SUSPICIOUS
JRST OPFRET ;AND RETURN
GTER1: HRROI 1,[ASCIZ/
CANNOT GTJFN FILE /]
JSYS PSOUT
PUSH SP,-3(SP)
PUSH SP,-3(SP)
PUSHJ P,OUTSTR
HRROI 1,[ASCIZ/, TRY AGAIN */]
JSYS PSOUT
JRST TRYAGN
OPERR: JTRUE ERTNBIT
JRST OPER1
JRST ERRRET
OPER1: HRROI 1,[ASCIZ/
CANNOT OPENF FILE /]
JSYS PSOUT
PUSH SP,-3(SP)
PUSH SP,-3(SP)
PUSHJ P,OUTSTR
HRROI 1,[ASCIZ/, TRY AGAIN */]
JSYS PSOUT
PUSH P,Q ;CLOSE AND RELEASE FILE AND CDB BLOCK
PUSHJ P,CFILE
JRST TRYAGN
BITTBL: APPBIT ;A
BINBIT ;B
CONFBIT ;C
DELBIT ;D
ERTNBIT ;E
0 ;F
0 ;G
THAWBIT ;H
0 ;I
0 ;J
0 ;K
0 ;L
0 ;M
NEWBIT ;N
OLDBIT ;O
0 ;P
0 ;Q
RDBIT ;R
0 ;S
TEMBIT ;T
0 ;U
0 ;V
WRBIT ;W
0 ;X
0 ;Y
0 ;Z
BEND OPENFILE
DSCR PROCEDURE SETINPUT(INTEGER CHAN; REFERENCE INTEGER COUNT,BR,EOF)
Sets up the variables associated with input (as in the DEC
open statement.)
⊗
HERE(SETINPUT)
PUSHJ P,SAVE
VALCHN 1,-4(P),SETERR
POP P,TEMP
POP P,ENDFL(CDB)
SKIPE ENDFL(CDB)
SETZM @ENDFL(CDB) ;ASSUME NOT EOF
POP P,BRCHAR(CDB)
SKIPE BRCHAR(CDB)
SETZM @BRCHAR(CDB) ;ASSUME NO BRCHAR
POP P,ICOUNT(CDB)
SETZ LPSA, ;NO PARAMETERS
SUB P,X11
JRST RESTR
SETERR: ERR <SETINPUT: ILLEGAL JFN>,1
MOVE LPSA,[XWD 5,5]
JRST RESTR
DSCR
SETPL(CHAN,@LINNUM,@PAGNUM,@SOSNUM)
Names the variables to be used by the INPUT
function for counting the line-feeds (12), formfeeds (14)
seen by INPUT, as well as keeping the current SOS line
number, if any. Useful when scanning a file, and
you want to know what page,line you are on.
Initializes all three variables to 0.
⊗
HERE(SETPL)
PUSHJ P,SAVE
VALCHN 1,-4(P),SETPER
POP P,TEMP ;RET ADR
POP P,SOSNUM(CDB)
SETZM @SOSNUM(CDB)
POP P,PAGNUM(CDB)
SETZM @SOSNUM(CDB)
POP P,LINNUM(CDB)
SETZM @LINNUM(CDB)
SUB P,X11 ;REMOVE CHANNEL NO.
SETRET: SETZ LPSA,
JRST RESTR
SETPER: ERR <SETPL: ILLEGAL JFN>,1
MOVE LPSA,[XWD 5,5]
JRST RESTR
DSCR
BOOLEAN PROCEDURE INDEXFILE(INTEGER JFN)
RETURNS TRUE AS LONG AS WE CAN GNJFN ANOTHER FILE
⊗
HERE(INDEXFILE)
PUSH P,-1(P)
PUSHJ P,CLOSF
PUSH P,-1(P)
PUSHJ P,GNJFN
JUMPE 1,INDRET ;RETURN FALSE IF NO OTHER FILES
PUSH P,2
PUSH P,CDB
PUSH P,Q
VALCHN 1,-4(P),NOIND
MOVE 2,OFL(CDB) ;GET OPENFLAGS
JSYS OPENF
JRST NOIND
SETO 1,
INDRET: POP P,Q
POP P,CDB
POP P,2
SUB P,X22
JRST @2(P)
NOIND: SETZ 1,
JRST INDRET
ENDCOM(OPF)
COMPIL(GTJFN,<GTJFN>,<.SKIP.,SETCHN,CATCHR,X22>,<GTJFN -- GET A JFN>)
DSCR INTEGER SIMPLE PROCEDURE GTJFN(STRING S; INTEGER FLAGS)
Does a GTJFN. If S is non-null, it is the filename, otherwise
the routine goes to the user's console for a file. FLAGS are used for
accumulator 1, and any error code is returned in .SKIP. The value
of the call is the JFN, if obtained.
Defaults for FLAGS: 0 means ordinary input, 1 means ordinary
output. Ordinarily the user will use the OPENFI routine.
⊗
HERE(GTJFN)
SKIPN 1,-1(P)
MOVSI 1,100001
CAIN 1,1
MOVSI 1,600001
TLO 1,1 ;MARK FOR SHORT CALL
HRRZ 2,-1(SP)
JUMPE 2,[MOVE 2,[100000101]
OR 1,[2000000]
JRST GOTDEST]
PUSH P,[0]
PUSHJ P,CATCHR ;PUT ON A NULL
MOVE 2,(SP)
GOTDEST: SETZM .SKIP. ;ASSUME NO ERROR
PUSH P,1 ;SAVE FLAGS
JSYS GTJFN
JRST GTBAD ; SOMETHING IS WRONG
PUSHJ P,SETCHN ;SETUP A CHANNEL, AND ALLOCATE, GET STATUS, SET CDB
POP P,GFL(CDB) ;SAVE FLAGS
GTRET: SUB SP,X22
SUB P,X22
JRST @2(P)
GTBAD:
MOVEM 1,.SKIP. ; REMEMBER
POP P,1 ;ADJUST STACK
SETO 1, ; SOMETHING SUSPICIOUS TO RETURN TO USER
JRST GTRET
ENDCOM(GTJFN)
COMPIL(FILINF,<GNJFN,SIZEF,JFNS,OPENF,CFILE,CLOSF,RLJFN,GTSTS,DELF,UNDELETE>
,<JFNTBL,CDBTBL,STRSND,X22,X33,CORREL,.SKIP.,ZSETST,ZADJST>
,<FILINF -- UTILITY TENEX FILE ROUTINES>)
DSCR INTEGER SIMPLE PROCEDURE GNJFN(INTEGER JFN)
Does the GNJFN jsys.
⊗
HERE(GNJFN)
PUSHJ P,SAVE
MOVE LPSA,X22
VALCHN 1,<-1(P)>,GNERR
MOVE 1,JFNTBL(Q) ;GET THE WHOLE JFN
SETO 2,; ;ASSUME GOOD
JSYS GNJFN
SETZ 2,
MOVEM 2,RACS+A(USER)
GNRET: JRST RESTR
GNERR: ERR <GNJFN: ILLEGAL JFN>,1
SETZM RACS+A(USER)
JRST RESTR
DSCR PROCEDURE DELF(INTEGER CHAN)
Deletes file open on CHAN. Errors to .SKIP.
⊗
HERE(DELF)
PUSH P,1
VALCH1 1,-2(P),DELF1
JSYS DELF
JRST DELF2
SETZM .SKIP. ;NO ERROR
DELFRE: POP P,1
SUB P,X22
JRST @2(P)
DELF1: SETO 1,
DELF2: MOVEM 1,.SKIP.
JRST DELFRE
DSCR PROCEDURE UNDELETE(INTEGER CHAN)
Undeletes file open on CHAN. Errors to .SKIP.
⊗
HERE(UNDELETE)
PUSHJ P,SAVE
VALCH1 1,-1(P),UNDEL1
HRLI 1,1 ;XWD 1,JFN
MOVSI 2,(1B3) ;DELETED BIT
SETZ 3, ;TURN IT OFF
JSYS CHFDB ;CHANGE THE FDB
JRST RESTR
UNDEL1: SETOM .SKIP.
JRST RESTR
DSCR INTEGER PROCEDURE SIZEF(INTEGER JFN)
Gets the size in pages of the file open on JFN, with error code to
.SKIP.
⊗
HERE(SIZEF)
PUSHJ P,SAVE
MOVE LPSA,X22
VALCHN 1,<-1(P)>,SIZERR
SETZM .SKIP.
JSYS SIZEF
JRST [MOVEM 1,.SKIP.
SETZM RACS+A(USER)
JRST SIZRET]
MOVEM 3,RACS+A(USER) ;ANSWER IN AC 3
SIZRET: JRST RESTR
SIZERR: ERR <SIZEF: ILLEGAL JFN>
SETOM .SKIP.
JRST SIZRET
DSCR STRING SIMPLE PROCEDURE JFNS(INTEGER JFN,FLAGS)
Returns the name of the file associated with JFN.
FLAGS are for ac 3 as described in the jsys manual, with
0 the reasonable default.
⊗
HERE(JFNS)
VALCHN 2,<-2(P)>,JFNSER ;GET JFN IN AC2
PUSH P,[=100]
PUSHJ P,ZSETST ;GET BP IN AC 1
MOVE 3,-1(P)
JSYS JFNS
PUSH P,[=100]
PUSH P,1
PUSHJ P,ZADJST
JFNSRE: SUB P,X33
JRST @3(P)
JFNSER: ERR <JFNS: ILLEGAL JFN>,1
PUSH SP,[0] ;RETURN NULL STRING
PUSH SP,[0]
JRST JFNSRE
DSCR SIMPLE PROCEDURE OPENF(INTEGER JFN,FLAGS)
Does an OPENF.
PARAMETERS:
JFN the JFN
FLAGS for accumulator 2.
.SKIP. the error code (if pertinent)
Some defaults:
FLAGS ACTION
-----------------------
0 INPUT CHARACTERS
1 OUTPUT CHARACTERS
2 INPUT 36-BIT WORDS
3 OUTPUT 36-BIT WORDS
4 DUMP MODE INPUT (USE DUMPI FUNCTION)
5 DUMP MODE OUTPUT (USE DUMPO FUNCTION)
VALUES 6-10 ARE RESERVED FOR EXPANSION
Other values of FLAGS are interpreted literally.
Ordinarily the user will use the OPENFI routine.
⊗
HERE(OPENF)
PUSHJ P,SAVE
MOVE LPSA,X33
VALCHN 1,-2(P),OPNERR
SKIPL 2,-1(P) ;GET THE FLAGS
CAILE 2,5 ;CHECK IN RANGE 0-5
JRST GOTFLAGS
MOVE 2,OPNTBL(2) ;GET CORRECT WORD
GOTFLAGS:
SETZM .SKIP.
PUSH P,2 ;SAVE FLAGS
JSYS OPENF
JRST NOOPN
POP P,OFL(CDB) ;AND SAVE FLAGS
OPNRET: JRST RESTR
OPNERR: ERR <OPENF: ILLEGAL JFN>,1
SETOM .SKIP.
JRST OPNRET
NOOPN: MOVEM 1,.SKIP.
SUB P,X11 ;ADJUST STACK
JRST OPNRET
OPNTBL: 070000200000 ;7-BIT READ
070000100000 ;7-BIT WRITE
440000200000 ;36-BIT READ
440000100000 ;36-BIT WRITE
447400200000 ;36-BIT DUMP READ
447400100000 ;36-BIT DUMP WRITE
DSCR SIMPLE INTEGER PROCEDURE CFILE(INTEGER JFN)
Closes the file (CLOSF) and releases (RLFJN)
the jfn. This is the ordinary way the user will use
to dispense with a file.
Returns TRUE if JFN legal and released, FALSE o.w.
Always returns.
⊗
HERE(CFILE)
PUSH P,2
PUSH P,3
PUSH P,Q
PUSH P,CDB
SKIPL Q,-5(P)
CAIL Q,JFNSIZE
JRST CFBAD
MOVE CDB,CDBTBL(Q) ;GET CDB
SKIPN 1,JFNTBL(Q) ;JFN ASSIGNED?
JRST CFBA1 ;NO, JUST RELEASE CORE
HRRZ 1,1 ;JFN ONLY
LDB 2,[POINT 6,OFL(CDB),5] ;GET BYTE SIZE
CAIE 2,=36 ;36-BIT?
JRST RLCOR ;NO
;FILE IN 36-BIT BYTES
SKIPE OBP(CDB) ; A BYTE-POINTER?
PUSHJ P,STRSND ;SEND OUT THE BUFFER
PUSHJ P,CUNMAP ;UNMAP THE PAGE
SKIPN DMPED(CDB) ;DUMP-MODE OUTPUT SEEN?
JRST RLCOR ;NO
PUSHJ P,MTCHK ;CHECK FOR MAGTAPE OUTPUT
SETZM DMPED(CDB) ;AND INDICATE ALL DONE
RLCOR: SKIPE B,CDBTBL(Q) ; ANY CORE TO RELEASE?
PUSHJ P,CORREL ; RELEASE THE BLOCK
TLZ 1,400000 ; BE SURE TO RELEASE
JSYS CLOSF ; CLOSE (AND RELEASE)
TDZA 1,1 ; ZERO 1 FOR ERROR RETURN AND SKIP
SETO 1, ; RETURN TRUE FOR GOOD RELEASE
SETZM CDBTBL(Q)
SETZM JFNTBL(Q)
CFRET: POP P,CDB
POP P,Q
POP P,3
POP P,2
SUB P,X22 ; ADJUST
JRST @2(P) ; RETURN
CFBAD: SETZ 1, ; RETURN FALSE
JRST CFRET ;
CFBA1: SKIPE B,CDB
PUSHJ P,CORREL ;RELEASE CORE BLOCK
SETZM CDBTBL(Q) ;REMOVE ALL TRACE
SETZM JFNTBL(Q)
SETZ 1, ; RETURN FALSE
JRST CFRET
;HERE WITH 1,Q,CDB LOADED
;IF DEVICE IS MAGTAPE, THEN WRITE TWO EOF'S AND BACKSPACE
MTCHK:
PUSH P,2 ;SAVE 2
MOVE 2,DVTYP(CDB) ;GET DEVICE TYPE
CAIE 2,2 ;IS IT A MAGTAPE?
JRST MTRET ;NO
MOVEI 2,3 ;WRITE EOF
JSYS MTOPR
JSYS MTOPR
MOVEI 2,17 ;NOW BACKSPACE
JSYS MTOPR
MTRET: POP P,2 ;RESTORE
POPJ P,
;HERE WITH 1,Q,CDB LOADED
;UNMAP PAGE ASSOCIATED WITH JFN
;CLOBBERS 2,3
CUNMAP:
PUSH P,1 ;SAVE JFN
MOVEI 2,STARTPAGE(1)
HRLI 2,400000 ;XWD THIS FORK, PAGE NO.
SETO 1,
SETZ 3,
JSYS PMAP
POP P,1 ;GET JFN BACK
POPJ P,
DSCR SIMPLE PROCEDURE CLOSF(INTEGER JFN)
Does a CLOSF on the JFN. Ordinarily the user
will want to use the CFILE routine, which handles errors
internally. The CLOSF is accomplished in such a way that
the JFN is actually not released.
If the device is a magtape open for output, then
2 eof's are written, followed by a backspace. This writes
a standard end-of-file on the tape.
⊗
HERE(CLOSF)
PUSHJ P,SAVE
MOVE LPSA,X22
VALCHN 1,<-1(P)>,CLOERR
LDB 2,[POINT 6,OFL(CDB),5] ;BYTE-SIZE
CAIE 2,=36 ;36-BIT BYTES?
JRST DOCLO
;RELEASE BUFFER IN CORE (IF THERE IS ONE)
SKIPE OBP(CDB) ;A BYTE POINTER?
PUSHJ P,STRSND ;CLEAN UP BUFFER IN CORE
PUSHJ P,CUNMAP ;UNMAP THE PAGE
SKIPN DMPED(CDB) ;DUMP-MODE IO SEEN?
JRST DOCLO ;NO
PUSHJ P,MTCHK ;CHECK IF MAGT-TAPE (AND MARK EOF,EOF)
SETZM DMPED(CDB) ;AND INDICATE ALL DONE
DOCLO: SETZM .SKIP. ;ASSUME NO ERROR
TLO 1,400000 ; DO NOT RELEASE THE JFN
JSYS CLOSF
MOVEM 1,.SKIP. ;ERROR
CLORET: JRST RESTR
CLOERR:
SETOM .SKIP.
JRST CLORET
DSCR SIMPLE PROCEDURE RLJFN(INTEGER JFN)
Does the RLJFN jsys. Ordinarily the user will want
to use the CFILE routine, which handles errors internally.
⊗
HERE(RLJFN)
PUSHJ P,SAVE
MOVE LPSA,X22
SKIPL C,-1(P)
CAIL C,JFNSIZE
JRST RLJBAD
SKIPN 1,JFNTBL(C)
JRST RLJBAD
SETZM JFNTBL(C)
SKIPE B,CDBTBL(C)
PUSHJ P,CORREL
SETZM CDBTBL(C)
SETZM .SKIP. ;ASSUME NO ERROR
JSYS RLJFN
MOVEM 1,.SKIP. ;ERROR RETURN
RLJRET: JRST RESTR
RLJBAD: ERR <RLJFN: ILLEGAL JFN>,1
SETOM .SKIP.
JRST RLJRET
DSCR INTEGER SIMPLE PROCEDURE GTSTS(INTEGER JFN);
Gets the file status.
WARNING: The results of this call are not necessarily appropriate
if the file is open in special character input mode. If you want to check
for end-of-file, examine the EOF variable instead.
⊗
HERE(GTSTS)
PUSHJ P,SAVE
MOVE LPSA,X22
VALCHN 1,<-1(P)>,GTSERR
JSYS GTSTS
MOVEM 2,RACS+A(USER)
GTSRET: JRST RESTR
GTSERR: ERR <GTSTS: ILLEGAL JFN>,1
JRST GTSRET
ENDCOM(FILINF)
COMPIL(FIO,<OUT,CHAROUT,LINOUT,GTFDB>
,<CDBTBL,JFNTBL,X22,X33,X44,.SKIP.,SAVE,RESTR>
,<FILIO -- IO ROUTINES>)
DSCR SIMPLE PROCEDURE CHAROUT(INTEGER JFN; INTEGER JFN)
⊗
HERE(CHAROUT)
BEGIN CHAROUT
PUSH P,1
PUSH P,2
PUSH P,CDB
PUSH P,Q
VALCHN 1,-2(P),CHAOBAD
LDB 2,[POINT 6,OFL(CDB),5] ;GET BYTE SIZE
CAIE 2,7
JRST B36
MOVE 2,-1(P)
JSYS BOUT
JRST CHARET
B36: CAIE 2,=36
JRST CHAOBAD
MOVE 2,-1(P)
SOSG OCNT(CDB)
PUSHJ P,STRSND ;WITH 1,CDB,Q LOADED
IDPB 2,OBP(CDB)
CHARET: POP P,Q
POP P,CDB
POP P,2
POP P,1
SUB P,X33
JRST @3(P)
CHAOBAD: ERR <CHAROUT: ILLEGAL JFN OR BYTE-SIZE>,1
JRST CHARET
BEND CHAROUT
DSCR SIMPLE PROCEDURE OUT(INTEGER JFN; STRING S)
Outputs a SAIL string to the JFN, which may be open
in DUMP mode.
⊗
HERE(OUT)
BEGIN OUT
PUSHJ P,SAVE
MOVE LPSA,X22
HRRZ 3,-1(SP) ; GET THE COUNT
JUMPE 3,SOURET ; DONT SEND NULL STRING
VALCHN 1,-1(P),SOUBAD
LDB 2,[POINT 6,OFL(CDB),5] ;GET BYTE SIZE
CAIN 2,7 ;7-BIT?
JRST USESOU ;USE SOUT
CAIE 2,=36 ;36-BIT?
JRST SOUBAD
;HERE TO DO BUFFERED OUTPUT
DMPAGN: ILDB 2,(SP) ;GET A CHARACTER
SOSG OCNT(CDB) ;AND DECREMENT BUFFER COUNT
PUSHJ P,STRSND ;SO SEND THE BUFFER ;WITH 1,CDB,Q LOADED
IDPB 2,OBP(CDB) ;AND COPY THE CHARACTER
SOJG 3,DMPAGN ;STRING CHAR COUNT
SOURET: SUB SP,X22
JRST RESTR
USESOU: MOVE 2,(SP) ; GET THE BYTE-POINTER
MOVN 3,3 ; NEGATE BYTE-COUNT
JSYS SOUT
JRST SOURET
SOUBAD: ERR <OUT ILLEGAL JFN OR BYTE-SIZE>,1
JRST SOURET
BEND OUT
DSCR PROCEDURE LINOUT(INTEGER JFN,VALUE)
⊗
HERE(LINOUT)
BEGIN LINOUT
PUSHJ P,SAVE
VALCHN A,-2(P),LINBAD
LDB B,[POINT 6,OFL(CDB),5] ;GET BYTE-SIZE
CAIE B,=36 ;MUST BE 36-BIT
JRST LINBAD
SKIPG B,OCNT(CDB) ;ANY CHARS WAITING?
PUSHJ P,STRSND ;NO, SEND (OR PERHAPS JUST INITIALIZE)
MOVE TEMP,OBP(CDB) ;GET BP
LINOPL: TLNN TEMP,760000 ;LINED BP?
JRST OKLIGN
IBP TEMP
SOJA B,LINOPL
OKLIGN: MOVEM TEMP,OBP(CDB)
MOVEM B,OCNT(CDB)
CAIGE B,=10 ;ENOUGH FOR 10 CHARS?
PUSHJ P,STRSND ;NO
SKIPGE B,-1(P) ;GET LINE-NO
JRST [MOVNS B
MOVNI A,5
JRST NOCONV]
MOVNI A,6
MOVE C,[<ASCII /00000/>/2]
EXCH B,C
PUSH P,LNBAK
LNCONV: IDIVI C,=10
IORI D,"0"
DPB D,[POINT 7,(P),6]
SKIPE C
PUSHJ P,LNCONV ;THE RECURSIVE PRINTER
HLL C,(P)
LSHC B,7
LNBAK: POPJ P,.+1
LSH B,1
TRO B,1
NOCONV: AOS C,OBP(CDB) ;MOVE A WORD OUT
MOVEM B,(C)
ADDM A,OCNT(CDB)
MOVEI B,11
CAME A,[-5]
IDPB B,OBP(CDB) ;OUTPUT A TAB
NOTAB: MOVE LPSA,X33
JRST RESTR
LINBAD: ERR <LINOUT: ILLEGAL JFN OR MODE>,
JRST NOTAB
BEND LINOUT
DSCR STRSND
CAL PUSHJ
SID SAVES ALL ACS
ARGS
1 JFN
CDB address of channel data block
The routine:
1) does the dump mode output only if there are characters
to be sent.
2) resets the OCNT and OBP variables
⊗
BEGIN STRSND
↑↑STRSND:
PUSH P,2 ;SAVE ACS
PUSH P,3
PUSH P,4
LDB 2,[POINT 4,OFL(CDB),9] ;GET MODE
JUMPE 2,STRSOU ;USE SOUT
CAIE 2,17 ;BETTER BE DUMP MODE
ERR <STRSND: MODE NOT 0 OR 17>
HRRZI 3,STARTPAGE(1) ;GET THE PAGE NUMBER FOR THE BUFFER
IMULI 3,1000 ;MAKE AN ADDRESS
SKIPN OBP(CDB) ;INITIALIZED?
JRST DMPINIT ;NO, JUST INITIALIZE
MOVEI 4,DMOCNT*5
CAMG 4,OCNT(CDB) ;ANY CHARS TO SEND
JRST STRRET ;NO
MOVEI 2,3
SUBI 3,1
MOVNI 4,DMOCNT ;WORD COUNT FOR DUMP MODE OUTPUT
HRL 3,4 ;MAKE AN IOWD
SETZ 4, ;MAKE A COMMAND LIST
JSYS DUMPO
ERR <DUMPOUT: CANNOT WRITE DATA IN DUMP MODE>,1
SETOM DMPED(CDB) ;AND INDICATE DONE
DMPINIT:
MOVEI 3,STARTPAGE(1)
IMULI 3,1000
HRL 2,3
HRRI 2,1(3)
SETZM (3)
BLT 2,DMOCNT-1(3) ;ZERO OUT
MOVEI 2,DMOCNT*5
MOVEM 2,OCNT(CDB) ;SAVE COUNT
HLL 3,[POINT 7,0,-1];FIX A BYTE-POINTER
MOVEM 3,OBP(CDB) ;AND SAVE BYTE-POINTER
STRRET: POP P,4 ;RESTORE AND RETURN
POP P,3
POP P,2
POPJ P,
STRSOU: SKIPN OBP(CDB) ;INITIALIZED?
JRST SOUINIT ;NO
MOVEI 3,1000*5
CAMG 3,OCNT(CDB) ;ANYTHING TO SEND?
JRST STRRET ;NO
HRRZI 2,STARTPAGE(1)
IMULI 2,1000 ;CALCULATE ADDRESS
HRLI 2,444400 ;BP
MOVNI 3,1000 ;COUNT
JSYS SOUT
SOUINIT:
HRRZI 2,STARTPAGE(1)
IMULI 2,1000
HRL 3,2
HRRI 3,1(2)
SETZM (2)
BLT 3,777(2) ;CLEAR OUT PAGE
HRLI 2,440700
MOVEM 2,OBP(CDB)
MOVEI 3,1000*5
MOVEM 3,OCNT(CDB)
JRST STRRET
BEND STRSND
DSCR SIMPLE PROCEDURE GTFDB(INTEGER JFN; REFERENCE INTEGER ARRAY BUF)
Entire FDB of JFN is read into BUF. No bounds checking,
so BUF should be at least '26 words.
⊗
HERE(GTFDB)
PUSHJ P,SAVE
MOVE LPSA,X33
VALCHN 1,<-2(P)>,GTFBAD
MOVSI 2,25 ;ALL 25 WORDS
HRRZ 3,-1(P) ;ADDRESS OF ARRAY
JSYS GTFDB
GTFRET: JRST RESTR
GTFBAD: ERR <GTFDB: ILLEGAL JFN>,1
JRST GTFRET
ENDCOM(FIO)
COMPIL(BINROU,<WORDIN,WORDOUT,ARRYIN,ARRYOUT,MTOPR,SFPTR,RFPTR,BKJFN,RFBSZ>
,<JFNTBL,X22,X33,.SKIP.,CDBTBL,SAVE,RESTR>
,<BINROU -- BINARY ROUTINES>)
DSCR INTEGER SIMPLE PROCEDURE WORDIN(INTEGER JFN);
Does the BIN jsys on JFN.
⊗
HERE(WORDIN)
PUSH P,2
PUSH P,Q
PUSH P,CDB
VALCHN 1,<-1(P)>,BINBAD
SKIPE ENDFL(CDB)
SETZM @ENDFL(CDB) ;ASSUME NO EOF
JSYS BIN
JUMPE 2,CKWEOF ;CHECK EOF
MOVE 1,2;
BINRET: POP P,CDB ;RESTORE
POP P,Q
POP P,2
SUB P,X22
JRST @2(P)
BINBAD: ERR <BIN: ILLEGAL JFN>,1
SETZ 1, ;RETURN A NULL
JRST BINRET
CKWEOF: JSYS GTSTS ;CHECK STATUS
TESTE 2,<1B8> ;END-OF-FILE?
JRST [SKIPE ENDFL(CDB) ;EOF LOCATION
SETOM @ENDFL(CDB) ;YES
JRST .+1]
SETZ 1, ;RETURN NULL TO USER
JRST BINRET
DSCR SIMPLE PROCEDURE WORDOUT(INTEGER JFN,BYTE);
Does the BOUT jsys.;
⊗
HERE(WORDOUT)
EXCH 1,-2(P)
EXCH 2,-1(P)
CAIL 1,0
CAIL 1,JFNSIZE
JRST BOUBAD
SKIPN 1,JFNTBL(1)
JRST BOUBAD
HRRZ 1,1
JSYS BOUT
BOURET: EXCH 1,-2(P)
EXCH 2,-1(P)
SUB P,X33
JRST @3(P)
BOUBAD: ERR <WORDOUT OR BOUT: ILLEGAL JFN>,1
JRST BOURET
DSCR SIMPLE PROCEDURE ARRYIN(INTEGER JFN; REFERENCE INTEGER LOC; INTEGER COUNT);
Reads in COUNT words into LOC from JFN. The file should be open
for 36-bit bytes for this to work.
WARNING: no array bounds checking.
⊗
HERE(ARRYIN)
PUSHJ P,SAVE
MOVE LPSA,X44
MOVN 3,-1(P) ;NEGATIVE WORD COUNT
JUMPE 3,ARIRET
JUMPG 3,ARIBAD ;NEGATIVE WORD COUNT
SKIPL Q,-3(P)
CAIL Q,JFNSIZE
JRST ARIBAD
MOVE CDB,CDBTBL(Q) ;GET CDB
SKIPN 1,JFNTBL(Q)
JRST ARIBAD
SKIPE ENDFL(CDB) ;EOF LOCATION?
SETZM @ENDFL(CDB) ;ASSUME GOOD
HRRZ 1,1 ;THIS IS THE JFN NOW
LDB 2,[POINT 4,OFL(CDB),9] ;GET THE MODE
JUMPE 2,USESIN ;MODE ZERO?
CAIE 2,17 ;BETTER BE DUMP
JRST ARIBAD
USEDMP: MOVEI 2,3
HRL 3,3 ;NEGATIVE WORD COUNT
HRR 3,-2(P) ;ADDRESS OF BUFFER
SUBI 3,1
SETZB 4,.SKIP. ;ZERO NEXT LOCATION, ERROR WORD
JSYS DUMPI
JRST DMPERR
JRST ARIRET ;RETURN
USESIN: MOVSI 2,444400 ;BYTE-POINTER
HRR 2,-2(P) ;LOCATION
SETZM .SKIP. ;ASSUME NO ERROR
JSYS SIN
SKIPE 3 ;EVERYTHING READ ?
JRST SINEOF
ARIRET: JRST RESTR
SINEOF: ADD 3,-1(P) ;CALCULATE NO. OF WORDS READ IN
HRLI 3,-1 ;MAKE IT XWD -1,COUNT
SKIPE ENDFL(CDB) ;EOF LOCATION
MOVEM 3,@ENDFL(CDB) ;AND SAVE
JRST ARIRET
ARIBAD: ERR <ARRYIN: NEGATIVE WORD COUNT, ILLEGAL JFN OR ILLEGAL MODE>,1
ARIBA1: SETOM .SKIP.
JRST ARIRET
DMPERR: CAIN 1,600220 ;END OF FILE?
JRST DMPEOF
ERR <ARRYIN: DUMP MODE ERROR>,1
JRST ARIBA1
DMPEOF: SKIPE ENDFL(CDB) ;EOF LOCATION
SETOM @ENDFL(CDB) ;INDICATE EOF
MOVE 1,DVTYP(CDB) ;GET DEVICE TYPE
CAIE 1,2 ;IS IT MAGNETIC TAPE?
JRST ARIRET ;NO
HRRZ 1,JFNTBL(Q) ;THE JFN
SETZ 2,
JSYS MTOPR ;CLEAR STATUS
JRST ARIRET ;AND RETURN
DSCR SIMPLE PROCEDURE ARRYOUT(INTEGER JFN; REFERENCE INTEGER LOC; INTEGER COUNT);
DESR
Writes COUNT words to JFN starting at LOC. The file should be open
in 36-bit bytes.;
⊗
HERE(ARRYOUT)
PUSHJ P,SAVE
MOVE LPSA,X44
MOVN 3,-1(P) ;COUNT
JUMPE 3,ARORET
JUMPG 3,AROBAD ;NEGATIVE COUNT?
SKIPL 1,-3(P) ;CHANNEL
CAIL 1,JFNSIZE
JRST AROBAD
MOVE CDB,CDBTBL(1)
SKIPN 1,JFNTBL(1)
JRST AROBAD
HRRZ 1,1 ;JFN
LDB 2,[POINT 4,OFL(CDB),9] ;GET THE MODE
JUMPE 2,AROSOU ;MODE ZERO?
CAIE 2,17 ;BETTER BE DUMP
JRST AROBAD ;NOT OPEN IN DUMP MODE
ARODMP: MOVEI 2,3
HRL 3,3 ;NEGATIVE WORD COUNT
HRR 3,-2(P)
SUBI 3,1 ;MAKE AN IOWD
SETZB 4,.SKIP.
JSYS DUMPO
JRST DMPOER
SETOM DMPED(CDB) ;INDICATE DUMP MODE
JRST ARORET ;RETURN
AROSOU: MOVSI 2,444400 ;BYTE-POINTER
HRR 2,-2(P) ;LOCATION
SETZM .SKIP.
JSYS SOUT
ARORET: JRST RESTR
AROBAD: ERR <ARRYOUT: NEGATIVE WORD COUNT, ILLEGAL JFN OR ILLEGAL MODE>,1
AROBA1: SETOM .SKIP.
JRST ARORET
DMPOER: ERR <ARRYOUT: DUMP MODE ERROR>,1
JRST AROBA1
DSCR SIMPLE PROCEDURE MTOPR(INTEGER JFN,FUNCTION,VALUE)
Does the MTOPR jsys.
⊗
HERE(MTOPR)
BEGIN MTOPR
PUSHJ P,SAVE
MOVE LPSA,X44
VALCHN 1,-3(P),MTBAD
MOVE 2,-2(P)
MOVE 3,-1(P)
JSYS MTOPR
MTRET: JRST RESTR
MTBAD: ERR <MTOPR: ILLEGAL JFN>,1
JRST MTRET
BEND MTOPR
DSCR SIMPLE PROCEDURE SFPTR(INTEGER JFN,POINTER)
Sets the file open on JFN to byte POINTER (-1 for EOF).
Errors returned in .SKIP.
WARNING: presently not compatible with special character
mode.
⊗
HERE(SFPTR)
PUSHJ P,SAVE
MOVE LPSA,X33
VALCHN 1,-2(P),SFBAD
SETZM .SKIP.
MOVE 2,-1(P)
JSYS SFPTR
MOVEM 1,.SKIP.
SFRET: JRST RESTR
SFBAD: ERR <SFPTR: ILLEGAL JFN>,1
SETOM .SKIP.
JRST SFRET
DSCR INTEGER SIMPLE PROCEDURE RFPTR(INTEGER JFN)
Reads the pointer of JFN. Error codes to .SKIP.
WARNING: presently does not work for files in special character
mode.
⊗
HERE(RFPTR)
PUSHJ P,SAVE
MOVE LPSA,X22
VALCHN 1,-1(P),RFBAD
SETZM .SKIP.
JSYS RFPTR
MOVEM 1,.SKIP.
MOVEM 2,RACS+A(USER) ;ANSWER IN 2
RFRET: JRST RESTR
RFBAD: ERR <RFPTR: ILLEGAL JFN>,1
SETOM .SKIP.
JRST RFRET
DSCR SIMPLE PROCEDURE BKJFN(INTEGER JFN)
Does the BKJFN jsys on JFN, error code to .SKIP.
⊗
HERE(BKJFN)
PUSHJ P,SAVE
MOVE LPSA,X22
VALCHN 1,-1(P),BKBAD
SETZM .SKIP.
JSYS BKJFN
MOVEM 1,.SKIP.
BKRET: JRST RESTR
BKBAD: ERR <BKJFN: ILLEGAL JFN>,1
SETOM .SKIP.
JRST BKRET
DSCR INTEGER SIMPLE PROCEDURE RFBSZ(INTEGER JFN);
Reads the byte-size of the file open on JFN.
⊗
HERE(RFBSZ)
PUSHJ P,SAVE
MOVE LPSA,X22
VALCHN 1,-1(P),RFBBAD
JSYS RFBSZ
MOVEM 2,RACS+A(USER) ;ANSWER IN 2
RFBRET: JRST RESTR
RFBBAD: ERR <RFBSZ: ILLEGAL JFN>,1
JRST RFBRET
ENDCOM(BINROU)
IFN IMSSS,<
COMPIL(DSKOPS,<DSKIN,DSKOUT>
,<JFNTBL,CDBTBL,.SKIP.>
,<DSKOPS -- DIRECT DSK ROUTINES>)
DSCR SIMPLE PROCEDURE
DSKIN(INTEGER MODULE,RECNO,COUNT; REFERENCE INTEGER LOC);
IMSSS only.
Does direct IO from the DSK (formerly device "PAK").
Modules 4-7 are legal for everyone. Other modules require enabled
status.
Count words are read into user's core at location LOC, from
MODULE, record RECNO. Error bits are in .SKIP.
Does the DSKOP jsys (as modified at IMSSS).
⊗
BEGIN DSKOPS
HERE(DSKIN)
PUSHJ P,SAVE
MOVSI 4,600000 ;INDICATE READ ONLY
DSK1: HRRZ 2,-2(P)
JUMPLE 2,DSBAD ;LEQ 0 -- ERROR
CAILE 2,1000 ;DONT READ MORE THAN 1000 WORDS
JRST DSBAD
HRLZ 1,-4(P) ;MODULE
HRR 1,-3(P) ;RECORD NO. IN RIGHT HALF
TDO 1,4 ;TURN ON APPROPRIATE BITS
HRRZ 3,-1(P) ; GET THE USER LOCATION
JSYS DSKOP
DSDUN: MOVEM 1,.SKIP. ; SAVE ERROR BITS
DSRET: MOVE LPSA,[XWD 5,5] ; TO ADJUST STACK
JRST RESTR
DSBAD: ERR <DSKIN OR DSKOUT: WORD COUNT EITHER <= 0 OR > '1000>,1
SETOM .SKIP.
JRST DSRET
DSCR SIMPLE PROCEDURE
DSKOUT(INTEGER MODULE,RECNO,COUNT; REFERENCE INTEGER LOC)
DESR Similar to DSKIN, except that a write is done.
⊗
HERE(DSKOUT)
PUSHJ P,SAVE
MOVSI 4,600010 ;INDICATE WRITE
JRST DSK1 ;AND TO THE ABOVE CODE
BEND DSKOPS
ENDCOM(DSKOP)
>;IFN IMSSS
COMPIL(DEVS,<DEVTYPE,DVCHR,ERSTR>
,<X22,X44,.SKIP.,JFNTBL,CDBTBL>
,<DEVS -- DEVICE HANDLERS, ERROR ROUTINE>)
DSCR INTEGER SIMPLE PROCEDURE DEVTYPE(INTEGER JFN);
Returns (via the DEVCHR jsys) the device type of
the device open on JFN. The more general DEVCHR call is
also implemented (below).
⊗
HERE(DEVTYPE)
VALCHN 1,-1(P),DEVBAD
JSYS DVCHR
HLRZ 1,2
ANDI 1,777
DEVRET: SUB P,X22
JRST @2(P)
DEVBAD: ERR <DEVTYPE: ILLEGAL JFN>,1
JRST DEVRET
DSCR INTEGER SIMPLE PROCEDURE DVCHR(INTEGER JFN; REFERENCE INTEGER AC1,AC3);
Does the DEVCHR jsys, returning the flags from AC2 as the
value of the call, and AC1 and AC3 get the contents of ac's 1 and 3.;
⊗
HERE(DVCHR)
VALCHN 1,-3(P),DVBAD
JSYS DVCHR
MOVEM 1,@-2(P)
MOVEM 3,@-1(P)
MOVE 1,2
DVRET: SUB P,X44
JRST @4(P)
DVBAD: ERR <DVCHR: ILLEGAL JFN>,1
JRST DVRET
DSCR SIMPLE PROCEDURE ERSTR(INTEGER ERRNO,FORK)
Using the ERSTR jsys, types out on the console the TENEX error string
associated with ERRNO for FORK fork (0 for the current fork). Parameters (in
the sense of the ERSTR jsys) are expanded.
Types out the string ERSTR: UNDEFINED ERROR number if
something is with your error number or fork (and sets .SKIP. to -1).
⊗
HERE(ERSTR)
SETZM .SKIP.
MOVEI 1,101 ;PRIMARY OUTPUT
SKIPN 2,-1(P) ;ANY FORK MENTIONED?
MOVEI 2,400000 ;ASSUME CURRENT FORK
HRLZ 2,2 ;IN LEFT HALF
HRR 2,-2(P) ;THE ERROR NUMBER
SETZ 3, ;NO LIMIT TO SIZE OF STRING
JSYS ERSTR
JRST ERSERR
JRST ERSERR ;ERROR RETURNS
ERSRET: SUB P,X44
JRST @4(P)
ERSERR: HRROI 1,[ASCIZ/
ERSTR: UNDEFINED ERROR NUMBER
/]
JSYS PSOUT
SETOM .SKIP. ;INDICATE ERROR
JRST ERSRET
ENDCOM(DEVS)
COMPIL(UTILITY,<SETCHN,ZSETST,ZADJST,.RESET>
,<CORGET,GOGTAB,JFNTBL,CDBTBL,STRNGC>
,<UTILITY -- UTILITY TENEX ROUTINES>)
DSCR
SETCHN accepts in A the JFN, and returns in A the channel number associated with a JFN.
It sets up the JFNTBL, the CDBTBL table, and returns the address of the
file command block in ac CDB. Other acs are not modified (except USER).
In order to accommodate the open statement, a channel will be
considered allocated when it has a CDB, even if it does not yet have a jfn.
⊗
HERE(SETCHN)
MOVE USER,GOGTAB
PUSH P,B
PUSH P,C
PUSH P,D
MOVEI C,IOTLEN
PUSHJ P,CORGET
ERR <SETCHN: CANNOT GET CORE FOR FILE DESCRIPTOR BLOCK>
MOVE CDB,B ;
HRL B,B ;ZERO OUT BLOCK
ADDI B,1
SETZM (CDB)
BLT B,IOTLEN-1(CDB)
SKIPE CDBTBL(A) ;CAN WE USE THE SAME CHANNEL AS JFN?
JRST FNDCHN ;NO, FIND ANOTHER CHANNEL
HRRZ D,A ;YES
GOTCHN: MOVEM CDB,CDBTBL(D)
SKIPE JFNTBL(D) ;CHECK FOR CONSISTENCY
ERR <SETCHN: INCONSISTENT BOOK-KEEPING>,1
MOVEM A,JFNTBL(D)
HRRZ 1,A ;JFN
JSYS DVCHR ;CLOBBERS 1,2,3
MOVEM 1,DVDSG(CDB) ;SAVE DESIGNATOR
MOVEM 2,DVCH(CDB) ;AND CHARACTERISTICS
HLRZ 1,2
ANDI 1,777 ;GET DEVICE TYPE
MOVEM 1,DVTYP(CDB) ;AND SAVE IT
HRRZ A,D ;CHANNEL INTO A
POP P,D ;RESTORE
POP P,C
POP P,B
POPJ P,
;FIND AN OPEN CHANNEL AND RETURN THE NUMBER IN D
FNDCHN: SETZ D,
FNDCH1: CAIL D,JFNSIZE
ERR <SETCHN: JFN TABLE IS FULL (SHOULD NEVER HAPPEN)>
SKIPE CDBTBL(D)
AOJA D,FNDCH1
JRST GOTCHN
DSCR SIMPLE INTEGER PROCEDURE ZSETST(INTEGER I);
Internal book-keeping routine not intended for
use from SAIL. Causes liberation from SAIL.
THE ARGUMENT IS THE MAXIMUM SIZE OF THE EXPECTED STRING.
THE RETURN IS THE BYTEPOINTER POINTING INTO THE TOP OF STRING SPACE
⊗
HERE(ZSETST)
MOVE USER,GOGTAB ; GET USER
MOVE 1,-1(P) ;GET EXPECTED LENGTH
ADDM 1,REMCHR(USER) ; ADD ON
SKIPLE REMCHR(USER) ; NEED TO COLLECT?
PUSHJ P,GOCOLLECT ; YES
MOVE 1,TOPBYTE(USER) ; RETURN BP
SUB P,X22 ; ADJUST STACK
JRST @2(P) ; RETURN
GOCOLLECT:
MOVEM RF,RACS+RF(USER) ;SAVE RF
PUSHJ P,STRNGC ;
POPJ P, ; RETURN TO ABOVE
DSCR STRING SIMPLE PROCEDURE ZADJST(INTEGER CNTEST,BP)
Internal book-keeping routine.
ADJUSTS THE PARAMETERS ASSOCIATED WITH STRING SPACE.
BP IS OUR NEW TOPBYTE. CNTEST IS THE COUNT ESTIMATE WE
ORIGINALLY MADE.
FIRST, WE MUST MAKE REMCHR HONEST, THEN WE
CAN FIX TOPSTR AND THE USER'S LENGTH WORD.
⊗
HERE(ZADJST)
BEGIN ZADJST
MOVE USER,GOGTAB;
PUSH P,1
PUSH P,2
PUSH P,3
PUSH P,4
DEFINE CNTARG <-6(P)>
DEFINE BPARG <-5(P)>
MOVE 2,BPARG ;UPDATED BP
MOVE 1,TOPBYTE(USER) ; GET OLD TOPBYTE
CAMN 1,2 ; THE NULL STRING?
JRST NULRET; ;YES
;P. KANERVA'S BYTE ROUTINE
LDB 3,[POINT 6,1,5] ;BITS TO THE RIGHT OF BYTE 1
LDB 4,[POINT 6,2,5] ;BITS TO THE RIGHT OF BYTE 2
SUBI 3,(4) ;BIT DIFFERENCE
IDIVI 3,7 ;WITHIN-WORD BYTE DIFFERENCE
SUBI 2,(1) ;WORDS BETWEEN BYTES
HRRE 2,2 ;FULL WORD DIFFERENCE
IMULI 2,5 ;CONVERT IT TO BYTE DIFFERENCE
ADD 2,3 ;ADD COUNT DERIVED FROM WITHIN-WORD
;DIFFERENCE
CAMLE 2,CNTARG ;WITHIN RANGE?
ERR <ZADJST: TENEX WROTE TOO LONG A STRING, MAY BE FATAL>,1
GOTLNG: HRRO 1,2 ; XWD -1,COUNT
PUSH SP,1 ; XWD -1,COUNT
PUSH SP,TOPBYTE(USER) ; OLD TOPBYTE FOR BP FOR STRING
SUB 2,CNTARG ; SUBTRACT THE COUNT ESTIMATE
ADDM 2,REMCHR(USER) ; MAKE REMCHR HONEST
MOVE 2,BPARG ; GET THE NEW TOPBYTE
MOVEM 2,TOPBYTE(USER) ; AND SAVE IT
POP P,4
POP P,3
POP P,2
POP P,1
SUB P,X33 ; ADJUST STACK
JRST @3(P) ;
NULRET: SETZ 2,;
JRST GOTLNG ; BE SURE TO FIX UP ALL THE GOODIES
BEND ZADJST
DSCR
.RESET
SID SAVES ALL ACS
CAL PUSHJ
RESETS TENEX IO AND BOOKKEEPING, AND SETS THE TTY MODE TO WAKEUP
ON EVERY CHARACTER.
THIS SHOULD ONLY BE CALLED INTERNALLY
⊗
HERE(.RESET)
BEGIN RESET
PUSH P,1
PUSH P,2
PUSH P,3
;ZERO OUT BOOKKEEPING
SETZM JFNTBL
MOVE 1,[XWD JFNTBL,JFNTBL+1]
BLT 1,JFNTBL+JFNSIZE-1
SETZM CDBTBL
MOVE 1,[XWD CDBTBL,CDBTBL+1]
BLT 1,CDBTBL+JFNSIZE-1
;RELEASE PAGES ASSOCIATED WITH FILES (FROM STARTPAGE TO STARTPAGE+JFNSIZE-1)
SETO 1, ;RELEASE PAGE
SETZ 3, ;FLAGS WORD
MOVE 2,[XWD 400000,STARTPAGE]
.RESE1: CAMN 2,[XWD 400000,STARTPAGE+JFNSIZE] ;THIS WOULD BE TOO MANY PAGES
JRST .RESE2
JSYS PMAP
AOJA 2,.RESE1 ;NEXT?
.RESE2:
JSYS RESET ;CLEAR ALL IO
;SET PRIMARY INPUT TO WAKE UP ON EVERY CHARACTER
;THE USER MAY RESET THIS.
MOVEI 1,100 ;PRIMARY INPUT
JSYS RFMOD
TRO 2,170000 ;WAKEUP ON ALL CHARS
JSYS SFMOD
POP P,3
POP P,2
POP P,1
POPJ P, ;RETURN
BEND RESET
ENDCOM(UTILITY)
COMPIL(TTM,<RFMOD,SFMOD,RFCOC,SFCOC>
,<SAVE,RESTR,X22,X33,X44>
,<TTM -- TERMINAL MODE ROUTINES>)
DSCR INTEGER PROCEDURE RFMOD(INTEGER CHAN)
Reads a file's mode word.
PROCEDURE SFMOD(INTEGER CHAN,AC2)
Sets a file's mode word to argument AC2.
PROCEDURE RFCOC(INTEGER CHAN; REFERENCE INTEGER AC2,AC3)
Does RFCOC jsys, returning values in AC2 and AC3.
PROCEDURE SFCOC(INTEGER CHAN,AC2,AC3)
Does SFCOC jsys, setting to AC2 and AC3.
⊗
HERE(RFMOD)
PUSHJ P,SAVE
MOVE LPSA,X22
VALCH1 1,-1(P),RFMO1
RFMO2: RFMOD
MOVEM 2,RACS+A(USER)
JRST RESTR
RFMO1: MOVE 1,-1(P) ;USE LITERALLY
JRST RFMO2
HERE(SFMOD)
PUSHJ P,SAVE
MOVE LPSA,X33
VALCH1 1,-2(P),SFMO1
SFMO2: MOVE 2,-1(P)
SFMOD
JRST RESTR
SFMO1: MOVE 1,-2(P)
JRST SFMO2
HERE(RFCOC)
PUSHJ P,SAVE
MOVE LPSA,X44
VALCH1 1,-3(P),RFCO1
RFCO2: RFCOC
MOVEM 2,@-2(P)
MOVEM 3,@-1(P)
JRST RESTR
RFCO1: MOVE 1,-3(P) ;USE LITERALLY
HERE(SFCOC)
PUSHJ P,SAVE
MOVE LPSA,X44
VALCH1 1,-3(P),SFCO1
SFCO2: MOVE 2,@-2(P)
MOVE 3,@-1(P)
SFCOC
JRST RESTR
SFCO1: MOVE 1,-3(P) ;USE LITERALLY
JRST SFCO2
ENDCOM(TTM)
COMPIL(PAGES,<PMAP>,<SAVE,RESTR,X44>
,<PAGES -- PAGE MANAGEMENT>)
DSCR SIMPLE PROCEDURE PMAP(INTEGER AC1,AC2,AC3);
DESR
Does the PMAP jsys, with these parameters:
ARGUMENTS:
AC1 contents of AC1
AC2 " of AC2
AC3 " of AC3
⊗
HERE(PMAP)
PUSHJ P,SAVE
MOVE LPSA,X44
MOVE 1,-3(P) ;FILEPAGE
MOVE 2,-2(P) ;XWD FORK,PAGE
MOVE 3,-1(P) ;ACCESS BITS
JSYS PMAP
JRST RESTR
ENDCOM(PAGES)
IFN IMSSS,<
COMPIL(TT2,<PBTIN,INTTY>
,<X22,.SKIP.,ZSETST,ZADJST,CTLOSW>
,<TT2 -- IMSSS TTY ROUTINES>)
DSCR INTEGER SIMPLE PROCEDURE PBTIN(INTEGER SECONDS);
DESR
Executes the PBTIN jsys, with timing of SECONDS.
⊗
HERE(PBTIN)
SETZM CTLOSW ;PROGRAM REQUESTS INPUT
EXCH 1,-1(P)
JSYS PBTIN
EXCH 1,-1(P)
SUB P,X22
JRST @2(P)
DSCR STRING SIMPLE PROCEDURE INTTY;
Using the PSTIN jsys, accepts as many as 200 characters from
the user's Teletype, with the standard system breakcharacters. The
breakcharacter itself is removed from the string, and
no timing is available. For fancier calls, see PSTIN routine.
⊗
HERE(INTTY)
PUSH P,1
PUSH P,2
PUSH P,3
SETZB 3,CTLOSW ;PROGRAM REQUESTS INPUT
MOVEI 2,=200 ;DEFAULT LENGTH
INTT2: PUSH P,2 ;LENGTH
PUSHJ P,ZSETST ;GET BP IN 1
JSYS PSTIN
CAIL 2,=200 ;DID WE GET 200 CHARS?
JRST [SETOM .SKIP.
JRST INTT1]
LDB 3,1 ;GET THE LAST CHAR
MOVEM 3,.SKIP. ;AND SAVE IT
SOJ 1, ;BACK UP BYTE-POINTER (OVER LAST CHAR)
IBP 1
IBP 1
IBP 1
IBP 1
INTT1: PUSH P,[=200]
PUSH P,1
PUSHJ P,ZADJST ;GET STRING ON STACK
POP P,3
POP P,2
POP P,1
POPJ P, ;RETURN
ENDCOM(TT2)
>;IFN IMSSS
COMMENT ⊗ TTY FUNCTIONS ⊗
DSCR TTY FUNCTIONS
CAL SAIL
⊗
Comment ⊗
INTEGER PROCEDURE INCHRW;
RETURN A CHAR FROM PBIN
INTEGER PROCEDURE INCHRS;
RETURN -1 IF NO CHAR WAITING, ELSE FIRST CHAR (SIBE FOLLOWED BY PBIN)
STRING PROCEDURE INCHWL;
WAIT FOR A LINE, THEN RETURN IT (PBINs, LINE EDITING)
STRING PROCEDURE INCHSL(REFERENCE INTEGER FLAG);
FLAG←-1, STR←NULL IF NO LINE, ELSE FLAG←0,
STR←LINE (SIBE, FOLLOWED BY PBINs)
STRING PROCEDURE INSTR(INTEGER BRCHAR);
RETURN ALL CHARS TO AND NOT INCLUDING BRCHAR (PBINs)
STRING PROCEDURE INSTRL(INTEGER BRCHAR);
WAIT FOR ONE LINE, THEN DO INSTR (PBINs WITH EDITING)
STRING PROCEDURE INSTRS(REFERENCE INTEGER FLAG; INTEGER BRCHAR);
FLAG←-1, STR←NULL IF NO LINES, ELSE FLAG←0,
STR←INSTR(BRCHAR)
PROCEDURE OUTCHR(INTEGER CHAR);
OUTPUT CHAR (PBOUT)
PROCEDURE OUTSTR(STRING STR);
OUTPUT STR (SOUT)
PROCEDURE CLRBUF;
CLEARS INPUT BUFFER (CFIBF)
TTYIN, TTYINS, TTYINL (TABLE, @BRCHAR);
TTYIN WORKS WITH TTCALL 0'S; TTYINS DOES A SKIP
ON LINE FIRST, RETURNING NULL AND -1 IN BREAK IF NO LINES
TTYINL DOES A WAIT FOR LINE FIRST.
FULL BREAKSET CAPABILITIES EXCEPT FOR
"R" MODE (AND OF COURSE, LINE NUM. STUFF)
TITLE TTYUUO
⊗
COMPIL(TTY,<PBIN,PBOUT,PSOUT,INCHRW,INCHRS,INCHWL,INCHSL,INSTR,OUTCHR,OUTSTR,ENCTLO,DSCTLO
ENTINT <INSTRL,INSTRS,CLRBUF,TTYIN,TTYINS,TTYINL>>
,<SAVE,RESTR,X11,X22,X33,INSET,CAT,STRNGC,GOGTAB,BRKMSK,.SKIP.,CTLOSW>
,<TELETYPE FUNCTIONS>)
;;#GF# DCS 2-1-72 (1-3) INCHWL BREAKS ON ALL ACTIVATION, TELLS WHICH IN .SKIP.
; .SKIP. EXTERNAL ABOVE
;;#GF#
HERE(ENCTLO)
;ROUTINE TO ENABLE CTRL-O PSEUDO INTERRUPT ON CHANNEL 3
PUSHJ P,SAVE
MOVEI 1,400000 ;THIS FORK
JSYS RIR ;READ ADDRESS OF CHNTAB INTO 2
SKIPN 2 ;TABLE ADDRESS?
ERR <ENCTLO: CHNTAB NOT SET UP>
HRLI 1,2 ;LEVEL 2
HRRI 1,INT.O ;ADDRESS OF ROUTINE
MOVEM 1,3(2) ;CHANNEL 3
MOVEI 1,400000 ;THIS FORK
MOVSI 2,040000 ;CHANNEL 3
JSYS AIC
MOVE 1,[XWD 17,3] ;Q FOR CHANNEL 3
JSYS ATI
MOVEI 1,400000 ;THIS FORK
JSYS EIR ;ENABLE INTERRUPT SYSTEM (IF NOT ALREADY)
SETZ LPSA, ;STACK ADJUSTING...
JRST RESTR ;RETURN
HERE(DSCTLO)
PUSHJ P,SAVE
MOVEI 1,400000 ;THIS FORK
MOVSI 2,040000 ;CHANNEL 3
JSYS DIC ;DE-ACTIVATE
SETZ LPSA,
JRST RESTR
;HERE WITH A CTRL-O PSEUDO INTERRUPT FROM TENEX
;CTLOSW←(IF CTLOSW THEN FALSE ELSE TRUE)
;THEN LEAVE INTERRUPT LEVEL
INT.O: SKIPE CTLOSW ;TURNED ON?
JRST [SETZM CTLOSW
JSYS DEBRK]
SETOM CTLOSW
JSYS DEBRK
HERE(PBIN)
HERE (INCHRW)
SETZM CTLOSW ;INPUT REQUESTED
INCHR1: JSYS PBIN
POPJ P,
HERE (INCHRS)
SETZM CTLOSW ;INPUT REQUESTED
MOVEI 1,100
JSYS SIBE
JRST INCHR1
SETO 1, ;RETURN -1
POPJ P,
HERE(PBOUT)
HERE (OUTCHR)
SKIPE CTLOSW ;DOING OUTPUT?
JRST OUTCRE ;NO
EXCH 1,-1(P) ;GET PARAMETER, SAVING AC 1
JSYS PBOUT ;OUTPUT CHAR
EXCH 1,-1(P) ;GET BACK 1
OUTCRE: SUB P,X22
JRST @2(P) ;RETURN
HERE(PSOUT)
HERE (OUTSTR)
SKIPE CTLOSW ;DOING OUTPUT?
JRST OUTSRE ;NO
EXCH 2,(SP) ;BP WORD
EXCH 3,-1(SP) ;LENGTH WORD
PUSH P,1 ;ALSO NEED 1
HRRZ 3,3 ;COUNT
JUMPE 3,NULSTR ;DONT SEND EMPTY STR
MOVEI 1,101 ;TERMINAL OUTPUT
MOVN 3,3
JSYS SOUT
NULSTR: POP P,1
OUTSRE: POP SP,2
POP SP,3 ;ADJUSTS STACK AUTOMATICALLY
POPJ P, ;RETURN
;REDSTR (0) MARKS CTLOSW THAT INPUT WAS REQUESTED
;(1) PREPARES TO MAKE A STRING OF 200 CHARS,
;(2) ZEROS C FOR COUNT
;(3) SETS UP D WITH THE ORIGINAL BYTE-POINTER
REDSTR: SETZM CTLOSW ;INPUT REQUESTED
SKIPE SGLIGN(USER)
PUSHJ P,INSET
MOVEI A,=200
ADDM A,REMCHR(USER)
SKIPLE REMCHR(USER)
PUSHJ P,STRNGC
SETZ C, ;COUNT HERE
MOVE D,TOPBYTE(USER) ;ORIGINAL BYTE-POINTER, IF NEEDED
PUSH SP,[0] ;NULL STRING IF NOTHING DONE
PUSH SP,TOPBYTE(USER)
POPJ P,
FINSTR: MOVEI A,=200
SUB A,C ;NUMBER USED
ADDM A,REMCHR(USER)
HRROM C,-1(SP) ;STRING COUNT WORD
MOVEM D,TOPBYTE(USER) ;NEW TOPBYTE
JRST RESTR
;CALL TO HERE WITH A PUSHJ TO GET A CHAR IN AC1
;AC 3 HAS THE COUNT, D THE BYTE-POINTER
EDICHR:
JSYS PBIN ;GET A CHARACTER
CAIN 1,DELLINE ;DELETE LINE CHAR
JRST CTRLU
CAIN 1,RUBCHAR ;RUBOUT?
JRST RUBOUT
CAIN 1,37 ;PHONEY TENEX EOL?
MOVEI 1,12
CAIN 1,33 ;PHONEY TENEX ALTMODE?
MOVEI 1,175
POPJ P, ;GOOD CHAR FOR USER
CTRLU:
;AC 1 IS FREE
HRROI 1,[BYTE (7) 7,15,12,0,0]
JSYS PSOUT
JUMPE C,EDICHR ;IF NO CHARS THEN DO NOTHING
SETZ C,
MOVE D,TOPBYTE(USER)
JRST EDICHR
RUBOUT: JUMPE C,CTRLU ;IF NO CHARS THEN DO CTRLU
;AC 1 IS AVAILABLE
MOVEI 1,"\"
JSYS PBOUT
LDB 1,D ;GET LAST CHAR
JSYS PBOUT ;AND SEND IT
IFN IMSSS,<
MOVEI 1,377 ;THREE RUBOUTS FOR IMLACS
JSYS PBOUT
JSYS PBOUT
JSYS PBOUT
>;IFN IMSSS
SOJ D, ;BACK UP BP TO LAST CHAR
IBP D
IBP D
IBP D
IBP D
SOJA C,EDICHR ;AND GET ANOTHER CHAR
HERE(INSTRL)
HERE (INSTR)
PUSHJ P,SAVE
PUSHJ P,REDSTR
MOVE B,-1(P) ;BREAK CHAR
MOVE LPSA,X22 ;# TO REMOVE
INS1: CAIL C,=200 ;COUNT EXHAUSTED?
JRST FINSTR ;YES
INS2: PUSHJ P,EDICHR ;GET A CHAR IN 1, USING EDITING
CAMN 1,B ;BREAK?
JRST FINSTR ; YES, ALL DONE
IDPB 1,D ;PUT IT AWAY AND
AOJA C,INS1
HERE (INCHWL) PUSHJ P,SAVE
PUSHJ P,REDSTR
MOVE LPSA,X11
INS3: CAIL C,=200 ;COUNT EXHAUSTED?
JRST DNSTR1 ;YES
PUSHJ P,EDICHR ;GET A CHAR
CAIE 1,175 ;ALTMODE?
CAIN 1,12
JRST DNSTR
CAIN 1,15 ;CR?
JRST INS3 ;IGNORE
IDPB 1,D ;PUT IT AWAY AND
AOJA C,INS3 ;NEXT CHARACTER
DNSTR: MOVEM 1,.SKIP. ;SET BREAK CHAR
JRST FINSTR
DNSTR1: SETOM .SKIP. ;INDICATE COUNT EXHAUSTED
JRST FINSTR
HERE (INCHSL) PUSHJ P,SAVE
MOVE LPSA,X22 ;PARAM (FLAG) AND RETURN
PUSHJ P,REDSTR
SETOM @-1(P) ;ASSUME FAILED
MOVEI 1,100 ;PRIMARY INPUT
JSYS SIBE ;CHARACTERS WAITING?
SKIPA ;YES
JRST FINSTR ;NO, FIX UP AND RETURN
SETZM @-1(P)
JRST INS3 ;AND USE INCHWL'S LOOP
HERE(INSTRS)
PUSHJ P,SAVE
MOVE LPSA,X33
PUSHJ P,REDSTR
SETOM @-2(P) ;ASSUME FAILED
MOVEI 1,100 ;RIMARY INPUT
JSYS SIBE ;CHARACTERS WAITING
SKIPA ;YES
JRST FINSTR ;NO, FIX UP AND RETURN
SETZM @-2(P) ;INDICATE SUCCESS
MOVE B,-1(P) ;GET BREAK CHARACTER
JRST INS2
HERE (CLRBUF)
PUSH P,1
MOVEI 1,100 ;PRIMARY INPUT
JSYS CFIBF ;CLEAR BUFFER
POP P,1
POPJ P,
HERE (TTYINS) PUSHJ P,SAVE
PUSHJ P,REDSTR ;PREPARE TO MAKE A STRING
MOVE LPSA,X33
SETOM @-1(P) ;ASSUME NO CHARS
MOVEI 1,100 ;PRIMARY INPUT
JSYS SIBE ;CHARS WAITING?
SKIPA ;YES
JRST FINSTR ;NONE WAITING
JRST TYIN1 ;GO AHEAD
HERE(TTYINL)
HERE (TTYIN) PUSHJ P,SAVE
TYIN: PUSHJ P,REDSTR ;PREPARE STACK,A,STRNGC FOR A STRING
MOVE LPSA,X33 ;PREPARE TO RETURN
TYIN1: SETZM @-1(P) ;ASSUME NO BREAK CHAR
SKIPL E,-2(P) ;TABLE #
CAILE E,=18
ERR <TTYIN: THERE ARE ONLY 18 BREAK TABLES>
HRRZ TEMP,USER
ADD TEMP,E ;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 Q,BRKMSK(E) ;GET MASK FOR THIS TABLE
HRRZ Y,USER
ADD Y,[XWD 1,BRKTBL] ;BRKTBL+RLC(USER)
TTYN: CAIL C,=200 ;COUNT EXCEEDED?
JRST FINSTR ;YES
PUSHJ P,EDICHR ;GET A CHAR
TTYN1: TDNE Q,@Y ;BREAK OR OMIT?
JRST TTYSPC ; YES, FIND OUT WHICH
TTYC: IDPB 1,D ;PUT IT AWAY
AOJA C,TTYN ;COUNT AND CONTINUE
JRST FINSTR ;DONE
TTYSPC: HLLZ TEMP,@Y ;WHICH?
TDNN TEMP,Q
JRST TTYN ;OMIT
MOVEM 1,@-1(P)
MOVE Y,-2(P) ;WHAT TO DO WITH IT
ADD Y,USER
SKIPN Y,DSPTBL(Y)
JRST FINSTR ;DONE, NO SAVE
JUMPL Y,TTYAPP ;APPEND
PUSH P,1 ;SAVE
MOVEI 1,100 ;PRIMARY INPUT
JSYS BKJFN
ERR <CAN'T RETAIN BREAK CHAR FROM TTYIN>,1
POP P,1
JRST FINSTR ;AND RETURN
TTYAPP: IDPB 1,D ;COUNT THE BREAK CHAR
ADDI C,1 ;ONE MORE HAPPY CHAR
JRST FINSTR
ENDCOM(TTY)
COMPIL(PTY)
ENDCOM(PTY)
COMPIL(FIL,<FILNAM>,<FLSCAN,X22>,<FILNAM SCANNING ROUTINE>)
COMMENT ⊗Filnam ⊗
DSCR FILNAM
CAL PUSHJ
PAR file name string on SP stack
of form FILENAME<.EXT><[PROJ,PROG]>
RES FNAME(USER) : SIXBIT /filename/
EXT(USER): SIXBIT /extension,,0/
0
PRPN(USER): SIXBIT /PRJ PRG/ (or zero)
SID uses D,X,Y (4-6), REMOVES STRING FROM STACK
⊗
↑↑FILNAM:
SUB SP,X22 ;ADJUST STACK
FOR II←1,3 <
SETZM FNAME+II(USER)>
MOVEI X,FNAME(USER) ;WHERE TO PUT IT
PUSHJ P,FLSCAN ;GET FILE NAME
JUMPE Y,FLDUN ;FILE NAME ONLY
CAIE Y,"." ;EXTENSION?
JRST FLEXT ;NO, CHECK PPN
MOVEI X,FNAME+1(USER)
PUSHJ P,FLSCAN
FLEXT: JUMPE Y,FLDUN ;NO PPN SPECIFIED
CAIE Y,"["
JRST FLERR ;INVALID CHARACTER
PUSHJ P,[
RJUST: SETZM PROJ(USER)
MOVEI X,PROJ(USER)
PUSHJ P,FLSCAN ;GET PROJ OR PROG IN SIXBIT
IFN SIXSW,<
MOVE X,PROJ(USER)
IMULI D,-6 ;SHIFT FACTOR
LSH X,(D) ;RIGHT-JUSTIFY THE PROJ OR PROG
>;IF SIXSW (SET IN HEAD, USUALLY CONDITIONED ON NOEXPO)
IFE SIXSW,<
MOVEI X,0
;;#GT# DCS 5-11-72 ALLOW LARGE OCTAL NUMBERS AT STD DEC SYSTEMS
MOVE D,PROJ(USER) ;WAS A HLLZ
;;
FBACK: MOVEI C,0
LSHC C,6 ;GET A SIXBIT CHAR
CAIL C,'0'
CAILE C,'7'
JRST FLERR ;INVALID OCTAL
LSH X,3
IORI X,-'0'(C)
JUMPN D,FBACK
>;NOT SIXSW (USUALLY CONDITIONED ON EXPO)
FPOP: POPJ P,]
HRLZM X,FNAME+3(USER)
CAIE Y,","
JRST FLERR ;INVALID CHAR
PUSHJ P,RJUST ;JUSTIFY(AND CONVERT IF EXPORT) PROG #
HRRM X,FNAME+3(USER)
CAIN Y,"]"
FLDUN: AOS (P) ;SUCCESSFUL
FLERR: POPJ P, ;DONE, NOT NECESSARILY RIGHT
ENDCOM(FIL)
COMPIL(FLS,<FLSCAN>,,<FLSCAN ROUTINE>)
COMMENT ⊗Flscan ⊗
DSCR FLSCAN
CAL PUSHJ
PAR X -- addr of destination SIXBIT
1(SP), 2(SP) -- input string
RES sixbit for next filename, etc in word addressed by X
break (punctuation) char in Y (0 if string exhausted)
D,X, input string adjusted
SID only those AC changes listed above (Y, for instance)
⊗
↑↑FLSCAN:
HRRZS 1(SP) ;WANT ONLY LENGTH PART
MOVEI D,6 ;MAX NUMBER PICKED UP
SETZM (X) ;ZERO DESTINATION
HRLI X,440600 ;BYTE POINTER NOW
FLN1: MOVEI Y,0 ;ASSUME NO STRING LEFT
SOSGE 1(SP) ;TEST 0-LENGTH STRING
POPJ P,
ILDB Y,2(SP) ;GET BYTE
CAIE Y,"." ;CHECK VALID BREAK CHAR
CAIN Y,"["
POPJ P,
CAIE Y,"]"
CAIN Y,","
POPJ P,
JUMPE D,FLN1 ;NEED NO MORE CHARS
TRZN Y,100 ;MOVE 100 BIT TO 40 BIT
TRZA Y,40 ; TO CONVERT TO SIXBIT
TRO Y,40 ; (NO CHECKING)
IDPB Y,X ;PUT IT AWAY
SOJA D,FLN1 ;CONTINUE
ENDCOM(FLS)
COMPIL(INP,<INPUT,CHARIN>
,<INSET,STRNGC,BRKMSK,X33,GOGTAB,JFNTBL,CDBTBL>
,<STRING INPUT ROUTINE>)
DSCR CHAR←CHARIN(CHANNEL)
⊗
HERE(CHARIN)
BEGIN CHARIN
PUSH P,CDB
PUSH P,CHNL
PUSH P,D
SKIPL CHNL,-3(P)
CAIL CHNL,JFNSIZE
JRST CHABAD
MOVE CDB,CDBTBL(CHNL) ;CDB
SKIPN CHNL,JFNTBL(CHNL) ;JFN IN CHNL FOR DOINP
JRST CHABAD
SKIPE ENDFL(CDB) ;EOF LOCATION?
SETZM @ENDFL(CDB) ;YES, ASSUME GOOD
SOSG ICOWNT(CDB)
JRST [PUSHJ P,DOINP
JRST IN1 ;36-BIT RETURN
JRST INB ;7-BIT RETURN (WITH CHAR IN D)
JRST CHAEOF ;END OF FILE OR ERROR
]
IN1: ILDB D,IBP(CDB)
INB: MOVE 1,D ;CHAR IN 1
CHARET: POP P,D
POP P,CHNL
POP P,CDB
SUB P,X22
JRST @2(P)
CHAEOF:
CHABA1: SETZ 1, ;RETURN NULL BYTE
JRST CHARET
CHABAD: ERR <CHARIN: ILLEGAL JFN>,1
JRST CHABA1
BEND CHARIN
DSCR STRING SIMPLE PROCEDURE SINI(INTEGER JFN,MAXLENGTH,BRKCHAR);
Reads in a string of characters, terminated by BRKCHAR or
reaching maxlength, whichever happens first.
.SKIP. will be -1 if call terminated for count, else
it will have the breakcharacter.
⊗
HERE(SINI)
BEGIN SINI
PUSHJ P,SAVE
MOVE LPSA,X44
VALCHN 1,<-3(P)>,SINBAD
SKIPE ENDFL(CDB) ;EOF LOCATION?
SETZM @ENDFL(CDB) ;YES, ASSUME NO EOF
SKIPG C,-2(P) ;ANY COUNT?
JRST NULRET
LDB B,[POINT 6,OFL(CDB),5]
CAIE B,=36 ;36-BIT BYTES?
JRST SIN7
;WITH RF(=CHNL) STILL LOADED, IN CASE STRNGC IS CALLED
PUSH P,C
PUSHJ P,ZSETST ;GET GOOD BYTE-POINTER IN 1
MOVE CHNL,1 ;JFN IN 1 FOR DOINP
MOVN C,C ;NEGATE THE COUNT
IN1: SOSG ICOWNT(CDB)
JRST [PUSHJ P,DOINP
JRST IN2 ;36-BIT
JRST SINBAD ;7-BIT??
JRST SINEOF]
IN2: ILDB D,IBP(CDB)
JUMPE D,IN3
CAMN D,-1(P) ;BREAK CHARACTER?
JRST DOBRK ;YES
IDPB D,1
IN3: AOJL C,IN1
SETOM .SKIP. ;INDICATE COUNT EXHAUSTED
FIXSTR: PUSH P,-2(P) ;ORIGINAL COUNT
PUSH P,1 ;BP
PUSHJ P,ZADJST
JRST RESTR
DOBRK: MOVEM D,.SKIP.
JRST FIXSTR
SIN7: CAIE 2,7 ;MUST BE 7-BIT
JRST SINBAD
;WITH RF (=CHNL) LOADED
PUSH P,-2(P) ;MAXLENGTH
PUSHJ P,ZSETST
MOVE 2,1 ;BYTE-POINTER IN 2
MOVE 3,-2(P) ;MAXLENGTH
MOVE 4,-1(P) ;OPTIONAL BREAKCHARACTER
JSYS SIN
HRRZ 1,CHNL ;CHECK EOF
JSYS GTSTS ;CHECK STATUS
TLNN 2,(1B8) ;EOF?
JRST NOEOF ;NO
SKIPE ENDFL(CDB) ;LOCATION?
SETOM @ENDFL(CDB)
SETZM .SKIP.
NOEOF:
PUSH P,-2(P) ;MAXLENGTH
PUSH P,2 ;UPDATED BYTE-POINTER
PUSHJ P,ZADJST
SINRET: JRST RESTR
SINBAD: ERR <SINI: ILLEGAL JFN OR ILLEGAL BYTE-SIZE>,1
NULRET: PUSH SP,[0] ;RETURN NULL STRING
PUSH SP,[0]
JRST RESTR
SINEOF:
SETZM .SKIP. ;BROKE ON A NULL I SUPPOSE
JRST FIXSTR ;RETURN WHAT WE HAVE
BEND SINI
COMMENT ⊗Input ⊗
DSCR "STRING"←INPUT(CHANNEL,BREAK TABLE NUMBER);
CAL SAIL
SID NO ACS SAVED BY INPUT!!!!!!
⊗
.IN.:
HERE (INPUT)
MOVE USER,GOGTAB ;GET TABLE POINTER
MOVEM RF,RACS+RF(USER);SAVE F-REGISTER
SKIPE SGLIGN(USER)
PUSHJ P,INSET
SKIPL CHNL,-2(P) ;CHANNEL NUMBER
CAIL CHNL,JFNSIZE
JRST INPBAD
MOVE CDB,CDBTBL(CHNL)
SKIPN CHNL,JFNTBL(CHNL) ;GET JFN
JRST INPBAD
LDB E,[POINT 4,OFL(CDB),9] ;DATA MODE
SKIPE ENDFL(CDB) ;EOF LOCATION
SETZM @ENDFL(CDB) ;YES, HELP USER ASSUME NO EOF
SKIPE BRCHAR(CDB) ;BRCHAR LOCATION
SETZM @BRCHAR(CDB) ;ASSUME NO BREAK CHAR
MOVEI A,=200 ;DEFAULT NO. OF CHARS
SKIPE ICOUNT(CDB) ;USER-SPECIFIED COUNT?
HRRZ A,@ICOUNT(CDB) ;MAX COUNT FOR INPUT STRING
ADDM A,REMCHR(USER)
SKIPLE REMCHR(USER) ;ENOUGH ROOM?
PUSHJ P,STRNGC ;NO, TRY TO GET SOME
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 Q,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
.IN: SOSG ICOWNT(CDB) ;BUFFER EMPTY?
JRST [ PUSHJ P,DOINP
JRST IN1 ;36-BIT RETURN
JRST INB ;7-BIT RETURN (WITH CHAR IN D)
JRST DONE1 ;EOF OR ERROR
]
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:
INB: JUMPE D,.IN ;ALWAYS IGNORE 0'S
SKIPN LINNUM(CDB) ;COUNTING THINGS?
JRST INB1 ;NO
CAIN D,12 ;LINE-FEED?
AOS @LINNUM(CDB) ;INDICATE ANOTHER LINE
CAIE D,14 ;FORM-FEED?
JRST INB1 ;NO
SKIPE PAGNUM(CDB)
AOS @PAGNUM(CDB) ;COUNT PAGES ALSO
INB1: TDNE Q,@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,Q ; (CHOOSE ONE)
JRST .IN ;IGNORE
; BREAK -- STORE BREAK CHAR, FINISH OFF
DONE: SKIPE BRCHAR(CDB) ;USER BRCHAR VAR?
MOVEM D,@BRCHAR(CDB) ;STORE BREAK CHAR
MOVE 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: PUSHJ P,BACKUP
JRST DONE1
APPEND: IDPB D,TOPBYTE(USER) ;PUT ON END
AOJA B,DONE1 ;ONE MORE TO COUNT
; DONE -- MARK STRING COUNT WORD
DONE1: ADDM B,REMCHR(USER) ;GIVE UP THOSE NOT USED
SKIPN ICOUNT(CDB) ;USER SUPPLIED COUNT?
JRST [ADDI B,=200 ;USER DEFAULT
JRST .+2]
ADD B,@ICOUNT(CDB) ;HOW MANY DID WE ACTUALLY GET?
;;#GI# DCS 2-5-72 REMOVE TOPSTR
HRROM B,-1(SP) ;MARK RESULT, NON-CONSTANT
;;#GI#
MOVE RF,RACS+RF(USER);GET F-REGISTER BACK
SUB P,X33 ;REMOVE INPUT PARAMETER, RETURN ADDRESS
JRST @3(P) ;RETURN
; CAN EITHER DELETE LINE NUMBER (Y GT 0) OR STOP,
; TELL THE USER (BRCHAR=-1), AND MARK LINE NUMBER
; NOT A LINE NUMBER FOR NEXT TIME
COMMENT ⊗ BACKUP, DOINP TO BACKUP JFN, DO INPUT. ⊗
;CALL TO HERE WITH A PUSHJ, WITH CDB,CHNL LOADED
↑BACKUP:
PUSH P,1
LDB 1,[POINT 6,OFL(CDB),5] ;BYTE-SIZE
CAIN 1,44
JRST BACKU1
;HERE USE BKJFN
HRRZ 1,CHNL ;THE JFN
JSYS BKJFN
ERR <BACKUP: CANNOT DO RETAIN MODE ON THIS FILE>,1
BACRET: POP P,1
POPJ P,
BACKU1: SOS IBP(CDB)
IBP IBP(CDB)
IBP IBP(CDB)
IBP IBP(CDB)
IBP IBP(CDB)
AOS ICOWNT(CDB)
JRST BACRET
;CALL TO HERE WITH PUSHJ
;RETURNS +1 FOR 36-BIT INPUT, +2 FOR 7 BIT INPUT (WITH CHAR IN D),
;+3 FOR END OF FILE
↑DOINP: PUSH P,1
PUSH P,2
PUSH P,3
LDB 1,[POINT 4,OFL(CDB),9] ;GET MODE
CAIN 1,17 ;DUMP MODE
JRST DMPI ; YES
;36 BIT BYTES (SIN) OR 7 BIT (BIN)
LDB 1,[POINT 6,OFL(CDB),5] ;BYTE-SIZE
CAIN 1,44 ;36 BIT
JRST DOSIN
CAIE 1,7 ;7-BIT
JRST INPBAD ;ERROR
;HERE TO DO 7-BIT INPUT
DOBIN:
HRRZ 1,CHNL
JSYS BIN
JUMPE 2,[JSYS GTSTS ;CHECK STATUS
TLNE 2,(1B8) ;EOF?
JRST DOIEOF
SETZ 2,
JRST .+1
]
MOVE D,2 ;GET THE CHAR IN D
CAIN D,32 ;A CONTROL-Z?
JRST [MOVE 1,DVTYP(CDB)
CAIE 1,12 ;A TTY?
JRST .+1 ;NO
JRST DOIEOF
]
SETZM ICOWNT(CDB) ;0 COUNT (SINCE NO MORE ARE WAITING)
POP P,3
POP P,2
POP P,1
AOS (P) ;7-BIT RETURN
POPJ P,
DOIEOF: SKIPE ENDFL(CDB) ;LOCATION?
SETOM @ENDFL(CDB) ;YES, SET IT
SETZM ICOWNT(CDB) ;ZERO THE COUNT
SETZM IBP(CDB) ;AND THE BP
POP P,3
POP P,2
POP P,1
AOS (P) ;INDICATE EOF
AOS (P)
POPJ P,
DOSIN: MOVE 1,CHNL ;JFN
SKIPE DVTYP(CDB) ;DEVICE DSK?
JRST DOSIN1 ;NO, USE SIN JSYS
;HERE TO PMAP CORRECT PAGE
;1, CHNL HAVE THE JFN, CDB IS LOADED, 2 AND 3 ARE FREE
JSYS RFPTR ;GET THE FILE POINTER IN 2
JRST INPBAD
IDIVI 2,1000 ;DIVIDE BY 1000
SKIPE 3 ;ANY REMAINDER?
AOJ 2, ;YES, NEXT PAGE
PUSH P,2 ;SAVE PAGE NO.
JSYS SIZEF ;GET THE SIZE OF THE FILE (IN 36-BIT BYTES) IN 2
JRST INPBAD
MOVE 3,(P) ;GET BACK NO.
LSH 3,=9 ;IMULI 3,1000
CAMLE 3,2 ;LESS THAN OR = TO SIZE OF FILE?
JRST [POP P,2 ;ADJUST STACK
MOVEI 2,STARTPAGE(1);PAGE
HRLI 2,400000;
SETO 1,
SETZ 3,
JSYS PMAP ;RELEASE PAGE
JRST DOIEOF ;END OF FILE
]
HRL 1,CHNL
HRR 1,(P) ;XWD JFN,PAGE
MOVEI 2,STARTPAGE(CHNL)
HRLI 2,400000 ;XWD THISFORK, CORE PAGE
SETO 3, ;FLAG WORD
JSYS PMAP
MOVE 1,CHNL
POP P,2 ;ADJUST STACK, GET CURRENT PAGE NO. BACK
AOJ 2, ;NEXT PAGE
LSH 2,=9 ;CONVERT TO BYTES
JSYS SFPTR ;AND SET THE FILE POINTER
JRST INPBAD
MOVEI 3,1000*5 ;NUMBER OF CHARS READ
JRST DO36CN ;AND SET UP COUNT, BYTE-POINTERS
;HERE TO DO 36-BIT INPUT WITH THE SIN JSYS
DOSIN1: MOVEI 2,STARTPAGE(1)
IMULI 2,1000 ;THE CORE ADDRESS
HRL 3,2
HRRI 3,1(2)
SETZM (2)
BLT 3,777(2) ;ZERO BUFFER
HRLI 2,444400 ;BYTE-POINTER
MOVNI 3,1000 ;1000 WORDS
JSYS SIN ;INPUT
CAMG 3,[-1000] ;SOMETHING RECEIVED?
JRST [CAMN 3,[-1000] ;NOTHING AT ALL?
JRST DOIEOF ;NOT A SINGLE WORD
JRST .+1
]
ADDI 3,1000 ;GET NUMBER OF WORDS READ
IMULI 3,5 ;NUMBER OF CHARACTERS
DO36CN: MOVEM 3,ICOWNT(CDB) ;REMEMBER
MOVEI 2,STARTPAGE(1)
IMULI 2,1000
HRLI 2,440700 ;BYTE-POINTER
MOVEM 2,IBP(CDB) ;REMEMBER
DOIRET: POP P,3
POP P,2
POP P,1
POPJ P,
; DUMP MODE -- ESPECIALLY FOR MAGTAPES
DMPI:
PUSH P,4 ;SAVE AN EXTRA AC
MOVE 1,CHNL
MOVEI 3,STARTPAGE(1)
IMULI 3,1000 ;THE ADDRESS OF THE BUFFER
HRL 2,3 ;ZERO BUFFER
HRRI 2,1(3)
SETZM (3)
BLT 2,777(3)
SUBI 3,1
HRLI 3,-1000 ;MAKE AN IOWD
MOVEI 2,3 ;COMMAND LIST STARTS AT 3
SETZ 4, ;COMMAND LIST ENDS AT 4
JSYS DUMPI
JRST DMIERR ;AN ERROR
MOVEI 3,1000*5 ;NO. OF CHARACTERS
POP P,4 ;RESTORE EXTRA AC
JRST DO36CN ;SET UP COUNT, BP, AND RETURN
DMIERR: CAIE 1,600220 ;EOF?
ERR <INPUT: DUMP MODE ERROR>
DMIEOF:
POP P,4 ;FIRST RESTORE 4
MOVE 1,DVTYP(CDB)
CAIE 2,3 ;MAGTAPE?
JRST DOIEOF ;NO JUST INDICATE EOF
HRRZ 1,CHNL
SETZ 2,
JSYS MTOPR ;RESET STATUS
JRST DOIEOF ;AND INDICATE EOF
;LINE NUMBER STUFF
INLINN:
NOPGNN:
SKIPE SOSNUM(CDB) ;WANT THE NUMBER?
JRST [MOVE TEMP,@IBP(CDB) ;SAVE IT FOR THE USER
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 5 ;INDICATE SKIPPING SIX
ADDB ICOWNT(CDB) ;IN COUNT
SKIPLE ;OVERFLOW BUFFER?
JRST (TEMP) ;NO, CONTINUE
PUSHJ P,DOINP
JRST OKLN ;36-BIT RETURN
ERR <INPUT: 7-BIT BYTES CANNOT HAVE LINE NUMBERS>
JRST DONE1 ;END-OF-FILE
OKLN:
IBP IBP(CDB) ;GET OVER TAB FINALLY
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
SKIPE BRCHAR(CDB) ;USER LOCATION?
MOVEM TEMP,@BRCHAR(CDB) ;STORE WHERE HE WANTS IT
JSP TEMP,EATLIN ;GO EAT UP LINE NUMBER AND
JRST DONE1 ;FINISH UP
GVLLN:
SKIPE BRCHAR(CDB)
SETOM @BRCHAR(CDB) ;TELL THE USER
AOS 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
INPBAD: ERR <INPUT: ILLEGAL JFN OR BAD INPUT>
ENDCOM(INP)
COMPIL(NUM,<REALIN,REALSCAN,INTIN,INTSCAN>
,<SIMIO,SAVE,RESTR,X22,X33,GETCHN,NOTOPN,.CH.,.MT.,.TEN.,BACKUP,DOINP>
,<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
JSP Q,LFMP
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
LFMP:
;MULTIPLIES AND NORMALIZES
MUL A,.MT.(Y)
TLNE A,200000
JRST (Q)
ASHC A,1
SOJA X,(Q)
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:
;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>
SKIPL CHNL,-2(P)
CAIL CHNL,JFNSIZE
JRST NUMBAD
MOVE CDB,CDBTBL(CHNL)
SKIPN CHNL,JFNTBL(CHNL)
JRST NUMBAD
SKIPE ENDFL(CDB)
SETZM @ENDFL(CDB); CLEAR EOF AND BREAK FLAGS
SKIPE BRCHAR(CDB)
SETZM @BRCHAR(CDB)
MOVE LPSA,[JSP X,NCH]
MOVEI Z,1; FOR LINE NUMBER TEST
PUSHJ P,SCAN
SKIPE BRCHAR(CDB)
MOVEM D,@BRCHAR(CDB); FIX UP BREAK CHARACTER
PUSHJ P,BACKUP ;BACKUP FOR NEXT TIME
POPJ P,
SCAN: JOV .+1
SETO Q,
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 Q,; FLAG REG.
ASTERN(INT1,FRA1,SIG1,SIG2,EXP1,INT1)
SIG1: TRO Q,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 Q,1; DECIMAL POINT
SOJ C,
ASTERN(INT1,ERR2,SIG5,SIG6,ERR1,INT1)
SIG5: TRO Q,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
EEXP: AHEAD(EXP9,ERR2,ERR5,ERR5,ERR1,EN,EN)
EN: TRNE Q,4; SIGN OF EXPONENT
MOVNS FF
ADD C,FF; FIX UP EXPONENT
JOV ERR3
DONE: ANDI D,177
JUMPGE Q,.+2
SETO D,
POPJ P,
INT1: HLRE A,TAB(D); FIRST DIGIT
TRNE Q,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 Q,1; IF PASSED DECIMAL POINT THEN DEC EXP BY ONE
SOJ C,
TRNE Q,2; IF ENOUGH DIGITS THEN INC EXP BY ONE
INT3: AOJA C,INT2
MOVE X,A
IMULI A,12
TRNE Q,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 Q,2
MOVE A,X
JRST INT3
XCT LPSA
EON: AHEAD(INT5,DP1,DONE,DONE,EXP6,DONE,DONE)
DP1: TROE Q,1
JRST ERR2
XCT LPSA
AHEAD(INT5,ERR2,ERR5,ERR5,EXP6,DONE,DONE)
EXP6: SETZ Q,
XCT LPSA
AHEAD(EXP2,ERR2,EXP7,EXP8,ERR1,ERR1,ERR1)
EXP7: TRO Q,4
EXP8: XCT LPSA
AHEAD(EXP2,ERR2,ERR5,ERR5,ERR1,ERR1,ERR1)
NCH: SOSG ICOWNT(CDB); DECREMENT CHARACTER COUNT
JRST [PUSHJ P,DOINP
JRST .+1 ;36-BIT RETURN
JRST (5) ;7-BIT RETURN
JRST NCH7 ;EOF OR ERROR
]
NCH1: ILDB D,IBP(CDB); LOAD BYTE
TDNE Z,@IBP(CDB); CHECK FOR LINE NUMBER
JRST NCH5
JRST (X); RETURN
NCH7: MOVEI D,200
JRST (X)
NCH5: AOS IBP(CDB); WE HAVE A LINE NUMBER
MOVNI TEMP,5; MOVE OVER IT
ADDB TEMP,ICOWNT(CDB)
SKIPLE TEMP; NOTHING LEFT
JRST NCH; DO ANOTHER INPUT
JRST [PUSHJ P,DOINP
JRST NCH6 ;36-BIT RETURN
ERR <NUMIN: CANNOT HANDLE THIS FILE IN 7-BIT BYTES>
JRST NCH7 ;EOF RETURN
]
NCH6: SOSG ICOWNT(CDB); REMOVE TAB
JRST NCH7 ;NONE THERE OR ERROR
IBP IBP(CDB)
JRST NCH
STRIN: MOVE LPSA,[JSP X,NCHA]
HRRZ Z,-3(P)
HRRZ Z,-1(Z)
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,
NCHA: SOJL Z,NCH7
HRRZS -4(P)
ILDB D,@-4(P)
JRST (X)
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)
NUMBAD: ERR <NUMIN: ILLEGAL JFN>
RZ: SETZ A,
JRST DONE
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
>
FOR A IN (5,5,6,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(STDBRK,<STDBRK>,<SAVE,RESTR,GOGTAB,X22>
,<STDBRK -- STANDARD BREAKSET ROUTINE>)
COMMENT ⊗Stdbrk ⊗
DSCR STDBRK(CHANNEL);
CAL SAIL
⊗
HERE (STDBRK)
PUSHJ P,SAVE
MOVSI 1,100001
MOVE 2,[ASCIZ/<SUBSYS>BKTBL.BKT/]
JSYS GTJFN
JRST STDERR
MOVE 2,[XWD 440000,200000]
JSYS OPENF
JRST STDERR
MOVE USER,GOGTAB
MOVSI 2,444400 ;BYTE-POINTER
HRR 2,DSPTBL(USER) ;ADDRESS
MOVNI 3,=19+=19+=128 ;COUNT
JSYS SIN
JSYS CLOSF
JFCL
STDRET: MOVE LPSA,X22
JRST RESTR
STDERR: ERR <STDBRK: CANNOT READ IN FILE>,1
JRST STDRET
IFN ALWAYS, <BEND IOSER>
DSCR BEND IOSER ⊗