|
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: 14196 (0x3774)
Notes: pts_type(SC)
Names: »PTSDE.SC«
└─⟦5c22ed822⟧ Bits:30009675 Philips computer tape "600209"
└─⟦this⟧ »DEN10/PTSDE.SC«
└─⟦bf903a231⟧ Bits:30009665 Philips computer tape "600109"
└─⟦this⟧ »DEN10/PTSDE.SC«
IDENT PTSDE REL 10.0 80-04-11 UPD 81-02-27 UPD 80-11-17/DALI UPD 80-10-22/DALI UPD 80-04-24/DALI 80-03-24/DALI DDUM DEDDIV PDIV ENTRY PTSDE * * ENTRIES FOR APPLICATIONAL HANDLING * ENTRY DEAPPL ENTRY DEAOK0 ENTRY DEAOK1 ENTRY DEAOK2 ENTRY DEAOK4 ENTRY DEANOK ENTRY DETCHK ENTRY DEPMSK ENTRY DEPRUT ENTRY ATTPRT ENTRY DETPRT ENTRY ATTDEV * ENTRY DEFIND ROUTINE FINDING FIELDINDEX EJECT * * EXTERNAL REFERENCES TO SCREEN * EXT DECLRA EXT DECLRS EXT DECLRN * * EXTERNAL REFERENCES TO DATA-ENTRY MODES * EXT DE10ST SUPERVISORY FUNCTIONS EXT DE20ST FORMAT DEFINITION EXT DE30ST JOB DEFINITION EXT DE40ST ENTRY MODE EXT DE50ST SEARCH/CORRECTION EXT DE60ST VERIFICATION EXT DE70ST CONVERSION * * EXTERNAL REFRERENCES FOR DATA-ENTRY FILES * EXT OPCL OPEN SYSTEM-FILE EXT CHANFC CHANGE FILECODE EXT GETVOL GET VOLUMENAME * * EXTERNAL REFERENCES FOR SPECIAL ROUTINES * EXT DEPOOL TESTVARIANT EXT DERR EXT SAVE EXT RESTOR EXT ATTBUF EXT TESTB EXT MSKOUT EXT COND SET/CLEAR CONDITION REG. EXT UPDBOL EXT POOLA EXT GETIND GETINDEX VARIABLE/LENGTH EJECT * * EXTERNAL REFERENCES TO APPL HANDLING ROUTINES * EXT DEAP1A EXT DEAP2A EXT DEAP3A EXT DEAP5A EXT DEAP7A * * INCLUDE DELITT EJECT * * START OF PROGRAM * PTSDE CALL SAVE,W0,W16,PWBDB4 SAVE ORIGINATE ADRESSES TO WORKBLOCKS AND DESCRIPTORS CALL ATTBUF,DEDSSCRN,STATSH ATTACH BUFFERS FOR THE CALL ATTBUF,DEDSPRT,STATSH SCREEN AND PRINT DSETS SET UORG BNZ FINISH CALL GETIND,RBUF,RBUFLN,DEBINW1 CALL POOLA ADJUST POOLS FINISH DEST SET BOOL1 PART OF FORMAT DISPLAY DEST00 ATTFMT F00ST SET DEPROMPT PROMPT-TEXTS DISPLAY STA050 CLEAR DECHANGE PERF DECLRA STA100 IB DEBINW2,CANCEL,RETUR,ENTER MOVE DEBINW4,W0 PERF DERR B STA100 CANCEL CLEAR DEPROMPT B STA050 * RETUR ATTFMT F00RET SET DEPROMPT PERF DECLRA B DEST * ENTER CBE BIN1,W0,DEST PERF OPCL,W1 BOK ENT4 BNERR ENT32 MOVE DEBINW1,W0 PERF DERR B STA100 ENT32 MOVE DEBINW1,W0 PERF DERR IB DEBINW2,ENT52,ENT52,ENT5 MOVE DEBINW4,W0 B ENT32 ENT4 MOVE MODE,MODTAB(BIN1) PERFI BIN1,DE10ST,DE20ST,DE30ST,DE40ST, C DE50ST,DE60ST,DE70ST,DE00ER,DE00ER,DE00ER PERF DEPMSK ENT5 CALL RESTOR,W0,W16,PWBDB4 RESTORE ORIGINATE ADRESSES TO WORKBLOCKS AND DESCRIPTORS CLEAR BOOL1 CBNE BIN1,W0,ENT4 ENT52 PERF OPCL,W2 BOK ENT6 PERF DERR ENT6 CBNE BIN2,W0,DEST00 B DEST * DE00ER PROC MOVE BIN1,W0 RET PEND EJECT * * APPLICATION ROUTINE * DEAPPL PROC CBG DEBINW3,=W'100',DEAPP0 IB DEBINW3 C DEAPRTES C DEAUNIT C DEAJOB C DEABATCH C DEAENKEY C DEUNENT B DEAER6 DEAPRTES CHECK OF NEW PRNUM MOVE BCD13A,DEINPUT MOVE BIN1,BCD13A MOVE BIN2,BIN1 SAVE KEYED INPUT DIV BIN1,W8 XCOPY DEBINW4,W0,W2,PROGNR,BIN1 PROGRAMNR MUL BIN1,W8 SUB BIN2,BIN1 CALL TESTB,DEBINW4,BIN2 LOOK IF EXISTING BZ DEAPRERR JUMP IF NOT MOVE BIN1,W0 CALL UPDBOL,BIN1 CLEAR ALL BOOLS MOVE BCD2A,BCD13A MOVE BIN2,BCD2A MOVE BCD3A,W10 DIV BCD13A,BCD3A MOVE BIN1,BCD13A PERF DEPMSK DEAENKEY MOVE DEBINW3,W0 MOVE DEBINW2,W17 B DEAOK0 DEAPRERR MOVE DEBINW4,W7 B DEANOK * * ATTFMT FORMN DUMMY INSTRUCTION ATTFMT FORMA - " - ATTFMT VSET EJECT DEUNENT MOVE DEBINW2,W17 DEAUNIT MOVE BCD2A,DEINPUT CHECK IF SPECIFIED MOVE DEBINW4,BCD2A UNIT NUMBER IS MOVE FILINDUS,DEBINW4 XCOPY DEBINW4,W1,W1,DUNIT,FILINDUS GET FILECODE ADD FILINDUS,W2 CBE FCOUNTER(FILINDUS),W0,DEAUN0 ERASE 1,W2,W2 MOVE TABLE,FVOLNAME(FILINDUS) B DEAUN5 DEAUN0 CALL CHANFC,DISK,DEBINW4 CHANGE FILECODE CALL GETVOL,DISK,RBUF,STRG10A,DEBINW4 GET VOLUMENAME CBE DEBINW4,W0,DEAUN4 JUMP IF OKEY MOVE DEBINW4,W9 NOT FOUND B DEANOK DEAUN4 ERASE 1,W2,W2 MOVE TABLE,STRG10A MOVE FVOLNAME(FILINDUS),TABLE DEAUN5 DISPLAY 2,W1,W1 B DEAOK0 DEAUN2 MOVE DEBINW4,W7 B DEANOK DEAJOB CHECK IF SPECIFIED MOVE STSAVE(W1),DEINPUT JOBNAME EXISTS ON USERFILE B DEAOK0 DEABATCH CHECK IF SPECIFIED BATCH EXISTS ON USERFILE MOVE STSAVE(W2),DEINPUT B DEAOK0 EJECT * * JUMP TO APPL HANDLING IN CORRESPONDING PROGRAM * DEAPP0 SUB DEBINW3,=W'100' MOVE DEBINW4,PRNUM SAVE PRNNUM MOVE BCD3A,W10 LOAD +10 DIV PRNUM,BCD3A GET MODE TENTH FIGURE MOVE DEBIN1,PRNUM LOAD MODE BINARY MOVE PRNUM,DEBINW4 RESTORE PRNUM MOVE BCD2A,PRNUM GET MODE LEVEL ONETH FIG MOVE DEBINW4,BCD2A LOAD MODE LEVEL BINARY IB DEBIN1 JUMP MODE APPL C DEAP1A C DEAP2A C DEAP3A C DEAER6 C DEAP5A C DEAER6 C DEAP7A C DEAER6 B DEAER6 EJECT * RETURNS FROM APPL HANDLING IN CORRESPONDING PROGRAM * DEAOK0 MOVE DEBINW3,W0 RET DEAOK1 MOVE DEBINW3,W1 RET DEAOK2 MOVE DEBINW3,W2 RET DEAOK4 MOVE DEBINW3,W4 RET DEAER6 MOVE DEBINW4,W6 ILLEGAL VALUE DEANOK MOVE DEBINW3,W3 RET PEND EJECT * * TABULATION-CHECK ROUTINE * DETCHK PROC TBF DOOL3,DCHKUT MOVE DEBINW3,W2 RET DCHKUT MOVE DEBINW3,W0 RET PEND EJECT ****************************************************************** * THIS PROCEDURE RETURNS THE PROGRAMNUMBER SPLIT INTO TO BINARYS * ****************************************************************** DEPRUT PROC NUM,FIRST,SECOND PBCD NUM PBIN FIRST PBIN SECOND MOVE FIRST,NUM DIV FIRST,W10 MOVE BCD2A,NUM MOVE SECOND,BCD2A RET PEND EJECT **************************************** * THIS PROCEDURE FIX THE PROGRAMMASKS. * **************************************** DEPMSK PROC MOVE PINACC,W0 MOVE PJOBCUR,W0 MOVE PINDFR,W0 MOVE PINDTB,W0 MOVE BIN4,BIN1 SUB BIN4,W1 FIRST DIGIT IN PRNUM BNL DEAPR10 JUMP IF > 00 MOVE KEYMSK,W0 RET DEAPR10 MUL BIN4,W10 ADD BIN4,BIN2 NEXT DIGIT IN PRNUM DIV BIN4,W2 BYTE POS IN PRKEYS MOVE DEBINW3,W0 XCOPY DEBINW3,W1,W1,PRKEYS,BIN4 CALL TESTB,BIN2,W15 LOOK WHICH HALFBYTE BZ DEAPR20 JUMP IF FIRST MOVE DEBINW2,W15 CALL MSKOUT,DEBINW2,DEBINW3 MOVE KEYMSK,DEBINW2 RET DEAPR20 DIV DEBINW3,W16 MOVE KEYMSK,DEBINW3 RET PEND EJECT * * ATTACH DE-PRINTER. SHOULD BE PERFORMED BEFORE ANY PRINTING IS DONE * CONDITION-REGISTER IS SET TO 0 : OKAY * 1 : PRINTER BUSY; * IF THE PRINTER IS BUSY, THE ERROR-INDICATION 11 (IN USE) IS GIVEN IN * IN DEBIN1, THE TERMINALNUMBER OF THE CURRENT TASK IS RGIVEN FOR EV P * ATTPRT PROC MOVE DEBINW4,=X'0036' PERF ATTDEV,DEBINW4 RET PEND ATTDEV PROC FC CALL CHANFC,DEDSPRT,FC MOVE DEBINW4,W0 DSC0 .NW,DEDSPRT,TSTAT CHECK IF PRINTER AVAILABLE DELAY W4 WAIT FOR 4/100 SEC TESTIO DEDSPRT BNZ NOTOK WAIT DEDSPRT XSTAT DEDSPRT,DEBINW4 CBE DEBINW4,W0,OK B ATT10 NOT OK NOTOK ABORT DEDSPRT B ATT10 NO PRINTER OK DSC1 DEDSPRT,ATTACH,W20 BOK OUT MOVE DEBINW4,W11 B OUT ATT10 MOVE DEBINW4,=W'35' 'OUT-DEV NOT OPERABLE' OUT PERF COND SET/CLEAR CONDITION REG. RET PEND * * RELEASE DE-PRINTER. MUST BE PERFORMED AFTER PRINTOUT. * DETPRT PROC DSC1 DEDSPRT,DETACH,W0 RET PEND * * THIS ROUTINE CALCULATE FIELDNUMBER FOR A * RELATIVE FIELD ADRESSING TYP + OR - * DEFIND PROC VAR1,VAR2 PBIN VAR1 PBIN VAR2 XCOPY VAR1,W1,W1,BPOOL(BIN11),BIN12 CBL VAR1,=W'254',UTFIN ADD BIN12,W1 XCOPY VAR2,W1,W1,BPOOL(BIN11),BIN12 GETABX BIN16 CBNE VAR1,=W'254',DEFI00 MOVE VAR1,BIN16 SUB VAR1,VAR2 RET DEFI00 ADD VAR2,BIN16 MOVE VAR1,VAR2 UTFIN RET PEND EJECT * * FORMATS * F00ST FRMT FSL FUL FCOPY =C'PTS' FILLR ' ',1 FCOPY =C'DATA' FILLR ' ',1 FCOPY =C'ENTRY' FILLR ' ',5 FCOPY =C'REL 10.0' FNUL FNL FNL FCOPY =C'PROGRAM:' FKI 9,MINL=2,MAXL=2,ME,NEOI,APPL=1 FMEL 'XX',PRNUM FBF BOOL1,F00OUT FNL FCOPY =C'10 SUPERVISORY FUNCTIONS' FNL FTEXT '20 ' FCOPY =C'FORMAT' FILLR '-',1 FCOPY =C'DEFINITION' FNL FTEXT '30 ' FCOPY =C'JOB' FILLR '-',1 FCOPY =C'DEFINITION' FNL FTEXT '40 ' FCOPY =C'ENTRY' FILLR ' ',1 FCOPY =C'MODE' FNL FTEXT '50 ' FCOPY =C'SEARCH' FILLR ' ',1 FCOPY =C'MODE' FNL FTEXT '60 ' FCOPY =C'VERIFY' FILLR ' ',1 FCOPY =C'MODE' FNL FCOPY =C'70 CONVERSION' FILLR ' ',1 FCOPY =C'MODE' FNL F00OUT FMEND F00RET FRMT FSL FTEXT 'RETURN FROM DATA-ENTRY' FNL FKI 1 FCOPY HEX00 FMEND EJECT ******************************* * TABLE = VALUE-SET NO. * * TIME = SIZE OF ELEMENTS * * ACK(W1) = ELEMENT NO. * ******************************* VSET FRMT FSL FMEL '99',PRNUM FBT BOOL1,F13 FCOPY =C' CREATE' FB F12A F13 FCOPY =C' GET' F12A FCOPY =C' VALUE-SETS' FNL FCOPY =C'NAME: T' FBT BOOL2,F12B FINP 7 FCOPY TABLE FB F12C F12B 2 LINES FKI 8,NUM,MINL=2,MAXL=2,ME,NCLR,NEOI,APPL=101 FCOPY STR6A FB F12UT F12C FLINK F121 F12UT FMEND * F121 FRMT FNL FCOPY =C'TYPE:' FBT BOOL3,F121A FBF BOOL1,F124 IF CREATE F121A FINP 7 FCOPY STR2A FB F125 F124 FKI 7,MINL=1,MAXL=1,ALPHA,NEOI,ME,NCLR,APPL=102 A/N FCOPY STR2A F125 FTAB 10 FCOPY =C'SIZE OF ' FCOPY =C'ELEMENT' FCOPY =C'S:' FBT BOOL3,F125A FBF BOOL1,F127 IF CREATE F125A FINP 28 FMEL 'XX',TIME FB F128 F127 FKI 28,MINL=1,MAXL=2,NEOI,ME,NCLR,REWRT,APPL=103 <61 FMEL 'XX',TIME F128 FNL FCOPY =C'ELEMENT' FCOPY =C' NO.:' FBF BOOL3,FEND IF LINE 1-3 FINP 13 ENTER FMEL 'XX',ACK(W1) FNL * FLINK STR64A FCTL X'DE',STR64A FEND FMEND * FORMN FRMT FKI 1,NUM,MINL=1,MAXL=1,REWRT,SCHK=1 FMEL 'XXXXXXXXXXXXXXXXXXXXX-',FDVBCD(BIN6) FNL FKI 1,MINL=0,MAXL=0 FCOPY HEX00 FMEND * FORMA FRMT * FKI 1,ALPHA,MINL=1,MAXL=1,NEOI,ME * FCOPY FDVBCD(BIN6) FCTL X'F0',1,X'C1',X'01',X'00',X'C0',FDVBCD(BIN6) FNL FKI 1,MINL=0,MAXL=0 FCOPY HEX00 FMEND END