|
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: 14254 (0x37ae)
Notes: pts_type(SC)
Names: »PTSDE.SC«
└─⟦48601905a⟧ Bits:30009668 Philips computer tape "600121"
└─⟦this⟧ »S:DE/PTSDE.SC«
└─⟦d2a299635⟧ Bits:30009698 Philips computer tape "600415"
└─⟦this⟧ »S:DE/PTSDE.SC«
IDENT PTSDE REL 10.0 80-04-11 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 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 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 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;