Trailing-Edge
-
PDP-10 Archives
-
decuslib10-01
-
43,50150/forse.306
There are 2 other files named forse.306 in the archive. Click here to see a list.
TITLE FORSE. V26 FORTRAN IV OPERATING SYSTEM
;SUBTTL 26/MAR/70 FROM V25+4/VAA
SUBTTL FORSE PATCHED FOR SNOBOL BY LPW 6-JUNE-70
; CHANGES ARE
; DON'T CONVERT CONTROL CHARACTERS TO BLANKS
; ON INPUT.
;
; RELEASE ONLY CHANNELS 0-17 ON RESET. UUO SINCE CHANNEL 17
; IS USED BY CCL FILES
;
; DON'T OUPUT CONTROL CHARACTERS TO NON-LPT/TTY DEVICES
;
; TRY TO INIT ONLY CHANNELS 0-16
;
; DON'T DO A RESET UUO SINCE SNOBOL DOES ONE ALREADY
;
;FROM V25+4 23/MAR/70 /VAA FROM V25+3 3/III/70
;FROM V25+2 19-FEB-70 FROM V 25+1/VAA
;V.25+1 13-FEB-70 / 11-FEB-70 FROMV.025 /VAA
;V25 29-JAN-70 FROM V24 /VAA
;V24 26-JAN-70 SUM V175,V1714,V20,V21,V22,V23
;V.22 11-DEC-69 /KK FIX FOR DOUBLE PRECISION BINARY READ/WRITE
;V.21 /TWE WITH CALLS TO ERRINI AND TRPINI
;V.17+5 26-SEPT-69 FROM V17+3 /VAA
;V.17+3 12-JUL-69 FROM V17+0 /NO RANDOM ACCESS
;V17.14 11-DEC-69 FROM V17.14 25-NOV-69 /VAA RANDOM.ENCDEC.BUFFER.END.ERR.
;V17.14 25-NOV-69 FROM V17+0/VAA
EXTERNAL JOBFF,JOBUUO,JOBVER
EXTERNAL ERROR.,LOGEN.,ILLCH.,INIER.,DEVER.,TBLER.,MSNG.,NOROM.
EXTERNAL LISTB.,REDER.,ENDTP.,ILUUO.,BPHSE.,ILLMG.,RANASC
EXTERNAL DEVTB.,PDLST.,IOADR.,ILLEG.,DEVND.,ILRED.,PARER.
EXTERNAL WLKER.,NMLST.,TFMT.,TPFCN.,BINEN.,BINDT.,BINWR.
EXTERNAL TABPT.,MBFBG.,MTACL.,DVTOT.,RANAC.,RECNO.
EXTERNAL DATTB.,NEG1.,NEG2.,NEG3.,NEG5.,BLOCK.,CHARS.,WORDS.
EXTERNAL ASVAR.,FAKEIN,GOBACK,RANBLT,RANIO.,SETROU
EXTERNAL SETBFS,RDWRER
EXTERNAL ERRINI,TRPINI ;V.021 /TWE
ENTRY FORSE.,DEPOT.,CHINN.,IIB.,ENDLN.,INP.,OUT1
ENTRY XIO.,OUTT.,RIN.,CLOS.,FI.,FNCTN.,CLRSY.
ENTRY CLROU.,LOOK.,CLOSI.,SETOU.,STAT.,SESTA.
ENTRY NXTCR.,NXTLN.,WAIT.,BUFCA.,INP.,IORTR.,EOFTS.
INTERNAL DYNND.,MTPZ.,FILNUM,FILES.,VADDR.
INTERNAL EOL.,DADDR.,TCNT1.,TCNT2.,ONLY1.,EOFFL.
INTERNAL TPNTR.,PAKFL.,TNAM1.,TNAM2.
INTERNAL TEMP.,UUOH.,DEVIC.,FMTEN.,FMTBG.
INTERNAL BUFHD.,DYNDV.,DEVNO.,TYPE.,OVFLS.
INTERNAL RESET.,IN.,OUT.,DATA.,FIN.,RTB.,WTB.,MTOP.
INTERNAL SLIST.,INF.,OUTF.,RERED.,NLI.,NLO.
INTERNAL RERDV.,INPDV.,DEVNUM,ROUSET,END.,ERR.
FTSW1=0 ;SOLVES READ,READ,WRITE PROBLEM ON DSK ,MTA
;ACCUMULATORS
A=1 ;UTILITY
B=2 ;UTILITY
C=3 ;UTILITY
D=4 ;UTILITY
E=5 ;FORMAT DESCRIPTOR
F=6 ;FORMAT REPEAT COUNT
M=7 ;ADDR. OF BUFFER HEADER(RH);DEV. NO. (LH)
H=10 ;SLIST AOBJN WORD
I=11 ;FLAG REGISTER
J=12 ;RECORD COUNT(RH);WORD COUNT(LH)-BINARY
K=13 ;FORMAT POINTER
L=14 ;PARENTHESIS COUNT
G=15 ;INPUT BUFFER HDR ADDR.(LH);DEV. NAME ADDR.(RH)
N=16 ;UNUSED
P=17 ;PUSHDOWN POINTER
;UUO DEFINITIONS
RESET.= 15B8
IN.= 16B8
OUT.= 17B8
DATA.= 20B8
FIN.= 21B8
RTB.= 22B8
WTB.= 23B8
MTOP.= 24B8
SLIST.= 25B8
INF.= 26B8
OUTF.= 27B8
RERED.= 30B8
NLI.= 31B8
NLO.= 32B8
DEC.= 33B8
ENC.= 34B8
;PARAMETER ASSIGNMENTS
LSTBYT==1 ;++ LAST BYTE POSN
DQ=42 ;DOUBLE QUOTE
SL=17 ;SLASH(SIXBIT)
LF=12 ;LINE FEED
CR=15 ;CARRIAGE RETURN
SFCN=10 ;NUMBER OF SPECIAL TAPE FUNCTIONS
VAR=100 ;LENGTH OF VARIABLE PUSHDOWN AREA
LINWDS=^D27 ;OUTPUT LINE BUFFER SIZE
LINCH=5*LINWDS ;NO. OF CHARACTERS IN LINE BUFFER
DYDVL.=20 ;LENGTH OF DYNAMIC DEVICE TABLE
;THE FOLLOWING ASSIGNMENTS ARE USED AS ARGUMENTS IN
;TLO INSTRUCTIONS WHICH GENERATE UUO'S.
NMTAPE=72000
NCLOSE=70000
NINPUT=66000
NOUTPT=67000
NSETST=60000
NINBUF=64000
NOUBUF=65000
NUSETI=74000
NUSETO=75000
NLOKUP=76000
;STATUS CHECK FLAGS
IOWERR=400000 ;WRITE PROTECTION ERROR
IODERR=200000 ;DATA MISSED ERROR
IOPERR=100000 ;PARITY OR CHECKSUM ERROR
IOBKTL=40000 ;BLOCK TOO LARGE ON INPUT
IODEND=20000 ;END OF FILE
IOBOT=4000 ;BEGINNING OF TAPE
IOTEND=2000 ;END OF TAPE
IOCON=40 ;CONTINUOUS I-O
;FLAG SETTINGS FOR AC FLAGS (LEFT HALF)
; FLAG MEANING ON/OFF
;400000 OUTPUT/INPUT OUTPUT/INPUT
;200000 SCALE FACTOR SIGN -/+
;200000 WRITE OR READ TAPE YES/NO
;100000 RETURN SWITCH ON/OFF
; 40000 BUFFER EMPTY(IN) YES/NO
; 20000 1ST LF ON BACKSPACE YES/NO
; 20000 T FORMAT YES/NO
; 10000 SLIST I-O YES/NO
; 4000 INHIBIT EOF CHECK YES/NO
; 2000 LAST RECORD IN YES/NO
; 2000 NAMELIST I-O YES/NO
; 1000 "TEXT" IN FORMAT YES/NO
; 1000 LAST RECORD OUT YES/NO
; 400 SPECIAL TAPE FUNCTION YES/NO
; 200 FILE COMMAND YES/NO
; 100 FORMAT I-O YES/NO
; 40 DECTAPE OR DISC YES/NO
; 20 DBL. PREC. IN SLIST. YES/NO
; 10 REREAD UUO YES/NO
; 4 T FORMAT BACKSPACE YES/NO
; 2 () REPEAT FOR LEVEL 0,1 YES/NO
; 1 DIGIT FLAG YES/NO
; SET UP UUO HANDLER
LOC 41
JSR UUOH.
RELOC 0
;VERSION NO
LOC 137
; OCT 026
OCT 301000,,26
RELOC 0
;FORMAT SCAN INITIALIZATION ROUTINE
MLON
FORSE.:
IORET: JUMPL I,GETAC ;JUMP ON OUTPUT
MOVE 0,DEVIC. ;GET DEVICE NAME
MOVEM 0,RERDV. ;SAVE INPUT DEVICE NAME
SKIPGE RANAC. ;DIRECT ACCESS CALLED FOR?
PUSHJ P,RANASC ;YES,GO OFF TO ASCII BLOCK CALC
TLNN I,10 ;REREAD UUO?
JRST GETAC ;NO
MOVE C,RPTR1 ;POINTER TO BEGINNING OF LINE
MOVEM C,1(M)
MOVE C,RCNT1 ;ORIGINAL ITEM COUNT
MOVEM C,2(M) ;IN BUFFER HEADER
GETAC: LDB C,PTRU ;AC CONTAINING POINTER TO FMT
ADDI C,SAVEAC ;ADDRESS OF AC BLOCK
MOVSI 0,350700
MOVEM 0,FMTEN. ;SET UP POINTER TO END OF FMT
HRRZ K,(C) ;POINTS TO BEG. OF FORMAT
HRLI K,700 ;BYTE SIZE
HLRZ 0,(K) ;SEE IF JRST AROUND FORMAT
CAIN 0,254000
JRST HRS ;YES,THERE IS A JRST
SOS K ;NOT A JRST BUT 1ST WORD OF FMT
HLRZ 0,(C) ;LENGTH OF FORMAT ARRAY
SKIPN 0
MOVEI 0,^D251 ;MAX. NO OF WORDS ALLOWED
ADD 0,K ;UPPER BOUND ON FORMAT
MOVEM K,LASTLP ;POINTER TO BEG. OF FORMAT
MOVEM K,GRPRPT ;POINTER TO BEGINNING OF FMT FOR REPEAT
AOSA 0 ;POINT TO LAST WORD
HRS: HRRZ 0,@K ;SET END ADR. FOR COMPARE
HRRM 0,FMTEN. ;END ADDR. OF FORMAT
MOVEM K,FMTBG. ;POINTER TO BEGINNING OF FORMAT
TDZ I,[377677777777];CLEAR ALL BUT INPUT/OUTPUT, FMT.
SETOM EOL. ;SET END OF LINE FLAG AND CHAR. COUNT
HRRI E,0 ;SCALE FACTOR=0
CLEARB L,OVFLS. ;() COUNT AND LINE OVERFLOW
IN1: TLZ I,100000 ;RETURN SWITCH OFF
RIN.: HRRI I,0 ;CLEAR ROUTINE FLAG
CLEARB A,F ;INITIALIZE COUNTERS
HRLI E,0 ;INITIALIZE FIELD WIDTH
,CHARACTER SCAN AND DISPATCH
IN: MOVE B,K ;SAVE PTR BEFORE INCREMENTING
MOVEM B,SAVSCN
ILDB B,K ;NEXT FORMAT CHARACTER
CAML K,FMTEN. ;CHECK FOR END OF FORMAT
JRST PARL
TRZ B,100 ;CLEAR HIGH ORDER BIT
TRC B,40 ;CONVERT TO SIXBIT ASCII
MOVE C,B ;SAVE FORMAT CHARACTER
IDIVI C,7 ;SET FOR DISPATCH TABLE ENTRY
LDB C,PTRTAB(D) ;PICK UP DISPATCH INDEX
JRST @DISTAB(C) ;DISPATCH TO CHARACTER ROUTINE
,CHARACTER IS 0-9
DIG: TLOE I,1 ;SET DIG FLG, SKIP IF IT WASN'T SET
JRST .+3
MOVE D,SAVSCN ;GET PTR POSN BEFORE DIGITS
MOVEM D,DIGPTR ;SAVE IT FOR RESCAN
SUBI B,20 ;OCTAL DIGIT
IMULI A,12 ;ACCUMULATE THE NUMBER
ADD A,B
JRST IN
, CHARACTER IS .
DECPT: TSO E,A ;SET FIELD WIDTH
TLZ I,1 ;CLEAR DIG FLG
MOVEI A,0
JRST IN
,CHARACTER IS (
PARLF: PUSH P,A ;SAVE COUNT
PUSH P,K ;SAVE POINTER TO ( IN FORMAT
TLNN I,2 ;LAST ( ALREADY STORED?
CAILE L,1 ;SAVE LEVEL 0 OR 1 ONLY
JRST PARLF1 ;LEVEL 2 DON'T SAVE FOR RESCAN
TLZN I,1 ;CLEAR DIG FLG, SKIP IF IT WAS SET
JRST PARLF0 ;NO DIGS BEFORE GROUP
MOVE A,DIGPTR ;DIGS BEFORE GROUP
MOVEM A,GRPRPT ;SAVE PTR TO 1ST LEVEL GROUP FOR RESCAN
JRST PARLF2 ;SKIP
PARLF0: MOVEM K,GRPRPT ;SAV PTR TO ( IN GROUP REPEAT
PARLF2: MOVEM K,LASTLP ;SAVE POINTER TO (
PARLF1: MOVEI A,0
AOJA L,IN ;ADD ONE TO () COUNT
,CHARACTER IS )
PARR: PUSHJ P,COMMA ;DO CONVERSION IF NECESSARY
HRRI I,0 ;PREVENT FURTHER CONVERSION
SOJG L,PARG ;OFFSET (
TLON I,2 ;CHECK FOR AUTO. FORMAT REPEAT
JUMPL L,PARL
SKIPLE -1(P) ;CHECK () COUNT
JRST PARG
PARL: PUSHJ P,COMMA ;PERFORM CONVERSION
PUSHJ P,ENDLN. ;TERMINATE THIS LINE
HRRZ 0,INIFLG
CAIL 0,2
SUB P,[XWD 2,2] ;COMPENSATE FOR () PUSH
TLO I,100000 ;RETURN SWITCH ON
MOVE K,GRPRPT ;RESET SCAN AT LAST 1ST LEVEL GROUP
TLZ I,1 ;CLEAR GRP PEPEAT FLG
,RETURN TO USER FOR DATA ADDRESS OR TERMINATION OF SCAN
IORTR.: TLNE I,10000 ;SLIST?
JRST NAS ;YES
NASBAK: SKIPGE EDERR ;++ ENCODE DECODE ERROR?
JRST EDERRM ;++ YES,TYPE OUT MESSAGE SKIP TO FIN.
MOVEI 0,SAVFAC ;SAVE OP SYS AC'S
BLT 0,SAVFAC+P
JRST UXIT.
,RESET SCAN AT LAST LEFT ( AND DROP COUNT
PARG: SOSLE -1(P) ;DROP () COUNT
JRST MSP
SUB P,[XWD 2,2] ;RESET P TO POINT TO LAST (
JRST IN1 ;GET NEXT FORMAT CHARACTER
MSP: MOVE K,(P) ;RESET SCAN AT LAST (
AOJA L,IN1 ;BUMP COUNT FOR RESCAN
,CHARACTER IS -
NEGSC: TLO I,200000 ;SCALE FACTOR SIGN
TLZ I,1 ;DIG FLAG
JRST IN
,CHARACTER IS /
SLASH: PUSHJ P,COMMA ;CONVERSION,IF ANY
PUSHJ P,ENDLN. ;TERMINATE LINE
JRST RIN.
;CHARACTER IS SINGLE QUOTE
SQUOTE: MOVEI A,^D132 ;MAXIMUM COUNT
TLZ I,1 ;DIG FLAG CLEAR
TLO I,1000 ;SINGLE QUOTE FLAG
,CHARACTER IS H
HIO: TLZ I,1 ;CLEAR DIG FLAG
JUMPE A,RIN.
HRRZ B,FMTEN. ;END OF FORMAT
SUBI B,(K) ;BEG OF FORMAT
IMULI B,5
JUMPGE I,HINPT ;JUMP ON INPUT
HLDB: ILDB 0,K ;CHARACTER FROM FORMAT
SOJE B,PARL ;TEST FOR END
TLNN I,1000 ;SINGLE QUOTE?
JRST HDPB ;NO
CAIN 0,"'" ;SINGLE QUOTE IN FORMAT?
PUSHJ P,DBLQTE ;TEST FOR TWO SINGLE QUOTES
HDPB: PUSHJ P,DEPOT. ;DEPOSIT CHARACTER
SOJG A,HLDB ;DROP COUNT
JRST RIN.
HINPT: PUSHJ P,CHINN. ;GET A CHARACTER
XCT IIB.
SOJE B,PARL ;TEST FOR END
ILDB C,K ;CHARACTER FROM FORMAT
TLNN I,1000 ;SINGLE QUOTE?
JRST HINDPB ;NO
CAIN 0,"'" ;SINGLE QUOTE IN INPUT?
MOVEI 0,DQ ;CHANGE TO "
CAIN C,"'" ;SINGLE QUOTE IN FORMAT?
PUSHJ P,DBLQTE ;YES,TEST FOR TWO SINGLE QUOTES
HINDPB: DPB 0,K ;PUT CHARACTER IN FORMAT
SOJG A,HINPT ;DROP COUNT
JRST RIN.
DBLQTE: MOVE F,K ;SAVE FORMAT POINTER
ILDB C,F ;LOOK FOR SINGLE QUOTE
CAIE C,"'"
JRST ET ;END OF TEXT
MOVEM F,K ;RESTORE FORMAT POINTER
POPJ P,
ET: POP P,0 ;RESET P
JRST RIN. ;RETURN TO SCAN
,CHARACTER IS X
XIO.: TLZ I,1 ;CLEAR DIG FLG
JUMPGE I,XINPT ;JUMP IF INPUT
MOVEI 0," " ;BLANK
PUSHJ P,DEPOT. ;OUTPUT A BLANK
SOJG A,.-1
JRST RIN.
XINPT: PUSHJ P,CHINN. ;SKIP A CHARACTER
SKIPN OVFLS. ;DON'T ADVANCE IF END OF LINE
XCT IIB. ;ADVANCE INPUT POINTER
SOJG A,XINPT
JRST RIN.
,CHARACTER IS P
PIO: TLZ I,1 ;CLEAR DIG FLAG
TLZE I,200000 ;TEST FOR SCALE SIGN
MOVNS A ;SCALE NEGATIVE
HRR E,A ;SET SCALE FACTOR
JRST RIN.
;CHARACTER IS T
TIO: TLZ I,1 ;CLEAR DIG FLG
TLO I,20000 ;T FORMAT
JRST RIN. ;GET T SETTING
;CHARACTER IS $
DOLSGN: TLZ I,1 ;CLEAR DIG FLG
SETOM DOLFLG ;$ CARRIAGE CONTROL CHAR.
JRST RIN. ;RETURN TO SCAN
;CHARACTER IS A,D,E,F,G,I,L,O
AEIOU: PUSHJ P,RTNSET ;PICK UP CONV. ROUTINE ADDRESS
AEIOU1: MOVE F,A ;SAVE DATA COUNT
SETZM A ;CLEAR DECIMAL DIGIT AC
TLZ I,1 ;CLEAR DIG FLAG
JRST IN ;RETURN TO FORMAT SCAN
RTNSET: LDB C,[POINT 6,DISTAB(C),11];ROUTINE INDEX
SKIPGE I ;INPUT OR OUTPUT ROUTINE NEEDED?
AOS C ;OUTPUT
HRR I,IOADR.(C) ;PICK UP ROUTINE ADDRESS
POPJ P,
,CHARACTER IS ,
COMA: PUSHJ P,COMMA ;CONVERSION,IF ANY
JRST RIN.
;CHARACTER IS G
GCONV: TLO E,200000 ;G FLAG
JRST AEIOU1
;CHARACTER IS E
ECONV: TLO E,400000 ;E FLAG
JRST AEIOU
;CHARACTER IS D
DCONV: TLO E,100000 ;SET D FLAG
JRST AEIOU
,ROUTINE TO SET FORMAT WORD & GO TO CONVERSION SUBPROGRAMS
COMMA: TLZ I,1 ;CLEAR DIG FLAG
TLZE I,20000 ;T FORMAT?
JRST TFMT. ;YES
TLNE E,200000 ; G TYPE?
JRST COMMA1 ;YES
TRNN I,-1 ;CONVERSION NECESSARY?
POPJ P, ;NO CONVERSION
COMMA1: ANDI A,177 ;W AND D MOD 128
MOVSS A
TLNE E,177 ;IS THERE A FIELD WIDTH?
ASH A,7 ;SHIFT TO D FIELD
IOR E,A
TLZN I,100000 ;RETURN SWITCH ON?
JRST IORTR. ;GET AN ADDRESS
JRST CNVT ;DO CONVERSION
,RETURN WITH DATA ADDRESS (DATA. UUO)
DATA: PUSH P,A ;SAVE UUO
MOVSI 0,SAVFAC ;RESTORE OP SYS AC'S
BLT 0,16 ;ALL BUT P
POP P,A ;PICK UP UUO
HRRZ C,A ;UUO ADDRESS
CAIGE C,20 ;SEE IF DATUM IN AC
ADDI C,SAVEAC ;YES,PICK UP FROM SAVE LOC.
MOVEM C,DADDR. ;SAVE DATA ADDRESS
LDB C,PTRU ;AC FIELD CONTAINS TYPE CODE
MOVEM C,TYPE. ;SAVE TYPE
CAIGE C,6 ;IF DATA IS NEITHER COMPLEX NOR
JRST TFB ;DOUBLE PRECISION, GO TO TFB
CAIN C,7 ;IF DATA IS COMPLEX,
JRST TFBM3 ;OR
HRRZ 0,I ;IF DATA IS DOUBLE PRECISION
CAIE 0,14 ;AND THE MODE IS BINARY, GO
JRST TFB3 ;TO TFBM3.
TFBM3: TLO I,10000 ;SET SLIST FLAG
MOVSI H,-2 ;ARRAY OF LENGTH 2
HRR H,A ;ARRAY ADDRESS
TFB: HRRZ 0,I ;PICK UP MODE
CAIN 0,14 ;BINARY MODE?
JRST BINDT. ;YES
TFB3: TLNE I,100000 ;RETURN SWITCH ON?
JRST RIN. ;YES,GO TO FORMAT SCAN
CNVT: SKIPGE F ;CHECK REPEAT COUNT
POPJ P, ;RETURN
TLNN E,200000 ;G FORMAT?
JRST NOTGTY ;NO
MOVE C,TYPE. ;PICK UP DATUM TYPE
CAIN C,6 ;CHECK FOR DOUBLE WORD
TLO E,100000 ;SETS DOUBLE PRECISION
PUSHJ P,RTNSET ;PICK UP CONV. ROUTINE ADDRESS
NOTGTY: PUSH P,E ;FORMAT SPECIFICATION
MOVE C,DADDR. ;ADDRESS OF DATUM
JUMPL I,OUTCNV ;JUMP IF OUTPUT
PUSHJ P,(I) ;INPUT CONVERSION
JRST CHECK ;ILLEGAL CHAR IN INPUT
MOVEM 0,(C) ;STORE HIGH ORDER WORD
TLNE E,100000 ;IS THERE A LOW ORDER PART?
MOVEM A,1(C) ;YES ,STORE IT
SOSO: POP P,0 ;ACCOUNT FOR FORMAT WORD
SOJG F,IORTR. ;GET NEXT ADDRESS
TLZ E,200000 ; CLEAR G FORMAT FLAG
POPJ P, ;REPEAT COUNT IS ZERO
OUTCNV: MOVE 0,(C) ;PICK UP HIGH ORDER PART
MOVE A,1(C) ;PICK UP LOW ORDER PART
PUSHJ P,(I) ;OUTPUT CONVERSION
JRST SOSO
CHECK: SKIPE ERR. ;DOES THE USER DESIRE PROGRAM CONTROL?
JRST FI. ;YES, GO TO POSITION SPECIFIED
JRST ILLCH. ;NO, PRINT ERROR MESSAGE AND FAIL
HRR H,A ;ARRAY ADDRESS
JRST TFB ;DO CONVERSION
;ENTRY ON SLIST. UUO SHORT LIST I/O
;THE AC OF THE SLIST UUO CONTAINS THE TYPE CODE--0 FOR INTEGER,
;6 FOR DOUBLE PRECISION, AND 7 FOR COMPLEX. FOR DOUBLE
;PRECISION TWO WORDS ARE PASSED AT A TIME. THE ADDRESS OF
;THE UUO CONTAINS THE ARRAY BASE ADDRESS. THE WORD FOLLOWING
;THE SLIST. UUO CONTAINS THE LENGTH OF THE ARRAY.
;ADDRESS OF THE ARRAY IN THE RIGHT HALF.
SLIST: PUSH P,A ;SAVE UUO
HRLZI 0,SAVFAC ;RESTORE OP SYS AC'S
BLT 0,16 ;ALL BUT P
POP P,A ;UUO
TLO I,10000 ;SLIST FLAG
LDB C,PTRU ;AC FIELD OF UUO
MOVEM C,TYPE. ;SAVE TYPE CODE
HRLZ H,@UUOH. ;ARRAY LENGTH
AOS UUOH. ;UPDATE RETURN ADDRESS
MOVNS H ;NEGATE LENGTH
CAIN C,7 ;IS ARRAY COMPLEX?
ASH H,1 ;YES,MULTIPLY BY 2
CAIN C,6 ;IS ARRAY DOUBLE PRECISION?
TLO I,20 ;YES,SET FLAG
HRR H,A ;BASE ADDRESS
HRS1: HRRZM H,DADDR. ;SAVE SLIST ADDRESS
JRST TFB ;DO CONVERSION OR SCAN
;CONTROL TRANSFERRED HERE FOR EACH ADDRESS
;ALSO USED FOR SINGLE COMPLEX ITEMS.
NAS: TLNE I,20 ;IS ARRAY DOUBLE PRECISION?
AOS H ;ACCOUNT FOR 2 WORDS
AOBJN H,HRS1 ;SET FOR NEXT DATUM
TLZ I,10020 ;RESET SLIST FLAGS
JRST NASBAK ;RETURN TO USER
,TABLE OF POINTERS FOR CHARACTER DISPATCH
PTRTAB: REPEAT 7,< POINT 5,IRTAB(C),34-<.-PTRTAB>*5>
,TABLE OF DISPATCHING INDICES
IRTAB: BYTE (5) 0,0,26,0,0,0,10
BYTE (5) 6,13,10,0,12,11,24
BYTE (5) 7,7,7,7,7,1,5
BYTE (5) 0,0,7,7,7,7,7
BYTE (5) 0,16,0,0,0,0,0
BYTE (5) 20,2,14,17,15,23,0
BYTE (5) 3,21,0,0,22,0,0
BYTE (5) 0,0,0,25,0,0,0
BYTE (5) 0,0,0,0,0,0,4
BYTE (5) 0,0,0,0,0,0,0
;DISPATCH TABLE USED FOR CHARACTER DISPATCH
;AND INDICES FOR CONVERSION ROUTINE NAMES.
;THE LEFT HALF OF THE FIRST 8 ENTRIES CONTAINS AN INDEX
;TO ENTRIES IN THE TABLE OF CONV. ROUTINE ADDRESSES,IOADR.,
;FOR G FORMAT.
;THE LEFT HALF OF THE ENTRIES FOR E,A,F,I,O,L,D CONTAINS
;AN INDEX TO THE ENTRIES IN IOADR. CORRESPONDING TO E,A,F,I,O,L,D.
DISTAB: XWD 400,ERROR1 ; ILLEGAL
XWD 000,SLASH ;/
XWD 200,HIO ;H
XWD 1000,PIO ;P
XWD 600,XIO. ;X
XWD 000,DECPT ;.
XWD 1200,NEGSC ;-
XWD 200,DIG ;0-9
XWD 000,IN ;BLANK OR +
XWD 0,PARLF ;(
XWD 0,PARR ;)
XWD 0,COMA ;,
XWD 000,GCONV ;G
XWD 200,ECONV ;E FLOATING
XWD 000,AEIOU ;A ALPHANUMERIC
XWD 200,AEIOU ;F FLOATING
XWD 400,AEIOU ;I FIXED
XWD 600,AEIOU ;O OCTAL
XWD 1000,AEIOU ;L LOGICAL
XWD 1200,DCONV ;D DOUBLE PRECISION
XWD 000,SQUOTE ;' TEXT
XWD 000,TIO ;T COLUMN SETTING
XWD 000,DOLSGN ;$ CARRIAGE CONTROL
ERROR1: PUSHJ P,ERROR. ;ILLEGAL CHARACTER IN FORMAT
;OUTPUT ROUTINE CALLED BY DEPOT. FOR DEPOSITING CHARACTERS
;IN PROPER BUFFER,CHECKING LINES FOR OVERFLOW, DOING OUTPUTS
;AND ERROR CHECKING.
CO: SKIPL TTYLPT ;TTY OR LPT?
SKIPG HDRADD ;LINE BUFFER IN USE?
JRST DLB ;NO
SKIPE OVFLS. ;LINE OVERFLOW?
JRST LBCRCK ;YES,LOOK FOR CR
IDPB 0,1(M) ;NO,DEPOSIT CHARACTER
SOSG 2(M) ;BUFFER FULL?
JRST LBXCD ;YES,STASH CR,LF
LBCRCK: CAIE 0,CR ;CARRIAGE RETURN?
POPJ P, ;NO,KEEP LOOKING
STLF: SETZM OVFLS. ;CLEAR LINE OVERFLOW SWITCH
MOVEI 0,LF ;PICK UP LINE FEED
IDPB 0,1(M) ;DEPOSIT IT
HRR A,HDRADD ;ADDRESS OF REAL BUFFER HEADER
SKIPL RANAC. ;RANDOM ACCESS?
JRST NOTRN1 ;NO
SKIPL ROUSET ;YES,IS BUF HDR SETUP FOR RANDOM I/O
PUSHJ P,SETROU ;NO,GO DIDDLE BUFFER HEADER
NOTRN1: MOVE 0,2(M) ;COUNT OF CHARS. LEFT IN LINE BUFFER
SUBI 0,LINCH+1 ;LENGTH OF LINE BUFFER +1 FOR LF
ADDM 0,2(A) ;UPDATE REAL BUFFER COUNT
SKIPGE 2(A) ;IF NEGATIVE,DO OUTPUT
JRST BOUT
BLTSET: MOVEI 0,@1(M) ;WHERE POINTER IS NOW
SUBI 0,LINBUF-1 ;NO. OF WORDS IN LINE BUFFER
HRRM 0,BUFBLT ;NO. OF WORDS TO BLT
HRRZ 0,1(A) ;ADDRESS OF REAL BUFFER
ADDM 0,BUFBLT ;BLT LIMIT
ADD 0,[XWD LINBUF,1];FROM-TO FOR BLT
BUFBLT: BLT 0,0 ;***THIS ADDRESS MODIFIED
HRR 0,BUFBLT ;LAST WORD USED
HLL 0,1(M) ;POSITION AND SIZE
MOVEM 0,1(A) ;UPDATED REAL BUFFER POINTER
LSHC 0,-36-44 ;POSITION
DIV 0,[-7] ;GET NUMBER OF NULLS
HRR A,HDRADD ;ADDRESS OF REAL BUFFER HEADER
ADDM 0,2(A) ;ACCOUNT FOR NULLS
ZELB: SETZM LINBUF ;CLEAR LINE BUFFER
MOVE 0,[XWD LINBUF,LINBUF+1]
BLT 0,@1(M) ;CLEAR UP TO LAST WORD USED
MOVEI 0,LINCH ;RESET ITEM COUNT
MOVEM 0,2(M)
MOVE 0,LBPTR ;RESET POINTER
MOVEM 0,1(M) ;TO BEGINNING OF LINE BUFFER
AOS ASVAR. ;INCREASE VALUE OF ASSOCIATED VARIABLE
POPJ P, ;RETURN
BOUT: SKIPE ENCDEC ;++ NO OUTPUT FOR ENCODE
JRST [PUSHJ P,EDERR. ;++SET ERROR FLG
JRST NOLOK1 ];++ RETURN
PUSH P,0 ;SAVE ITEM COUNT
PUSHJ P,OUTOK ;DO OUTPUT
SKIPGE RANAC. ;RANDOM ACCESS?
PUSHJ P,RANIO. ;YES,GET NEXT DATA SETUP FOR OUTPUT
POP P,0 ;RESTORE ITEM COUNT
ADDM 0,2(A) ;PUT INTO BUFFER HEADER
JRST BLTSET ;DUMP AND CLEAR LINE BUFFER
LBXCD: CAIN 0,CR ;WAS LAST CHAR. A CR?
JRST STLF ;YES,STASH LF
HRLI 0,170700 ;NO,SET POINTER FOR CR
HLLM 0,1(M)
MOVEI 0,CR ;PICK UP CR
IDPB 0,1(M) ;STASH IT
SETOM OVFLS. ;SET LINE OVERFLOW FLAG
POPJ P,
DLB: IDPB 0,1(M) ;DEPOSIT CHARACTER
SOSLE 2(M) ;DROP ITEM COUNT
CAIN 0,CR
SKIPA
POPJ P,
; FOLLOWING CHANGED FOR SNOBOL IN ORDER TO OUTPUT ACR-LF
; PAIR ON LINE TERMINATIONS INSTEAD OF JUST CR
; SKIPGE DOLFLG ;CHECK FOR $
; MOVEI 0,0 ;YES,CLEAR OUT CR
; DPB 0,1(M) ;DEPOSIT CHARACTER
SKIPL DOLFLG
JRST WADE10 ;NOT A DOLLAR SIGN TERMINATION
MOVEI 0,0 ;CLEAR OUT THE CR
DPB 0,1(M)
JRST OUTOK
WADE10: MOVEI 0,LF ;ADD THE NEW SNOBOL LF CHARACTER
SKIPG 2(M) ;GUARD AGAINST THE CASE OF LAST CHARACTER
JRST OUTOK
IDPB 0,1(M)
SOS 2(M) ;UPDATE THE BUFFER CHARACTER COUNT
OUTOK: PUSHJ P,OUTT. ;DO OUTPUT
PUSH P,F ;SAVE F-USED FOR STATUS
PUSHJ P,STAT. ;GET STATUS
TRNE F,IODERR
PUSHJ P,REDER. ;DATA ERROR
TRNE F,IOPERR
PUSHJ P,PARER. ;PARITY ERROR
TRNE F,IOWERR
PUSHJ P,WLKER. ;WRITE PROTECTION ERROR
TRNN F,IOBKTL ;ILL DECTAPE BLK. NUMBER
TRNE F,IOTEND
PUSHJ P,ENDTP. ;END OF TAPE
SETZM OVFLS. ;CLEAR LINE OVERFLOW SWITCH
POP P,F ;RESTORE F
POPJ P,
;DEPOT. IS CALLED BY ALL OUTPUT ROUTINES FOR DEPOSITING
;CHARACTERS IN THE OUTPUT BUFFER AND DOING OUTPUTS. THE
;CHARACTER IS SENT IN AC 0 AND AC M IS USED.DEPOT. IS
;CALLED BY PUSHJ P,DEPOT.
DEPOT.: PUSH P,A ;UTILITY AC
PUSH P,0 ;OUTPUT CHARACTER
SKIPGE ENCDEC ;++ ENCODE?
JRST ENCOUT ;++ DON'T MESS AROUND WITH CRLF STUFF
AOSLE EOL. ;IS THIS THE FIRST CHARACTER?
JRST NOLOOK ;NO
SKIPGE CDPCDR ;CARDS...FORCE LF ON OUTPUT
JRST [MOVE A,0 ;SAVE CHAR
MOVEI 0,LF ;GET LINE FEED
PUSHJ P,CO ;OUTPUT IT
MOVE 0,A ;GET THE CHAR
JRST NOLOOK ];OUTPUT THAT CHAR
; FOLLOWING PATCHED OUT FOR SNOBOL IN ORDER TO ALLOW THE
; SNOBOL PROGRAMMER TO GET HIS DISK LISTINGS WITHOUT HAVING
; TO GO THROUGH PIP WITH THE "P" SWITCH
; SKIPL TTYLPT ;TTY OR LPT?
; JRST NOLOOK ;NO
MOVE A,0 ;CONTROL CHARACTER
MOVEI 0,LF ;LINE FEED
CAIN A,"0" ;0?
; FOLLOWING CHANGED FOR SNOBOL IN ORDER TO OUTPUT A CR-LF
; PAIR ON LINE TERMINATIONS INSTEAD OF JUST CR
; JRST ZE ;YES
JRST NOLOOK
CAIN A," " ;BLANK?
; FOLLOWING CHANGED FOR SNOBOL IN ORDER TO OUTPUT A CR-LF
; PAIR ON LINE TERMINATIONS INSTEAD OF JUST CR
; JRST NOLOOK ;YES
JRST NOLOK1
CAIN A,"-" ;- SKIP TWO LINES
JRST MI ;MINUS SIGN
HRRI A,-52(A) ;LOOK FOR CODE
JUMPL A,NOLOOK ;SKIP A LINE IF NOT IN RANGE
CAILE A,11 ;NOT IN RANGE
JRST NOLOOK ;THEN ISSUE LF
HRRZ 0,TABLE(A) ;SELECT CONTROL CHARACTER
JRST NOLOOK ;DEPOSIT CONTROL CHARACTER
MI: PUSHJ P,CO ;DEPOSIT CHARACTER
ZE: PUSHJ P,CO ;DEPOSIT CHARACTER
NOLOOK: PUSHJ P,CO ;DEPOSIT CHARACTER
NOLOK1: POP P,0
POP P,A
POPJ P,
;++ THIS REPLACES THE OUTPUT STUFF FOR REGULAR OUTPUT. DOES NO CRLF
;++ INSERTS, JUST DEPOSITS CHAR.
ENCOUT: IDPB 0,1(M) ;++ DEPOSIT
SKIPL OVFLS. ;++ LINE FINISHED?
SOSG 2(M) ;++ NO,BUFFER EMPTY?
JRST [HRR A,HDRADD ;++GET REAL BUFFER HEADER
JRST NOTRN1 ;++ DO BLT
]
JRST NOLOK1 ;++ NOT END OF LINE NOR BUFFER.
TABLE: OCT 23 ;*,CR WITH NO FF AFTER 60 LINES
OCT 0 ;+, NULL
OCT 21 ;,,THIRTIETH
OCT 0 ;-,SKIP 2 LINES
OCT 22 ;.,TWENTIETH
OCT 24 ;/,SIXTH
OCT 0 ;0,SKIP 1 LINE FF AFTER 60 LINES
OCT 14 ;1,TOP OF FORM
OCT 20 ;2, HALF
OCT 13 ;3, THIRD OR V.T.
,END OF FORMAT ROUTINES
ENDLN.: TLZN I,4 ;T FORMAT THIS LINE
JRST NOTTL ;NO
MOVE 0,TPNTR. ;RESET POINTER
CAMG 0,1(M) ;IF THERE HAS BEEN A BACKUP
JRST NOTTL ;THERE HASN'T BEEN
MOVEM 0,1(M)
MOVE 0,TCNT2. ;RESTORE ITEM COUNT
MOVEM 0,2(M)
NOTTL: JUMPGE I,BUFST ;JUMP IF INPUT
SKIPGE ENCDEC ;++ ENCODE?
JRST [SETOM OVFLS. ;++ SET LIN END FLG - ENCODE!
POPJ P, ;++ AND RETURN
]
SKIPLE L ;YES,IS IT END OF FMT?
CAIN B,SL ;THIS CHAR. A /?
SKIPLE EOL. ;YES, CHARACTER COUNT <= 0?
JRST CRTN ;NO,DELIMIT WITH CR
MOVEI 0," " ;BLANK TURNS INTO LF
PUSHJ P,DEPOT. ;DEPOSIT BLANK
CRTN: MOVEI 0,CR ;CARRIAGE RETURN
PUSHJ P,DEPOT. ;DEPOSIT C.R.
SETOM EOL. ;SET END OF LINE FLAG
POPJ P,
BUFST: SKIPGE ENCDEC ;++DECODE?
JRST LINEND ;++ YES TERMINATE LINE
CAIN B,SL ;LAST CHAR. A /?
SKIPLE 2(M) ;YES,BUFFER EMPTY?
JRST PPN ;NO,ADVANCE TO NEXT RECORD
SETZM OVFLS. ;CLEAR LINE OVERFLOW
TLZN I,40000 ;BUFFER EMPTY FLAG ON?
PUSHJ P,CHINN. ;NO,DO INPUT
PPN: PUSHJ P,NXTCR ;ADVANCE TO NEXT LINE
SETZM OVFLS. ;CLEAR LINE OVERFLOW
SETOM EOL. ;SET END OF LINE FLAG
POPJ P, ;RETURN
;++ FINISH UP ENCODE DECODE LINE END
LINEND: SETOM EOL. ;++ END OF LINE FLG
LINEN1: LDB 0,[POINT 6,1(M),5] ;++ GET PTR
CAIN 0,LSTBYT ;++ IS THIS THE LAST BYTE?
POPJ P, ;++ YES, RETURN
XCT IIB. ;++ BUMP POINTER
JRST LINEN1 ;++ TEST THIS BYTE
INTERN FIN
;TERMINATE FORTRAN I-O STATEMENT
FIN: HRLZI 0,SAVFAC ;SET UP BLT TO RESTORE OP SYS AC'S
BLT 0,16 ;RESTORE ALL BUT P
HRRZ 0,I ;PICK UP MODE
CAIN 0,14 ;BINARY MODE?
JRST BINEN. ;YES
AOSE EOL. ;END OF LINE SEEN?
PUSHJ P,ENDLN. ;NO,TERMINATE LINE
SETZM END. ;CLEAR END OF FILE FLAG
SETZM ERR. ;CLEAR INPUT ERROR FLAG
SKIPL RANAC. ;RANDOM ACCESS?
JRST FI. ;NO
MOVE B,FILNUM ;GET F4 DEVICE NO.
IMULI B,5 ;5 ENTRIES/DEVICE(DATA SET)
MOVE C,FILES.-1(B) ;GET ADR OF ASSOC VARIABLE
MOVE B,ASVAR. ;GET INTERNAL ASSOC VAR VALUE
MOVEM B,(C) ;PUT VALUE IN REAL ASSOC VAR
SKIPGE I
PUSHJ P,OUTOK ;OUTPUT THE BUFFER IF RANDOM OUTPUT
PUSHJ P,CLOSI. ;??? SET UP FOR NEW INPUT EACH TIME
SETZM RANAC. ;CLEAR RANDOM ACCESS FLG
FI.: MOVE 0,FOBPDP ;INITIALIZE PUSHDOWN POINTER
MOVEM 0,SAVFAC+P ;RESTORE PUSHDOWN PTR
SETZM ILLEG. ;CLEAR ILL. CHAR. FLAG
SETZM INIFLG ;CLEAR FLAGS FOR NXT I/O
MOVE 0,[XWD INIFLG,INIFLG+1]
BLT 0,INPDEV ;...
MOVSI 17,SAVEAC ;SET UP BLT TO RESTORE USERS ACS
BLT 17,17
MOVE 0,SAVEAC+0 ;RESTORE AC0
SKIPN A,ERR. ;USER PROGRAM CONTROL IF INPUT ERROR
JRST ENDTST ;NO ERROR OR CONTROL NOT DESIRED
SETZM ERR. ;CLEAR ERROR FLAG
JRSTF (A) ;GO TO POSITION SPECIFIED
ENDTST: SKIPN A,END. ;USER PROGRAM CONTROL IF END-OF-FILE
JRST RERTN1 ;CHECK FOR SYSTEM CUT DESIRED
; JRSTF @UUOH. ;NO END OF FILE OR CONTROL NOT DESIRED
SETZM END. ;CLEAR EOF FLAG
JRSTF (A) ;GO TO POSITION SPECIFIED
;CHINN. IS CALLED BY ALL INPUT ROUTINES TO GET A CHARACTER.
;THE CHARACTER IS RETURNED IN AC 0. AC M IS USED.
CHINN.: SKIPE OVFLS. ;SWITCH ON IF ALL CHARS. USED
JRST RETCR ;IN WHICH CASE, RETURN A C.R.
IOK6: SKIPG 2(M) ;IS BUFFER EMPTY?
PUSHJ P,DOINP ;YES,DO INPUT
IOK: LDB 0,1(M) ;PICK UP A CHARACTER
; FOLLOWING ADDED FOR SNOBOL TO MAKE FORSE IGNORE ANY LINES
; WITH LINE NUMBERS. A FULL WORD OF FIVE CHARACTERS IS SKIPPED
; ALONG WITH AN ASSUMED 'TAB' AS ADDED BY LINED.
PUSH P,I ;GRAB AN EXTRA AC
IOK2: MOVE I,@1(M)
TRZN I,1 ;LINE SEQ. NO. ON?
JRST IOK1 ;BRIEF MODE EXIT
CAMN I,[ASCII ' '] ;PAGE MARK?
JRST PGMRK ;YES
MOVNI I,6
ADDM I,2(M)
AOS 1(M)
IBP 1(M) ;THIS SHOULD GET THE TAB
IOK4: POP P,I
JRST IOK6 ;CONTINUE PROCESSING
PGMRK: AOS 1(M) ;BYPASS BLANKS
MOVNI I,5
ADDM I,2(M)
MOVE I,@1(M) ;LOOK AT NEXT WORD
CAME I,[BYTE (7) 15,15,14,00,00]
JRST IOK4 ;DON'T KNOW WHAT IT IS THEN
AOS 1(M)
MOVNI I,5
ADDM I,2(M)
JRST IOK4
IOK1: POP P,I
; END OF CHANGE
AOS EOL. ;INCREMENT COLUMN COUNT
CAIN 0,CR ;IS IT A CARRIAGE RETURN?
JRST NXTLN. ;YES,SKIP TO NEXT LINE
; FOLLOWING CODE ADDED TO SNOBOL IN ORDER TO ALLOW FORM FEEDS
; AND VERTICAL TABS IN THE SOURCE TEXT
CAIE 0,14 ;FORM FEED?
CAIN 0,13 ;VERT. TAB?
JRST [ MOVEI 0,LF ;CONVERT TO LF
JRST NXTLN.]
; END OF FF AND VT FIX
; CAIG 0,24 ;IGNORE SPECIAL CHARACTERS
; MOVEI 0," " ;REPLACE WITH BLANK
SOSG 2(M) ;DROP CHARACTER COUNT
TLO I,40000 ;BUFFER EMPTY FLAG
POPJ P, ;RETURN
DOINP: SKIPGE ENCDEC ;++ DECODE?
JRST EDERR. ;++ YES DON'T DO INPUT
PUSHJ P,INP. ;GET NEXT BUFFERFUL
PUSHJ P,SAVPTR ;SAVE POINTER FOR REREAD
IBP RPTR2 ;INCREMENT SAVED POINTER
IIB.: IBP 1(M) ;ADVANCE POINTER
PUSH P,F ;SAVE F-USED FOR STATUS
PUSHJ P,STAT. ;GET ERRORS NOT ASSOCIATED WITH A BUFFER
TRNE F,IODEND
JRST EOFTS. ;END OF FILE
TRNE F,IOTEND ;END OF TAPE
PUSHJ P,ENDTP. ;EOT
; FOLLOWING REMOVED FOR SNOBOL-I BELIEVE THERE IS NO
; GUARANTEE IN 4S50 OR 4S72 THAT THE ERROR STATUS IS EVER
; RECORDED IN THE PROPER BUFFER
; HRRZ F,(M) ;PICK UP 1ST WORD BUFFER
; MOVE F,-1(F) ;TO GET STATUS
TRNN F,740000 ;ANY ERRORS?
JRST WADE1 ;NO SO DON'T CHECK ANY!
SKIPN ERR. ;IS THE USER INTERESTED?
JRST WADE2 ;SO TELL HIM ANYWAY
MOVEM F,ERRW. ;RECORD IT FOR THE INTERESTED USER
POP P,F ;RESTORE ORIGINAL F
POP P,(P) ;RETURN ONE LEVEL UP
JRST FI. ;RETURN TO USER AT ERR. ENTRY
WADE2:
; END OF CHANGE FOR SNOBOL
TRNE F,IODERR
PUSHJ P,REDER. ;DATA ERROR
TRNE F,IOPERR
PUSHJ P,PARER. ;PARITY ERROR
TRNE F,IOBKTL
PUSHJ P,LISTB. ;LIST TOO LONG
WADE1: POP P,F ;RESTORE F
POPJ P, ;RETURN WITH CHARACTER
EDERR.: SKIPE EDERR ;++ HAVE WE BEEN HERE BEFORE?
SETOM EDERR ;++YES, SET 2ND TIME ERROR FLAG
HRRM P,EDERR ;++ NO SET 1ST TIME FLG(NON 0 R.H.)
POPJ P, ;++ RETURN
;SEARCH TO END OF CURRENT LINE
NXTCR: SKIPE OVFLS. ;END OF LINE ALREADY SEEN?
POPJ P, ;YES
NXTCR.: XCT IIB.
SOSG 2(M) ;DROP ITEM COUNT
PUSHJ P,DOINP ;DO INPUT
LDB 0,1(M) ;GET NEXT CHARACTER
CAIE 0,CR ;IS IT A CARRIAGE RETURN
CAIN 0,LF ;IS IT A LINE FEED?
JRST NXTLN. ;YES,YES...GO TO NEXT LINE
; FOLLOWING CODE ADDED TO SNOBOL TO ALLOW FORM FEEDS AND VERT. TABS
; TO BE IN THE SOURCE TEXT
CAIE 0,14
CAIN 0,13
JRST [ MOVEI 0,LF
JRST NXTLN.]
; END OF ADDITION
JRST NXTCR. ;NO,KEEP LOOKING
;ADVANCE TO NEXT LINE IN BUFFER (IF THERE IS ONE)
NXTLN.: SETOM OVFLS. ;SET END-OF-LINE SWITCH
SKIPGE RANAC. ;RANDOM ACCESS?
AOS ASVAR. ;YUP, INCREMENT VALUE OF ASSOC VAR
; THE FOLLOWING INSTRUCTION PATCHED OUT FOR SNOBOL IN ORDER
; TO FIX AN INTERMITTENT PROBLEM CAUSED BY A CARRIAGE RETURN
; BEING THE LAST CHARACTER IN THE BUFFER. THIS CAUSES THE
; SYSTEM TO RETRIEVE ANOTHER BUFFER. THERE IS ADDITIONAL CODE REQUIRED
; A FEW INSTRUCTIONS DOWN
; JRST RETBLK ;RETURN A C.R.
NXTCH: SOSG 2(M) ;DROP ITEM COUNT
JRST [ PUSHJ P,DOINP
SOSG 2(M)
JRST NXTCH ;SHOULDN'T HAPPEN!
JRST NXTCH3]
NXTCH3:
ILDB 0,1(M) ;GET NEXT CHARACTER
JUMPE 0,NXTCH ;IGNORE NULLS
; FOLLOWING CHANGED FOR SNOBOL
; CAIE 0,CR ;LOOK FOR CR IN CASE CALLED FROM ENDLN
; CAIN 0,LF ;LINE FEED?
; JRST NXTCH ;YES,CONTINUE LOOKING
CAIN 0,CR ;IS IT A CARRIAGE RETURN?
JRST NXTCH ;DO AS BEFORE
CAIE 0,LF
JRST RETBLK ;WE HAVE FOUND BEGINNING OF NEXT LINE
; THE FOLLOWING GYMNASTICS ARE NECESSARY BECAUSE OF NULL CHARACTERS
NXTCH1: SOSG 2(M) ;BUFFER EMPTY?
JRST RETBLK ;YES
ILDB 0,1(M) ;GET THE NEXT CHARACTER
JUMPE 0,NXTCH1
CAIN 0,LF
JRST NXTCH1
; THIS MAY SEEM UNNECESSARY BUT IT WORKS AT LEAST!
RETBLK: SKIPGE RERDFL ;HAS THERE BEEN A REREAD?
JRST RETCR ;YES,LEAVE POINTERS AS THEY ARE
MOVE 0,1(M) ;SAVE POINTER
EXCH 0,RPTR2 ;AND EXCHANGE WITH LAST ONE
MOVEM 0,RPTR1
MOVE 0,2(M) ;SAME FOR ITEM COUNT
EXCH 0,RCNT2
MOVEM 0,RCNT1
RETCR: MOVEI 0,CR ;RETURN A C.R.
POPJ P, ;RETURN
;END OF FILE TESTING
EOFTS.: SKIPL EOFFL. ;HAS THE EOFTST PROGRAM BEEN CALLED
JRST [SKIPN END. ;NO,DOES USER WANT PROGRAM CONTROL?
JRST LOGEN. ;NO,PRINT ERROR MESSAGE AND FAIL
SETZM ERR. ;AVOID UNPLEASANT HAPPENINGS
;WITH ERRORS ON EOFS
JRST FI. ];YES,GO TO POSITION SPECIFIED
PUSHJ P,CLOSI. ;YES EOFTST WAS CALLED,TURN OFF EOF BIT
MOVEI A,4 ;SET UP EOF SWITCH
IORM A,(G) ; IN DEVICE NAME
SETZM ERR. ;PREVENT ERROR RETURN ON EOF
EDFIN: SOS UUOH. ;SET UP FOR CHECKING FOR FIN.
MOVSI B,21000 ;PUT FIN.'S OP CODE IN AC B
MOVUUO: MOVE A,@UUOH. ;GET FORTRAN UUO FROM PROGRAM
AOS UUOH. ;INCREMENT PASSED THE FIN. OP CODE
CAME A,B ;IS THE UUO A FIN. 00,0
JRST MOVUUO ;NO,GET NEXT UUO
JRST FI. ;EXECUTE FI. AND GO TO NXT UUO AFTER FIN.
;RETURN TO USER...RESTORE USER'S AC'S
UXIT.:
FINUX: MOVSI 17,SAVEAC ;SET UP BLT TO RESTORE USER'S AC'S
BLT 17,17
RERTN: MOVE 0,SAVEAC+0 ;RESTORE AC0
EXTERN CUTFLG
RERTN1: SETZM NCTRLC
SKIPE CUTFLG ;REENTER TYPED WHILE IN FORSE?
JRST @CUTFLG ;YES
JRSTF @UUOH. ;RETURN TO USER
;ENTRY FROM USER
UUOH.: 0
SETOM NCTRLC ;DONT ALLOW REENTER WHILE IN FORSE
MOVEM 0,SAVEAC+0 ;SAVE AC 0
EXCH A,JOBUUO ;PICK UP UUO
LDB 0,[POINT 9,A,8] ;PICK UP UUO OP CODE
CAIE 0,15 ;RESET. ?
JRST NRES ;NO
;RESET. UUO COMES HERE
;RELEASE ALL DEVICES IN CASE ANY BUFFERS STILL FULL
MOVEI 0,16 ;CHANNELS 16-0
DPB 0,[POINT 4,REL,12];DEPOSIT CHANNEL NO.
REL: RELEAS ;**** MODIFIED
SOJGE 0,.-2
; CALLI 0 ;RESET I/O
HRRZ A,JOBFF ;CURRENT END OF JOB AREA
HRLI A,-VAR ;LENGTH OF OP SYS PUSHDOWN
MOVEM A,FOBPDP ;SAVE START OF PUSHDOWN
MOVEM A,SAVFAC+P ;SAVE POINTER FOR NEXT UUO
ADDI A,VAR ;ADD LENGTH OF PUSHDOWN
HRRM A,JOBFF ;NEW END OF JOB AREA
SETZM TNAME ;CLEAR FILE NAME BLOCK
MOVE 0,[XWD TNAME,TNAME+1]
BLT 0,LASTFL ; TNAME IS 36 LOC
MOVE 17,PDLST. ;INITIALIZE FORTRAN
;FUNCTION PUSHDOWN POINTER
PUSHJ P,MTACL. ;V.008 CLEAR MTA TABLE
PUSHJ P,ERRINI ;V.021- INITIALIZE ERROR HANDLER
PUSHJ P,TRPINI ;V.021- INITIALIZE TRAP HANDLER
HRRZS UUOH. ;V.021- CLEAR ARITHMETIC FLAGS
JRST RERTN ;RETURN TO USER
;UUO'S OTHER THAN RESET. COME HERE
NRES: CAIG 0,34 ;CHECK UUO LIMITS
CAIG 0,15
PUSHJ P,ILUUO. ;ILLEGAL UUO VALUE
SUBI 0,16 ;UUO VALUE RELATIVE TO ZERO
DPB 0,XRP ;PUT UUO IN I.R.FIELD
MOVEM A,0 ;SAVE UUO
MOVE A,ACBLT ;SET UP BLT FOR USER'S AC'S
BLT A,SAVEAC+P
MOVE P,SAVFAC+P ;SET UP OP SYS PUSHDOWN POINTER
;SAVE USER'S ACCUMULATORS AND DISPATCH ON UUO
MOVEM 0,A ;UUO
MOVE 0,JOBUUO ;USER'S AC A
MOVEM 0,SAVEAC+A ;USER'S AC A
LDB B,XRP ;RELATIVE UUO VALUE
JRST @TABU(B) ;DISPATCH TO UUO ROUTINES
XRP: POINT 4,A,17 ;X.R. FIELD OF UUO
;DISPATCH TABLE FOR INCOMING UUO'S..IN ORDER OF NUMERIC VALUE.
TABU: EXP IN12 ;IN.
EXP OUT1 ;OUT.
EXP DATA ;DATA.
EXP FIN ;FIN.
EXP RTB ;RTB.
EXP WTB ;WTB.
EXP RRBBW ;REW.,REWUN.,BSR.,WEF.,SPR.
EXP SLIST ;SLIST.
EXP INF ;INF.
EXP OUTF ;OUTF.
EXP REREAD ;RERED.
EXP NLI ;NAMELIST INPUT
EXP NLO ;NAMELIST OUTPUT
EXP DEC ;DECODE
EXP ENC ;ENCODE
,ENTRY ON IN. OR OUT. UUOS
OUT1: SKIPL RANAC. ;RANDOM ACCESS?
JRST OUT3 ;NO,DO NORMAL OUTPUT
SKIPE FAKEIN ;YES,RANDOM,MUST WE INPUT A BLOCK?
JRST OUT2 ;NO,FAKEIN FLG WAS SET,DO OUTPUT
SETOM FAKEIN ;YES,SET FAKEIN,DO INPUT
JRST IN12 ;INPUT A BUFFER FULL & RETURN
OUT2: SETZM FAKEIN ;INHIBIT INPUT SET UP
SETZM INPDEV ;CLEAR ASCII INPUT DEVICE FLAG
OUT3: MOVSI I,400000 ;OUTPUT,ASCII
JRST SFMTFL ;SET THE FORMAT FLAG
IN12: SKIPL RANAC. ;RANDOM ACCESS?
JRST IN13 ;NO DO NORMAL INPUT
MOVE B,RECNO. ;GET NEXT RECORD FROM FORTRAN PROGRAM
MOVEM B,ASVAR. ;PUT IN ASSOCIATED VARIABLE (INTERNAL)
IN13: SETZM I ;INPUT,ASCII
SETOM INPDEV ;SET ASCII INPUT DEVICE FLAG
SFMTFL: TLO I,100 ;SET FORMAT FLAG
NFI: AOS INIFLG
HRRE 0,A ;DEVICE NO.
JUMPE 0,PDERR ;DEVICE 0 IS ILLEGAL
CAIG 0,77 ;CHECK RANGE OF DEVICE NO.
CAMGE 0,[-6] ;6 SPECIAL FORTRAN I/O STATEMENTS
PDERR: PUSHJ P,DEVER. ;ILLEGAL DEVICE NO.
MOVEM 0,DEVNUM ;SAVE F4 DEV NUM
JUMPL 0,NEGNUM ;IS DEV NEG => DEFAULT DEVICES?
PUSH P,A ;SAVE AC
IDIVI 0,12 ;CONVRT TO 6-BIT
LSH 0,6
OR 0,1 ;CAN HAVE UP TO 77 OCT DEVICES THIS WAY
IORI 0,2020
TRNN 0,700 ;TWO DIGITS?
LSH 0,6 ;ONE DIGIT
LSH 0,30 ;LEFT JUSTIFY
MOVEM 0,E
MOVEM 0,B
MOVEM 0,DEVNAM
POP P,A ;RESTORE AC
CALL E,[SIXBIT .DEVCHR.]
TRNN E,400000 ;HAS THE DEVICE BEEN ASIGNED BY CONSOL?
NEGNUM: PUSHJ P,GETDEV ;NO, GET NAME FROM DEVTB
TLNE E,4 ;DECTAPE OR DISK?
TLOA I,40 ;YES
TLNN E,40000 ;LPT
TLNE E,10 ;LPT OR TTY?
SETOM TTYLPT ;YES,SET LPT OR TTY FLAG
TLNE E,100000 ;CARDS I/O?
SETOM CDPCDR ;SET CARD READER/PUNCH FLAG
TLNE E,20000 ;IS THIS THE USERS TELETYPE ?
MOVE B,[SIXBIT ?TTY?];YES, MOVE TTY INTO DYNDV. TABLE
MOVEI D,DYNDV. ;ADDR. OF DYNAMIC DEVICE TABLE
MOVE C,DEVNO. ;HIGHEST CHANNEL NUMBER
JUMPE C,OKINIT ;FIRST DEVICE
ADD D,C ;ADDR. OF THIS DEVICE NAME
LPT3: LDB 0,[POINT 30,(D),29] ;YES,ITS BEEN INITED
LSH 0,6 ;GET THE NAME AND CHAN NO
CAMN B,0 ;CORRECT CHAN ?...DOES THE NAME MATCH?
JRST DEVFND ;YUP DO LOOKUPS,TAPE FUNCTS ETC.
SOS D ;SET FOR NEXT LOWER DEVICE IN DYNDV.
SOJG C,LPT3 ;KEEP LOOKING
JRST OKINIT ;FAILED TO MATCH DEV NAME IN DYNDV.
GETDEV: MOVE 0,DEVNUM ;RESTORE DEVICE LOGICAL NUMBER
MOVNI C,DEVTB. ;CALCULATE ADDR. OF DEVICE NAME
AOS C
SKIPG B,0 ;DEVICE NO. NEGATIVE?
ADDI B,DEVND.(C) ;YES,GO TO END OF TABLE
MOVE B,DEVTB.(B) ;PICK UP DEVICE NAME
CAMN B,[SIXBIT /REREAD/]
JRST REREAD ;SET UP TO REREAD
SAVDNM: SKIPN E,B ;GET DEV NAME AND
PUSHJ P,ILRED. ;FAIL IF IT WAS RELEASED.
ANDCM E,[770000] ;STRIP OFF #
CAME E,[SIXBIT .DSK.] ;DSKN ?
MOVE E,B ;NO RESTORE NAME
MOVEM E,DEVNAM ;SAVE DEVICE FOR INITIALIZATION
CALL E,[SIXBIT .DEVCHR.]
POPJ P,
OKINIT: TLNE I,10 ;COMPARE FOR REREAD
PUSHJ P,ILRED. ;ILLEGAL REREAD
MOVEI C,1 ;SET DEVICE NO. TO 1
ADDB C,DEVNO. ;UPDATE AND SAVE HIGHEST DEV. NO.
ADD D,C ;ADDR. OF NAME IN TABLE
CAILE C,16 ;IF MORE THAN 16 INIT,
PUSHJ P,FNDSLT ;SEE IF ANY WERE RELEASED
HRLZ M,C ;SAVE DEVICE NO.
ASH M,5 ;DEVICE NO. IN AC FIELD
MOVEM B,(D) ;PUT DEVICE NAME IN TABLE
HRR G,D ;SAVE ADDR. FOR THIS NAME
PUSHJ P,BUFCA. ;GET A BUFFER HEADER
MOVEM G,DNAME ;SAVE DEV NAME ADDR
MOVEM 0,INT+2 ;BUFFER HEADER ADDRESS
MOVE B,DEVNAM
MOVEM B,INT+1 ;DEVICE NAME
DPB C,[POINT 4,INT,12];DEVICE NO.
SKIPGE TTYLPT ;TTY OR LPT?
HRRI I,1 ;YES,ASCII LINE
HLLZS INT ;V.007 ZERO THE ADDRESS PART
TLNE E,20 ;V.007 DEVICE MTA?
PUSHJ P,MGINIT ;V.007 YES, GO SET UP MODE BITS
INT: INIT 0,(I) ;INIT THE DEVICE
Z
Z
PUSHJ P,INIER. ;NOT AVAILABLE OR UNDEFINED
MOVEM B,DEVIC. ;CURRENT DEVICE NAME
PUSHJ P,CLROU. ;CLEAR OUTPUT-LAST BIT
MOVE B,DEVNUM ;GET DEV NUMBER
SKIPL I ;SKIP ON OUTPUT
MOVEM B,RERDN. ;SAVE DEV. # FOR REREAD.
SKIPG B ;IF DEV NUM < 0,
PUSHJ P,MAKPOS ;MAKE IT POSITIVE.
MOVEM B,FILNUM ;SAVE FOR FILE NAME
; SKIPE B,DATTB.(B) ;IF BUFFER WAS CALLED,
; PUSHJ P,SETBFS ;GO SET UP RINGS.
SKIPGE RANAC. ;RANDOM ACCESS?
PUSHJ P,SNGLBF ;YES,SETUP SINGLE BUFFERING
TLNE I,200 ;FILE COMMAND?
JRST FCM ;YES
JRST FTST ;NO
SNGLBF: MOVEI B,1 ;SETUP INBUF UUO
TLO B,NINBUF ;WITH ONE BUFFER
DPB C,[POINT 4,B,12];CHANNEL #
XCT B
ADD B,[1000000000] ;OUTBUF UUO
XCT B
POPJ P,
DEVFND: MOVE B,DEVNUM
SKIPG B
PUSHJ P,MAKPOS
MOVEM B,FILNUM ;SAVE F4 DEVICE NUMBER
SKIPL I ;SKIP ON OUTPUT
MOVEM B,RERDN. ;SAVE DEV. # FOR REREAD
MOVEM 0,DEVIC. ;SAVE DEVICE NAME
SKIPGE INPDEV ;IS THIS AN ASCII INPUT DEVICE ?
PUSHJ P,CKDVEQ ;YES, SEE IF THE SAME AS LAST INPUT DEV.
HRLZ M,C ;DEVICE NUMBER
ASH M,5 ;DEVICE NO. IN AC FIELD
PUSHJ P,BUFCA. ;GET HEADER ADDRESS
HRR G,D ;ADDR. FOR THIS DEVICE NAME
MOVEM G,DNAME ;SAVE DEVICE NAME ADDR
SKIPLE INPDEV ;IS THIS A NEW INPUT DEVICE ?
PUSHJ P,SAVPTR ;YES,SAVE NEW POINTER FOR REREAD
SKIPL TTYLPT ;IS THE DEVICE THE TTY OR LPT ?
PUSHJ P,JSB ;NO,CHECK FOR CHANGE IN MODE
IFE FTSW1<JUMPGE I,DVF ;DONT CHECK ON INPUT FOR CHANGE IN I/O
SKIPG -3(M) ;HAS AN INPUT BEEN DONE YET?
JRST DVF ;NO,CONTINUE
MOVE D,(D) ;
TRNN D,2 ;OUTPUT LAST?
SETOM RDWRFL ;SET READ TO WRITE FLAG
>
DVF: TLNE I,200 ;FILE COMMAND?
JRST FCM ;YES
FTST: TLNE I,400 ;SPECIAL TAPE FUNCTION?
JRST FTST1 ;YES
TLNN I,40 ;DECTAPE?
JRST FTST1
MOVE D,C ;YES,GET DEV. NO.
ASH D,1 ;SET INDEX FOR FILE NAME
SKIPG I ;SKIP ON INPUT
AOS D ;INDEX FOR OUTPUT FILE
SKIPE TNAME-2(D) ;ANY NAME THERE?
JRST FTST1 ;FILE NAME ALREAD SET
PUSH P,A
MOVE B,FILNUM
IMULI B,5 ;B HAS F4 DEV NO
SKIPE A,FILES.-5(B) ;IS THERE A FILE NAME?
JRST SETNAM ;YES, GO PUT IT IN TEMP FOR LOOKUP ETC.
LDB 0,[POINT 6,FILNUM,35] ;NO, GET POSITIVE F4 DEVICE NO
IDIVI 0,12 ;CONVERT TO 6BIT
LSH 0,6
OR 0,1
IOR 0,FORZRO ;SIXBIT FOR00
LSH 0,6
MOVEM 0,TEMP
MOVSI A,444164 ;SIXBIT 'DAT'
MOVEM A,TEMP+1 ;SET 'DAT' UP FOR EXTENSION
SKIPE A,FILES.-3(B) ;IS THERE A PPN FOR LOOKUPS OR ENTER?
JRST SETPPN ;YES, GO SET IT UP
DEFALT: POP P,A ;NO,FORGET IT
PUSHJ P,FCM1 ;DO LOOKUP OR ENTER
FTST1: IFE FTSW1<SKIPGE RDWRFL ;TRYING TO READ THEN WRITE?
JRST RDWR ;YES,GO SET UP BUFFERS ETC
FTST0:>JUMPGE I,FTST2 ;OUTPUT?
PUSHJ P,CLOSI. ;YES,DO INPUT CLOSE FOR LAST READ
SKIPG (M) ;DUMMY OUTPUT NEC. ?
PUSHJ P,OUTT. ;YES
SKIPGE RANAC. ;RANDOM ACCESS I/O?
PUSHJ P,RANBLT ;YES,GET INPUT BUFFER FULL AND BLT
;IT INTO THE OUTPUT BUFFER
FTST2: TLNE I,2000 ;NAMELIST?
JRST NAMEL ;YES
TLNE I,400 ;SPECIAL TAPE FUNCTION?
JRST TPFCN. ;YES,GO TO FUNCTION DISPATCH
TLNN I,100 ;FORMAT?
JRST BINWR. ;NO,GO TO BINARY READ & WRITE
SKIPGE TTYLPT ;TTY OR LPT?
JRST IORET ;YES
LDB C,[POINT 9,@(M),17];PICK UP BUFFER WORD-SIZE
SUBI C,LINWDS+1
JUMPLE C,IORET ;DON'T USE LINE BUFFER IF
;DEVICE BUFFER SIZE TOO SMALL
FTST3: HRRZM M,HDRADD ;ADDRESS OF REAL BUFFER HEADER
JUMPGE I,IORET ;ON INPUT,DON'T SET UP LINE BUFFER
PUSHJ P,SETOU. ;SET OUTPUT BIT
MOVEI C,LINBUF-1 ;INITIALIZE LINE BUFFER HEADER
MOVEM C,LINHDR
MOVE C,LBPTR ;POINTER TO LINE BUFFER
MOVEM C,LINHDR+1
MOVEI C,LINCH ;ITEM COUNT
MOVEM C,LINHDR+2
HRRI M,LINHDR ;HEADER ADDRESS
SETOM PAKFL. ;SET PACK FLAG
JRST IORET ;GO TO FORMAT SCAN
;SET UP PROJ,PROG NO, FILENAME, EXT FOR I/O.
SETNAM: MOVEM A,TEMP ;SET UP DESIRED FILENAME
SKIPE A,FILES.-4(B) ;GET EXT IF ANY & SET IT UP
MOVEM A,TEMP+1
SKIPE A,FILES.-3(B) ;GET PPN, IF ANY
SETPPN: MOVEM A,TEMP+3 ;SET IT UP
JRST DEFALT ;RETURN.
;CHECK TO SEE IF CURRENT INPUT DEVICE IS THE SAME AS LAST ONE
CKDVEQ: SKIPN INPDV. ;IS THIS THE FIRST INPUT DEV. ?
MOVEM 0,INPDV. ;YES,MOVE INTO HOLDING AREA
CAMN 0,INPDV. ;ARE THE TWO DEVICES THE SAME ?
POPJ P, ;YES, RETURN
MOVEM 0,INPDV. ;NO,MOVE NEW DEV. INTO HOLDING AREA
XORM 0,INPDEV ;SET UP FLAG TO SAY THEY ARE DIFF.
POPJ P, ;RETURN
;SAVE THE CURRENT POINTER AND ITEM COUNT FOR REREAD
SAVPTR: MOVE 0,1(M) ;GET POINTER
MOVEM 0,RPTR2 ;SAVE IN RPTR2
MOVE 0,2(M) ;GET ITEM COUNT
MOVEM 0,RCNT2 ;SAVE IN RCNT2
POPJ P, ;RETURN
;RESET STATUS FOR CURRENT DEVICE
JSB: TLNN I,100 ;IS THE MODE ASCII ?
POPJ P, ;NO, RETURN
LDB 0,[POINT 6,1(M),11];YES, GET POINTER SIZE
CAIE 0,44 ;IS THE POINTER BINARY ?
POPJ P, ;NO,RETURN
MOVEI 0,0700 ;YES,SET UP ASCII POINTER
HRLM 0,1(M) ;PUT NEW POINTER INTO BUFFER HEADER
MOVE 0,2(M) ;ADJUST WORD COUNT
IMULI 0,5 ;FOR ASCII MODE
MOVEM 0,2(M) ;REPLACE WITH NEW COUNT
POPJ P, ;RETURN WITH MODE CHANGED
;SET BUFFER HEADER ADDRESS FOR CURRENT DEVICE
BUFCA.: LDB 0,[POINT 4,M,12];DEVICE NUMBER
IMULI 0,6 ;SIX WORDS FOR EACH DEVICE
ADDI 0,BUFHD. ;BASE ADDRESS
HRLS 0 ;IN BOTH HALVES
HLL G,0 ;ADDRESS OF INPUT BUFFER HEADER
ADD 0,[XWD 3,0] ;OUTPUT ADDR.,INPUT ADDR.
HLRM 0,M ;HEADER ADDRESS
SKIPL I ;SKIP ON OUTPUT
HRRM 0,M ;HEADER ADDRESS
POPJ P,
;ENTRY ON INF. AND OUT. UUOS
INF: MOVSI I,200 ;FILE COMMAND,ASCII
LDB D,PTRU ;AC CONTAINING FILE NAME
ADDI D,SAVEAC ;ADDR. WHERE AC SAVED
HRLZ D,(D) ;NEW FORM FOR IFILE/OFILE LPW
HRRI D,TEMP
BLT D,TEMP+3
JRST NFI
;CONVERT FILE NAME TO SIXBIT
; MOVE B,[POINT 6,TEMP];RESULT POINTER
; MOVE D,(D) ;7-BIT ASCII FILE NAME
; SETZM TEMP ;CLEAR NAME
;SSBC: JUMPE D,NFI ;JUMP IF THROUGH
; LSHC C,7 ;GET NEXT CHARACTER
; TRC C,40 ;CONVERT TO SIXBIT
; IDPB C,B ;DEPOSIT IN ENTRY BLOCK
; JRST SSBC
OUTF: MOVSI I,400200 ;OUTPUT,FILE COMMAND,ASCII
JRST INF+1 ;GET NAME AND DO INIT
;ENTRY ON REREAD UUO--FORMAT SIMILAR TO READ
REREAD: TLO I,10 ;REREAD , ASCII
SETOM RERDFL ;SET REREAD USE FLAG ON
MOVE B,RERDN. ;PICK UP LAST INPUT DEVICE NUMBER
MOVEM B,DEVNUM ;MAKE IT THIS DEVICE NUMBER
MOVE B,RERDV. ;PICK UP LAST INPUT DEVICE NAME
JRST SAVDNM ;RETURN
;ENTRY ON NAMELIST (NLIN.,NLOUT.) UUO'S
NLI: MOVSI I,2000 ;NAMELIST
JRST NFI ;INITIALIZE DEVICE
NLO: MOVSI I,402000 ;OUTPUT,NAMELIST,ASCII
JRST NFI
;NAMELIST SET UP
NAMEL: LDB A,PTRU ;AC FIELD OF NAMELIST UUO
MOVEI A,@SAVEAC(A) ;POINTER TO NAMELIST TABLE
PUSHJ P,NMLST. ;GO OFF TO NAMELIST ROUTINE
JRST IORTR. ;RETURN TO USER
;ENTRY ON BINARY TAPE READ UUO
;DEVICE NO. IN RIGHT HALF OF UUO
RTB: SKIPL RANAC. ;RANDOM ACCESS?
JRST RTB1 ;NO,DO NORMAL BINARY READ
MOVE 0,RECNO. ;YES,GET RECORD NUMBER TO BE ACCESSED
MOVEM 0,ASVAR. ;PUT IT IN INTERNAL ASSOCIATED VARIABLE
SETZM FAKEIN ;CLEAR A FLG THAT IS SET DURING ASCII
RTB1: MOVEI I,14 ;SET TO BINARY MODE
JRST NFI ;DO INITIALIZATION
;ENTRY ON BINARY TAPE WRITE UUO
WTB: SKIPL RANAC. ;RANDOM ACCESS?
JRST WTB1 ;NO DO NORMAL BINARY WRITE
MOVE 0,RECNO. ;GET RECORD # TO BE ACCESSED
MOVEM 0,ASVAR. ;PUT IN INTERNAL ASSOCIADTED VARIABLE
SETZM FAKEIN ;CLEAR AN ASCII RANDOMACCESS FLAG
WTB1: MOVE I,[XWD 400000,14];OUTPUT,BINARY
JRST NFI ;DO INITIALIZATION
;ENTRY ON SPECIAL TAPE FUNCTIONS
;DEVICE NO. IN RIGHT HALF OF UUO
;FUNCTION IN AC FIELD OF UUO
RRBBW: LDB I,PTRU ;AC FIELD OF UUO
TRO I,400 ;SPECIAL FUNCTION
HRLZS I ;SWAP AND ZERO RH FOR ASCII
JRST NFI ;DO INITIALIZATION
;++ ENCODE COMES HERE
ENC: HRLI I,400100 ;++ FORMAT, OUTPUT.
MOVEI M,ENCHDR ;++ SET UP ENCODE BUFFER HEADER
PUSHJ P,DECENC ;++ SET UP HEADER WORDS
JRST GETAC ;++ GO TO FORMAT SCAN
;++ DECODE COMES HERE
DEC: HRLI I,100 ;++ INPUT ASCII
AOS INIFLG ;++ ??
MOVEI M,DECHDR ;++ SET UP DECODE BUFFER HDR
PUSHJ P,DECENC ;++SET UP HEADER WORDS
XCT IIB. ;++ MOVE POINTER UP ONE
JRST GETAC ;++ GO TO FORMAT SCAN
DECENC: SETOM ENCDEC ;++ SET ENCODE/DECODE FLAG
HRRM A,2(M) ;++ GET # CHARS PUT IN HDR
HRLI 0,700 ;++ SET UP HEADER
HRR 0,VADDR. ;++ GET ADR OF 1ST WORD
MOVEM 0,1(M) ;++ SET UP BYTE PTR
SOS 1(M) ;++POINT TO WORD BEFORE DATA FOR ENC.
POPJ P, ;++ RETURN
EDMESS: ASCIZ /
ENCODE - DECODE ERROR!
/
EDERRM: TTCALL 3,EDMESS ;++ TYPE OUT ERROR MESSAGE
SETZM EDERR ;++ CLEAR ERROR FLAG
JRST EDFIN ;++ GO TO FIN UUO DIRECTLY SKIPPING OTHERS
;ROUTINE TO DO LOOKUP AND ENTER FOR FILE NAMES ON TAPE.
;DEVICE NO. IN ACZ AND FILE NAME IN TEMP
FCM: PUSHJ P,CLOSI. ;DO INPUT CLOSE ON DEVICE
PUSHJ P,FCM1 ;DO LOOKUP OR ENTER
JRST FI. ;RETURN
FCM1: SKIPGE RANAC. ;RANDOM ACCESS?
JRST LOSES1 ;DO LOOKUP FOLLOWED BY ENTER ONLY
LOSES2: MOVE 0,TEMP ;GET FILE NAME
ASH C,1 ;SET INDEX FOR LOC. OF NAME
JUMPL I,OENTER ;JUMP ON OUTPUT
PUSHJ P,CLOS. ;DO CLOSE BEFORE LOOKUP
MOVE 0,TEMP ;INPUT,GET FILE NAME
MOVEM 0,TNAME-2(C) ;SAVE THE NAME
MOVE 0,[LOOKUP 0,TEMP]
DPB C,[POINT 5,0,13];DEPOSIT CHAN. NO.
XCT 0 ;DO LOOKUP
JRST RETRY ;DO ANOTHER LOOKUP WITHOUT THE EXT.
POPJ P,
OENTER: AOS C ;SET INDEX FOR OUTPUT FILE NAME
MOVEM 0,TNAME-2(C) ;SAVE NAME
SOS C ;RESTORE DEV. NO. VALUE
SETZM TEMP+2 ;FOR DATE
MOVE 0,[ENTER 0,TEMP]
DPB C,[POINT 5,0,13]; CHAN. NO.
XCT 0 ;DO ENTER
; FOLLOWING CHANGED FOR SNOBOL IN ORDER TO PROVIDE THE ABILITY
; TO CHECK FOR FUNCTION FAILURE ON 'IFILE' AND 'OFILE' CALLS.
; INSTEAD OF TYPING AN ERROR MESSAGE, THE ROUTINE SETS A
; FLAG WHICH IS NONZERO ON FUNCTION FAILURE
; PUSHJ P,NOROM. ;DIRECTORY FULL
PUSHJ P,FLGSNO ;SET THE FAILURE FLAG
POPJ P,
;THIS INSURES LOOKUP IS FOLLOWED IMMEDIATELY BY AN ENTER AND AN ENTER
;DOES NOT FOLLOW AN INPUT IN THE CASE OF RANDOM OUTPUT.
LOSES1: TLNN I,100 ;BINARY?
JRST LOSES2 ;YES,DO REGULAR LOOKUP-ENTER
SKIPGE I ;SKIP ON INPUT
POPJ P, ;RETURN ON OUTPUT
PUSH P,C ;CHANNEL NUMBER WHICH GETS CLOBBERED
PUSHJ P,LOSES2 ;DO LOOKUP
POP P,C ;RESTORE CHANNEL #
SKIPL FAKEIN ;RANDOM OUTPUT?
POPJ P, ;NO,RETURN
TLO I,400000 ;SET OUTPUT FLG
PUSHJ P,LOSES2 ;DO ENTER
TLZ I,400000 ;CLEAR OUTPUT FLG
POPJ P, ;RETURN
;DO ANOTHER LOOKUP ON DECTAPE OR DISC---THIS TIME WITHOUT
;EXTENSION "DAT" ,THEN ON FORTR.DAT THEN ON FORTR.
RETRY: SETZM TEMP+1 ;CLEAR EXTENSION
XCT 0 ;LOOKUP 0,TEMP IN AC 0
JRST .+2 ;FAIL
POPJ P, ;SUCCEED
MOVE D,[SIXBIT .FORTR.]
MOVEM D,TEMP
MOVSI D,444164 ;DAT
MOVEM D,TEMP+1
XCT 0
JRST .+2
POPJ P,
SETZM TEMP+1 ;NULL EXTENSION
XCT 0
; FOLLOWING CHANGED FOR SNOBOL TO PROVIDE FUNCTION
; FAILURE CAPABILITY FOR 'IFILE'
; PUSHJ P,MSNG. ;COMPLETE FAILURE
PUSHJ P,FLGSNO ;SET THE FUNCTION FAILURE FLAG
POPJ P,
EXTERN IFFAIL
FLGSNO: SETOM IFFAIL
POPJ P,
;DO SPECIAL MAG TAPE OPERATION
FNCTN.: HLLZ 0,M ;DEVICE NO.
TLO 0,NMTAPE+D ;MTAPE UUO
XCT 0
POPJ P,
;SET OUTPUT LAST FLAG IN WORD CONTAINING SIXBIT DEVICE NAME
SETOU.: PUSH P,G
MOVE G,DNAME
MOVEI 0,2
IORM 0,(G)
SETOU1: POP P,G
POPJ P,
;CLEAR OUTPUT LAST FLAG
CLROU.: PUSH P,G
MOVE G,DNAME
MOVEI 0,2
ANDCAM 0,(G)
JRST SETOU1
;CLEAR ITEM COUNT IN INPUT BUFFER HEADER
; ITEM COUNT USED AS USER-SYSTEM SYNC FLAG
CLRSY.: PUSH P,G
HLRZ G,DNAME
SETZM 2(G)
JRST SETOU1
;DO STATUS CHECK FOR CURRENT DEVICE
STAT.: HLLZ 0,M ;DEVICE NO.
IOR 0,[GETSTS F] ;GET STATUS
XCT 0
POPJ P,
;DO CLOSE FOR CURRENT DEVICE
CLOSI.: SKIPGE 0,RANAC. ;DONT WANT TO CLOSE ON RANDOM ACCESS
JRST CLRSY.
IFE FTSW1<
EXCH 0,D
LDB D,[POINT 4,M,12] ;GET CHAN #
SETZM INCNT(D) ;CLEAR "INPUT"TALLY
EXCH 0,D
>
MOVEI 0,1 ;INHIBIT OUTPUT CLOSE
SKIPA
CLOS.: SETZM 0
HLL 0,M ;DEVICE NO.
TLO 0,NCLOSE ;CLOSE UUO
XCT 0
JRST CLRSY. ;CLEAR SYNC FLAG
;DO INPUT FOR CURRENT DEVICE
INP.: SKIPL 0,RANAC. ;@@@ARE WE DOING DIRECT ACCESS?
JRST INP1 ;@@@NO
HLLZ 0,M ;@@@YES,GET THE BLOCK WHERE THE RECORD IS
HRR 0,BLOCK. ;@@@SET UP BLOCK # WHERE REC IS.
TLO 0,NUSETI ;@@@USETI OP CODE
XCT 0 ;@@@
INP1: HLLZ 0,M ;DEVICE NO.
TLO 0,NINPUT ;INPUT UUO
XCT 0
IFE FTSW1<
EXCH 0,D
LDB D,[POINT 4,M,12] ;GET CHAN#
AOS INCNT(D) ;TALLY UP # OF "INPUTS" DONE
EXCH 0,D
>
SKIPL RANAC. ;@@@RANDOM ACCESS?
JRST CLROU. ;NO,CLEAR OUTPUT LAST FLAG
TLNN I,100 ;@@@YES, FORMAT INPUT?
JRST CLROU. ;@@@NO, BINARY! CLEAR FLAGS.
HLLZ 0,M ;@@@YES FORMAT ,RESET BLOCK FOR OUTPUT
HRR 0,BLOCK. ;@@@GET BLOCK
TLO 0,NUSETO ;@@@USETO=USETI IN REALITY
XCT 0 ;@@@'USETO CHAN,BLOCK. '
AOS BLOCK. ;@@@SETUP BLOCK FOR NEXT INPUT
SKIPGE GOBACK ;@@@IS THIS INPUT FOR OUTPUT PURPOSES?
POPJ P, ;YUP!
SKIPGE RINSET ;@@@NO, HAS PTR & CNTR BEEN SET ONCE?
JRST CLROU. ;@@@YES,RETURN
SETOM RINSET ;@@@NO,SET UP HEADER FOR RANDOM INPUT
MOVE 0,2(M) ;@@@ GET CHAR COUNT
SUB 0,CHARS. ;@@@ SUBTRACT THOSE TO BE SKIPPED
MOVEM 0,2(M) ;@@@ RESET CHAR COUNT
HRRZ 0,1(M) ;@@@ GET ADDR FOR BYTE PTR
ADD 0,WORDS. ;@@@ ADD WORDS TO BE SKIPPED
HRRM 0,1(M) ;@@@ RESET PTR
JRST CLROU. ;@@@ CLEAR OUTPUT LAST FLAG
;DO OUTPUT FOR CURRENT DEVICE
OUTT.: SKIPL RANAC. ;RANDOM ACCESS?
JRST OUTT1 ;NO, NORMAL OUTPUT
TLNN I,100 ;FORMAT?
PUSHJ P,USET ;NO,BINARY, GET BLOCK
OUTT1: HLLZ 0,M ;DEVICE NO.
TLO 0,NOUTPT ;OUTPUT UUO
XCT 0
PUSHJ P,SETOU. ;SET OUTPUT LAST FLAG
JRST CLRSY. ;CLEAR USER-SYS SYNCH FLAG
USET: HLLZ 0,M ; CHAN #
HRR 0,BLOCK. ;BLOCK WHERE RECORD STARTS
TLO 0,NUSETO ;USETO UUO OPCODE
XCT 0 ;
POPJ P,
IFE FTSW1<
RDWR: SKIPL RANAC. ;RETURN IF RANDOM ACCESS
TLNN I,100 ;FORMAT I/O?
JRST FTST0 ;NO,BINWR TAKES CARE OF THIS FOR BINARY
SKIPL TTYLPT ;TTY IS OK.
TLNE I,2400 ;NAMELIST OR TAPE FUNCTION?
JRST FTST0 ;YES,DON'T SET UP BUFFERS ETC
TLNN E,20 ;MTA? THIS WILL WORK FOR DSK LATER
JRST [PUSHJ P,RDWRER ;NO,PRINT ERROR MESSAGE
JRST FTST0];CONTINUE
MOVE 0,-1(M) ;GET NO OF CHARS.
MOVEM 0,CHARS. ;STORE IT
HRRZ 0,-2(M) ;BYTE PTR
HRRZ B,-3(M) ;BUFFER PTR
SUB 0,B ;GET NO WORDS USED
SUBI 0,2 ;MAKE UP FOR 3RD WORD & IN/OUT DIFFERENCES
MOVEM 0,WORDS. ;STORE IT
SKIPG (M) ;OUTPUT RING SETUP?
PUSHJ P,OUTT. ;NO DO DUMMY OUTPUT
HRRZ B,@(M) ;GET 2ND WD IN BUFFER
HLRZ B,(B) ;# WORDS IN THIS BUFFER
HRRZ D,(M) ;GET BUFFER ADDRESS
ADDM B,D ;GET FINAL ADDRESS
HRRM D,BLOTZ ;SET UP BLT
HRLZ D,-3(M) ;-FROM- INPUT BUFFER
HRR D,(M) ;-TO- OUTPUT BUFFER
ADD D,[XWD 1,1] ;1ST DATA WORD
BLOTZ: BLT D,0 ;***THIS INST GETS CHANGED, DO BLT
MOVE 0,CHARS. ;PICK UP CHAR COUNT
MOVEM 0,2(M) ;SET IT UP FOR OUTPUT
HRRZ 0,1(M) ;OUTPUR POINTER
ADD 0,WORDS. ;SKIP OVER WORDS USED ALREADY
HRRM 0,1(M) ;SET UP OUTPUT POINTER
TLNN I,40 ;DSK?
JRST [MOVEI D,7 ;BACKSPACE CODE
PUSHJ P,FNCTN.;NO,MTA. DO A BACKSPACE
PUSHJ P,CLOSI. ;CLOSE INPUT
JRST FTST3] ;CONTINUE,SET UP LINE BUFFERS ETC.
LDB D,[POINT 4,M,12];CHANNEL NUMBER
MOVE 0,INCNT(D) ;GET COUNT OF # OF INPUTS DONE
MOVEM 0,BLOCK. ;SET UP BLOCK#
PUSHJ P,CLOSI. ;CLOSE INPUT
PUSHJ P,USET ;DO USETI ON 'BLOCK'
JRST FTST3 ;CONTINUE,SET UP LINE BUFFERS ETC
>
;SET STATUS FOR CURRENT DEVICE
SESTA.:HLLZ 0,M ;DEVICE NO.
TLO 0,NSETST+F ;SET STATUS UUO
XCT 0
POPJ P,
;I-O WAIT FOR CURRENT DEVICE
WAIT.: HLLZ 0,M ;DEVICE NO.
IOR 0,[CALLI 10] ;WAIT
XCT 0
POPJ P,
;I/O WAIT FOR MAG TAPES
MTPZ.: HLLZ 0,M ;CHAN NO
IOR 0,[MTAPE 0,0] ;MTAPE AC,0 UUO
XCT 0
POPJ P, ;RETURN
;DUMMY LOOKUP FOR CURRENT DEVICE-CLEARS SYSTEM CLOSE BIT
LOOK.: HLLZ 0,M ;DEVICE NO.
TLO 0,NLOKUP ;LOOKUP UUO
XCT 0
JFCL ;ERROR RETURN
POPJ P,
; WE ARE ABOUT TO INIT A MAG TAPE UNIT
; SEE IF MAGDEN HAS BEEN CALLED FOR THIS UNIT, IF SO SET
; THE APPROPRIATE MODE BITS IN THE RIGHT HALF OF THE INIT.
MGINIT: PUSH P,G ;SAVE
PUSH P,C ;AC'S
PUSH P,D ;G,C,D
SETZM D ;INIT
MOVEI G,TABPT. ;POINTERS
FINDLP: LDB C,[POINT 30,(G),29] ;GET A NAME
LSH C,6 ;LEFT ADJUST IT
CAMN C,B ;IS IT THE ONE WE WANT?
JRST SETMOD ;YES, GO SET MODE
JUMPN C,MGNDTS ;NO, IS IT AN EMPTY SLOT?
MOVE D,G ;YES, SAVE POINTER
MGNDTS: SOS G ;NO, DECREMENT POINTER AND
CAIE G,MBFBG. ;SEE IF DONE WITH TABLE
JRST FINDLP ;NOT DONE, GET NEXT NAME
JUMPE D,TBLER. ;IF NOT ENTERED & NO ROOM, FAIL!
JRST SETRET ;RETURN
SETMOD: LDB B,[POINT 6,(G),35] ;GET MODE BITS
LSH B,6 ;POSITION THEM
HRRM B,INT ;PUT THEM IN INT
SETRET: MOVEI B,40 ;SYNC MODE BIT
IORM B,INT ;SET SYNC MODE FOR INIT
POP P,D ;RESTORE
POP P,C ;AC'S D,C,G
POP P,G
POPJ P, ;RETURN
;THIS ROUTINE CONVERTS A NEG F4 DEV NUM TO A POS DEV NUM.
;EXPECTS (B)=DEV NUM, RETURNS DEV NUM IN B.
MAKPOS: CAMGE B,[-5] ;LEGAL NUM?
PUSHJ P,ILRED. ;NO, PROBABLY "REREAD".
CAMN B,[-5] ;CDR?
MOVEI B,NEG5. ;YES.
CAMN B,[-3] ;LPT?
MOVEI B,NEG3. ;YES.
CAMN B,[-2] ;PTP?
MOVEI B,NEG2. ;YES.
SKIPL B ;DONE?
POPJ P, ;YES,RETURN.
MOVEI B,NEG1. ;NO,MUST BE TTY.
POPJ P, ;RETURN.
; CALLED BY: PUSHJ P,FNDSLT
; FINDS AN AVAILABLE SLOT IN DYNDV.
; BAD RETURN: TBLER.---DYNDV. IS REALLY FULL.
; GOOD RETURN: (C)=THE NUMBER OF THIS CHANNEL,(D)=PTR TO SLOT IN DYNDV.
; (DEVNO.)=17
FNDSLT: MOVEI D,DYNND. ;PTR TO LAST SLOT
SLLOOP: LDB C,[POINT 30,(D),29] ;GET NAME
JUMPE C,GOTSLT ;IS SLOT EMPTY?
SOS D ;NO, UPDATE PTR.
CAILE D,DYNDV. ;DONE?
JRST SLLOOP ;NO, LOOP BACK.
PUSHJ P,TBLER. ;YES, FAIL!
GOTSLT: MOVEI C,17 ;HIGHEST
MOVEM C,DEVNO. ;CHANNEL NUMBER.
MOVEI C,DYNDV. ;SET UP ACTUAL
SUBM D,C ;CHANNEL NUMBER
POPJ P, ;RETURN
; THE FOLLOWING BLOCK FROM TNAME TO LASTFL GETS CLEARED BY RESET
;A SUBSET OF WHICH GETS CLEARED DURING FIN. UUO (INIFLG-INPDEV)
MLOFF
TNAME: BLOCK 36 ;FILE NAME ENTRIES
TNAM1.= TNAME-1
TNAM2.= TNAME-2
DEVNO.: BLOCK 1 ; HIGHEST DEVICE NUMBER
INIFLG: BLOCK 1 ; INITIALIZATION FLAG
HDRADD: BLOCK 1 ; ADDRESS OF REAL HEADER IF LINE
;BUFFER IN USE...ALSO LINE BUF. FLAG
TEMP.:
TEMP: BLOCK 4 ;DIRECTORY NAME,EXT,PPN BLOCK
EDERR: BLOCK 1 ;++ ENCODE - DECODE ERROR FLAG
VADDR.: BLOCK 1 ;++ENCODE DECODE
ENCDEC: BLOCK 1 ;++ -1 IF ENCODE OR DECODE
RINSET: BLOCK 1 ;-1 IF RANDOM INPUT HEADER HAS BEEN SETUP
ROUSET: BLOCK 1 ;-1 IN RANDOM OUTPUT HEADER HAS BEEN SETUP
CDPCDR: BLOCK 1 ;-1 IF CARD I/O
TTYLPT: BLOCK 1 ;-1 IF TTY OR LPT IN USE
DOLFLG: BLOCK 1 ;-1 IF CR AFTER TEXT
RERDFL: BLOCK 1 ;-1 IF A REREAD
RDWRFL: BLOCK 1 ;FORMAT READ TO WRITE ATTRMPT
INPDEV: BLOCK 1 ;-1 IF AN ASCII INPUT DEVICE
OVFLS.: BLOCK 1 ;LINE OVERFLOW SWITCH
INPDV.: BLOCK 1 ;ASCII INPUT DEVICE USED LAST
ONLY1.: BLOCK 1 ;-1 IF EOF SKIPPED
EOFFL.: BLOCK 1 ;-1 IF EOFTST PROGRAM LOADED
DEVNUM: BLOCK 1 ;FOR "BUFFER"
PAKFL.: BLOCK 1 ;-1 IF PACKED I/O WAS DONE
END.: BLOCK 1 ;FOR END OF FILE ON INPUT
ERR.: BLOCK 1 ;FOR ILLEGAL CHAR ON INPUT
INTERN ERRW.
ERRW.: BLOCK 1 ;ERROR RECORD FOR INTERESTED USER
INTERN NCTRLC
NCTRLC: Z ;FLAG WORD FOR NOT ALLOWING REENTER TO HAPPEN
;WHILE INSIDE OF FORSE
SXBTNO: BLOCK 1 ;6-BIT F4 DEVICE # FOR INITS
FILNUM: BLOCK 1 ;FOR FILENAME
INCNT: BLOCK DYDVL. ;COUNT OF #OF INPUT UUOS DONE ON EACH CHAN
DYNDV.: BLOCK DYDVL. ;DYNAMIC DEVICE TABLE
ENCHDR: BLOCK 3 ;++ ENCODE 'BUFFER' HEADER
DECHDR: BLOCK 3 ;++ DECODE 'BUFFER' HEADER
FILES.: BLOCK 36 ;FILE NAMES,EXT,PPN ETC.IN HERE
LASTFL=.-1
FOBPDP: BLOCK 1 ;PUSHDOWN POINTER SAVED
LASTLP: BLOCK 1 ;POINTER TO LAST ( IN FORMAT
FMTEN.: BLOCK 1 ;POINTER TO END OF FORMAT
FMTBG.: BLOCK 1 ;POINTER TO BEG. OF FORMAT
EOL.: BLOCK 1 ;END OF LINE FLAG AND COLUMN COUNT
DADDR.: BLOCK 1 ;ADDRESS OF DATUM BEING CONVERTED
SAVEAC: BLOCK 20 ;USER'S AC'S SAVED
SAVFAC: BLOCK 20 ;OP SYS AC'S SAVED
BUFHD.: BLOCK 140 ;BUFFER HEADERS
DEVIC.: BLOCK 1 ;DEVICE NAME SAVED
DNAME: BLOCK 1 ;DEVICE NAME ADDR
RERDV.: BLOCK 1 ;REREAD DEVICE NAME SAVED
RERDN.: BLOCK 1 ;REREAD DEVICE NUMBER SAVED
DEVNAM: BLOCK 1 ;DEVICE NAME SAVED
TYPE.: BLOCK 1 ;CODE FOR DATA TYPE
TPNTR.: BLOCK 1 ;SAVED POINTER FOR T FORMAT
TCNT1.: BLOCK 1 ;SAVED VALUE OF EOL FOR T FORMAT
TCNT2.: BLOCK 1 ;SAVED ITEM COUNT FOR T FORMAT
RPTR1: BLOCK 1 ;POINTER TO BEG. OF PREV. LINE
RPTR2: BLOCK 1 ;POINTER TO BEG. OF CURRENT LINE
RCNT1: BLOCK 1 ;ITEM COUNT,PREV. LINE
RCNT2: BLOCK 1 ;ITEM COUNT,CURRENT LINE
LINBUF: BLOCK LINWDS ;LINE BUFFER
LINHDR: BLOCK 3 ;HEADER FOR LINE BUFFER
SAVSCN: BLOCK 1 ;POINTER TO POSN BEFORE ILDB FOR RESCAN
DIGPTR: BLOCK 1 ;POINTER TO DIGIT IN FORMAT
GRPRPT: BLOCK 1 ;GROUP REPEAT SAVE FOR FORMAT RESCAN
XVAR: XWD VAR,VAR ;LENGTH OF PUSHDOWN LIST
ACBLT: XWD B,SAVEAC+B ;BLT POINTER FOR AC SAVE
LBPTR: POINT 7,LINBUF ;POINTER TO LINE BUFFER
PTRU: POINT 4,A,12 ;AC FIELD OF UUO
FORZRO: OCT 4657622020 ;6-BIT FOR00
DYNND.=DYNDV.+DYDVL. ;V.007 PTR TO LAST DYNDV. ENTRY
CODEND: END