|
DataMuseum.dkPresents historical artifacts from the history of: Philips Data Systems |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Philips Data Systems Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 17530 (0x447a)
Notes: pts_type(SC)
Names: »DEVGAC.SC«
└─⟦48601905a⟧ Bits:30009668 Philips computer tape "600121"
└─⟦this⟧ »S:DE/DEVGAC.SC«
└─⟦d2a299635⟧ Bits:30009698 Philips computer tape "600415"
└─⟦this⟧ »S:DE/DEVGAC.SC«
IDENT DEVGAC REL 10.0 80-04-11
80-04-14/JAER
*
* THIS PROGRAM-MODUL CONTAINS ENTRIES TO THE DIFFERENT
* CONVERTIONS THAT OCCURS IN THE FORMAT GENERATION
*
DDUM DEDDIV
PDIV
*
ENTRY VGACNT VAL-GEN-ACC-STRING-CONTROL
*
ENTRY CNTNUM CONTROL OF VARIABLE INDEX
*
EXT DERROR ERRORMESSAGE
*
EXT CMPIND COMPARE INDEX (DIMENSION)
*
EXT EMPTYT CHECK EMPTY ITEM
*
* KEYTABLES
*
* USAGE: DATA ENTRY SCREEN
*
CLR EQU X'8F' CLEAR
CAN EQU X'91' CANCEL
RET EQU X'92' RETURN
CFW EQU X'86' CURSOR FORWARD
*
DEKTAB4 KTAB CLR,CAN,RET,CFW
*
EJECT
*
* VALIDATION- GENERATION- AND ACCUMULATION CONTROL
*
* THIS MODULE STEERS THE PROCESSING OF THE THREE DIFFERENT FUNCTIO
*
* INPUT PARAMETERS:
* FMTWK(W10) = NUMBER OF CHARACTERS STRING1
* FMTWK(W11) = NUMBER OF CHARACTERS STRING 2
*
* WORK ITEMS:
* FMTWK(W12) = CALCULATE TOTAL NUMBER OF CHARCTE
* DEBIN3 = POINTER FUNC,-TEXT-STRING
* DEBIN4 = POINTER CHARACTER-STRING
* DEBINW2 = FUNCTION-INDEX
* = 1 = VALIDATION
* = 2 = GENERATION
* = 3 = ACCUMULATION
* STRG10A = FUNCTION TEXTS
* STR1A = WORK
* BIN16 = WORK
*
* OUTPUT PARAMETERS:
* 'CR' = 0 = OK
* = 1 = NOT OK
* DEBINW1 = ERRORPOSITION IN CHARACTERSTRING
* DEBINW4 = FIELDNR WHEN ERROR FOUND
VGACNT PROC
CALL EMPTYT,FORTAB(W1) CHECK IF 1ST LINE EMPTY
AFTER CORRECTION
BOK VGAC00 NOT EMPTY
MOVE FMTWK(W10),W0 EMPTY => NO CHARS
VGAC00
CALL EMPTYT,FORTAB(W2) CHECK IF 2ND LINE EMPTY
AFTER CORRECTION
BOK VGAC03 NOT EMPTY
MOVE FMTWK(W11),W0 EMPTY => NO CHARS
VGAC03
MOVE FMTWK(W12),FMTWK(W10) LOAD NUMB CHARS 1
ADD FMTWK(W12),FMTWK(W11) ADD NUMB CHARS 2
CBE FMTWK(W10),=X'50',VGAC10 JUMP IF MAX FILLED
CBE FMTWK(W11),W0,VGAC10 JUMP IF STRG2 EMPTY
EJECT
*
* 1ST STRING ('FORTAB(W1)') NOT MAX FILLED AND 2ND STRING
* PARTIAL FILLED.
* -ACTION: DELETE EMPTY POSITIONS OF 1ST STRING
* WITH HELP OF THE REDEFINED ITEM JOBSPC
* FINALLY DISPLAY IT IN SEQUENS AGAIN
*
MOVE BIN16,=X'50' LOAD 80 AS MAX LENGTH
SUB BIN16,FMTWK(W10) COMPUTE SIZE OF EMPTY CHARS
DLETE JOBSPC,FMTWK(W10),BIN16 DELETE EMPTY CHARACTERS
MOVE BIN15,=X'A0' LOAD WITH MAXLENTH
SUB BIN15,BIN16 COMPUTE STARTP]OS
XCOPY JOBSPC,BIN15,BIN16,DEINPUT,W0 FILL REST WITH X'00'
CBL FMTWK(W12),=X'51',VGAC05
MOVE FMTWK(W11),FMTWK(W12)
SUB FMTWK(W11),=X'50'
MOVE FMTWK(W10),=X'50'
B VGAC10
VGAC05
MOVE FMTWK(W10),FMTWK(W12)
MOVE FMTWK(W11),W0
EJECT
VGAC10
MOVE DEBIN4,W0 STARTPOS IN JOBSPC
MOVE STR1A,=C'#' WORK:=FUNCTIONSEPARATOR
MOVE STRG10A,=C'V:G:A:' LOAD FUNCTION-TEXTS
MOVE DEBIN3,DEBIN4 LOAD ACTUAL POS
MATCH JOBSPC,DEBIN3,W1,STR1A,W0,W1 1ST POS = #
BNOK VGAC90 JUMP IF ERROR
ADD DEBIN4,W1 NEXT POSITION
VGAC15
MOVE DEBINW2,W0 FUNCTIONINDEX:=0
MATCH STRG10A,DEBINW2,W6,JOBSPC,DEBIN4,W2
BNOK VGAC90 JUMP IF NOT FOUND
MOVE FBIN1,DEBINW2 SAVE FUNCTEXT POINTER
ADD DEBINW2,W2
DIV DEBINW2,W2
TBF BOOL6,VGAC20 JUMP IF ORDINARY FORMAT
CBE DEBINW2,W3,VGAC90 ACC NOT ALLOWED IN BALFORM
VGAC20
ADD DEBIN4,W2 NEXT POSITION FUNCCODE
MOVE DEBIN3,DEBIN4 LOAD ACTUAL POSITION
MOVE DEBIN2,FMTWK(W12) LOAD TOTAL NUMB OF CHARS
SUB DEBIN2,DEBIN4 NUMB OF CHARS TO MATCH
MATCH JOBSPC,DEBIN3,DEBIN2,STRG10A,FBIN1,W2 JUST ONE FUNC EACH
BNOK VGAC35 NO MORE OF SAME FONC OK
MOVE DEBIN4,DEBIN3 RESTORE ERROR-POSITION
SUB DEBIN4,W1 ADJUST
B VGAC90
EJECT
VGAC35
MOVE DEBIN3,DEBIN4 LOAD ACTUAL POSITION
MOVE STR1A,=C'#'
MATCH JOBSPC,DEBIN3,DEBIN2,STR1A,W0,W1 NEXT
BOK VGAC40 OK NEXT # FOUND
MOVE DEBIN3,FMTWK(W12) LOAD WITH LAST POSITION
VGAC40
MOVE FMTWK(DEBINW2),DEBIN3 LOAD ENDPOS OF CONTROL
PERF CNTNUM,JOBSPC,FMTWK,DEBINW2 CONTROL FUNCTION
BNOK VGAC90 JUMP IF NOT OK
CBNE DEBINW2,W3,VGAC45 JUMP IF NOT ACC
SET ACKUM
VGAC45
CBE DEBIN4,FMTWK(W12),VGAC99 JUMP IF END OF STRING
ADD DEBIN4,W1 NEXT POSITION
B VGAC15
EJECT
VGAC90
TBF BOOL6,VGAC92 JUMP IF ORDINARY FORMAT
ERASE 0,W13,W14 ERASE 2 LINES
DISPLAY 1,W6,W7 REDISPLAY
MOVE DEBINW4,W6 FIELD TO MAKE CURRENT = 6
B VGAC94
VGAC92
ERASE 0,W17,W18 ERASE 2LINES ON SCREEN
DISPLAY 1,W12,W13 REDISPLAY
MOVE DEBINW4,W12 FIELD TO MAKE CURRENT =19
VGAC94
MOVE BIN16,W1 1ST LINE CURRENT
MOVE BIN15,=X'50' LOAD SIZE = 80
MOVE DEBINW1,DEBIN4 STORE ACTUAL POSITION
ADD DEBINW1,W1 ADJUST FOR CURSOR
CBL DEBIN4,=X'51',VGAC95 < = 80
SUB DEBINW1,BIN15 ADJUST POINTER 2ND LINE
ADD DEBINW4,W1 FIELD TO MAKE CURRENT = +1
ADD BIN16,W1 2ND LINE CURRENT
VGAC95
GETFLD 0,DEBINW4,DEBINW3
MOVE DEBINW4,W6 ILLEGAL VALUE
PERF DERROR,DEKTAB4
XCOPY DEINPUT,W0,BIN15,FORTAB(BIN16),W0 RELOAD FALSE LINE
CMP W1,W0 CR /= 0
B VGACEX
VGAC99
MOVE FMTWK(W10),W0 NUMB OF CHARS STRG1:=0
MOVE FMTWK(W11),W0 NUMB OF CHARS STRG2:=0
CMP W1,W1 CR = 0
VGACEX
RET
PEND
EJECT
*
* CONTROL VARIABLE NUMBER (INDEX)
*
* INPUT PARAMETERS (FORMAL):
* CHNUM = NUMBER OF INPUT CHARACTERS
* WIND = INDEX TO CORRESPONDING CHAR-
* DEBIN4 = STRG TO CONTROL
*
* INPUT PARAMETERS:
* VALSTR = VAL/GEN/ACC---CHARACTERSTRIN
* DEBIN4 = POINTER CHARACTER-STRING
*
* WORKITEMS : DEBIN2 = LENGTH OF LITERAL STRING
* DEBIN3 = NUMBER OF LITERALS
* BIN15 = LENGTH OF VALSTR
* BIN16 = MATCHING-POINTER 'VALSTR'
*
* OUTPUT PARAMETERS :
* 'CR' = 0 , OK
* /=0 , NOT OK
* DEBINW1 = ERROR-POSITION IN INPUT-BUFF
*
************************************************************************
CNTNUM PROC WSTRG,CHNUM(),WIND
MOVE BIN15,=W'31' LOAD LENGTH OF VALSTR
CLEAR BOOL8 F=NO TREASPASSING OF DUPL
CLEAR BOOL4
EJECT
CNT00
MOVE BIN16,W0 MATCHINDEX:=0
MATCH VALSTR,BIN16,BIN15,WSTRG,DEBIN4,W1
BNOK CNNOKL
IB WIND,CNTV,CNTG,CNTA,CNTD
CNTV
CBE BIN16,W0,CNTM JUMP IF 'M'
IB BIN16,CNT0,CNT0,CNT0,CNT0, 1-4 C
CNT3,CNT2,CNT0,CNT2,CNT2, 5-9 C
CNT1,CNT3,CNT2,CNT2,CNT0, 10-14 C
CNT0,CNT0,CNT0,CNT0,CNT0, 15-19 C
CNT0,CNT0,CNT0,CNTLL,CNNOKL, 20-24 C
CNT3,CNTF,CNTF,CNT0 26-28
B CNNOKL
EJECT
CNTG GENSTRINGCONTROL
CBE BIN16,W0,CNNOKL M NOT ALLOWED
IB BIN16,CNT0,CNT0,CNT0,CNT0, 1-4 C
CNT3,CNT2,CNT0,CNT2,CNT2, 5-9 C
CNT1,CNT3,CNT2,CNT2,CNT0, 10-14 C
CNT0,CNT0,CNT0,CNT0,CNT0, 15-19 C
CNT0,CNT0,CNT0,CNTL,CNNOKL, 20-24 C
CNTCC,CNNOKL,CNNOKL,CNT0,CNTLP, 25-29 C
CNTRP 30
B CNNOKL
EJECT
CNTA ACCSTRINGCONTROL
CBE BIN16,W0,CNNOKL M NOT ALLOWED
IB BIN16,CNT0,CNT0,CNT0,CNT0, 1-4 C
CNT3,CNT2,CNT0,CNTCC,CNT2, 5-9 C
CNT1,CNT3,CNT2,CNT2,CNT0, 10-14 C
CNT0,CNT0,CNT0,CNT0,CNT0, 15-19 C
CNT0,CNT0,CNT0,CNTL,CNT0, 20-24 C
CNNOKL,CNNOKL,CNNOKL,CNNOKL,CNTLP 25-29 C
CNTRP 30
B CNNOKL
EJECT
CNTD DUPLSTRINGCONTROL
TBT BOOL8,CNNOKL JUMP IF DUPL PASSED
SET BOOL8 DUPL PASSED ONCE
CBE BIN16,W0,CNNOKL M NOT ALLOWED
IB BIN16,CNNOK,CNNOK,CNNOK,CNNOK 1-4 C
CNT0,CNNOK,CNNOK,CNT2,CNT2 5-9 C
CNT1,CNT3,CNT2 10-12
CNNOKL
B CNNOK
CNTLL
B CNTL
EJECT
CNTM M=MESSAGE SPLIT
CBNL DEBIN4,CHNUM(WIND),CNNOKL NOT OK IFNOT LESS ENDPOS
ADD DEBIN4,W1 NEXT POS
MOVE DEBIN3,DEBIN4 LOAD ACTUAL POSITION
MATCH WSTRG,DEBIN3,W1,VALSTR,W23,W1 M'...' ?
BOK CNTL M'......'
SUB DEBIN4,W1 ADJUST
B CNT2 M99
EJECT
CNTCC CONDITIONAL GEN/ACC
ADD DEBIN4,W1 NEXT POD0S
CBE DEBIN4,CHNUM(WIND),CNNOKL NOT OK IF EOL-FOUND
MOVE DEBIN2,W29
MATCH VALSTR,DEBIN2,W1,WSTRG,DEBIN4,W1 CHECK IF ( CHAR
BOK CNTLP LEFT PARENTESIS
CBE WIND,W2,CNNOKL G OR A NOT ALLOWED IN GEN
SUB DEBIN4,W1 ADJUST FOR ORDIN ACC
B CNT2
*
*
*
CNTLP LEFT PARENTHESIS
SET BOOL4 T=COND GEN/ACC FOUND
BNZ CNNOKL
B CNT0
*
*
*
CNTRP RIGHT PARENTHESIS
CLEAR BOOL4 F=END OF COND GEN/ACC FOUND
BNZ CNT0
B CNNOKL
EJECT
*
* CNT0 NO CONTROL
*
CNT0
ADD DEBIN4,W1 NEXT POS
CBE DEBIN4,CHNUM(WIND),CNTOK JUMP IF END OF LINE FOUND
B CNT00 GO ON
*
* CNT1 CONTROL 1 BYTE
*
CNT1
PERF DIGCHK,WSTRG,CHNUM,WIND,W1 DIGIT CHECK
BNOK CNNOK JUMP IF NOT OK
CALL CMPIND,DEBIN2,USEV(W1)
BNZ CNNOK OUT OF RANGE
B CNT0 GO ON
EJECT
*
* CNT2 CONTROL OF 2 BYTES
* -M,-L,-A,-S,-T,-C
*
CNT2
PERF DIGCHK,WSTRG,CHNUM,WIND,W2 DIGIT CHECK
BNOK CNNOK JUMP IF NOT OK
CBE BIN16,W8,CNT2B A 10
CBE BIN16,W9,CNT2C S 10
CBE BIN16,W12,CNT2E T --
*
* M,L,C
*
CBL DEBIN2,W0,CNNOK <00 NOT OK
CBG DEBIN2,=W'99',CNNOK >99 NOT OK
B CNT2F
*
* A
*
CNT2B
CALL CMPIND,DEBIN2,ACK(W1)
BNZ CNNOK OUT OF RANGE
B CNT2F
*
* S
*
CNT2C
CALL CMPIND,DEBIN2,SYSV(W1)
BNZ CNNOK OUT OF RANGE
B CNT2F
CNT2E
CBL DEBIN2,W1,CNNOK <01 NOT OK
CBG DEBIN2,=W'94',CNNOK >94 NOT OK
MOVE DEBIN3,DEBIN4 LOAD WORKPOSITIONER
ADD DEBIN3,W2 ADJUST WORKPOSITIONER
CBG DEBIN3,CHNUM(WIND),CNT0 JUMP IF OVERFLOW
MATCH WSTRG,DEBIN3,W1,VALSTR,W18,W1 NEXT POS : ?
BNOK CNT2F
ADD DEBIN4,W2 ADJUST POINTER IF OK
MOVE BIN16,W6 SIMULATE L TO CHECK VS-IND
B CNT2
CNT2F
ADD DEBIN4,W1 NEXT POS
B CNT0 GO ON
EJECT
*
* CNT3 CONTROL OF 3 BYTES -D,-F
*
CNT3
TBT BOOL6,CNNOK -D,-F,-G NOT OK IN BALANCE
PERF DIGCHK,WSTRG,CHNUM,WIND,W3 DIGIT CHECK
BNOK CNNOK
CBL DEBIN2,W0,CNNOK < 0 NOT OK
CBG DEBIN2,=W'999',CNNOK > 999 NOT OK
CBE BIN16,W5,CNT3A JUMP IF 'D'
B CNT3B JUMP IF 'F' OR 'G'
CNT3A
CBNL BIN10,DEBIN2,CNT3B FXX NOT < DXX OK
B CNNOK JUMP IF ERROR
CNT3B
ADD DEBIN4,W2
B CNT0 GO ON
EJECT
*
* CNTL CONTROL LITERAL
*
CNTL
ADD DEBIN4,W1
CBNL DEBIN4,CHNUM(WIND),CNNOK JUMP, IF OFERFLOW
MOVE DEBIN2,CHNUM(WIND) SAVE ENDPOS
SUB DEBIN2,DEBIN4 NUMB OF CHRS TO MATCH
MOVE DEBIN3,DEBIN4 STARTPOS IN MATCH
MATCH WSTRG,DEBIN3,DEBIN2,VALSTR,W23,W1 MATCH NEXT '
BNOK CNNOK
SUB DEBIN3,DEBIN4 =NUMB OF LIT-CHARS
CBNG DEBIN3,W0,CNNOK < 1 NOT OK
CBNL DEBIN3,W64,CNNOK >63 NOT OK
CBE BIN16,W26,CNTLFK JUMP IF COND FORM CHANGE (R)
CBE BIN16,W27,CNTLFK JUMP IF COND FORM CHANGE (N)
B CNTLOK
CNTLFK
CBG DEBIN3,W6,CNNOK FORMAT NAME > 6 NOT OK
CNTLOK
ADD DEBIN4,DEBIN3 ADJUST NEXT POS
B CNT0 GO ON
EJECT
*
* CNTF CONTROL FORMATNAME-LITERAL
*
CNTF
ADD DEBIN4,W1 ADJUST POINTER POSITION
CBNL DEBIN4,CHNUM(WIND),CNNOK JUMP IF OVERFLOW
B CNTL JUMP LITERAL CONTROL
EJECT
CNNOK
CBNE WIND,W4,CNNCR JUMP IF NOT DUPL
MOVE DEBINW1,DEBIN4 RESTORE ERROR-POSITION
ADD DEBINW1,W1 ADJUST FOR POINTER IN LDES
MOVE DEBINW4,W6
PERF DERROR,DEKTAB4 'ILLEGAL VALUE'
CNNCR
CMP W1,W0 SET CR
B CNRT
CNTOK
TBT BOOL4,CNNOK NOT OK IF COND GEN/ACC NOT CONCLUDED
CMP W1,W1 CLEAR CR
CNRT
RET
PEND
EJECT
*
* THIS PROCEDURE CHECKS IF RIGHT NUMBER OF REAL DIGITS
* HAVE BEEN KEYED IN FOR THE CORRESPONDING FUNCTION
* IN VAL-, GEN- AND ACC-STRING
*
* INPUT PARAMETERS (FORMAL) : WSTRG = WORKSTRING CONTAINS DIGIT
* CHNUM = ENDPOSITION IN WSTRG FOR
* WIND = INDEX TO CHNUM
* NUMB = NUMBER OF DIGITS TO CHECK
*
* INPUT PARAMETERS : DEBIN4 = CURRENT POSITION POINTER
*
* USED PARAMETERS : DEBIN3 =WORKAREA
* STR6A = WORKAREA
* BCD13A = WORKAREA
*
* OUTPUT PARAMETERS : DEBIN2 = CHECKED DIGITS BINARY STO
* DEBIN4 = POSITION POINTER ADJUSTED
* CR = 0 = OK
* CR/= 0 = NOT OK
************************************************************************
DIGCHK PROC WSTRG,CHNUM(),WIND,NUMB
ADD DEBIN4,W1 ADJUST POINTER POSITION
MOVE DEBIN3,DEBIN4 SAVE POINTER ADRESS
ADD DEBIN3,NUMB ADD NUMB OF CHARACTERS
CBG DEBIN3,CHNUM(WIND),DIGC99 JUMP IF OVERFLOW
MOVE STR6A,HEX00 INITIALIZE:=00000000
XCOPY STR6A,W0,NUMB,WSTRG,DEBIN4
MOVE BCD13A,STR6A STR=>BCD
MOVE DEBIN3,W0
EDSUB STR6A,DEBIN3,FSCONV
CMP DEBIN3,NUMB CHECK IF EQUAL = OK
MOVE DEBIN2,BCD13A BCD=>BIN
DIGC99
RET
PEND
EJECT
FSCONV FRMT
FMEL 'AAAAAA',BCD13A
FMEND
END