Trailing-Edge
-
PDP-10 Archives
-
bb-bt99h-bb
-
alglib.c05
There are 15 other files named alglib.c05 in the archive. Click here to see a list.
REP 3/1 ;05C1
;COPYRIGHT (C) 1975,1981,1982 BY
WIT
;COPYRIGHT (C) 1975,1982,1983 BY
DEL 47/2 ;05C2
.PTSFD==3 ; [275] PATH. BLOCK INDEX FOR SFD'S
.PTPPN==2 ; [275] INDEX FOR PPN
DEL 83/2 ;05C3
HRLZI A1,%JBEDT
LSH A1,^D9
MOVEI A2,3
HRLZI A5,(SIXBIT/ALG/)
MOVE A3,[POINT 6,A5,17]
MOVE A4,[POINT 7,SEGMES+6,6]
GET2: SETZ A0,
LSHC A0,3
ADDI A0,20 ; TO SIXBIT
IDPB A0,A3
ADDI A0,40 ; TO ASCII
IDPB A0,A4 ; TO ERROR-MESSAGE
SOJG A2,GET2
MOVEM A5,HSEG+1
MOVEM A5,HSEG1+1
REP 102/2 ;05C4
JRST NOSYS ; NOT FOUND
WIT
JRST NOSEG ; [322] NOT FOUND
DEL 107/2 ;05C5
NOSYS: MOVEI A0,HSEG1
GETSEG A0, ; TRY ON DSK INSTEAD
JRST NOSEG ; NOT THERE EITHER
JRST GET1 ; FOUND ON DSK
REP 14/3 ;05C6
HSEG: SIXBIT /SYS/
0 0
WIT
HSEG: SIXBIT /SYS/ ; [340]
SIXBIT /ALGOTS/ ; [340]
SIXBIT /EXE/ ; [340]
DEL 20/3 ;05C7
HSEG1: SIXBIT /DSK/
0 0
0
0
0
REP 36/3 ;05C8
?ALGOL object time system ALGNNN.EXE not found, GETSEG error code / ; [265]
WIT
?ALGOL object time system ALGOTS.EXE not loaded, GETSEG error code /
; [340] [322] [265]
DEL 166/115 ;05C9
;[245] XCTA .A(DL) ; GET ADDRESS OF A
REP 25/116 ;05C10
LDB A0,[
POINT 24,STR2(A2),35] ; AND ITS LENGTH
WIT
LDB A0,[POINT 24,STR2(A2),35] ; AND ITS LENGTH
INS 1/117 ;05C11
REP 5/117 ;05C12
LDB A0,[
POINT 6,STR1(A2),11] ; GET BYTE SIZE
WIT
LDB A0,[POINT 6,STR1(A2),11] ; GET BYTE SIZE
INS 14/129 ;05C13
MOVE AX,PRGLNK(DL) ; [335] GET RETURN ADDR.
MOVE AX,-1(AX) ; [335] GET FORMAL BITS
MOVEM AX,A01TMP(DB) ; [335] PUT THEM HERE UNTIL WE NEED THEM
REP 24/129 ;05C14
SETZ A0, ; [256] GET READY TO DELETE STRING SPACE
TLC A2,STRDYN!STRPRC; [256] COMPLEMENT STRING STATUS BITS
TLCE A2,STRDYN!STRPRC; [256] WAS THIS A TRANSIENT STRING?
JRST .EXIT(DL) ; [256] NO, EXIT
PUSHJ SP,GETOWN ; [256] YES, DELETE IT
WIT
HLRZ A0,A01TMP(DB) ; [335] GET FORMAL BITS INTO RIGHT HALF
TRZ A0,77 ; [335] TURN OFF WHAT WE DON'T CARE ABOUT
CAIE A0,$PRO!$S ; [335] STATIC SIMPLE STRING PROC (USER PROC.)?
CAIN A0,$D!$EXP!$S ; [335] DYNAMIC SIMPLE STR EXPR (STR EXPRSION)?
JRST LAB321 ; [335] YES, GO DELETE IT
CAIE A0,$PRO!$S!$EXT ; [335] STATIC EXTERN STR PROC. (ALGLIB PROC.)?
JRST .EXIT(DL) ; [335] NO, EXIT BUT DON'T DELETE IT
LAB321: SETZ A0, ; [335] YES, GET READY TO DELETE THE STRING
PUSHJ SP,GETOWN ; [335] DO IT
INS 14/130 ;05C15
MOVE AX,PRGLNK(DL) ; [335] GET RETURN ADDR.
MOVE AX,-1(AX) ; [335] GET FORMAL BITS
MOVEM AX,A01TMP(DB) ; [335] PUT THEM HERE UNTIL WE NEED THEM
REP 22/130 ;05C16
SETZ A0, ; [256] GET READY TO DELETE STRING SPACE
TLC A2,STRDYN!STRPRC; [256] COMPLEMENT STRING STATUS BITS
TLCE A2,STRDYN!STRPRC; [256] WAS THIS A TRANSIENT STRING?
JRST .EXIT(DL) ; [256] NO, EXIT
PUSHJ SP,GETOWN ; [256] YES, DELETE IT
WIT
HLRZ A0,A01TMP(DB) ; [335] GET FORMAL BITS INTO RIGHT HALF
TRZ A0,77 ; [335] TURN OFF WHAT WE DON'T CARE ABOUT
CAIE A0,$PRO!$S ; [335] STATIC SIMPLE STRING PROC (USER PROC.)?
CAIN A0,$D!$EXP!$S ; [335] DYNAMIC SIMPLE STR EXPR (STR EXPRSION)?
JRST LAB326 ; [335] YES, GO DELETE IT
CAIE A0,$PRO!$S!$EXT ; [335] STATIC EXTERN STR PROC. (ALGLIB PROC.)?
JRST .EXIT(DL) ; [335] NO, EXIT BUT DON'T DELETE IT
LAB326: SETZ A0, ; [335] YES, GET READY TO DELETE THE STRING
PUSHJ SP,GETOWN ; [335] DO IT
DEL 15/131 ;05C17
EDIT (133) ; AVOID STACK-SHIFT PROBLEMS
REP 1/132 ;05C18
TITLE CONCAT - STRING CONCATENATION ROUTINE
WIT
TITLE CONCAT - STRING CONCATENATION ROUTINE
DEL 35/132 ;05C19
REP 15/133 ;05C20
LDB A0,[
POINT 6,STR1(A2),11] ; GET BYTE-SIZE INTO A0
LDB A1,[
POINT 24,STR2(A2),35] ; AND LENGTH INTO A1
WIT
LDB A0,[POINT 6,STR1(A2),11] ; GET BYTE-SIZE INTO A0
LDB A1,[POINT 24,STR2(A2),35] ; AND LENGTH INTO A1
REP 6/134 ;05C21
LDB A5,[
POINT 24,STR2(A2),35] ; GET LENGTH OF STRING
WIT
LDB A5,[POINT 24,STR2(A2),35] ; GET LENGTH OF STRING
REP 35/145 ;05C22
IOERR 6,(A13) ; [251][E1017] HIT EOF, ERROR WITH CH. # IN A13
WIT
JRST READ90 ; [312] EOF, DONE
INS 14/148 ;05C23
MOVE AX,PRGLNK(DL) ; [335] GET RETURN ADDR.
MOVE AX,-1(AX) ; [335] GET FORMAL BITS
MOVEM AX,A01TMP(DB) ; [335] PUT THEM HERE UNTIL WE NEED THEM
REP 19/148 ;05C24
WRIT1: MOVE A3,STR1(A0) ; [237] GET BYTE-POINTER
LDB A1,[POINT 24,STR2(A0),35] ; [237] GET STRING LENGTH
WIT
MOVE A3,A0 ; [325] [237] GET BYTE-POINTER
LDB A1,[POINT 24,A1,35] ; [325] [237] GET STRING LENGTH
REP 30/148 ;05C25
SETZ A0, ; [256] GET READY TO DELETE STRING SPACE
TLC A2,STRDYN!STRPRC; [256] COMPLEMENT STRING STATUS BITS
TLCE A2,STRDYN!STRPRC; [256] WAS THIS A TRANSIENT STRING?
JRST .EXIT(DL) ; [256] NO, EXIT
PUSHJ SP,GETOWN ; [256] YES, DELETE IT
JRST .EXIT(DL) ; [256] AND EXIT
WRIT4: JSP AX,WRIT2 ; GET NEXT BYTE
WRIT5: CAIN A13,"[" ; LEFT SQUARE BRACKET?
XCT [
AOJA A4,WRIT4
AOJA A4,WRIT4
SOJA A4,WRIT6]+1(A4)
CAIN A13,"]" ; NO - RIGHT SQUARE BRACKET?
XCT [
AOJA A4,WRIT6
SOJA A4,WRIT4
SOJA A4,WRIT6]+1(A4)
XCT [
AOJA A4,WRIT6
JRST WRIT6
JRST WRIT8]+1(A4) ; NO
WIT
HLRZ A0,A01TMP(DB) ; [335] GET FORMAL BITS INTO RIGHT HALF
TRZ A0,77 ; [335] TURN OFF WHAT WE DON'T CARE ABOUT
CAIE A0,$PRO!$S ; [335] STATIC SIMPLE STRING PROC (USER PROC.)?
CAIN A0,$D!$EXP!$S ; [335] DYNAMIC SIMPLE STR EXPR (STR EXPRSION)?
JRST LAB413 ; [335] YES, GO DELETE IT
CAIE A0,$PRO!$S!$EXT ; [335] STATIC EXTERN STR PROC. (ALGLIB PROC.)?
JRST .EXIT(DL) ; [335] NO, EXIT BUT DON'T DELETE IT
LAB413: SETZ A0, ; [335] YES, GET READY TO DELETE THE STRING
PUSHJ SP,GETOWN ; [335] DO IT
JRST .EXIT(DL) ; [256] AND EXIT
WRIT4: JSP AX,WRIT2 ; GET NEXT BYTE
WRIT5: CAIN A13,"[" ; LEFT SQUARE BRACKET?
XCT [AOJA A4,WRIT4
AOJA A4,WRIT4
SOJA A4,WRIT6]+1(A4)
CAIN A13,"]" ; NO - RIGHT SQUARE BRACKET?
XCT [AOJA A4,WRIT6
SOJA A4,WRIT4
SOJA A4,WRIT6]+1(A4)
XCT [AOJA A4,WRIT6
JRST WRIT6
JRST WRIT8]+1(A4) ; NO
REP 22/149 ;05C26
WRIT8: TDZA A5,A5 ; CLEAR COUNT (FIRST TIME)
WIT
WRIT8: TDZA A5,A5 ; CLEAR COUNT (FIRST TIME)
INS 15/160 ;05C27
.SFMAX=6 ; [324] MAX. DEPTH OF SFD'S ALLOWED + 1
REP 29/160 ;05C28
OPF0: JRST OPF0(A1) ; BRANCH ON NUMBER OF PARAMETERS
WIT
OPNFIL: JRST OPNFIL(A1) ; [324] BRANCH ON NUMBER OF PARAMETERS
REP 46/160 ;05C29
MOVE A2,.LU(DL) ; RESTORE ADDRESS OF STRING
MOVEI A2,@A2 ; STATICISE IT
LDB A0,[POINT 24,STR2(A2),35] ; GET IT'S LENGTH
MOVE A4,STR1(A2) ; AND SAVE BYTE POINTER
SETZB A5,A6 ; CLEAR FILE AND EXTENSION
JUMPE A0,OPF5 ; NULL STRING?
MOVE A7,[POINT 6,A5,]; BYTE POINTER FOR FILE NAME
MOVEI A10,1 ; BYTE INDEX
OPF1: PUSHJ SP,OPF6 ; GET NEXT BYTE
CAIN A2,'.' ; POINT?
AOJA A10,OPF3 ; YES
IDPB A2,A7 ; PLANT BYTE IN NAME
CAIGE A10,6 ; NAME FULL?
AOJA A10,OPF1 ; NO - KEEP GOING
AOJ A10, ; [210] COUNT THE SIXTH CHARACTER
OPF2: PUSHJ SP,OPF6 ; SCAN FOR POINT
CAIE A2,'.'
AOJA A10,OPF2
ADDI A10,1
OPF3: MOVE A7,[POINT 6,A6,]; BYTE POINTER FOR FILE EXTENSION
MOVEI A11,3 ; BYTE COUNT
OPF4: PUSHJ SP,OPF6 ; GET NEXT BYTE
IDPB A2,A7 ; AND PLANT IT IN EXTENSION
SOJE A11,OPF5 ; ANY MORE EXTENSION?
AOJA A10,OPF4 ; NO - KEEP GOING
EDIT(); FIX STACK ON RETURN FROM OPF6
OPF5A: POP SP,(SP) ; [E037] STEP BACK OVER RETURN ADDRESS
OPF5: MOVE A1,.N(DL) ; RESTORE CHANNEL NUMBER
LRLOAD A2,A5 ; LOAD FILE NAME AND EXTENSION
HRLZ A4,.P(DL)
LSH A4,11 ; PROTECTION
MOVE A5,.PP(DL) ; PROJECT-PROGRAMMER
PUSHJ SP,OPFILE ; AND OPEN FILE
POP SP,A2 ; GET ADDR OF I (OR 0)
SKIPN A0, ; ERROR ?
EDIT(160); Don't clobber label address when storing error code.
JRST [POP SP,(SP) ; [E160]
JRST .EXIT(DL)] ; [E160]
SUBI A0,100 ; ERR-CODE HAS 100 ADDED TO IT BY OTS
SKIPE .I(DL) ; YES - I ?
XCT .I+1(DL) ; YES - PUT ERROR-CODE IN IT
POP SP,A2 ; [E160] Get label address
EDIT(020) ; FORLAB NEEDS ADDRESS IN A2, NOT A3 !
SKIPE A2 ; [E020][E160] IS THERE AN ERROR EXIT ?
JRST (A2) ; [E020] IF SO, TAKE IT
IOERR 5,(A1) ; ELSE GIVE ERROR MESSAGE
OPF6: CAMLE A10,A0 ; GET SIXBIT BYTE SUBROUTINE
JRST OPF5A ; [E037] NONE LEFT - ERROR RETURN
ILDB A2,A4 ; AND GET NEXT BYTE
SUBI A2,40
JUMPL A2,OPF7 ; TOO LOW
CAILE A2,132
JRST OPF7 ; TOO HIGH
CAIL A2,100 ; LOWER CASE ALPHA?
SUBI A2,40 ; YES - RECODE TO UPPER CASE ALPHA
POPJ SP,0
OPF7: MOVEI A2,0
POPJ SP,0
WIT
MOVEI A0,.SFMAX+4 ; [324] NEED SPACE FOR PATH BLOCK
PUSHJ SP,GETCLR ; [324] GET THE SPACE
PUSH SP,A1 ; [324] SAVE ADDR. OF PATH BLOCK
MOVE A2,.LU(DL) ; [324] GET ADDR. OF STRING
MOVEI A2,@A2 ; [324] STATICISE IT
MOVE A0,.PP(DL) ; [324] GET PPN
MOVEM A0,.PTPPN(A1) ; [324] STORE IN PATH BLOCK
SETZB A5,A6 ; [324] CLEAR FILENAME AND EXTENSION
LDB A10,[POINT 24,STR2(A2),35] ; [324] GET STRING LENGTH
JUMPE A10,OPFNOW ; [324] ALLOW NULL NAME TO DELETE FILE
MOVE A4,STR1(A2) ; [324] COPY BYTE POINTER
MOVE A7,[POINT 6,A5] ; [324] BYTE POINTER FOR FILE NAME
MOVEI A0,6 ; [324] MAX. LENGTH OF FILENAME
PUSHJ SP,GETCHR ; [324] GET FIRST BYTE OF FILESPEC
PUSHJ SP,OPFERR ; [324] ERROR IF STRING EOF IS FOUND
CAIG A2,'Z' ; [324] FIRST CHR. MUST BE ALPHANUMERIC
CAIGE A2,'0' ; [324]
PUSHJ SP,OPFERR ; [324] ISN'T, CHR. CAN'T APPEAR HERE
JRST OPFNM1 ; [324] NO, BEGIN BUILDING FILENAME
; [324] PARSE AND BUILD FILENAME IN A5
OPFNAM: PUSHJ SP,GETCHR ; [324] GET NEXT BYTE
JRST OPFNOW ; [324] GO OPEN FILE IF STRING EOF IS FOUND
CAIN A2,'.' ; [324] POINT?
JRST OPFEXT ; [324] YES, GO PARSE EXTENSION
CAIN A2,'[' ; [324] NO, BEGINNING OF PPN AND SFD SPEC.?
JRST OPFPPN ; [324] YES, GO PARSE IT
OPFNM1: IDPB A2,A7 ; [324] NO, PLANT BYTE IN FILENAME
SOJG A0,OPFNAM ; [324] LOOP UNTIL SIX CHRS. OR A DELIMITER
PUSHJ SP,GETCHR ; [324] SIX CHRS. FOUND, GET NEXT ONE
JRST OPFNOW ; [324] GO OPEN FILE IF STRING EOF IS FOUND
CAIN A2,'[' ; [324] BEGINNING OF PPN AND SFD SPEC.?
JRST OPFPPN ; [324] YES, GO PARSE IT
CAIE A2,'.' ; [324] NO, POINT?
PUSHJ SP,OPFERR ; [324] NO, FILESPEC IS BAD
; [324] PARSE AND BUILD EXTENSION IN A6
OPFEXT: MOVEI A0,3 ; [324] MAX. LENGTH OF EXTENSION
MOVE A7,[POINT 6,A6] ; [324] BYTE POINTER FOR EXTENSION
OPFEX1: PUSHJ SP,GETCHR ; [324] GET NEXT BYTE
JRST OPFNOW ; [324] GO OPEN FILE IF STRING EOF IS FOUND
CAIN A2,'[' ; [324] BEGINNING OF PPN AND SFD SPEC.?
JRST OPFPPN ; [324] YES, GO PARSE IT
IDPB A2,A7 ; [324] NO, PLANT IT IN EXTENSION
SOJG A0,OPFEX1 ; [324] LOOP UNTIL THREE CHRS. OR A DELIMITER
PUSHJ SP,GETCHR ; [324] GET NEXT CHR.
JRST OPFNOW ; [324] GO OPEN FILE IF STRING EOF IS FOUND
CAIE A2,'[' ; [324] BEGINNING OF PPN AND SFD SPEC?
PUSHJ SP,OPFERR ; [324] NO, BAD FILESPEC
; [324] PARSE PPN AND SFD SPEC. PPN IS BUILT FIRST, IN A7
OPFPPN: PUSHJ SP,GETPP ; [324] GET PROJECT NUMBER IN A3 RIGHTHALF
JRST [JUMPE A3,OPFERR ; [324] DON'T ALLOW EOF AFTER BRACKET
MOVEI A2,']' ; [324] OK, FAKE OURSELVES OUT
JRST .+1] ; [324] AND CONTINUE
HRLZ A7,A3 ; [324] SAVE PROJECT NUMBER IN A7 LEFTHALF
CAIN A2,']' ; [324] END OF ENTIRE FILESPEC?
JRST OPFPP1 ; [324] YES, GO BUILD PPN AND OPEN FILE
PUSHJ SP,GETPP ; [324] NO, GET PROGRAMMER NUMBER
MOVEI A2,']' ; [324] EOF, FAKE OURSELVES OUT
HRR A7,A3 ; [324] MAKE COMPLETE PPN
OPFPP1: JUMPE A7,OPFSFD ; [324] IF PPN IS ZERO, DON'T DEFAULT HERE!
GETPPN A0, ; [324] SOME PPN SPEC WAS GIVEN, GET OUR PPN
TRN ; [324] IGNORE NORMAL RETURN
HLRZ A3,A7 ; [324] GET PROJECT NUMBER
SKIPN A3 ; [324] ZERO?
HLL A7,A0 ; [324] YES, DEFAULT TO OUR PROJECT NUMBER
HRR A3,A7 ; [324] NO, GET PROGRAMMER NUMBER
SKIPN A3 ; [324] ZERO?
HRR A7,A0 ; [324] YES, DEFAULT TO OUR PROGRAMMER NUMBER
MOVEM A7,.PP(DL) ; [324] NO, SAVE COMPLETED PPN
MOVE A1,(SP) ; [324] GET PATH BLOCK ADDR. BACK
MOVEM A7,.PTPPN(A1) ; [324] STORE PPN IN PATH BLOCK
; [324] NOW BUILD SFD LIST
OPFSFD: CAIN A2,']' ; [324] DONE WITH SFD'S?
JRST OPFNOW ; [324] YES, GO OPEN FILE
MOVEI A1,.SFMAX ; [324] NO, LOAD MAX. DEPTH OF SFD'S ALLOWED
OPFSF1: PUSHJ SP,GETSFD ; [324] GET FIRST SFD NAME
JUMPE A7,OPFSF2 ; [324] DONE WITH SFD LIST IF NULL
MOVE A3,(SP) ; [324] GET PATH BLOCK ADDR.
SUBI A3,(A1) ; [324] POINT TO PROPER SFD NAME ENTRY
MOVEM A7,.PTSFD+.SFMAX(A3) ; [324] PLANT SFD NAME
CAIN A2,']' ; [324] LAST NAME IN SFD LIST?
JRST OPFNOW ; [324] YES, GO OPEN FILE
SOJG A1,OPFSF1 ; [324] NO, LOOP UNTIL MAX. SFD NAMES ARE READ
PUSHJ SP,GETCHR ; [324] GET NEXT CHR. AFTER MAX. SFD'S READ
JRST OPFNOW ; [324] HAD BETTER BE EOF
PUSHJ SP,OPFERR ; [324] ELSE BAD FILESPEC
OPFSF2: CAIN A2,',' ; [324] NULL SFD NAME FOUND?
PUSHJ SP,OPFERR ; [324] YES, ILLEGAL FILESPEC
; [324] THE PPN AND SFD'S ARE ALL NOW IN PLACE - OPEN THE FILE.
OPFNOW: MOVE A1,.N(DL) ; [324] RESTORE CHANNEL NUMBER
LRLOAD A2,A5 ; [324] LOAD FILENAME AND EXTENSION
HRLZ A4,.P(DL) ; [324] GET PROTECTION CODE
LSH A4,11 ; [324] MOVE IT OVER
MOVE A5,(SP) ; [324] GET PATH BLOCK ADDR.
PUSHJ SP,OPFILE ; [324] AND GO OPEN FILE
POP SP,A1 ; [324] RESTORE PATH BLOCK ADDR.
PUSH SP,A0 ; [324] SAVE ERROR CODE FROM ALGOTS
SETZ A0, ; [324] RETURN SPACE TO HEAP
PUSHJ SP,GETOWN ; [324] DO IT
POP SP,A0 ; [324] RESTORE ERROR CODE
POP SP,A2 ; [324] GET ADDR. OF I (OR 0)
JUMPE A0,[POP SP,(SP) ; [324] RESTORE LABEL ADDR.
JRST .EXIT(DL)] ; [324] AND EXIT
SUBI A0,100 ; [324] ERROR CODE HAS 100 ADDED TO IT BY OTS
SKIPE .I(DL) ; [324] HAVE ANYPLACE TO PUT ERROR CODE?
XCT .I+1(DL) ; [324] YES, PLANY CODE
POP SP,A2 ; [324] GET LABEL ADDRESS
JUMPN A2,(A2) ; [324] TAKE ERROR EXIT IF ONE EXISTS
MOVE A1,.N(DL) ; [324] ELSE GET CHANNEL NUMBER BACK
IOERR 5,(A1) ; [324] AND GIVE ERROR MESSAGE
JRST .EXIT(DL) ; [324] CONTINUE AT USER'S RISK ONLY
; [324] GET UP TO SIX OCTAL NUMBERS IN A3 RIGHTHALF. USED IN BUILDING PPN.
; [324] DELIMITING CHR. IS LEFT IN A2.
GETPP: MOVEI A0,6 ; [324] MAX. LENGTH OF NUMBER
SETZ A3, ; [324] INIT. A3 TO BUILD SIX DIGIT NUMBER
GETPP1: PUSHJ SP,GETCHR ; [324] GET NEXT CHR.
POPJ SP, ; [324] RETURN IF EOF
CAIN A2,',' ; [324] COMMA?
JRST AOSRET ; [324] YES, END OF PROJECT NUMBER
CAIN A2,']' ; [324] NO, CLOSE BRACKET?
JRST AOSRET ; [324] YES, END OF PROJECT NUMBER
CAIG A2,'7' ; [324] NO, WITHIN RANGE OF
CAIGE A2,'0' ; [324] OCTAL NUMBERS?
PUSHJ SP,OPFERR ; [324] NO, BAD SPEC.
SUBI A2,'0' ; [324] YES, CONVERT TO BINARY
LSH A3,3 ; [324] MAKE ROOM FOR NEW DIGIT
ADD A3,A2 ; [324] CONTINUE BUILDING PROJECT NUMBER
SOJG A0,GETPP1 ; [324] LOOP UNTIL 6 CHRS. READ
PUSHJ SP,GETCHR ; [324] GET NEXT CHR.
JRST AOSRET ; [324] YES, END OF PROJECT NUMBER
CAIN A2,',' ; [324] COMMA?
JRST AOSRET ; [324] YES, END OF PROJECT NUMBER
CAIN A2,']' ; [324] NO, END OF WHOLE FILESPEC?
JRST AOSRET ; [324] YES, END OF PROJECT NUMBER
PUSHJ SP,OPFERR ; [324] NO, BAD FILESPEC
; [324] GET UP TO SIX SFD-TYPE CHRS. IN A7. DELIMITING CHR. IS LEFT IN A2.
GETSFD: MOVEI A0,6 ; [324] MAX. NUMBER OF CHRS. IN SFD NAME
MOVE A3,[POINT 6,A7] ; [324] LOAD SIXBIT ILDB PTR. TO BUILD SFD NAME
SETZ A7, ; [324] CLEAR SFD NAME
GETSF1: PUSHJ SP,GETCHR ; [324] GET CHR.
POPJ SP, ; [324] RETURN IF EOF
CAIN A2,',' ; [324] COMMA?
POPJ SP, ; [324] YES, END OF THIS SFD NAME
CAIN A2,']' ; [324] NO, CLOSE BRACKET?
POPJ SP, ; [324] YES, END OF WHOLE FILESPEC
CAIG A2,'Z' ; [324] OUTSIDE RANGE OF
CAIGE A2,'0' ; [324] LEGAL SFD NAME CHRS.?
PUSHJ SP,OPFERR ; [324] YES, BAD FILESPEC
CAILE A2,'9' ; [324] WITHIN RANGE OF
CAIL A2,'A' ; [324] GOOD CHRS.?
TRNA ; [324] YES, SKIP
PUSHJ SP,OPFERR ; [324] NO, BAD FILESPEC
IDPB A2,A3 ; [324] CONTINUE BUILDING SFD NAME
SOJG A0,GETSF1 ; [324] LOOP UNTIL SIX CHRS. ARE READ
PUSHJ SP,GETCHR ; [324] GET NEXT CHR.
POPJ SP, ; [324] RETURN IF EOF
CAIN A2,',' ; [324] COMMA?
POPJ SP, ; [324] YES, END OF THIS SFD NAME
CAIN A2,']' ; [324] NO, CLOSE BRACKET?
POPJ SP, ; [324] YES, END OF WHOLE FILESPEC
PUSHJ SP,OPFERR ; [324] NO, BAD FILESPEC
; [324] GET SIXBIT BYTE SUBROUTINE - RETURNS THE NEXT SIXBIT CHARACTER OF
; [324] THE FILESPEC IN A2. THE CHR. IS GUARANTEED TO BE A LEGITIMATE
; [324] SIXBIT FILESPEC-TYPE CHR. (UPPERCASE, ALPHANUMERIC, COMMA, OPEN
; [324] OR CLOSE BRACKET, OR PERIOD).
; [324]
; [324] RETURN: +1 END OF FILESPEC STRING
; [324] +2 NORMAL, A2/ SIXBIT CHR.
; [324]
; [324]
GETCHR: SOJGE A10,.+2 ; [324] KEEP CHR. COUNT - DONE?
POPJ SP, ; [324] YES, RETURN
ILDB A2,A4 ; [324] NO, GET NEXT ASCII BYTE
CAILE A2,"]" ; [324] LOWER CASE?
SUBI A2,"a"-"A" ; [324] MAYBE, CONVERT TO UPPER CASE
CAILE A2,"[" ; [324] NO, ABOVE MAX. LIMIT FOR LEGAL CHR.?
CAIN A2,"]" ; [324] CHECK THIS CHR. TOO
TRNA ; [324] SKIP IF GOOD SO FAR
PUSHJ SP,OPFERR ; [324] ELSE BAD CHR.
CAIE A2,"." ; [324] IS THIS A DOT?
CAIN A2,"," ; [324] OR COMMA?
JRST GETCH1 ; [324] YES, GOOD CHR.
CAIGE A2,"0" ; [324] NO, BELOW ASCII ZERO?
PUSHJ SP,OPFERR ; [324] YES, BAD CHR.
CAILE A2,"9" ; [324] LAST CHECK FOR GOOD CHR.
CAIL A2,"A" ; [324] BETWEEN ASCII "9" AND "A"?
TRNA ; [324] NO, CHR. IS GOOD AT LAST
PUSHJ SP,OPFERR ; [324] YES, CHR. IS BAD
GETCH1: SUBI A2,"A"-'A' ; [324] CONVERT TO SIXBIT
AOSRET: AOS (SP) ; [324] PREPARE FOR GOOD RETURN
POPJ SP, ; [324] RETURN WITH GOOD FILESPEC CHR. IN A2
OPFERR: MOVE A1,.N(DL) ; [324] BAD FILESPEC, GET CHANNEL NUMBER BACK
IOERR 16,(A1) ; [324] AND GIVE THE ERROR (STACK IS WRONG)
JRST .EXIT(DL) ; [324] CONTINUE AT USER'S RISK ONLY
REP 17/168 ;05C30
SETO A2, ; PRESET ANSWER
WIT
MOVEI A2,1 ; [336] PRESET ANSWER
REP 21/168 ;05C31
AOJA A2,INFO1 ; NO
WIT
LIBERR 10, ; [336]
REP 26/168 ;05C32
INFOTB: HRRZ A2,.JBREL ; 0 -CORE SIZE
WIT
INFOTB: ADD A2,.JBREL ; [336] 0 - CORE SIZE (.JBREL LEFT MUST BE 0)
REP 31/168 ;05C33
PUSHJ SP,INFPRC ; 5 - PROCESSOR (1=KA,2=KI,3=KL)
WIT
LDB A2,[POINT 2,DB,1] ; [336] GET PROCESSOR TYPE (1=KA,2=KI,3=KL)
DEL 41/168 ;05C34
INFPRC: HLRZ A2,DB
LSH A2,-^D16 ; GET OMC BITS (PROCESSOR TYPE)
AOS 2(A2) ; KLUDGE - IF 0, MAKE IT 1 !
POPJ SP,
REP 42/169 ;05C35
MOVE A2,[
XWD %CNMON,.GTCNF]
WIT
MOVE A2,[%CNMON,,.GTCNF]
REP 47/169 ;05C36
ADD A2,[
POINT 7,MONTAB-2] ; GET POINTER TO ASCII MONTH
MOVE A0,.LU(DL) ; RECOVER # CHARS (3 OR MANY)
WIT
ADD A2,[POINT 7,MONTAB-2] ; GET POINTER TO ASCII MONTH
MOVE A0,.LU(DL) ; RECOVER # CHARS (3 OR MANY)
REP 58/169 ;05C37
MOVE A2,[
XWD %CNYER,.GTCNF]
WIT
MOVE A2,[%CNYER,,.GTCNF]
REP 15/170 ;05C38
HRLI A1,440700 ; MAKE BYTE-POINTER TO IT
MOVE A2,[
STRDYN!STRPRC,,^D8]
LRSTOR A1,.EXIT+1(DL) ; THE ANSWER (8 CHARS, DYNAMIC, RESULT-OF-PROC)
MOVEI A4,":" ; GET SEPARATOR
MOVE A2,[
XWD %CNHOR,.GTCNF]
PUSHJ SP,TIME2 ; GET HOUR & CONVERT TO ASCII
IDPB A4,A1 ; DEPOSIT SEPARATOR
MOVE A2,[
XWD %CNMIN,.GTCNF] ; MINUTE
PUSHJ SP,TIME2
IDPB A4,A1
MOVE A2,[
XWD %CNSEC,.GTCNF] ; SECOND
WIT
HRLI A1,(POINT 7,) ; [334] MAKE BYTE-POINTER TO IT
MOVE A2,[STRDYN!STRPRC,,^D8]
LRSTOR A1,.EXIT+1(DL) ; THE ANSWER (8 CHARS, DYNAMIC, RESULT-OF-PROC)
MOVEI A4,":" ; GET SEPARATOR
MOVE A2,[%CNHOR,,.GTCNF]
PUSHJ SP,TIME2 ; GET HOUR & CONVERT TO ASCII
IDPB A4,A1 ; DEPOSIT SEPARATOR
MOVE A2,[%CNMIN,,.GTCNF] ; MINUTE
PUSHJ SP,TIME2
IDPB A4,A1
MOVE A2,[%CNSEC,,.GTCNF] ; SECOND
REP 12/173 ;05C39
HLRZ A0,%SYS17(DB)
WIT
HLRZ A0,%UUOTM(DB) ; [320] PICK UP TRAP NUMBER
SUM 66881