Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
decus/20-0124/10s.m37
There are 2 other files named 10s.m37 in the archive. Click here to see a list.
TITLE 10S MACRO PORTION OF FLECS FOR THE PDP-10
VFLECS==22
EDIT==37
.JBVER==137
LOC .JBVER
<VFLECS>B11+EDIT
RELOC
;
;--------------------------------------------
;
; MACRO-10 PACKAGE FOR USE WITH
; FLECS SYSTEM ON THE PDP-10 IN INTERACTIVE MODE
;
; AUTHOR: TERRY BEYER
; ADDRESS: DEPARTMENT OF COMPUTER SCIENCE
; UNIVERSITY OF OREGON
; EUGENE, OREGON 97405
; TELEPHONE: (503) 686-4416
; DATE: OCTOBER 23,1974
;
; REWRITE DONE AT SYRACUSE UNIVERSITY
;
; NAME: DAVID CARR
; ADDRESS: ACADEMIC COMPUTER CENTER
; SYRACUSE UNIVERSITY
; SYRACUSE, NEW YORK 13210
; TELEPHONE: (315) 423-3995
; DATE: JUNE 15,1975
;
; FURTHER MODIFICATIONS:
; BEYER JULY 22,1975
;--------------------------------------------
;
; ASSEMBLY PARAMETERS
;
; (ON MEANS NON-ZERO, OFF MEANS ZERO)
;
; FDC ON TO ASSEMBLE FDC LOCAL MODIFICATIONS (DEFAULT:ON) ;FDC;
; FOREXT ON FOR '.FOR' DEFAULT FORTRAN EXTENSION (DEFAULT:ON) ;FDC;
; F40 ON MEANS COMPILE FOR F40 (DEFAULT: OFF)
; F10 ON MEANS COMPILE FOR F10. CAN ONLY BE ON IF
; F40 IS OFF (DEFAULT: ON)
; PURE MAKE TWO SEGMENT CODE IF ON. MUST BE OFF IF F40
; ON (DEFAULT: ON IF F10 IS ON, OFF OTHERWISE)
; FOROTS USE FOROTS IF ON. MUST BE OFF IF PURE IS ON (DEFAULT: OFF)
; TVER IF ON VERSION IS TYPED ON FIRST CALL TO OPENF (DEFAULT: OFF)
; PDLEN LENGTH OF PUSHDOWN LIST. NO EFFECT IF FOROTS IS ON.
; DEFAULT IS 16.
; BUFLEN LENGTH OF CCL BUFFER. MUST BE LARGE ENOUGH FOR THE
; WHOLE TMP FILE. DEFAULT IS 127. (635 CHARACHTERS)
;
; NOTICE!!!!!!!!!!
;
; THE CALLING SEQUENCES GENERATED BY THE F40 AND FORTRAN-10
; COMPILERS DIFFER.
;
; IF THE FLECS TRANSLATOR WITH WHICH THESE SUBROUTINES ARE
; TO BE LOADED IS COMPILED UNDER THE OLD F40 COMPILER,
; ASSEMBLE THIS FILE WITH THE SYMBOL "F40" .NE. 0
;
IFNDEF FDC,< FDC==1> ;FDC;
IFN FDC,< ;FDC;
IFNDEF FOREXT,< FOREXT==1> ;FDC;
> ;FDC;
IFNDEF F40,< F40==0>
IFE F40,< F10==1>
IFN F40,< F10==0
PURE==0>
IFNDEF PURE,< PURE==1>
IFN PURE,< FOROTS==0
TWOSEG
RELOC 400000
DEFINE HIGH,<RELOC>>
IFE PURE,< IFNDEF FOROTS,<FOROTS==0>
DEFINE HIGH,<>>
SYN HIGH,LOW
IFNDEF PDLEN,<PDLEN==20>
IFNDEF TVER,<TVER==0>
;
;-----------------------------------------------
;
; EDIT HISTORY
;
; 34 BEYER REVISION OF SYRACUSE MODIFICATIONS
; 35 CHANGE DEVICE DEFAULT TO DSK FROM LPT FOR
; CCL MODE
; 36 CHANGE BUFLEN DEFAULT TO 127 WORDS.
; 37 NUMBER ALL LINES TO FORTOUT
;
;------------------------------------
;
; THE ENTRY POINTS ARE FOUND BELOW IN THE FOLLOWING ORDER
;
; CHARACTER ROUTINES:
; GETCH
; PUTCH
; CHTYP
;
; STRING MOVING ROUTINES:
; CPYSTR
; CPYSUB
; CATSTR
; CATSUB
;
; NUMERICAL STRING ROUTINES:
; CATNUM
; PUTNUM
;
; STRING COMPARISON ROUTINES:
; STREQ
; STRLT
;
; MISCELLANEOUS ROUTINES:
; HASH
; NEWNO
;
; I/O ROUTINES:
; OPENF
; GET
; PUT
; CLOSEF
;
;
; MAIN PROGRAM:
; START
;
;
; FOR A MORE COMPLETE FUNCTIONAL DEFINITION OF THESE
; ROUTINES PLEASE SEE THE FLECS SYSTEM MODIFICATION
; GUIDE.
;
;----------------------------------------------------------
;
ENTRY GETCH
;
; CALL GETCH(WD,POS,CH)
; PLACES THE POS-TH CHARACTER FROM WORD WD IN CH
; RIGHT JUSTIFIED AND LEFT PADDED WITH ZEROS.
;
CH=1
POS=2
;
GETCH:
IFN F40<Z>
MOVE POS,@1(16) ; OBTAIN RELATIVE POSITION
LDB CH,PTR-1(POS) ; USE AN APPROPRIATE BYTE POINTER
MOVEM CH,@2(16) ; STORE IN THIRD ARGUMENT
IFN F40<JRA 16,3(16) ; RETURN>
IFN F10<POPJ 17,0 ; RETURN>
;
;------------------------------------------------------------
;
; POINTER TABLE FOR USE BY GETCH AND PUTCH
;
PTR: POINT 7,@(16),6 ; BYTE POINTERS TO THE FIVE
POINT 7,@(16),13 ; CHARACTERS FOR USE BY
POINT 7,@(16),20 ; GETCH AND PUTCH
POINT 7,@(16),27
POINT 7,@(16),34
;
;------------------------------------------------------------
;
ENTRY PUTCH
;
; CALL PUTCH(WD,POS,CH)
; PLACES THE RIGHT MOST 7 BITS OF CH INTO THE
; POS-TH CHARACTER POSITION IN WD
;
CH=1
POS=2
;
;
PUTCH:
IFN F40<Z>
MOVE CH,@2(16) ; OBTAIN WORD WITH CHARACTER
MOVE POS,@1(16) ; OBTAIN RELATIVE POSITION
DPB CH,PTR-1(POS) ; STORE IN FIRST ARGUMENT
IFN F40<JRA 16,3(16) ; RETURN>
IFN F10<POPJ 17,0 ; RETURN>
;
;------------------------------------------------------------
;
ENTRY CHTYP
;
; I = CHTYP(CH)
; SETS I TO A CODE VALUE GIVING THE SYNTACTIC TYPE OF
; CHARACTER CH
;
;
CHTYP:
IFN F40<Z>
MOVE 1,@(16) ; OBTAIN CHARACTER CODE
ROT 1,-1 ; DIVIDE VALUE BY 2 AND SAVE PARITY
JUMPL 1,.+3 ; WAS CH ODD?
HLRZ 0,CHTAB(1) ; NO USE LEFT HALF TABLE
IFN F40<JRA 16,1(16) ; RETURN>
IFN F10<POPJ 17,0 ; RETURN>
HRRZ 0,CHTAB(1) ; YES,USE RIGHT HALF TABLE
IFN F40<JRA 16,1(16) ; RETURN>
IFN F10<POPJ 17,0 ; RETURN>
;
; TABLE OF SYNTACTIC CODES FOR USE BY CHTYP
;
;
CHTAB: BYTE (18) 7,7,7,7,7,7,7,7 ; O-07
BYTE (18) 7,6,7,7,7,7,7,7 ; 10-17
BYTE (18) 7,7,7,7,7,7,7,7 ; 20-27
BYTE (18) 7,7,7,7,7,7,7,7 ; 30-37
BYTE (18) 6,7,7,7,7,7,7,7 ; 40-47
BYTE (18) 4,5,7,7,7,3,7,7 ; 50-57
BYTE (18) 2,2,2,2,2,2,2,2 ; 60-67
BYTE (18) 2,2,7,7,7,7,7,7 ; 70-77
BYTE (18) 7,1,1,1,1,1,1,1 ;100-107
BYTE (18) 1,1,1,1,1,1,1,1 ;110-117
BYTE (18) 1,1,1,1,1,1,1,1 ;120-127
BYTE (18) 1,1,1,7,7,7,7,7 ;130-137
BYTE (18) 7,1,1,1,1,1,1,1 ;140-147
BYTE (18) 1,1,1,1,1,1,1,1 ;150-157
BYTE (18) 1,1,1,1,1,1,1,1 ;160-167
BYTE (18) 1,1,1,7,7,7,7,7 ;170-177
;
;------------------------------------------------------
;
; REGISTER ASSIGNMENTS FOR STRING ROUTINES
;
A=1 ; A,B, AND C ARE WORKING REGISTERS
B=2 ;
C=3 ;
SS=4 ; SOURCE STRING START INDEX
SL=5 ; SOURCE STRING LENGTH IN CHARACTER
SA=6 ; SOURCE STRING ADDRESS
DA=7 ; DESTINATION ADDRESS
DL=10 ; DESTINATION LENGTH
;
;-------------------------------------------------------
;
ENTRY CPYSTR
;
; CALL CPYSTR(DEST,SOURCE)
; SETS STRING DEST EQUAL TO STRING SOURCE
;
CPYSTR:
IFN F40<Z>
;
; SET UP BLOCK TRANSFER
;
MOVEI A,@(16) ; GET DESTINATION ADDRESS
HRLI A,@1(16) ; GET SOURCE ADDRESS
;
; COMPUTE NUMBER OF WORDS TO BE MOVED
;
MOVE B,@1(16) ; GET SOURCE LENGTH
MOVEI B,-1(B) ; DECREMENT BY 1
IDIVI B,5 ; DIVIDE BY NCHWRD
ADDI B,1(A) ; COMPUTE ADDR. OF LAST WORD
;
; TRANSFER THEM
;
BLT A,(B) ; TRANSFER AND
IFN F40<JRA 16,2(16) ; RETURN>
IFN F10<POPJ 17,0 ; RETURN>
;
;------------------------------------------------------
;
ENTRY CPYSUB
;
; CALL CPYSUB(DEST,SOURCE,START,LEN)
; SETS THE DEST STRING EQUAL TO THE SUBSTRING
; OF SOURCE STARTING AT START AND OF LENGTH LEN
;
CPYSUB:
IFN F40<Z>
HRRZI DA,@0(16) ; GET DEST ADDRESS
HRRZI SA,@1(16) ; GET SOURCE ADDRESS
MOVE SS,@2(16) ; GET START INDEX
MOVE SL,@3(16) ; GET SUBSTRING LENGTH
MOVEM SL,(DA) ; SET DESTINATION LENGTH
MOVEI DL,0 ; SET CURRENT LENGTH FOR CON
PUSHJ 17,CON ; MOVE THE STRING
IFN F40<JRA 16,4(16) ; RETURN>
IFN F10<POPJ 17,0 ; RETURN>
;
;--------------------------------------------------
;
ENTRY CATSTR
;
; CALL CATSTR(DEST,SOURCE)
; CONCATENATES THE STRING SOURCE TO THE RIGHT END
; OF THE STRING DEST
;
CATSTR:
IFN F40<Z>
HRRZI DA,@0(16) ; GET DEST ADDRESS
HRRZI SA,@1(16) ; GET SOURCE ADDRESS
MOVEI SS,1 ; SET START INDEX
MOVE SL,(SA) ; GET SOURCE LENGTH
MOVE DL,(DA) ; GET DEST LENGTH
ADDM SL,(DA) ; RESULTING LENGTH IS DL+SL
PUSHJ 17,CON ; MOVE THE STRING
IFN F40<JRA 16,2(16) ; RETURN>
IFN F10<POPJ 17,0 ; RETURN>
;
;----------------------------------------------------
;
ENTRY CATSUB
;
; CALL CATSUB(DEST,SOURCE,START,LEN)
; CONCATENATES THE SPECIFIED SUBSTRING OF SOURCE
; TO THE STRING DEST
;
CATSUB:
IFN F40<Z>
HRRZI DA,@0(16) ; GET DEST ADDR
HRRZI SA,@1(16) ; GET SOURCE ADDR
MOVE SS,@2(16) ; GET SUBSTR START INDEX
MOVE SL,@3(16) ; GET SUBSTR LENGTH
MOVE DL,(DA) ; GET DESTINATION LENGTH
ADDM SL,(DA) ; SET RESULTING LENGTH
PUSHJ 17,CON ; MOVE THE STRING
IFN F40<JRA 16,4(16) ; RETURN>
IFN F10<POPJ 17,0 ; RETURN>
;
;-------------------------------------------------------------
;
; INTERNAL CON (USED BY CPYSUB,CATSTR AND CATSUB)
;
; CONCATENATES TWO STRINGS
; USED BY CPYSUB, CATSTR, CATSUB
; CALLED WITH REGISTERS SS, SL,SA,DA,DL
; SET AS ABOVE BY A PUSHJ 17,CON
;
CON:
; PREPARE DESTINATION BYTE POINTER
;
MOVEI A,-1(SS) ; ADDRESS OF FIRST DESTINATION
IDIVI A,5 ; BYTE IS
ADDI A,1(SA) ; A = (SS-1)/5 + 1 + SA
HLL A,[POINT 7,0] ; SET UP POINTER IN A
SOJL B,CON1 ; SKIP PTR ADJUSTMENT IF FIRST BYTE
IBP A ; OTHERWISE ADJUST POINTER
SOJGE B,.-1 ; TO APPROPRIATE VALUE
;
;
; PREPARE SOURCE BYTE POINTER
;
CON1: MOVE B,DL ; ADDR OF FIRST DESTINATION
IDIVI B,5 ; BYTE IS
ADDI B,1(DA) ; A = DL/5 + 1 + DA
HLL B,[POINT 7,0] ; SET UP POINTER IN B
SOJL C,CON2 ; SKIP PTR ADJUSTMENT IF FIRST BYTE
IBP B ; OTHERWISE ADJUST POINTER
SOJGE C,.-1 ; TO APPROPRIATE VALUE
;
; MOVE THE BYTES
;
CON2: SOJL SL,CPOPJ ; RETURN IF NULL STRING
CON2A: ILDB C,A ; GET AND
IDPB C,B ; PUT A BYTE
SOJGE SL,CON2A ; AND LOOP TILL DONE
POPJ 17,0
;
;----------------------------------------------------------------
;
ENTRY CATNUM
;
; CALL CATNUM(DEST,NUM)
; CONCATENATES TO THE STRING DEST, THE 5 CHARACTER
; REPRESENTATION FOR THE NUMBER NUM
;
CATNUM:
IFN F40<Z>
MOVE A,@1(16) ; GET NUMBER
PUSHJ 17,CONVRT ; CONVERT TO ASCII
MOVEM C,SNUM+1 ; PUT INTO DUMMY STRING
MOVEI DA,@0(16) ; SET UP CALL TO CATSTR
IFN F40<HRRM DA,.+2 ; BY SUPPLYING ADDR OF DEST
JSA 16,CATSTR ; CALL CATSTR
ARG DA ;
ARG SNUM ;
JRA 16,2(16) ; RETURN>
IFN F10<HRRM DA,CATNA ; BY SUPPLYING ADDR OF DEST
MOVEI 16,CATNA ; SET ADDR OF TRANSFER VECTOR
PUSHJ 17,CATSTR ; CALL CATSTR
POPJ 17,0 ; RETURN
;
; TRANSFER VECTOR FOR USE WITH F10
;
LOW
XWD -2,0 ; NUMBER OF ARGS
CATNA: ARG DA ;
ARG SNUM ;
HIGH>
;
; DUMMY STRING
;
LOW
SNUM: DEC 5
Z
HIGH
;
;------------------------------------------------------------
;
ENTRY PUTNUM
;
; CALL PUTNUM(DEST,NUM)
; SETS THE FIRST FIVE CHARACTERS OF THE STRING DEST
; TO THE VALUE OF NUM
;
PUTNUM:
IFN F40<Z>
HRRZI DA,@0(16) ; GET DESTINATION ADDRESS
MOVE A,@1(16) ; GET NUMBER
PUSHJ 17,CONVRT ; CONVERT TO ASCII
MOVEM C,1(DA) ; PUT IN PLACE
IFN F40<JRA 16,2(16) ; RETURN>
IFN F10<POPJ 17,0 ; RETURN>
;
;------------------------------------------------------------
;
; INTERNAL CONVRT ( USED BY CATNUM AND PUTNUM )
;
;
; PUSHJ 17,CONVRT
; CONVERTS VALUE IN A TO 5 DIGIT ASCII
; USES 0 AND B
; RETURNS RESULT IN C
;
CONVRT: SETZ C, ; CLEAR CHARACTER ACCUMALATOR
MOVEI 0,5 ; USE 0 AS LOOP COUNT
IDIVI A,^D10 ; GET NEXT DIGIT
MOVEI B,60(B) ; CONVERT TO ASCII
LSHC B,-7 ; SHIFT INTO C
SOJG 0,.-3 ; LOOP 5 TIMES
POPJ 17,0 ; RETURN
;
;--------------------------------------------------------
;
; REGISTERS FOR STREQ AND STRLT
;
L=1 ; NUMBER OF CHARACTERS TO COMPARE
K=2 ; WORKING REGISTER
S1A=3 ; INDEXES STRING 1
S2A=4 ; INDEXES STRING 2
N==4 ; HIGHEST REGISTER TO SAVE
;
;--------------------------------------------------------
;
ENTRY STREQ
;
; L = STREQ(S1,S2)
; SETS L .TRUE. OR .FALSE. DEPENDING ON
; WHETHER STRING S1 IS IDENTICAL TO S2
;
STREQ:
IFN F40<Z>
;
; QUICK CHECK ON LENGTH
;
MOVEI 0,0 ; SET UP DEFAULT OF .FALSE.
MOVE L,@0(16) ; GET LENGTH OF S1
CAME L,@1(16) ; SAME LENGTH AS S2?
IFN F40<JRA 16,2(16) ; NO - RETURN .FALSE.>
IFN F10<POPJ 17,0 ; RETURN>
PUSHJ 17,SAVEAC
PUSHJ 17,COMP ; ARE STRINGS SAME?
SETOI ; IF SO, CHANGE TO TRUE
JRST RSTR4 ; RESTORE AND RETURN
;
;---------------------------------------------------------
;
ENTRY STRLT
;
; L = STRLT(S1,S2)
; SETS L .TRUE. OR .FALSE. DEPENDING ON WHETHER
; STRING S1 IS LESS THEN S2
;
STRLT:
IFN F40<Z>
PUSHJ 17,SAVEAC
; SET DEFAULT IN CASE ONE STRING IS AN INITIAL
; SEGMENT OF THE OTHER
;
MOVEI 0,0 ; SET DEFAULT OF .FALSE.
MOVE L,@0(16) ; GET LENGTH OF S1
CAML L,@1(16) ; IS S1 SHORTER THAN S2?
SKIPA L,@1(16) ; NO - SET UP SHORTER LENGTH
; AND SKIP
MOVNI 0,1 ; YES - CHANGE DEFAULT TO .TRUE.
;
; COMPARE FIRST L CHARACTERS
;
PUSHJ 17,COMP ; ARE FIRST L CHARS SAME ?
JRST RSTR4 ; YES - RETURN WITH DEFAULT
;
; COMPARE DIFFERENCE IN STRINGS
;
MOVE L,(S1A) ; NO - SET UP DIFFERENCE
LSH L,-1 ; WORD FOR S1
MOVE K,(S2A) ; AND CORRESPONDING
LSH K,-1 ; WORD FOR S2
MOVEI 0,0 ; SET DEFAULT OF .FALSE.
CAMGE L,K ; IS WORD IN S1 .GE. WORD IN S2?
MOVNI 0,1 ; NO - SET RESULT TO .TRUE.
JRST RSTR4 ; RESTORE AND RETURN
;
;------------------------------------------------------
;
; INTERNAL RSTR4 & RSTR 3
;
; RESTORE AC'S 4 (OR 3) THROUGH 2 AND POPJ
;
;
; SAVE AC'S 2-4
;
SAVEAC: POP 17,SAVE17
PUSH 17,2
PUSH 17,3
PUSH 17,4
PUSH 17,SAVE17
POPJ 17,0
;
; RESTORE AC'S AND EXIT
;
RSTR4: POP 17,4 ; RESTORE REGISTERS 4-2
RSTR3: POP 17,3 ; RESTORE REGISTERS 3-2
POP 17,2
IFN F40<JRA 16,2(16) ; RETURN>
IFN F10<POPJ 17,0 ; RETURN>
;
;--------------------------------------------------------
;
; INTERNAL COMP ( USED BY STREQ AND STRLT )
;
; THE CODE :
; MOVEI L,N
; PUSHJ 17,COMP
; WILL DO A NORMAL RETURN IF THE FIRST N CHARACTERS
; OF S1 AND S2 (BASED ON REGISTER 16) ARE EQUAL
; OTHERWISE A SKIP RETURN IS MADE AND S1A AND S2A INDEX
; THE CORRESPONDING WORDS WHICH ARE DIFFERENT.
;
COMP: JUMPE L,CPOPJ ; RETURN EQUAL IF LENGTH IS 0
HRRZI S1A,@0(16) ; GET ADDR OF S1
HRRZI S2A,@1(16) ; GET ADDR OF S2
COMP1: MOVEI S1A,1(S1A) ; INCREMENT ADDRESSES IN
MOVEI S2A,1(S2A) ; S1 AND S2
MOVE K,(S1A) ; SET UP FOR COMPARISON
XOR K,(S2A) ; SET UP POSITIONS WHERE THEY DIFFER
SUBI L,5 ; DECREMENT LENGTH BY 5
JUMPLE L,COMP2 ; IS THIS LAST WORD ?
TRZ K,1 ; NO- MASK OUT BIT 35
JUMPE K,COMP1 ; IF EQUAL, KEEP LOOPING
JRST CPOPJ1 ; NOT EQUAL - GO TO .NE. EXIT
;
; DEAL WITH LAST WORD
;
COMP2: AND K,MASK+4(L) ; MASK OUT RESIDUAL BITS
JUMPE K,CPOPJ ; IF EQUAL - RETURN EQUAL
;
; EXIT - NOT EQUAL
;
CPOPJ1: AOS (17)
CPOPJ: POPJ 17,0
;
;---------------------------------------------------
;
; MASKS FOR DELETING RESIDUAL BITS ( USED BY COMP AND HASH)
;
MASK: OCT 774000000000 ; 1 CHAR
OCT 777760000000 ; 2 CHARS
OCT 777777700000 ; 3 CHARS
OCT 777777777400 ; 4 CHARS
OCT 777777777776 ; 5 CHARS
;
;-------------------------------------------------------------
;
ENTRY HASH
;
; I = HASH(STRING,PRIME)
; SETS I EQUAL TO AN INTEGER IN THE RANGE
; 0 ... (PRIME - 1) OBTAINED BY HASHING STRING
;
HASH:
IFN F40<Z>
PUSH 17,2
PUSH 17,3
HRRZI 2,@0(16) ; 2 = (ADDR OF STRING)
MOVE 0,(2) ; 0 = (LENGTH OF STRING)
ADDI 0,4 ; ADJUST AND DIVIDE
IDIVI 0,5 ; 0 = (# OF WORDS)
; 1 = (# OF CHARS IN LASTWD) -1
MOVE 3,2 ;
ADD 3,0 ; 3 = (ADDRESS OF LASTWD)
MOVN 0,0 ; 0 = -(# OF WORDS)
HRL 2,0 ; PLACE COUNT IN LH OF 2
MOVE 0,MASK(1) ; 0 = (MASK FOR LAST WORD)
AND 0,(3) ; SET UP MASKED LAST WORD
AOBJP 2,HASH1 ; OMIT LOOP IF ONLY 1 WORD
XOR 0,(2) ; XOR IN NEXT WORD
AOBJN 2,.-1 ; LOOP UNTIL DONE
HASH1: LSH 0,-1 ; MAKE > 0 AND DISCARD BIT 35
IDIV 0,@1(16) ; DIVIDE BY PRIME AND
MOVE 0,1 ; SET UP REMAINDER
JRST RSTR3 ; RESTORE AND RETURN
;
;----------------------------------------------------------
;
ENTRY NEWNO
;
; N=NEWNO(K)
; WHERE K > 0 SETS THE SEED TO K AND RETURNS K
; N=NEWNO(0)
; DECREMENTS THE SEED AND RETURNS ITS NEW VALUE
;
NEWNO:
IFN F40<Z>
SKIPN 1,@(16) ; IS THE ARG 0
SOSA 1,NEWNOA ; YES GET LAST # AND SUB 1 (SKIP)
MOVEM 1,NEWNOA ; NO STORE THIS ONE
MOVE 1 ; RETURN IT REG 0
IFN F40<JRA 16,1(16) ; RETURN NEW SEED>
IFN F10<POPJ 17,0 ; RETURN>
LOW
NEWNOA: Z
HIGH
;
;-----------------------------------------------------------
;
ENTRY OPENF
;
; CALL OPENF(CALLNO,DONE,SVER)
; INVOKES OPENF AS DESCRIBED IN THE SYSTEM MODIFICATION
; GUIDE.
;
;
; WORKING REGISTERS
;
A=1
B=2
C=3
D=4
E=5
R=6
;
; DATA AREA
;
LOW
SAVE17: BLOCK 1 ;SAVE REG 17 HERE
IFE FOROTS,<STTIME: BLOCK 1>
;
; LOOKUP, ENTER, AND BUFFER HEADERS FOR THE VARIOUS FILES
;
RUNDEV: BLOCK 1 ; DEVICE FOR RUN UUO(MUST BE JUST BEFORE NAME:)
NAME: BLOCK 5 ; FILENAME BLOCK FOR UUO'S
BUFH1: BLOCK 3 ; BUFFER HEADER FOR CHAN 1(FLX)
BUFH2: BLOCK 3 ; BUFFER HEADER FOR CHAN 2(LST)
BUFH3: BLOCK 3 ; BUFFER HEADER FOR CHAN 3(F4)
EDAT: ; START OF AREA TO BE CLEARED @ START OF SCAN OF FILE SPEC.
NOF4: BLOCK 1 ; NON-ZERO IF NO F4 OUTPUT
DEVF: BLOCK 1 ; DEVICE FOR F4 OUTPUT OR 0 (NONE SPECIFIED) OR 1 (NONE WANTED)
FNAME: BLOCK 4 ; F4 FILENAME
NOLST: BLOCK 1 ; NON-ZERO IF NO LISTING
DEVL: BLOCK 1 ; LISTING DEVICE OR 0 (NONE SPECIFIED) OR 1 (NONE WANTED)
LNAME: BLOCK 4 ; LISTING FILENAME
NOERR: BLOCK 1 ; NON-ZERO IF NO ERROR TO TTY
EEND: ; END OF AREA TO CLEAR
;
; FORM FEED FLAG SET BY GET USED BY PUT
;
FORMF: BLOCK 1 ;
;
;CRLF USED FOR TYPEOUTS
;
HIGH
CRLF: ASCIZ \
\
;
; INITIAL OPENF LOGIC FOLLOWS
;
OPENF:
IFN F40<Z>
MOVE A,@0(16) ; GET CALLNO
SETOM LINENO ; INITIALIZE INTERNAL LINE NUMBER
SETZM FORMF ; INITIALIZE FORMF
SKIPE TMPFLG ; ARE WE CCL?
JRST OPENF2 ; NO - SKIP TYPEOUT
IFN TVER,<CAIN A,1 ; IS THIS FIRST CALL?
PUSHJ 17,TYPVER ; YES - TYPE VERSION NUMBER>
OPENF1: OUTSTR [ASCIZ /
*/] ; ASK FOR NAME OF FILE
OPENF2: JRST GETNXT ; GET NEXT COMMAND STRING (RETURN ONLY IF FURTHER FILES TO BE PROSESSED)
GOTNXT: SKIPN TMPFLG ; ARE WE CCL?
JRST OPENF3 ; NO - ONWARD
OUTSTR [ASCIZ \FLECS: \] ; SHOW WHAT WE ARE DOING
MOVE A,NAME ; AND TO WHOM WE ARE DOING IT
PUSHJ 17,SIXPRT ; BOTH NAME
OUTCHR ["."] ; AND
MOVE A,NAME+1 ;
PUSHJ 17,SIXPRT ; EXTENSION
OUTSTR CRLF ; AND MAKE THINGS NEAT
OPENF3: PUSHJ 17,OPENFX ; OPEN FLECS FILE
SKIPN NOLST ; SKIP IF NO LISTING
PUSHJ 17,OPENFL ; OPEN LISTING FILE
SKIPN NOF4 ; SKIP IF NO F4 OUTPUT
PUSHJ 17,OPENF4 ; OPEN FORTRAN FILE
SETZM @1(16) ; SET DONE .FALSE.
IFN F40<JRA 16,3(16) ; RETURN>
IFN F10<POPJ 17,0 ; RETURN>
;
; TYPE OUT VERSION NUMBER
;
IFN TVER,<
TYPVER: MOVSI B,(POINT 7,,35) ; SETUP BYTE POINTER
MOVE C,@2(16) ; GET COUNT
HRRI B,@2(16) ; ADDRESS IN RIGHT
ILDB A,B ; GET CHR
OUTCHR A ; TYPE IT
SOJG C,.-2 ; GET ALL
OUTSTR CRLF ; TYPE CRLF
POPJ 17,0 ; AND RETURN>
;
; PROCESS NEST COMMAND STRING
;
GETNXT: SETZM EDAT ; PREPARE TO CLEAR DATA AREA
MOVE A,[EDAT,,EDAT+1]
BLT A,EEND-1 ; AND CLEAR
;
;PROCESS NEXT FILE SPEC
;
GETNB: SETZM RUNDEV ; INIT DEVICE
;
;PROCESS NEXT SYMBOL IN FILE SPEC
;
GETN8: SETZM NAME ; INIT. SIXBIT NAME TO NULLS
MOVE A,[SIXBIT /FLX/]; AND EXTENSION
MOVEM A,NAME+1 ; TO "FLX"
SETZM NAME+3 ; CLEAR PPN
PUSHJ 17,INCH ; INPUT A CHARACTER
CAIE A,12 ; IS IT A BREAK?
JRST GETN1 ; NO GO ASSEMBLE FILENAME
SKIPN FNAME ; HAVE WE SEEN A F4 FILE NAME?
SKIPE LNAME ; OR A LAST FILE NAME?
JRST BADNAM ; YES - FLECS NAME IS MISSING.
JRST EXDONE ; NO - LINE EMPTY, SIGNAL DONE.
;
; ASSEMBLE NEXT SYMBOL
;
GETN1: MOVE D,[POINT 6,NAME]; SET UP SIXBIT POINTER
MOVEI E,6 ; WANT 6 OR FEWER CHARACTERS
GETN2: PUSHJ 17,CHOK ; CHECK CHAR AND CONVERT
JRST GETN3 ; NOT A LETTER OR DIGIT
IDPB B,D ; SAVE IN SIXBIT
PUSHJ 17,INCH ; GET NEXT CHAR
SOJG E,GETN2 ; LOOP FOR 6 CHARS
PUSHJ 17,CHOK ; SEVENTH SHOULD NOT BE ALPHA NUM
JRST GETN3 ; NOT ALPHA NUM - GO SEE WHAT IT IS
JRST GETN6 ; ALPHA NUM - HENCE SYNTAX ERROR
;
; ASSEMBLE DEVICE
;
GETN3: CAIL E,6 ; WERE ANY ALPHA NUM CHARS ENCOUNTERED
JRST GETN9 ; NO - GO DETERMIN DISPOSITION
CAIN A,":" ; YES - WAS THIS A DEVICE?
JRST [SKIPE RUNDEV
JRST GETN7
MOVE A,NAME
MOVEM A,RUNDEV
JRST GETN8]
;
; ASSEMBLE EXTENSION
;
CAIE A,"." ; IS EXTENSION SPECIFIED?
JRST GETN5 ; NO - CHECK FOR [PPN]
PUSHJ 17,INCH ; YES -- GET NEXT CHAR
SETZM NAME+1 ; AND SIXBIT EXTENSION
MOVE D,[POINT 6,NAME+1] ; SIXBIT POINTERS
MOVEI E,3 ; WANT 3 OR FEWER CHARS
GETN4: PUSHJ 17,CHOK ; CHECK CHAR AND CONVERT
JRST GETN5 ; NOT LETTER OR DIGIT
IDPB B,D ; AND IN SIX BIT
PUSHJ 17,INCH ; GET NEXT CHAR
SOJG E,GETN4 ; LOOP FOR 3 CHARS
PUSHJ 17,CHOK ; FOURTH SHOULD NOT BE ALPHA
JRST GETN5 ; NOT ALPHA - GO SEE WHAT IT IS
JRST GETN7 ; VALID - HENCE SYNTAX ERROR
;
; ASSEMBLE [PPN]
;
GETN5: CAIE A,"[" ; PPN?
JRST GETND ; NO - CHECK CCL LINK
PUSHJ 17,OCTIN ; GET PROJ
SKIPN B ; NULL?
HLR B,MYPPN ; YES USE OURS
CAIE A,"," ; PROPER DELIM?
JRST GETN6 ; NO - BAD SYNTAX
HRLM B,NAME+3 ; STORE IT
PUSHJ 17,OCTIN ; GET PROG
SKIPN B ; NULL?
HRR B,MYPPN ; USE OURS
CAIE A,"]" ; PROPER DELIM?
JRST GETN6 ; NO - BOMB
HRRM B,NAME+3 ; STORE
PUSHJ 17,INCH ; GET CHR
;
; PROCESS CCL LINK
;
GETND: CAIE A,"!" ; CCL LINK?
JRST GETN9 ; NO - JUMP
SKIPE MAJERF ; ANY MAJOR ERRORS?
JRST ABORT ; YES - TOO BAD
PUSHJ 17,INCH ; NO FLUSH THE REST OF THE LINE
CAIE A,12 ; DONE YET?
JRST .-2 ; NO - GO FOR MORE
HLLZ A,NAME+1 ; GET EXT
CAMN A,['FLX '] ; OLD DEFAULT?
SETZI A, ; YES - USE NEW
MOVEM A,NAME+1 ; PUT IT BACK
SKIPN A,RUNDEV ; GET DEVICE
MOVSI A,'SYS' ; FOR DEFAULT
MOVEM A,RUNDEV ; STORE DEVICE
SETZM NAME+2 ; CLEAR THESE
SETZM NAME+4
MOVE B,[1,,RUNDEV] ; CCL RUN AND BLOCK
IFE PURE,<MOVEM 17,SAVE17 ; RUN UUO KILLS AC'S>
RUN B, ; RUN IT
IFN PURE,<HALT> ; RUN UUO KILLS HISEG
IFE PURE,< ; IF LOWSEG WE CAN REPORT IT WITHOUT MUCH TROUBLE
SETOM TMPFLG ; THIS WILL GARANTEE WE DONT GET BACK
MOVE 17,SAVE17
MOVE A,RUNDEV ; GET DEVICE
OUTSTR [ASCIZ \
?FLXRUE Run UUO\]
JRST NOOPN4> ; REPORT THE TROUBLE
;
; FILE SPECIFICATION HAS BEEN ACCUMULATED
; DETERMINE DISPOSITION BASED ON DELIMETER
;
;
; PROCESS LF
;
GETN9: CAIN A,12 ; LF?
JRST [SKIPE DEVF ; YES - SO NO "," HAS BEEN SEEN
SKIPE DEVL ; NO - OK IF BOTH "," AND "="
JRST GOTNXT ; THEN GO!
JRST BADNAM] ; ELSE BAD SYNTAX!
;
; PROCESS ","
;
CAIE A,"," ; NO LF - ","?
JRST GETNA ; NO - CHECK FOR "="
SKIPE DEVF ; YES - DO WE HAVE ONE YET?
JRST GETN7 ; YES - ONE'S ENOUGH
GETNC: SKIPN NAME ; DID HE GIVE A NAME?
SKIPE RUNDEV ; OR DEVICE?
CAIA
JRST [SETOM DEVF ; NO - SHOW HE DID SOMETHING ABOUT F4
SETOM NOF4 ; BUT WANTS NO OUTPUT
JRST GETNB] ; GET NEXT FILE
MOVE A,NAME+1 ; YES - GET EXT
CAMN A,['FLX '] ; WAS IT DEFAULT?
IFE FOREXT,< MOVSI A,'F4 ' ; YES - USE THIS ONE> ;FDC;
IFN FOREXT,< MOVSI A,'FOR'> ;FDC;
MOVEM A,NAME+1 ; PUT IT BACK
MOVSI B,'DSK' ; GET DEFAULT
SKIPN RUNDEV ; NEED IT?
MOVEM B,RUNDEV ; USE IT
MOVE A,[RUNDEV,,DEVF]; SET FOR BLT
BLT A,FNAME+3 ; DO IT
JRST GETNB ; GET MORE
;
; PROCESS "="
;
GETNA: CAIE A,"=" ; "="?
JRST GETN6 ; NO - SYNTAX ERR
SKIPN DEVF ; GOT F4?
JRST [SETOM DEVL ; NO - THEN THIS IS IT AND NO LISTING
SETOM NOLST ; SHOW NO LISTING
JRST GETNC] ; GO STORE AS F4
SKIPE DEVL ; YES - LISTING ALREADY SPECIFIED
JRST GETN7 ; YES - DON'T GET ANOTHER
SKIPN NAME ; DOES HE WANT A FILE
SKIPE RUNDEV ; OR DEVICE
CAIA
JRST [SETOM DEVL ; NO - SHOW HE SAID SOMETHING ABOUT LST
SETOM NOLST ; SHOW NO LIST
JRST GETNB] ; GO GET MORE
MOVE A,NAME+1 ; GET EXT
CAMN A,['FLX '] ; WAS IT DEFAULT?
MOVSI A,'LST' ; YES -USE THIS ONE
MOVEM A,NAME+1 ; PUT IT BACK
SKIPN B,RUNDEV ; NEED DEFAULT?
MOVSI B,'DSK' ; YES-GET IT
SKIPE TMPFLG ; CCL MODE?
CAME B,[SIXBIT /LPT/]; YES-IS DEVICE LPT?
CAIA ; NO-DEVICE OK
MOVSI B,'DSK' ; CHANGE LPT TO DSK IF CCL
MOVEM B,RUNDEV ; USE THIS DEVICE
MOVE A,[RUNDEV,,DEVL]; READY FOR A BLT
BLT A,LNAME+3 ; DO IT
JRST GETNB ; GO FOR MORE
;
; FLUSH LINE AND REPORT SYNTAX ERRORS
;
GETN7: PUSHJ 17,INCH ; SCAN TO <LF>
GETN6: CAIE A,12 ;
JRST GETN7
JRST BADNAM
;
; CONVERT LC TO UC
; CHECK FOR LETTER OR DIGIT
; SET UP SIX BIT
;
CHOK: CAIL A,141 ; IS IT UPPER CASE LETTER?
CAILE A,172 ;
CAIA ; NO - CONTINUE
MOVEI A,-40(A) ; YES - CONVERT TO LOWER CASE
CAIL A,101 ; IS IT A LETTER?
CAILE A,132 ;
CAIA ; NO - CONTINUE
JRST CHOK1 ; YES - RETURN OK
CAIL A,60 ; IS IT A DIGIT?
CAILE A,71 ;
POPJ 17,0 ; NO - NOT OK RETURN
CHOK1: MOVEI B,-40(A) ; CONVERT TO SIXBIT
JRST CPOPJ1 ; AND SKIP RETURN
;
; SIGNAL DONE TO CALLING PROGRAM AND RETURN
;
EXDONE: SETOM @1(16) ; SET DONE TO .TRUE.
IFN F40<JRA 16,3(16) ; RETURN>
IFN F10<POPJ 17,0 ; RETURN>
;
; INFORM USER OF INVALID NAME, TRY AGAIN
;
BADNAM: OUTSTR [ASCIZ /?FLXIFS Improper file specification/]
CAIA
;
; ERROR EXIT
;
ERRRET: POP 17,A
SKIPN TMPFLG ; ARE WE CCL?
JRST OPENF1 ; NO - TRY AGAIN
EXIT ; YES - BOMB
;
; ATTEMPT TO OPEN INPUT FILE FOR FLECS SOURCE
;
OPENFX: SKIPN A,RUNDEV ; IS THERE A DEVICE?
MOVSI A,'DSK' ; NO - USE DSK
SETZI ; ASCII MODE
MOVEI B,BUFH1 ; BUFFER
OPEN 1, ; TRY OPEN
JRST NOINIT ; NO GO
LOOKUP 1,NAME ; CAN WE OPEN FOR INPUT?
JRST NOOPN1 ; NO - TROUBLE
POPJ 17,0
;
; ATTEMPT TO OPEN OUTPUT FILE FOR LISTING
;
OPENFL: SKIPE DEVL ; WAS THERE A FILE SPEC.?
JRST OPENL1 ; YES - GO TO L1
MOVSI B,'LST' ; NO - USE THIS DEFAULT
MOVEM B,NAME+1 ; STORE IT
MOVSI A,'DSK' ; GET DEVICE
SETZM NAME+2 ; CLEAR FOR DATE75
SETZM NAME+3 ; AND PPN
JRST OPENL2 ; GO DO IT
OPENL1: SKIPN A,LNAME ; IF HIS ISN'T THERE
MOVE A,NAME ; USE DEFAULT
MOVEM A,LNAME ; BUT USE SOMETHING
MOVE A,[LNAME,,NAME] ; GET FILE SPEC.
BLT A,NAME+3 ; PUT IT HERE
MOVE A,DEVL ; GET DEVICE
CAMN A,[SIXBIT /TTY/] ; LISTING TO TTY?
SETOM NOERR ; YES - ONLY WANT ERRORS ONCE
OPENL2: SETZI ; ASCII MODE
MOVSI B,BUFH2 ; HEADER
OPEN 2, ; OPEN IT
JRST NOINIT ; CAN'T
ENTER 2,NAME ; ATTEMPT TO OPEN FILE
JRST NOOPN2 ; CAN'T - TROUBLE
POPJ 17,0 ; RETURN
;
; ATTEMPT TO OPEN OUTPUT FILE FOR FORTRAN OUTPUT
;
OPENF4: SKIPE DEVF ; SAME AS FOR OPENFL:
JRST OPEN41
IFE FOREXT,< MOVSI B,'F4 '> ;FDC;
IFN FOREXT,< MOVSI B,'FOR'> ;FDC;
MOVEM B,NAME+1
MOVSI A,'DSK'
SETZM NAME+2
SETZM NAME+3
JRST OPEN42
OPEN41: SKIPN A,FNAME
MOVE A,NAME
MOVEM A,FNAME
MOVE A,[FNAME,,NAME]
BLT A,NAME+3
MOVE A,DEVF
OPEN42: SETZI
MOVSI B,BUFH3
OPEN 3,
JRST NOINIT
ENTER 3,NAME ; ATTEMPT TO OPEN FILE
JRST NOOPN2 ; CAN'T - TROUBLE
POPJ 17,0
;
; VARIOUS UGLY ERROR HANDLERS FOLLOW
;
NOINIT: OUTSTR [ASCIZ \?FLXCID Cannot initialize device \] ; TELL
PUSHJ 17,DEVPRT ; PRINT DEVICE
JRST ERRRET ; AND RETURN
NOOPN1: HRRZ B,NAME+1 ; ERROR CODE
JUMPN B,NOOPN3 ; JUMP IF OTHER THAN ZERO
OUTSTR [ASCIZ \?FLXNSF No such file as \] ; NOT THERE
JRST FILPRT ; TELL WHAT
NOOPN3: OUTSTR [ASCIZ \?FLXLEF Lookup\] ; LOOKUP PROBS
JRST NOOPN4 ; CONTINUE
NOOPN2: OUTSTR [ASCIZ \?FLXEEF Enter\] ; ENTER PROBS
HRRZ B,NAME+1 ; GET ERROR CODE
NOOPN4: OUTSTR [ASCIZ \ error (\] ; SAY ERROR
PUSHJ 17,OCTPRT ; SAY WHICH
OUTSTR [ASCIZ \) for file \]
;
; TYPE FILE SPECIFICATIONS PART OF ERROR MESSAGE
;
FILPRT: PUSHJ 17,DEVPRT ; PRINT DEVICE
MOVE A,NAME ; GET FILENAME
PUSHJ 17,SIXPRT ; PRINT IT
HLLZ A,NAME+1 ; GET EXT
OUTCHR ["."] ; SAY DOT
SKIPE A ; SKIP IF NULL
PUSHJ 17,SIXPRT ; PRINT EXT
HLRZ B,NAME+3 ; GET PROJ
JUMPE B,ERRRET ; RETURN IF NONE
OUTCHR [133] ; PRINT [
PUSHJ 17,OCTPRT ; PRINT PROJ
OUTCHR [","] ; PRINT ,
HRRZ B,NAME+3 ; GET PROG
PUSHJ 17,OCTPRT ; PRINT IT
OUTCHR [135] ; PRINT ]
JRST ERRRET ; RETURN
;
; TYPE DEVICE MNEMONIC IN REG A
;
DEVPRT: PUSHJ 17,SIXPRT ; PRINT IT
OUTCHR [":"] ; AND :
POPJ 17,0
;
; SCAN OCTAL NUMBER FROM INPUT
;
OCTIN: SETZI B, ; INIT AC
PUSH 17,B ; SAVE B
PUSHJ 17,INCH ; GET CHR
POP 17,B ; RESTORE B
SUBI A,"0" ; MAKE NUMERIC
JUMPL A,OCTRET ; LESS THAN "0"?
CAIL A,10 ; GREATER THAN "7"
JRST OCTRET ; YES - RETURN
IMULI B,10 ; SHIFT
ADD B,A ; AND ADD
JRST OCTIN+1 ; GET NEXT DIGIT
OCTRET: ADDI A,"0" ; RESTORE A
POPJ 17,0 ; RETURN
;
; TYPE NUMBER IN REG B
;
DECPRT: SKIPA D,[^D10] ; DECIMAL PRINT
OCTPRT: MOVEI D,^D8 ; OCTAL PRINT
RDXPRT: IDIVI B,(D) ; SHAVE OFF DIGIT
HRLM C,(17) ; STORE IT
SKIPE B ; ANY MORE?
PUSHJ 17,RDXPRT ; YES GET MORE
HLRZ B,(17) ; GET DIGIT
ADDI B,"0" ; MAKE IT A CHR
OUTCHR B ; PRINT IT
POPJ 17,0 ; GO FOR MORE AND RETURN
;
; TYPE CONTENTS OF REG A IN SIXBIT
;
SIXPRT: MOVE B,[440600,,A] ; SETUP POINTER
ILDB C,B ; GET A CHR
JUMPE C,CPOPJ ; JUMP IF DONE
ADDI C," " ; MAKE IT ASCII
OUTCHR C ; PRINT IT
TLNE B,770000 ; DONE?
JRST SIXPRT+1 ; NO GO FOR MORE
POPJ 17,0
;
; ABORT CCL RUN UUO IF MAJOR ERRORS
;
ABORT: OUTSTR [ASCIZ \
?FLXFEA Further execution aborted DUE TO MAJOR ERRORS\];DON'T CONTINUE
EXIT ; BYE BYE
;
;
;-----------------------------------------------------------
;
; REGISTERS FOR GET AND PUT
;
A=1 ; WORKING REGISTERS
B=2 ;
C=3 ;
D=4 ;
LN=5 ; LINE NUMBER FOR PUT
PT=6 ; LOCAL BYTE POINTER TO BUFFER
COUNT=7 ; LOCAL COUNT FOR BUFFER
BUF=10 ; ADDRESS OF BUFFER IN USE
SCOUNT=11 ; COUNT OF CHARS FOUND BY GET
;
; FLAGS FOR PUT
;
NEGFLG=1B35 ; LINE NO NEGATIVE
ERRFLG=1B34 ; ERROR CLASS
FORTF=1B33 ; OUTPUT CLASS FLAGS
LISTF=1B32 ;
ERRF=1B31 ;
VALID=FORTF!LISTF!ERRF ; VALID NUMBER SEEN
;
LOW
;
; LAST BLANK SEEN
;
LAST: BLOCK 1
;
; LAST LINE NUMBER PUT TO FORTOUT
;
LINENO: BLOCK 1
;
HIGH
;
;----------------------------------------------------------
;
ENTRY GET
;
; CALL GET(LINENO,STRING,ENDFIL)
; INVOKES GET AS DESCRIBED IN THE SYSTEM MODIFICATION
; GUIDE
;
GET:
IFN F40<Z>
;
; SET UP POINTERS AND COUNT
;
MOVE PT,BUFH1+1 ; GET BUFFER POINTER AND
MOVE COUNT,BUFH1+2 ; BYTES REMAINING COUNT
HRRZI A,@1(16) ; OBTAIN ADDRESS OF STRING
MOVEI A,1(A) ; CONVERT TO ADDR OF FIRST CHAR
HLL A,[POINT 7,0] ; MAKE A BYTE POINTER
SETZB SCOUNT,LAST ; TALLIES OF STRING LENGTH
;
; LOCATE FIRST BYTE
;
GET1: SOSGE COUNT ; IS THERE A NEXT BYTE IN BUFFER ?
JSP D,FILBUF ; NO - GET NEXT BUFFER
ILDB C,PT ; YES - GET IT
JUMPE C,GET1 ; LOOP PAST NULLS
LDB B,[POINT 6,PT,5]; GET LOCATION OF BYTE
CAIE B,^D29 ; IS THIS FIRST BYTE OF WORD
JRST GET1A ; NO - CHECK FORM FEED
MOVE B,0(PT) ; YES - GET COMPLETE WORD
TRNE B,1 ; IS BIT 35 ON?
JRST GET2 ; YES - FILE IS LINE-NUMBERED.
GET1A: CAIE C,14 ; IS IT A FORM FEED?
JRST GET3 ; NO - INVENT LINE NUMBER
SETOM FORMF ; YES - SET FORM FEED FLAG
JRST GET1 ; TRY NEXT BYTE
;
;
; ASSEMBLE LINE NUMBER AND STORE
;
GET2: MOVEI D,-60(C) ; SET UP VALUE OF FIRST DIGIT
MOVEI B,4 ; LOOP ON NEXT 4 CHARS.
GET2A: ILDB C,PT ; GET NEXT CHAR
IMULI D,^D10 ; LEFT SHIFT 1 DECIMAL PLACE
ADDI D,-60(C) ; ADD IN NEW DIGIT
SOJG B,GET2A ; LOOP FOR NEXT DIGIT
MOVEM D,@0(16) ; SET LINENO.
MOVEI COUNT,-4(COUNT) ; ADJUST COUNT TO PROPER VALUE
;
; DEAL WITH FORM FEEDS AND TABS IN LINE NUMBERED FILES
;
SOSGE COUNT ; ANY MORE CHARACTERS?
JSP D,FILBUF ; NO - FILL BUFFER
ILDB C,PT ; PICK UP NEXT CHAR
CAIE C,15 ; IS IT A <CR>?
JRST GET4 ; NO - ONWARD
SOSGE COUNT ; YES - ANY MORE CHARACTERS?
JSP D,FILBUF ; NO - FILL BUFFER
MOVE D,PT ; YES - COPY BYTE POINTER
ILDB C,D ; GET NEXT CHARACTER
CAIE C,14 ; IS IT <FORM FEED>?
JRST GET4 ; NO - ONWARD
SETOM FORMF ; YES - SET FORM FEED FLAG
IBP PT ; IGNORE FORM FEED
JRST GET1 ; TRY NEXT BYTE
;
; INVENT OWN LINE NUMBER
;
GET3: MOVEI B,^D10 ; SET INCREMENT OF 10 DECIMAL
ADDM B,@0(16) ; GIVE NEW VALUE TO USER
MOVEI B,6 ; INITIALIZE LOOP OVER COL 1 - 6
JRST GET5A ; ENTER LOOP
;
; DEAL WITH FIRST 6 COLUMNS
;
GET4: MOVEI B,6 ; INITIALIZE LOOP OVER COL 1 - 6
GET5: SOSGE COUNT ; ANY MORE CHARS?
JSP D,FILBUF ; NO - GO TO NEXT BUFFER
ILDB C,PT ; GET NEXT CHAR
GET5A: CAIN C,15 ; IS IT <CR> ?
JRST GET8 ; YES - TERMINATE
CAIN C,11 ; IS IT <TAB> ?
JRST GET6 ; YES - SUBSTITUTE BLANKS
IDPB C,A ; NO - TUCK IT AWAY IN STRING
MOVEI SCOUNT,1(SCOUNT); UPDATE COUNT
CAIE C,40 ; IS IT <SP>?
MOVEM SCOUNT,LAST ; NO - UPDATE LAST COUNT
SOJG B,GET5 ; LOOP FOR NEXT CHAR
JRST GET7 ; ONWARD
;
; DEAL WITH TAB IN FIRST 6 PLACES
;
GET6: MOVEI D,40 ; SET UP <SP>
GET6A: IDPB D,A ; TUCK IT AWAY IN STRING
MOVEI SCOUNT,1(SCOUNT); INCREMENT COUNT
SOJG B,GET6A ; LOOP TO COL 7
SOSGE COUNT ; ANY MORE CHARS ?
JSP D,FILBUF ; NO - GET NEXT BUFFER
ILDB C,PT ; GET NEXT CHARACTER
CAIL C,60 ; IS IT A DIGIT ?
CAILE C,71 ;
JRST GET7A ; NO - GET ON WITH IT
DPB C,A ; YES - DEPOSIT CONTINUATION NUMBER
MOVEM SCOUNT,LAST ; UPDATE LAST NON-BLANK COUNT
;
; MAIN LOOP TO MOVE CHARACTERS
;
GET7: SOSGE COUNT ; ANY MORE CHARS ?
JSP D,FILBUF ; NO - GET NEXT BUFFER
ILDB C,PT ; GET NEXT CHAR
GET7A: CAIN C,15 ; IS IT <CR> ?
JRST GET8 ; YES - TERMINATE
IDPB C,A ; NO - TUCK IT AWAY IN STRING
MOVEI SCOUNT,1(SCOUNT); UPDATE COUNT
CAIE C,40 ; WAS IT A <SP> ?
MOVEM SCOUNT,LAST ; NO - UPDATE LAST COUNT
CAIGE SCOUNT,^D72 ; HAVE WE REACHED THE END ?
JRST GET7 ; NO - LOOP
GET7B: SOSGE COUNT ; ANY MORE CHARS?
JSP D,FILBUF ; NO - GET NEXT BUFFER
ILDB C,PT ; GET NEXT CHAR
CAIE C,15 ; IS IT <CR> ?
JRST GET7B ; NO - LOOP
;
; RETURN STRING LENGTH TO USER
;
GET8: MOVE A,LAST ; GET # OF NON BLANKS
MOVEM A,@1(16) ; AND RETURN IT
;
; SKIP <LF> AND RESTORE BUFFER HEADER
;
SOSGE COUNT ; ANY MORE CHARS?
JSP D,FILBUF ; NO - GET NEXT BUFFER
IBP PT ; IGNORE <LF>
MOVEM PT,BUFH1+1 ; RESTORE POINTER
MOVEM COUNT,BUFH1+2 ; AND COUNT
IFN F40<JRA 16,3(16) ; RETURN>
IFN F10<POPJ 17,0 ; RETURN>
;
; FILL BUFFER INTERNAL SUBROUTINE
;
FILBUF: IN 1, ; INPUT NEXT BUFFER
JRST FIL2 ; SUCCESS - ONWARD
GETSTS 1,C ; FAIL - GET STAUS
TRNE C,1B22 ; WAS IT END OF FILE?
JRST FIL1 ; YES - GO HANDLE IT
; NO - OTHER ERROR
OUTSTR [ASCIZ/?FLXREI Read error on input file/]
EXIT
FIL1: SETOM @2(16) ; ENDFIL = .TRUE.
IFN F40<JRA 16,3(16) ; RETURN TO USER>
IFN F10<POPJ 17,0 ; RETURN>
FIL2: MOVE PT,BUFH1+1 ; CAPTURE LOCAL COPIES OF
MOVE COUNT,BUFH1+2 ; POINTER AND COUNT
JRST -2(D) ; RETURN FOR RETRY
;
;-----------------------------------------------------------
;
ENTRY PUT
;
; CALL PUT(LINENO,STRING,IOCLASS)
; INVOKES PUT AS DESCRIBED IN THE SYSTEM MODIFICATION
; GUIDE.
;
PUT:
IFN F40<Z>
;
; SET FLAGS TO INDICATE CLASS
;
PUT1: SETZ 0, ; ZERO THE FLAGS
MOVE A,@2(16) ; GET IO CLASS
MOVEI BUF,0 ; ZERO BUFFER ADDRESS
CAIN A,1 ; IS IT FORT?
TRO 0,FORTF ; YES - SET FLAG
CAIN A,2 ; NO - IS IT LIST?
TRO 0,LISTF ; YES - SET FLAG
CAIN A,3 ; NO - IS IT ERR ?
TRO 0,LISTF!ERRF ; YES - SET FLAG
SKIPE NOF4 ; IF FORTRAN NOT DESIRED
TRZ 0,FORTF ; LOWER FLAG
SKIPE NOLST ; IF LISTING NOT DESIRED
TRZ 0,LISTF ; LOWER FLAG
SKIPE NOERR ; IF ERRORS NOT TO TTY
TRZ 0,ERRF ; LOWER FLAG
TRNN 0,VALID ; DID A FLAG GET SET?
IFN F40<JRA 16,3(16)>
IFN F10<POPJ 17,0>
;
; SET UP LINE NUMBER INFO
;
PUT1A: MOVE A,@0(16) ; GET LINE NO
JUMPG A,PUT3 ; IS IT POSITIVE ?
JUMPL A,PUT2 ; IS IT NEGATIVE ?
TRNE 0,FORTF ;[37] IS THIS FOR FORTOUT?
JRST PUT3 ;[37] YES.
MOVE LN,[ASCII/ /] ; IT'S ZERO - SET UP 5 BLANKS
JRST PUT5 ; ONWARD
PUT2: TRO 0,NEGFLG ; IT'S NEGATIVE -- SET NEGFLAG .TRUE.
MOVM A,A ; TAKE ABSOLUTE VALUE
PUT3: TRNN 0,FORTF ; IS THIS FOR FORTOUT?
JRST PUT3B ; NO - ONWARD
CAMLE A,LINENO ; YES - WILL NEW NUMBER BE LARGER THAN LAST?
JRST PUT3A ; YES - ONWARD
MOVEI A,1 ; NO - SET UP AND
ADD A,LINENO ; INCREMENT
PUT3A: MOVEM A,LINENO ; SAVE FOR FUTURE REFERENCE
;
; CONVERT LINENO TO CHARACTERS
;
PUT3B: SETZI C, ; INITIALIZE ACCUMALATOR
MOVEI D,5 ; CONSTRUCT 5 CHARACTERS
PUT4: IDIVI A,^D10 ; GET FIRST DIGIT
MOVEI B,60(B) ; CONVERT TO ASCII
LSHC B,-7 ; SHIFT INTO C
SOJG D,PUT4 ; LOOP BACK
MOVE LN,C ; SAVE IT IN LN
;
; SET UP BUF AND LOCAL INFO
;
PUT5:: TRNE 0,FORTF ; WAS IT FORT ?
MOVEI BUF,BUFH3 ; YES - SET ADDR
TRNE 0,LISTF ; WAS IT LIST OR ERROR ?
MOVEI BUF,BUFH2 ; YES - SET ADDR
TRNN 0,FORTF!LISTF ; OUTPUT TO FORTOUT OR LISTOUT?
JRST PUT6 ; NO - ONWARD
MOVE PT,1(BUF) ; MAKE LOCAL POINTER
MOVE COUNT,2(BUF) ; AND COUNT
;
; MOVE TO FIRST WORD IF FORT
;
PUT6: TRNN 0,FORTF ; WAS IT FORT?
JRST PUT10 ; NO - ONWARD
PUT7: SOSGE COUNT ; YES - ANY MORE POSITIONS?
PUT7A: JSP D,NXTBUF ; NO - GET NEW BUFFER
IBP PT ; YES - BUMP POINTER
LDB A,[POINT 6,PT,5] ; GET BYTE POSITION
CAIE A,^D29 ; IS IT FIRST BYTE?
JRST PUT7 ; NO - LOOP
;
; WILL THE ENTIRE LINE FIT?
;
PUT7B: MOVE A,@1(16) ; GET LINE LENGTH
MOVEI A,^D8(A) ; ADJUST FOR LINE# <TAB><CR><LF>
CAMG A,COUNT ; ENOUGH ROOM?
JRST PUT8 ; YES - ONWARD
MOVEI D,PUT7A+1 ; NO - GET NEXT BUFFEP
JRST NXTBUF
;
; MOVE IN LINE NUMBER IF FORT
;
PUT8: TRO LN,1 ; SET LINE NUMBER BIT
MOVEM LN,(PT) ; PLACE IN BUFFER
TLZ PT,770000 ; ADVANCE BYTE POINTER
SUBI COUNT,5 ; DECREASE COUNT
;
; MOVE IN <TAB> FOLLLOWING LINE NUMBER
;
PUT9: MOVEI A,11 ; SET UP <TAB>
PUSHJ 17,OUTCH ; PUT IT OUT
JRST PUT15 ; GO MOVE STRING
;
; GENERATE <FF> IN LISTING IF NECESSARY
;
PUT10: AOSN FORMF ; GENERATE A <FF> ?
TRNN LISTF ; YES - ARE WE LISTING?
JRST PUT11 ; NO - ONWARD
MOVEI A,14 ; SET UP FORM FEED
PUSHJ 17,OUTCH1 ; PUT IT OUT TO LIST ONLY
;
; OUTPUT HYPHENS IF NECESSARY
;
PUT11: TRNN NEGFLG ; WAS LINE NO NEGATIVE ?
JRST PUT13 ; NO - ONWARD
MOVEI A,55 ; YES - SET UP "-"
MOVEI B,5 ; WANT 5 OF THEM
PUT12: PUSHJ 17,OUTCH ; PUT IT OUT
SOJG B,PUT12 ; LOOP UNTIL DONE
MOVEI A,15 ; SET UP <CR>
PUSHJ 17,OUTCH ; PUT IT OUT
;
; OUTPUT FIRST 6 COLUMNS OF LISTING
;
PUT13: MOVEI B,5 ; PUT OUT 5 COLUMNS
MOVE C,[POINT 7,LN] ; FROM CHARS IN LN
PUT14: ILDB A,C ; GET NEXT CHAR
PUSHJ 17,OUTCH ; PUT IT OUT
SOJG B,PUT14 ; LOOP UNTIL DONE
MOVEI A,40 ; SET UP <SP>
PUSHJ 17,OUTCH ; PUT IT OUT
;
; COME HERE TO OUTPUT STRING ITSELF
;
PUT15: HRRZI C,@1(16) ; GET ADDR OF STRING
MOVE B,(C) ; GET LENGTH
JUMPLE B,PUT17 ; TERMINATE IF NOT POSITIVE
MOVEI C,1(C) ; SET UP BYTE
HLL C,[POINT 7,0] ; POINTER TO STRING
ILDB A,C ; YES - SET UP BYTE
PUSHJ 17,OUTCH
SOJG B,.-2 ; LOOP TIL DONE
PUT17: MOVEI A,15 ; SET UP <CR>
PUSHJ 17,OUTCH ; PUT IT OUT
MOVEI A,12 ; SET UP <LF>
PUSHJ 17,OUTCH ; PUT IT OUT
;
; UPDATE BUFFER HEADER
;
MOVEM PT,1(BUF) ; SET UP PT
MOVEM COUNT,2(BUF) ; SET COUNT
;
; RETURN
;
IFN F40<JRA 16,3(16) >
IFN F10<POPJ 17,0 ; RETURN>
;
;--------------------------------------------------------------
;
; INTERNAL OUTCH (USED BY PUT)
;
; MOVEI A,X
; PUSHJ 17,OUTCH
;
; WILL OUTPUT THE CHARACTER X TO THE BUFFER AND TO THE
; TTY IN CASE OF ERR CLASS
;
OUTCH: TRNE 0,ERRF ; IS THIS CLASS ERROR ?
OUTCHR A ; YES - PUT OUT CHAR
TRNN 0,LISTF!FORTF ; ANY OUTPUT OTHER TNAN ERRORS?
POPJ 17,0 ; NO - RETURN
OUTCH1: SOSGE COUNT ; ANY MORE ROOM?
JSP D,NXTBUF ; NO - GET NEXT BUFFER
IDPB A,PT ; YES - PUT BYTE IN BUFFER
POPJ 17,0
;
;------------------------------------------------------------
;
; INTERNAL NXTBUF
;
; JSP D,NXTBUF
;
; WILL OUTPUT THE CURRENT BUFFER AND SET UP A NEW ONE
; AND RETURN TO THE PREVIOUS INSTRUCTION !!!!!!!
;
NXTBUF: MOVEM PT,1(BUF) ; SAVE CURRENT PT
MOVEM COUNT,2(BUF) ; AND COUNT
TRNN FORTF ; IS IT FORT ?
JRST NXT1 ; NO - ONWARD
OUT 3, ; YES - OUTPUT ON CHAN 3
JRST NXT2 ; SUCCESS - ONWARD
OUTSTR [ASCIZ /?FLXOEF Output failure to Fortran source file/]
EXIT
NXT1: OUT 2, ; OUTPUT ON CHAN 2
JRST NXT2 ; SUCCESS - ONWARD
OUTSTR [ASCIZ /?FLXOEL Output failure to Flecs listing file/]
EXIT
NXT2: MOVE PT,1(BUF) ; RESET PT AND
MOVE COUNT,2(BUF) ; COUNT
JRST -2(D) ; REVERSE SKIP RETURN (UGH!)
;
;----------------------------------------------------------
;
ENTRY CLOSEF
; CALL CLOSEF(MINCNT,MAJCNT)
; WILL INVOKE CLOSEF AS DESCRIBED IN THE FLECS SYSTEM
; MODIFICATION GUIDE.
;
;
CLOSEF:
IFN F40<Z>
CLOSE 1,0
RELEASE 1,
CLOSE 2,0
RELEASE 2,
CLOSE 3,0
RELEASE 3,
MOVE B,@(16) ; GET MINOR ERROR CNT
JUMPE B,CLOSE1 ; NONE CHECK MAJOR
OUTSTR [ASCIZ \%FLXMNE \] ; TELL USER
PUSHJ 17,DECPRT ; HOW MANY
OUTSTR [ASCIZ \ minor error(s) detected
\] ; OF WHAT
CLOSE1: MOVE B,@1(16) ; GET MAJOR ERROR CNT
JUMPE B,CLOSER ; NONE RETURN
SETOM MAJERF ; INDICATE MAJOR ERRORS WERE SEEN
OUTSTR [ASCIZ \?FLXMJE \] ; TELL HIM
PUSHJ 17,DECPRT ; HOW MANY
OUTSTR [ASCIZ \ major error(s) detected
\] ;AND WHAT
CLOSER: ; RETURN
IFN F40<JRA 16,2(16)>
IFN F10<POPJ 17,0 ; RETURN>
;
;--------------------------------------------------------------
;
; SUBROUTINE INCH
; INPUT ONE CHARACHTER FROM TMPCOR,TMPFILE,OR TTY
; DESTROYS B, FLUSHES CARRIAGE RETURNS, TABS, AND SPACES,
; AND CHANGES ALL BREAK CHRS TO LINEFEEDS
;
INCH: SKIPN A,TMPFLG ; IS THIS CCL?
JRST [INCHWL A ; NO - GET FROM TTY
JRST INCH1] ; AND SKIP THIS
TLNN A,-1 ; YES - HAVE WE REACH THE END YET?
JRST INCH1 ; YES - LF IN A, SO JUMP
ILDB A,TMPFLG ; NO - GET A CHR
JUMPN A,INCH1 ; DID WE REACH THE END?
MOVEI A,12 ; YES - SET UP LF AS BREAK
MOVEM A,TMPFLG ; STORE A LF
INCH1: CAIN A,11 ; A TAB?
JRST INCH ; YES - FLUSH
CAIE A," " ; A SPACE,
CAIN A,15 ; OR A CR?
JRST INCH ; YES - EAT IT
MOVSI B,-BRKLEN ; SET UP IOWD
CAIN A,BRKTAB(B) ; IS IT A BREAK?
SKIPA A,[12] ; YES - STORE A LF
AOBJN B,.-2 ; LOOP TO CHECK AGAINST ALL
POPJ 17,0
;
BRKTAB: EXP 7,13,14,32,33,175,176 ;TABLE OF BREAK CHRS
BRKLEN==.-BRKTAB ;TABLE LENGTH
;
;--------------------------------------------------------------
;
; MAIN PROGRAM
;
; ACTUAL STARTING ADDRESS OF FLECS IS BELOW AT START
; THIS IS TO DETERMINE CCL ENTRY
;
LOW
TMPFLG: BLOCK 1 ; ZERO IF NOT CCL OTHERWISE BYTE PNTR
MYPPN: BLOCK 1 ; OUR PPN
IFNDEF BUFLEN,<BUFLEN==^D127> ; LENGTH OF BUFFER FOR CCL
TBUF: BLOCK BUFLEN ; CCL BUFFER
Z ; MAKE SURE ENDS WITH NULL
MAJERF: Z ; NON-ZERO IF MAJOR ERRORS WERE SEEN
IFE FOROTS,<PDLST: BLOCK PDLEN>
HIGH
IFN F40,<OPDEF GO[JRST FLECS##+1]>
IFN F10,<OPDEF GO[JRST FLECS##]>
;
; ENTER AND DETERMINE CCL
;
START: TDZA ; IF NOT CCL, SKIP
MOVE [POINT 7,TBUF] ; CCL SET UP BYTE POINTER
MOVEM TMPFLG ; SETUP TMPFLG
;
; INITIALIZE SYSTEM
;
IFE FOROTS,<
RESET
SETZI
RUNTIME
MOVEM STTIME
MOVE 17,[IOWD PDLEN,PDLST]>
IFN FOROTS,<
JSP 16,RESET.## ;INIT FOROTS
Z>
;
; OBTAIN PPN
;
GETPPN ; GET OUR PPN
JFCL ; JUST IN CASE
MOVEM MYPPN ; STORE IT
SKIPN 0,TMPFLG
JRST NOTCCL ; START IF NOT CCL
;
; INITIALIZE CCL MODE
;
CCL: SETZM MAJERF ; CLEAR MAJOR ERRORS FLAG
MOVE [2,,1] ; TMPCOR READ AND DELETE
MOVSI 1,'FLE' ; OUR NAME
MOVE 2,[IOWD BUFLEN,TBUF]; AND WHERE IT GOES
TMPCOR ; TRY TO GET IT
CAIA ; NOT THERE SKIP
GO ; GOT IT, SO GO
INIT 17 ; INIT FOR TMP FILE READ
'DSK ' ; FROM DSK
Z ; NO BUFFERS (DUMP MODE)
JRST NOTCCL ; CAN'T, SO ASSUME NOT CCL
PJOB ; GET OUR JOB #
MOVEI 3,3 ; # OF CHRS
IDIVI 12 ; MAKE IT SIXBIT IN LEFT OF 2
ADDI 1,20
LSHC 1,-6
SOJG 3,.-3 ; LOOP FOR ALL
HRRI 2,'FLE' ; OUR NAME
MOVSI 3,'TMP' ; EXTENSION
SETZB 4,5 ; CLEAR THIS FOR DATE75
LOOKUP 2 ; TRY TO GET THE FILE
JRST NOTCCL ; CAN'T, SO ASSUME NOT CCL
MOVE [IOWD BUFLEN,TBUF]; DUMP COMMAND LIST TO AC'S
SETZI 1, ; END COMMAND LIST
IN ; GET FILE
CAIA ; GOT IT
SETZM TMPFLG ; CAN'T READ FILE
RENAME 1 ; DELETE IT
JFCL ; DON'T CARE IF CAN'T
CLOSE
GO ; AND GO
;
; INITIATE NON CCL MODE
;
NOTCCL: SETZM TMPFLG ; CLEAR FLG
GO ; AND GO
;
;----------------------------------------------------------
;
; SUBROUTINE EXIT IF NOT USING FOROTS
;
IFE FOROTS,<
ENTRY EXIT
EXIT: IFN F40,<Z>
OUTSTR [ASCIZ \
Runtime: \]
SETZI A,
RUNTIME A,
SUB A,STTIME
IDIVI A,^D1000
CAILE B,^D500
MOVEI A,1(A)
IDIVI A,^D60
JUMPN A,[EXCH A,B
PUSH 17,B
PUSHJ 17,DECPRT
OUTSTR [ASCIZ \ minute\]
POP 17,B
CAIN B,1
OUTCHR ["s"]
OUTSTR [ASCIZ \, \]
MOVE B,A
JRST .+1]
PUSHJ 17,DECPRT
OUTSTR [ASCIZ \ seconds
\]
EXIT>
END START